licom.cgi

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