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