licom.cgi

   1 #!/usr/bin/perl
   2
   3 # LiCoM - Lightweight contact manager
   4 # Copyright (c) 2005-2006  Florian octo Forster <octo at verplant.org>
   5 #
   6 # This program is free software; you can redistribute it and/or modify it under
   7 # the terms of the GNU General Public License as published by the Free Software
   8 # Foundation; only version 2 of the License is applicable.
   9 #
  10 # This program is distributed in the hope that it will be useful, but WITHOUT
  11 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  12 # FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
  13 # details.
  14 #
  15 # You should have received a copy of the GNU General Public License along with
  16 # this program; if not, write to the Free Software # Foundation, Inc.,
  17 # 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  18
  19 use strict;
  20 use warnings;
  21 use lib (qw(lib));
  22
  23 use CGI (':cgi');
  24 use CGI::Carp (qw(fatalsToBrowser));
  25 use URI::Escape;
  26 use HTML::Entities (qw(encode_entities));
  27 use Data::Dumper;
  28
  29 use LiCoM::Config (qw(get_config set_config read_config));
  30 use LiCoM::Connection ();
  31 use LiCoM::Group ();
  32 use LiCoM::Person ();
  33
  34 our $Debug = 0;
  35
  36 our @MultiFields = (qw(address homephone cellphone officephone fax mail uri));
  37
  38 our %FieldNames =
  39 (
  40         address         => 'Address',
  41         homephone       => 'Home Phone',
  42         cellphone       => 'Cell Phone',
  43         officephone     => 'Office Phone',
  44         fax             => 'FAX',
  45         mail            => 'E-Mail',
  46         uri             => 'URI (Homepage)',
  47         group           => 'Group'
  48 );
  49
  50 our $MySelf = $ENV{'SCRIPT_NAME'};
  51
  52 our $Action = param ('action');
  53 $Action ||= 'default';
  54
  55 our %Actions =
  56 (
  57         browse  => [\&html_start, \&action_browse,  \&html_end],
  58         default => [\&html_start, \&action_browse,  \&html_end],
  59         detail  => [\&html_start, \&action_detail,  \&html_end],
  60         edit    => [\&html_start, \&action_edit,    \&html_end],
  61         list    => [\&html_start, \&action_list,    \&html_end],
  62         save    => [\&html_start, \&action_save,    \&html_end],
  63         search  => [\&html_start, \&action_search,  \&html_end],
  64         verify  => [\&html_start, \&action_verify,  \&html_end],
  65         delete  => [\&html_start, \&action_ask_del,  \&html_end],
  66         expunge => [\&html_start, \&action_do_del,  \&html_end],
  67         vcard   => \&action_vcard
  68 );
  69
  70 read_config ();
  71
  72 # make sure AuthLDAPRemoteUserIsDN is enabled.
  73 die unless ($ENV{'REMOTE_USER'});
  74 set_config ('base_dn', $ENV{'REMOTE_USER'});
  75
  76 die unless (defined (get_config ('uri'))
  77         and defined (get_config ('base_dn'))
  78         and defined (get_config ('bind_dn'))
  79         and defined (get_config ('password')));
  80
  81 LiCoM::Connection->connect
  82 (
  83         uri      => get_config ('uri'),
  84         bind_dn  => get_config ('bind_dn'),
  85         password => get_config ('password')
  86 ) or die;
  87
  88 our ($UserCN, $UserID) = LiCoM::Person->get_user ($ENV{'REMOTE_USER'});
  89
  90 if (!$UserID and $Action ne 'save')
  91 {
  92         $Action = 'edit';
  93 }
  94
  95 if (!$UserCN)
  96 {
  97         die;
  98 }
  99
 100 if (!defined ($Actions{$Action}))
 101 {
 102         die;
 103 }
 104
 105 if (ref ($Actions{$Action}) eq 'CODE')
 106 {
 107         $Actions{$Action}->();
 108 }
 109 elsif (ref ($Actions{$Action}) eq 'ARRAY')
 110 {
 111         for (@{$Actions{$Action}})
 112         {
 113                 $_->();
 114         }
 115 }
 116
 117 LiCoM::Connection->disconnect ();
 118
 119 exit (0);
 120
 121 ###
 122
 123 sub action_browse
 124 {
 125         my $group = param ('group');
 126         $group = shift if (@_);
 127         $group ||= '';
 128
 129         if (!$group)
 130         {
 131                 my @groups = LiCoM::Group->all ();
 132
 133                 print qq(\t\t<h2>Contact Groups</h2>\n\t\t<ul class="groups">\n);
 134                 for (@groups)
 135                 {
 136                         my $group = $_;
 137                         my @members = $group->get_members ();
 138                         my $members = scalar (@members);
 139                         my $group_name = $group->name ();
 140                         my $group_esc  = uri_escape ($group_name);
 141                         my $desc = $group->description ();
 142
 143                         print qq#\t\t\t<li><a href="$MySelf?action=browse&group=$group_esc">#,
 144                         encode_entities ($group_name),
 145                         qq#</a> ($members Member#, ($members == 1 ? ')' : 's)');
 146                         print qq(<br />\n\t\t\t\t<span class="description">),
 147                         encode_entities ($desc) . '</span>' if ($desc);
 148                         print "</li>\n";
 149                 }
 150                 if (!@groups)
 151                 {
 152                         print qq(\t\t\t<li class="empty">There are no groups yet.</li>\n);
 153                 }
 154                 print <<EOF;
 155                 </ul>
 156                 <div class="menu">
 157                         [<a href="$MySelf?action=list">List&nbsp;all</a>]
 158                 </div>
 159 EOF
 160         }
 161         else
 162         {
 163                 my $group_obj = LiCoM::Group->load ($group);
 164                 my $group_esc = uri_escape ($group_obj->name ());
 165                 my @member_names = $group_obj->get_members ();
 166
 167                 print qq(\t\t<h2>Contact Group &quot;$group&quot;</h2>\n),
 168                 qq(\t\t<ul class="results">\n);
 169                 for (sort (@member_names))
 170                 {
 171                         my $cn = $_;
 172                         my $cn_esc = uri_escape ($cn);
 173
 174                         print qq(\t\t\t<li><a href="$MySelf?action=detail&cn=$cn_esc">$cn</a></li>\n);
 175                 }
 176
 177                 print <<EOF;
 178                 </ul>
 179                 <div class="menu">
 180                         [<a href="$MySelf?action=list&group=$group_esc">List</a>]
 181                         [<a href="$MySelf?action=browse">Back</a>]
 182                         [Edit]
 183                 </div>
 184 EOF
 185         }
 186 }
 187
 188 sub action_list
 189 {
 190         my $group = param ('group');
 191         $group = shift if (@_);
 192         $group ||= '';
 193
 194         my $title = $group ? "List of group &quot;$group&quot;" : 'List of all addresses';
 195         my @fields = (qw(address homephone cellphone officephone fax mail));
 196
 197         my @all = ();
 198         if ($group)
 199         {
 200                 @all = LiCoM::Person->search ([[group => $group]]);
 201         }
 202         else
 203         {
 204                 @all = LiCoM::Person->search ();
 205         }
 206
 207         print <<EOF;
 208                 <h2>$title</h2>
 209
 210                 <table class="list">
 211                         <tr>
 212                                 <th>Name</th>
 213 EOF
 214         for (@fields)
 215         {
 216                 print "\t\t\t\t<th>" . (defined ($FieldNames{$_}) ? $FieldNames{$_} : $_) . "</th>\n";
 217         }
 218         print "\t\t\t</tr>\n";
 219
 220         for (sort { $a->name () cmp $b->name () } (@all))
 221         {
 222                 my $person = $_;
 223                 my $sn = $person->lastname ();
 224                 my $gn = $person->firstname ();
 225
 226                 print "\t\t\t<tr>\n",
 227                 "\t\t\t\t<td>$sn, $gn</td>\n";
 228
 229                 for (@fields)
 230                 {
 231                         my $field = $_;
 232                         my @values = $person->get ($field);
 233                         print "\t\t\t\t<td>" . join ('<br />', map { encode_entities ($_) } (@values)) . "</td>\n";
 234                 }
 235
 236                 print "\t\t\t</tr>\n";
 237         }
 238         print "\t\t</table>\n\n";
 239
 240         if ($group)
 241         {
 242                 my $group_esc = uri_escape ($group);
 243                 print qq(\t\t<div class="menu">[<a href="$MySelf?action=browse&group=$group_esc">Back</a>]</div>\n);
 244         }
 245         else
 246         {
 247                 print qq(\t\t<div class="menu">[<a href="$MySelf?action=browse">Back</a>]</div>\n);
 248         }
 249 }
 250
 251 sub action_detail
 252 {
 253         my $cn = param ('cn');
 254         $cn = shift if (@_);
 255         die unless ($cn);
 256
 257         my $cn_html = encode_entities ($cn);
 258         my $cn_uri  = uri_escape ($cn);
 259
 260         my $person = LiCoM::Person->load ($cn);
 261         if (!$person)
 262         {
 263                 print qq(\t<div>Entry &quot;$cn_html&quot; could not be loaded from DB.</div>\n);
 264                 return;
 265         }
 266
 267         print qq(\t\t<h2>Details for $cn_html</h2>\n);
 268
 269         print <<EOF;
 270                 <table class="detail">
 271                         <tr>
 272                                 <th>Name</th>
 273                                 <td>$cn_html</td>
 274                         </tr>
 275 EOF
 276         for (@MultiFields)
 277         {
 278                 my $field = $_;
 279                 my $values = $person->get ($field);
 280                 my $num = scalar (@$values);
 281                 my $field_name = defined ($FieldNames{$field}) ? $FieldNames{$field} : $field;
 282
 283                 next unless ($num);
 284
 285                 $field_name = encode_entities ($field_name);
 286
 287                 print "\t\t\t<tr>\n";
 288                 if ($num > 1)
 289                 {
 290                         print qq(\t\t\t\t<th rowspan="$num">$field_name</th>\n);
 291                 }
 292                 else
 293                 {
 294                         print qq(\t\t\t\t<th>$field_name</th>\n);
 295                 }
 296
 297                 for (my $i = 0; $i < $num; $i++)
 298                 {
 299                         my $val = $values->[$i];
 300                         my $val_uri  = uri_escape ($val);
 301                         my $val_html = encode_entities ($val);
 302
 303                         if ($field eq 'group')
 304                         {
 305                                 $val = qq(<a href="$MySelf?action=browse&group=$val_uri">$val_html</a>);
 306                         }
 307                         elsif ($field eq 'uri')
 308                         {
 309                                 if ($val =~ m#^([a-z]+)://(.+)$#)
 310                                 {
 311                                         $val_uri = $1 . '://' . uri_escape ($2);
 312                                 }
 313                                 else
 314                                 {
 315                                         $val_uri = 'http://' . uri_escape ($val);
 316                                 }
 317                                 $val = qq(<a href="$val_uri" class="extern">$val_html</a>);
 318                         }
 319                         elsif ($field eq 'mail')
 320                         {
 321                                 $val = qq(<a href="mailto:$val_uri" class="mail">$val_html</a>);
 322                         }
 323                         else
 324                         {
 325                                 $val = $val_html;
 326                         }
 327
 328                         print "\t\t\t<tr>\n" if ($i);
 329                         print "\t\t\t\t<td>$val</td>\n",
 330                         "\t\t\t</tr>\n";
 331                 }
 332         }
 333
 334         my @groups = LiCoM::Group->load_by_member ($cn);
 335         if (@groups)
 336         {
 337                 my $num = scalar (@groups);
 338                 print "\t\t\t<tr>\n",
 339                 "\t\t\t\t<th", ($num == 1 ? '' : qq( rowspan="$num")), ">Group", ($num == 1 ? '' : 's'), "</th>\n";
 340                 for (my $i = 0; $i < $num; $i++)
 341                 {
 342                         my $group = $groups[$i];
 343                         my $group_name = $group->name ();
 344                         my $group_uri  = uri_escape ($group_name);
 345                         my $group_html = encode_entities ($group_name);
 346
 347                         print "\t\t\t<tr>\n" if ($i != 0);
 348                         print qq(\t\t\t\t<td><a href="$MySelf?action=browse&group=$group_uri">$group_html</a></td>\n),
 349                         "\t\t\t</tr>\n";
 350                 }
 351         }
 352
 353         print <<EOF;
 354                 </table>
 355
 356                 <div class="menu">
 357                         [<a href="$MySelf?action=verify&cn=$cn_uri">Verify</a>]
 358                         [<a href="$MySelf?action=vcard&cn=$cn_uri">vCard</a>]
 359                         [<a href="$MySelf?action=edit&cn=$cn_uri">Edit</a>]
 360                         [<a href="$MySelf?action=delete&cn=$cn_uri">Delete</a>]
 361                 </div>
 362
 363 EOF
 364 }
 365
 366 sub action_search
 367 {
 368         my $search = param ('search');
 369
 370         $search ||= '';
 371         $search =~ s/[^\s\w]//g;
 372
 373         if (!$search)
 374         {
 375                 print qq(\t<div class="error">Sorry, the empty search is not allowed.</div>\n);
 376                 action_default ();
 377                 return;
 378         }
 379
 380         my @patterns = split (m/\s+/, $search);
 381         my @filter = ();
 382
 383         for (@patterns)
 384         {
 385                 my $pattern = "$_*";
 386                 push (@filter, [[lastname => $pattern], [firstname => $pattern]]);
 387         }
 388
 389         my @matches = LiCoM::Person->search (@filter);
 390
 391         if (!@matches)
 392         {
 393                 print qq(\t<div>No entries matched your search.</div>\n);
 394                 return;
 395         }
 396
 397         if (scalar (@matches) == 1)
 398         {
 399                 my $person = shift (@matches);
 400                 my $cn = $person->name ();
 401                 action_detail ($cn);
 402                 return;
 403         }
 404
 405         print qq(\t<ul class="result">\n);
 406         for (sort { $a->name () cmp $b->name () } (@matches))
 407         {
 408                 my $person = $_;
 409                 my $cn = $person->name ();
 410                 my $cn_uri  = uri_escape ($cn);
 411                 my $cn_html = encode_entities ($cn);
 412
 413                 print qq(\t\t<li><a href="$MySelf?action=detail&cn=$cn_uri">$cn_html</a></li>\n);
 414         }
 415         print qq(\t</ul>\n);
 416 }
 417
 418 sub action_edit
 419 {
 420         my %opts = @_;
 421
 422         my $cn = param ('cn');
 423
 424         $cn = $opts{'cn'} if (defined ($opts{'cn'}));
 425         $cn ||= '';
 426
 427         my $cn_html = encode_entities ($cn);
 428
 429         if (!$UserID)
 430         {
 431                 $cn = $UserCN;
 432         }
 433
 434         my $person;
 435
 436         my $lastname;
 437         my $firstname;
 438
 439         my $contacts = {};
 440         $contacts->{$_} = [] for (@MultiFields);
 441
 442         if ($cn)
 443         {
 444                 $person = LiCoM::Person->load ($cn);
 445
 446                 if (!$person)
 447                 {
 448                         print qq(\t<div class="error">Unable to load CN &quot;$cn&quot;. Sorry.</div>\n);
 449                         return;
 450                 }
 451
 452                 $lastname    = $person->lastname ();
 453                 $firstname   = $person->firstname ();
 454
 455                 for (@MultiFields)
 456                 {
 457                         $contacts->{$_} = $person->get ($_);
 458                 }
 459         }
 460
 461         $lastname    = param ('lastname')    if (param ('lastname')  and $UserID);
 462         $firstname   = param ('firstname')   if (param ('firstname') and $UserID);
 463
 464         get_contacts ($contacts);
 465
 466         $lastname    =   $opts{'lastname'}     if (defined ($opts{'lastname'}));
 467         $firstname   =   $opts{'firstname'}    if (defined ($opts{'firstname'}));
 468         for (@MultiFields)
 469         {
 470                 my $field = $_;
 471                 @{$contacts->{$field}} = @{$opts{$field}} if (defined ($opts{$field}));
 472         }
 473
 474         if ($cn)
 475         {
 476                 print "\t\t<h2>Edit contact $cn_html</h2>\n";
 477         }
 478         else
 479         {
 480                 print "\t\t<h2>Create new contact</h2>\n";
 481         }
 482
 483         print <<EOF;
 484                 <form action="$MySelf" method="post">
 485                 <input type="hidden" name="action" value="save" />
 486                 <input type="hidden" name="cn" value="$cn_html" />
 487                 <table class="edit">
 488                         <tr>
 489                                 <th>Lastname</th>
 490 EOF
 491         if ($UserID)
 492         {
 493                 print qq(\t\t\t\t<td><input type="text" name="lastname" value="$lastname" /></td>\n);
 494         }
 495         else
 496         {
 497                 print qq(\t\t\t\t<td>$lastname</td>\n);
 498         }
 499         print <<EOF;
 500                         </tr>
 501                         <tr>
 502                                 <th>Firstname</th>
 503 EOF
 504         if ($UserID)
 505         {
 506                 print qq(\t\t\t\t<td><input type="text" name="firstname" value="$firstname" /></td>\n);
 507         }
 508         else
 509         {
 510                 print qq(\t\t\t\t<td>$firstname</td>\n);
 511         }
 512
 513         print "\t\t\t</tr>\n";
 514
 515         for (@MultiFields)
 516         {
 517                 my $field = $_;
 518                 my $print = defined ($FieldNames{$field}) ? $FieldNames{$field} : $field;
 519                 my @values = @{$contacts->{$field}};
 520
 521                 next if ($field eq 'group');
 522
 523                 push (@values, '');
 524
 525                 $field = encode_entities ($field);
 526                 $print = encode_entities ($print);
 527
 528                 for (@values)
 529                 {
 530                         my $value = encode_entities ($_);
 531
 532                         print <<EOF;
 533                         <tr>
 534                                 <th>$print</th>
 535                                 <td><input type="text" name="$field" value="$value" /></td>
 536                         </tr>
 537 EOF
 538                 }
 539         }
 540
 541         if ($UserID)
 542         {
 543                 my @all_groups = LiCoM::Group->all ();
 544
 545                 if (@all_groups)
 546                 {
 547                         print "\t\t\t<tr>\n",
 548                         "\t\t\t\t<th>Group(s)</th>\n",
 549                         qq(\t\t\t\t<td><select name="group" multiple="multiple" size="5">\n);
 550
 551                         for (@all_groups)
 552                         {
 553                                 my $group = $_;
 554                                 my $group_name = encode_entities ($group->name ());
 555                                 my $selected = '';
 556
 557                                 if (grep { $cn eq $_ } ($group->get_members ()))
 558                                 {
 559                                         $selected = ' selected="selected"';
 560                                 }
 561
 562                                 print qq(\t\t\t\t\t<option value="$group_name"$selected>$group_name</option>\n);
 563                         }
 564                         print "\t\t\t\t</select></td>\n",
 565                         "\t\t\t</tr>\n";
 566                 }
 567
 568                 print "\t\t\t<tr>\n",
 569                 "\t\t\t\t<th>New Group</th>\n",
 570                 qq(\t\t\t\t<td><input type="text" name="newgroup" value="" /></td>\n),
 571                 "\t\t\t</tr>\n";
 572         }
 573
 574         print <<EOF;
 575                         <tr>
 576                                 <th colspan="2" class="menu">
 577 EOF
 578         if ($UserID)
 579         {
 580                 print <<EOF;
 581                                         <input type="submit" name="button" value="Cancel" />
 582                                         <input type="submit" name="button" value="Apply" />
 583 EOF
 584         }
 585         print <<EOF;
 586                                         <input type="submit" name="button" value="Save" />
 587                                 </th>
 588                         </tr>
 589                 </table>
 590                 </form>
 591 EOF
 592 }
 593
 594 sub action_save
 595 {
 596         my $cn = $UserID ? param ('cn') : $UserCN;
 597
 598         if (verify_fields ())
 599         {
 600                 action_edit (cn => $cn);
 601                 return;
 602         }
 603
 604         if ($cn)
 605         {
 606                 action_update ();
 607                 return;
 608         }
 609
 610         die unless ($UserID);
 611
 612         my $button = lc (param ('button'));
 613         $button ||= 'save';
 614
 615         if ($button eq 'cancel')
 616         {
 617                 action_browse ();
 618                 return;
 619         }
 620
 621         if (!param ('lastname') or !param ('firstname'))
 622         {
 623                 print qq(\t<div class="error">You have to give both, first and lastname, to identify this record.</div>\n);
 624                 action_edit (cn => '');
 625                 return;
 626         }
 627
 628         my $lastname  = param ('lastname');
 629         my $firstname = param ('firstname');
 630
 631         my $contacts = get_contacts ();
 632
 633         my $person = LiCoM::Person->create (lastname => $lastname, firstname => $firstname, %$contacts);
 634
 635         if (!$person)
 636         {
 637                 print qq(\t<div class="error">Unable to save entry. Sorry.</div>\n);
 638                 return;
 639         }
 640
 641         $cn = $person->name ();
 642
 643         for (param ('group'))
 644         {
 645                 my $group_name = $_;
 646                 my $group = LiCoM::Group->load ($group_name);
 647
 648                 if ($group)
 649                 {
 650                         $group->add_members ($cn);
 651                 }
 652                 else
 653                 {
 654                         my $group_html = encode_entities ($group_name);
 655                         print qq(\t<div class="error">Group &quot;$group_html&quot; does not exist or could not be loaded.</div>\n);
 656                 }
 657         }
 658
 659         if (param ('newgroup'))
 660         {
 661                 # FIXME add error handling
 662                 my $group_name = param ('newgroup');
 663                 LiCoM::Group->create ($group_name, '', $cn);
 664         }
 665
 666         if ($button eq 'apply')
 667         {
 668                 action_edit (cn => $cn);
 669         }
 670         else
 671         {
 672                 action_detail ($cn);
 673         }
 674 }
 675
 676 sub action_update
 677 {
 678         my $cn = $UserID ? param ('cn') : $UserCN;
 679         my $person = LiCoM::Person->load ($cn);
 680
 681         die unless ($person);
 682
 683         my $button = lc (param ('button'));
 684         $button ||= 'save';
 685
 686         if ($UserID and $button eq 'cancel')
 687         {
 688                 action_detail ($cn);
 689                 return;
 690         }
 691
 692         if ($UserID)
 693         {
 694                 my $lastname  = param ('lastname');
 695                 my $firstname = param ('firstname');
 696
 697                 $person->lastname  ($lastname)  if ($lastname  and $lastname  ne $person->lastname ());
 698                 $person->firstname ($firstname) if ($firstname and $firstname ne $person->firstname ());
 699
 700                 $cn = $person->name ();
 701                 # FIXME Fix groups:
 702                 # Each group is one entry of type (objectClass=groupOfNames)
 703                 # with one or more `member' attributes. These attributes are
 704                 # the `dn' (distinguished name) of the member entries.
 705         }
 706
 707         my $contacts = get_contacts ();
 708
 709         for (@MultiFields)
 710         {
 711                 my $field = $_;
 712
 713                 next if (!$UserID and $field eq 'group');
 714
 715                 if (defined ($contacts->{$field}))
 716                 {
 717                         my $values = $contacts->{$field};
 718                         $person->set ($field, $values);
 719                 }
 720                 else
 721                 {
 722                         $person->set ($field, []);
 723                 }
 724         }
 725
 726         my %changed_groups = map { $_ => 1 } (param ('group'));
 727         my @current_groups = LiCoM::Group->load_by_member ($cn);
 728
 729         for (@current_groups)
 730         {
 731                 my $group_obj = $_;
 732                 my $group_name = $group_obj->name ();
 733
 734                 if (!defined ($changed_groups{$group_name}))
 735                 {
 736                         $group_obj->del_members ($cn);
 737                 }
 738                 else
 739                 {
 740                         delete ($changed_groups{$group_name});
 741                 }
 742         }
 743         for (keys %changed_groups)
 744         {
 745                 my $group_name = $_;
 746                 my $group_obj = LiCoM::Group->load ($group_name) or die;
 747
 748                 $group_obj->add_members ($cn);
 749         }
 750
 751         if (param ('newgroup'))
 752         {
 753                 # FIXME add error handling
 754                 my $group_name = param ('newgroup');
 755                 LiCoM::Group->create ($group_name, '', $cn);
 756         }
 757
 758         if ($button eq 'apply' or !$UserID)
 759         {
 760                 action_edit (cn => $cn);
 761         }
 762         else
 763         {
 764                 action_detail ($cn);
 765         }
 766 }
 767
 768 sub action_vcard
 769 {
 770         my $cn = param ('cn');
 771         $cn = shift if (@_);
 772         die unless ($cn);
 773
 774         my $person = LiCoM::Person->load ($cn);
 775         die unless ($person);
 776
 777         my %vcard_types =
 778         (
 779                 homephone       => 'TEL;TYPE=home,voice',
 780                 cellphone       => 'TEL;TYPE=cell',
 781                 officephone     => 'TEL;TYPE=work,voice',
 782                 fax             => 'TEL;TYPE=fax',
 783                 mail            => 'EMAIL',
 784                 uri             => 'URL',
 785                 group           => 'ORG'
 786         );
 787
 788         my $sn = $person->lastname ();
 789         my $gn = $person->firstname ();
 790         my $cn_esc = uri_escape ($cn);
 791
 792         print <<EOF;
 793 Content-Type: text/x-vcard
 794 Content-Disposition: attachment; filename="$cn.vcf"
 795
 796 BEGIN:VCARD
 797 VERSION:3.0
 798 FN: $cn
 799 N: $sn;$gn
 800 EOF
 801
 802         for (@MultiFields)
 803         {
 804                 my $field = $_;
 805                 my $vc_fld = $vcard_types{$field};
 806                 my $values = $person->get ($field);
 807
 808                 next unless ($vc_fld);
 809
 810                 for (@$values)
 811                 {
 812                         my $value = $_;
 813                         print "$vc_fld:$value\n";
 814                 }
 815         }
 816         print "END:VCARD\n";
 817 }
 818
 819 sub action_verify
 820 {
 821         my $cn = param ('cn');
 822         $cn = shift if (@_);
 823         die unless ($cn);
 824
 825         my $cn_html = encode_entities ($cn);
 826
 827         my $person = LiCoM::Person->load ($cn);
 828         die unless ($person);
 829
 830         my ($mail) = $person->get ('mail');
 831         $mail ||= '';
 832
 833         my $message;
 834         my ($password) = $person->get ('password');
 835         my $password_html;
 836
 837         if (!$password)
 838         {
 839                 $password = pwgen ();
 840                 $person->set ('password', [$password]);
 841         }
 842         $password_html = encode_entities ($password);
 843
 844         $message = qq(The password for the record &quot;$cn_html&quot; is &quot;$password_html&quot;.);
 845
 846         if ($mail)
 847         {
 848                 if (action_verify_send_mail ($person))
 849                 {
 850                         my $mail_html = encode_entities ($mail);
 851                         $message .= qq( A request for verification has been sent to $mail_html.);
 852                 }
 853         }
 854         else
 855         {
 856                 $message .= q( There was no e-mail address, thus no verification request could be sent.);
 857         }
 858
 859         print qq(\t\t<div class="message">$message</div>\n);
 860
 861         action_detail ($cn);
 862 }
 863
 864 sub action_verify_send_mail
 865 {
 866         my $person = shift;
 867         my $owner = LiCoM::Person->load ($UserCN);
 868         my $smh;
 869
 870         my ($owner_mail) = $owner->get ('mail');
 871         if (!$owner_mail)
 872         {
 873                 my $cn_uri = uri_escape ($UserCN);
 874                 print qq(\t\t<div class="error">You have no email set in your own profile. <a href="$MySelf?action=edit&cn=$cn_uri">Edit it now</a>!</div>\n);
 875                 return (0);
 876         }
 877
 878         my $max_width = 0;
 879         for (keys %FieldNames)
 880         {
 881                 $max_width = length $FieldNames{$_} if ($max_width < length $FieldNames{$_});
 882         }
 883         $max_width++;
 884
 885         my $person_name   = $person->name ();
 886         my ($person_mail) = $person->get ('mail');
 887         my $person_gn     = $person->firstname ();
 888         my ($password)    = $person->get ('password');
 889
 890         my $host = $ENV{'HTTP_HOST'};
 891         my $url = (defined ($ENV{'HTTPS'}) ? 'https://' : 'http://') . $host . $MySelf;
 892
 893         open ($smh, '|-', '/usr/sbin/sendmail', '-t', '-f', $owner_mail) or die ("open (sendmail): $!");
 894         print $smh <<EOM;
 895 To: $person_name <$person_mail>
 896 From: $UserCN <$owner_mail>
 897 Subject: Please verify our entry in my address book
 898
 899 Hello $person_gn,
 900
 901 the following is your entry in my address book:
 902 EOM
 903         for (@MultiFields)
 904         {
 905                 my $field = $_;
 906                 my $print = defined ($FieldNames{$field}) ? $FieldNames{$field} : $field;
 907                 my @values = $person->get ($field);
 908
 909                 for (@values)
 910                 {
 911                         printf $smh ('%'.$max_width."s: %-s\n", $print, $_);
 912                 }
 913         }
 914         print $smh <<EOM;
 915
 916 If this entry is outdated or incomplete, please take a minute and correct it.
 917   Address: $url
 918  Username: $person_name
 919  Password: $password
 920
 921 Thank you very much :)
 922
 923 Regards,
 924 $UserCN
 925 --
 926 This message was automatically generated by LiCoM,
 927 http://verplant.org/licom/
 928 EOM
 929         close ($smh);
 930
 931         return (1);
 932 }
 933
 934 sub action_ask_del
 935 {
 936         my $cn = param ('cn');
 937         $cn or die;
 938
 939         my $person = LiCoM::Person->load ($cn);
 940         $person or die;
 941
 942         my $cn_uri  = uri_escape ($cn);
 943         my $cn_html = encode_entities ($cn);
 944
 945         print <<EOF;
 946                 <h2>Really delete $cn_html?</h2>
 947
 948                 <div>
 949                         You are about to delete <strong>$cn_html</strong>.
 950                         Are you totally, absolutely sure you want to do this?
 951                 </div>
 952
 953                 <div class="menu">
 954                         [<a href="$MySelf?action=expunge&cn=$cn_uri">Yes, delete</a>]
 955                         [<a href="$MySelf?action=detail&cn=$cn_uri">No, keep</a>]
 956                 </div>
 957
 958 EOF
 959 }
 960
 961 sub action_do_del
 962 {
 963         my $cn = param ('cn');
 964         $cn or die;
 965
 966         my $cn_html = encode_entities ($cn);
 967
 968         my $person = LiCoM::Person->load ($cn);
 969         $person or die;
 970
 971         $person->delete ();
 972
 973         print <<EOF;
 974                 <div>$cn_html has been deleted.</div>
 975
 976 EOF
 977         action_browse ();
 978 }
 979
 980 sub html_start
 981 {
 982         my $title = shift;
 983         $title = q(Lightweight Contact Manager) unless ($title);
 984
 985         $title = encode_entities ($title);
 986
 987         print <<EOF;
 988 Content-Type: text/html; charset=UTF-8
 989
 990 <html>
 991         <head>
 992                 <title>$title</title>
 993                 <style type="text/css">
 994                 <!--
 995                 \@media screen
 996                 {
 997                         a
 998                         {
 999                                 color: blue;
1000                                 background-color: inherit;
1001                                 text-decoration: none;
1002                         }
1003
1004                         a:hover
1005                         {
1006                                 text-decoration: underline;
1007                         }
1008
1009                         a:visited
1010                         {
1011                                 color: navy;
1012                                 background-color: inherit;
1013                         }
1014
1015                         body
1016                         {
1017                                 color: black;
1018                                 background-color: white;
1019                         }
1020
1021                         div.error
1022                         {
1023                                 color: red;
1024                                 background-color: yellow;
1025
1026                                 font-weight: bold;
1027                                 padding: 1ex;
1028                                 border: 2px solid red;
1029                         }
1030
1031                         div.foot
1032                         {
1033                                 color: gray;
1034                                 background-color: white;
1035
1036                                 position: fixed;
1037                                 top: auto;
1038                                 right: 0px;
1039                                 bottom: 0px;
1040                                 left: 0px;
1041
1042                                 font-size: x-small;
1043                                 text-align: right;
1044                                 border-top: 1px solid black;
1045                                 width: 100%;
1046                         }
1047
1048                         div.foot a
1049                         {
1050                                 color: black;
1051                                 background-color: inherit;
1052                                 text-decoration: none;
1053                         }
1054
1055                         div.foot a:hover
1056                         {
1057                                 text-decoration: underline;
1058                         }
1059
1060                         div.menu
1061                         {
1062                                 border-top: 1px solid black;
1063                                 margin-top: 1ex;
1064                                 font-weight: bold;
1065                         }
1066
1067                         div.menu a
1068                         {
1069                                 color: blue;
1070                                 background-color: transparent;
1071                         }
1072
1073                         div.topmenu
1074                         {
1075                                 margin-bottom: 1ex;
1076                                 padding-bottom: 1ex;
1077                                 border-bottom: 1px solid black;
1078                         }
1079
1080                         div.topmenu form
1081                         {
1082                                 display: inline;
1083                                 margin-right: 5ex;
1084                         }
1085
1086                         h1
1087                         {
1088                                 position: absolute;
1089                                 top: 1ex;
1090                                 right: 1ex;
1091                                 bottom: auto;
1092                                 left: auto;
1093
1094                                 font-size: 100%;
1095                                 font-weight: bold;
1096                         }
1097
1098                         img
1099                         {
1100                                 border: none;
1101                         }
1102
1103                         table.list
1104                         {
1105                                 width: 100%;
1106                         }
1107
1108                         table.list td
1109                         {
1110                                 empty-cells: show;
1111                         }
1112
1113                         td
1114                         {
1115                                 color: black;
1116                                 background-color: #cccccc;
1117                                 vertical-align: top;
1118                         }
1119
1120                         th
1121                         {
1122                                 color: black;
1123                                 background-color: #999999;
1124                                 padding: 0.3ex;
1125                                 text-align: left;
1126                                 vertical-align: top;
1127                         }
1128                 }
1129
1130                 \@media print
1131                 {
1132                         a
1133                         {
1134                                 color: inherit;
1135                                 background-color: inherit;
1136                                 text-decoration: underline;
1137                         }
1138
1139                         div.topmenu, div.menu
1140                         {
1141                                 display: none;
1142                         }
1143
1144                         div.foot
1145                         {
1146                                 font-size: 50%;
1147                                 text-align: right;
1148                         }
1149
1150                         h1
1151                         {
1152                                 display: none;
1153                         }
1154
1155                         h2
1156                         {
1157                                 font-size: 100%;
1158                         }
1159
1160                         table
1161                         {
1162                                 border-collapse: collapse;
1163                         }
1164
1165                         table.list
1166                         {
1167                                 width: 100%;
1168                         }
1169
1170                         table.list td
1171                         {
1172                                 empty-cells: show;
1173                         }
1174
1175                         table.list th
1176                         {
1177                                 border-bottom-width: 2px;
1178                         }
1179
1180                         td, th
1181                         {
1182                                 border: 1px solid black;
1183                                 vertical-align: top;
1184                         }
1185
1186                         th
1187                         {
1188                                 font-weight: bold;
1189                                 text-align: center;
1190                         }
1191                 }
1192                 //-->
1193                 </style>
1194         </head>
1195
1196         <body>
1197 EOF
1198
1199         if ($UserID)
1200         {
1201                 my $search = param ('search') || '';
1202                 $search = encode_entities ($search);
1203                 print <<EOF;
1204                 <div class="topmenu">
1205                         <form action="$MySelf" method="post">
1206                                 <input type="hidden" name="action" value="browse" />
1207                                 <input type="submit" name="button" value="Browse" />
1208                         </form>
1209                         <form action="$MySelf" method="post">
1210                                 <input type="hidden" name="action" value="search" />
1211                                 <input type="text" name="search" value="$search" />
1212                                 <input type="submit" name="button" value="Search" />
1213                         </form>
1214                         <form action="$MySelf" method="post">
1215                                 <input type="hidden" name="action" value="edit" />
1216                                 <input type="hidden" name="dn" value="" />
1217                                 <input type="submit" name="button" value="Add New" />
1218                         </form>
1219                 </div>
1220 EOF
1221         }
1222         print "\t\t<h1>$title</h1>\n";
1223 }
1224
1225 sub html_end
1226 {
1227         print <<EOF;
1228                 <div class="foot">
1229                         &quot;Lightweight Contact Manager&quot;,
1230                         written 2005-2006 by <a href="http://verplant.org/">Florian octo Forster</a>
1231                         &lt;octo at verplant.org&gt;
1232                 </div>
1233         </body>
1234 </html>
1235 EOF
1236 }
1237
1238 sub pwgen
1239 {
1240         my $len = @_ ? shift : 6;
1241         my $retval = '';
1242
1243         while (!$retval)
1244         {
1245                 my $numbers = 0;
1246                 my $lchars  = 0;
1247                 my $uchars  = 0;
1248
1249                 while (length ($retval) < $len)
1250                 {
1251                         my $chr = int (rand (128));
1252
1253                         if ($chr >= 48 and $chr < 58)
1254                         {
1255                                 $numbers++;
1256                         }
1257                         elsif ($chr >= 65 and $chr < 91)
1258                         {
1259                                 $uchars++;
1260                         }
1261                         elsif ($chr >= 97 and $chr < 123)
1262                         {
1263                                 $lchars++;
1264                         }
1265                         else
1266                         {
1267                                 next;
1268                         }
1269                         $retval .= chr ($chr);
1270                 }
1271
1272                 $retval = '' if (!$numbers or !$lchars or !$uchars);
1273         }
1274
1275         return ($retval);
1276 }
1277
1278 sub verify_fields
1279 {
1280         my @errors = ();
1281         for (param ('uri'))
1282         {
1283                 my $val = $_;
1284                 next unless ($val);
1285
1286                 if ($val !~ m#^[a-zA-Z]+://#)
1287                 {
1288                         push (@errors, 'URIs have to begin with a protocol, e.g. &quot;http://&quot;, &quot;ftp://&quot; etc.');
1289                         last;
1290                 }
1291         }
1292
1293         for (param ('homephone'), param ('cellphone'), param ('officephone'), param ('fax'))
1294         {
1295                 my $number = $_;
1296                 next unless ($number);
1297
1298                 if ($number !~ m/^\+[0-9 \-]+$/)
1299                 {
1300                         push (@errors, 'Telephone numbers have to begin with the country code and only numbers, spaces and dashes are allowed, e.g. &quot;+49 911-123456&quot;');
1301                         last;
1302                 }
1303         }
1304
1305         print qq(\t\t<div class="error">\n) if (@errors);
1306         for (my $i = 0; $i < scalar (@errors); $i++)
1307         {
1308                 my $e = $errors[$i];
1309
1310                 print "<br />\n" if ($i);
1311                 print "\t\t\t$e";
1312         }
1313         print qq(\n\t\t</div>\n\n) if (@errors);
1314
1315         return (scalar (@errors));
1316 }
1317
1318 sub get_contacts
1319 {
1320         my $contacts = @_ ? shift : {};
1321
1322         for (@MultiFields)
1323         {
1324                 my $field = $_;
1325                 my @values = grep { $_ } (param ($field));
1326
1327                 next unless (@values);
1328
1329                 if ($field eq 'homephone' or $field eq 'cellphone' or $field eq 'officephone' or $field eq 'fax')
1330                 {
1331                         for (@values)
1332                         {
1333                                 $_ =~ s/[^0-9 \-]//g;
1334                                 $_ = '+' . $_ if ($_);
1335                         }
1336                 }
1337
1338                 $contacts->{$field} = [@values] if (@values);
1339         }
1340
1341         return ($contacts);
1342 }