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->get ('password');
 702
 703         if (!$password)
 704         {
 705                 $password = pwgen ();
 706                 $person->set ('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->get ('password');
 753
 754         my $host = $ENV{'HTTP_HOST'};
 755         my $url = (defined ($ENV{'HTTPS'}) ? 'https://' : '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 :)
 786
 787 Regards,
 788 $UserCN
 789 --
 790 This message was automatically generated by LiCoM,
 791 http://verplant.org/licom/
 792 EOM
 793         close ($smh);
 794
 795         return (1);
 796 }
 797
 798 sub action_ask_del
 799 {
 800         my $cn = param ('cn');
 801         $cn or die;
 802
 803         my $person = LiCoM::Person->load ($cn);
 804         $person or die;
 805
 806         my $cn_esc = uri_escape ($cn);
 807
 808         print <<EOF;
 809                 <h2>Really delete $cn?</h2>
 810
 811                 <div>
 812                         You are about to delete <strong>$cn</strong>. Are you
 813                         totally, absolutely sure you want to do this?
 814                 </div>
 815
 816                 <div class="menu">
 817                         [<a href="$MySelf?action=expunge&cn=$cn_esc">Yes, delete</a>]
 818                         [<a href="$MySelf?action=detail&cn=$cn_esc">No, keep</a>]
 819                 </div>
 820
 821 EOF
 822 }
 823
 824 sub action_do_del
 825 {
 826         my $cn = param ('cn');
 827         $cn or die;
 828
 829         my $person = LiCoM::Person->load ($cn);
 830         $person or die;
 831
 832         $person->delete ();
 833
 834         print <<EOF;
 835                 <div>$cn has been deleted.</div>
 836
 837 EOF
 838         action_browse ();
 839 }
 840
 841 sub html_start
 842 {
 843         my $title = shift;
 844         $title = q(Lightweight Contact Manager) unless ($title);
 845
 846         print <<EOF;
 847 Content-Type: text/html; charset=UTF-8
 848
 849 <html>
 850         <head>
 851                 <title>$title</title>
 852                 <style type="text/css">
 853                 <!--
 854                 \@media screen
 855                 {
 856                         a
 857                         {
 858                                 color: blue;
 859                                 background-color: inherit;
 860                                 text-decoration: none;
 861                         }
 862
 863                         a:hover
 864                         {
 865                                 text-decoration: underline;
 866                         }
 867
 868                         a:visited
 869                         {
 870                                 color: navy;
 871                                 background-color: inherit;
 872                         }
 873
 874                         body
 875                         {
 876                                 color: black;
 877                                 background-color: white;
 878                         }
 879
 880                         div.error
 881                         {
 882                                 color: red;
 883                                 background-color: yellow;
 884
 885                                 font-weight: bold;
 886                                 padding: 1ex;
 887                                 border: 2px solid red;
 888                         }
 889
 890                         div.foot
 891                         {
 892                                 color: gray;
 893                                 background-color: white;
 894
 895                                 position: fixed;
 896                                 top: auto;
 897                                 right: 0px;
 898                                 bottom: 0px;
 899                                 left: 0px;
 900
 901                                 font-size: x-small;
 902                                 text-align: right;
 903                                 border-top: 1px solid black;
 904                                 width: 100%;
 905                         }
 906
 907                         div.foot a
 908                         {
 909                                 color: black;
 910                                 background-color: inherit;
 911                                 text-decoration: none;
 912                         }
 913
 914                         div.foot a:hover
 915                         {
 916                                 text-decoration: underline;
 917                         }
 918
 919                         div.menu
 920                         {
 921                                 border-top: 1px solid black;
 922                                 margin-top: 1ex;
 923                                 font-weight: bold;
 924                         }
 925
 926                         div.menu a
 927                         {
 928                                 color: blue;
 929                                 background-color: transparent;
 930                         }
 931
 932                         div.topmenu
 933                         {
 934                                 margin-bottom: 1ex;
 935                                 padding-bottom: 1ex;
 936                                 border-bottom: 1px solid black;
 937                         }
 938
 939                         div.topmenu form
 940                         {
 941                                 display: inline;
 942                                 margin-right: 5ex;
 943                         }
 944
 945                         h1
 946                         {
 947                                 position: absolute;
 948                                 top: 1ex;
 949                                 right: 1ex;
 950                                 bottom: auto;
 951                                 left: auto;
 952
 953                                 font-size: 100%;
 954                                 font-weight: bold;
 955                         }
 956
 957                         img
 958                         {
 959                                 border: none;
 960                         }
 961
 962                         table.list
 963                         {
 964                                 width: 100%;
 965                         }
 966
 967                         table.list td
 968                         {
 969                                 empty-cells: show;
 970                         }
 971
 972                         td
 973                         {
 974                                 color: black;
 975                                 background-color: #cccccc;
 976                                 vertical-align: top;
 977                         }
 978
 979                         th
 980                         {
 981                                 color: black;
 982                                 background-color: #999999;
 983                                 padding: 0.3ex;
 984                                 text-align: left;
 985                                 vertical-align: top;
 986                         }
 987                 }
 988
 989                 \@media print
 990                 {
 991                         a
 992                         {
 993                                 color: inherit;
 994                                 background-color: inherit;
 995                                 text-decoration: underline;
 996                         }
 997
 998                         div.topmenu, div.menu
 999                         {
1000                                 display: none;
1001                         }
1002
1003                         div.foot
1004                         {
1005                                 font-size: 50%;
1006                                 text-align: right;
1007                         }
1008
1009                         h1
1010                         {
1011                                 display: none;
1012                         }
1013
1014                         h2
1015                         {
1016                                 font-size: 100%;
1017                         }
1018
1019                         table
1020                         {
1021                                 border-collapse: collapse;
1022                         }
1023
1024                         table.list
1025                         {
1026                                 width: 100%;
1027                         }
1028
1029                         table.list td
1030                         {
1031                                 empty-cells: show;
1032                         }
1033
1034                         table.list th
1035                         {
1036                                 border-bottom-width: 2px;
1037                         }
1038
1039                         td, th
1040                         {
1041                                 border: 1px solid black;
1042                                 vertical-align: top;
1043                         }
1044
1045                         th
1046                         {
1047                                 font-weight: bold;
1048                                 text-align: center;
1049                         }
1050                 }
1051                 //-->
1052                 </style>
1053         </head>
1054
1055         <body>
1056 EOF
1057
1058         if ($UserID)
1059         {
1060                 my $search = param ('search') || '';
1061                 print <<EOF;
1062                 <div class="topmenu">
1063                         <form action="$MySelf" method="post">
1064                                 <input type="hidden" name="action" value="browse" />
1065                                 <input type="submit" name="button" value="Browse" />
1066                         </form>
1067                         <form action="$MySelf" method="post">
1068                                 <input type="hidden" name="action" value="search" />
1069                                 <input type="text" name="search" value="$search" />
1070                                 <input type="submit" name="button" value="Search" />
1071                         </form>
1072                         <form action="$MySelf" method="post">
1073                                 <input type="hidden" name="action" value="edit" />
1074                                 <input type="hidden" name="dn" value="" />
1075                                 <input type="submit" name="button" value="Add New" />
1076                         </form>
1077                 </div>
1078 EOF
1079         }
1080         print "\t\t<h1>$title</h1>\n";
1081 }
1082
1083 sub html_end
1084 {
1085         print <<EOF;
1086                 <div class="foot">
1087                         &quot;Lightweight Contact Manager&quot;,
1088                         written 2005 by <a href="http://verplant.org/">Florian octo Forster</a>
1089                         &lt;octo at verplant.org&gt;
1090                 </div>
1091         </body>
1092 </html>
1093 EOF
1094 }
1095
1096 sub pwgen
1097 {
1098         my $len = @_ ? shift : 6;
1099         my $retval = '';
1100
1101         while (!$retval)
1102         {
1103                 my $numbers = 0;
1104                 my $lchars  = 0;
1105                 my $uchars  = 0;
1106
1107                 while (length ($retval) < $len)
1108                 {
1109                         my $chr = int (rand (128));
1110
1111                         if ($chr >= 48 and $chr < 58)
1112                         {
1113                                 $numbers++;
1114                         }
1115                         elsif ($chr >= 65 and $chr < 91)
1116                         {
1117                                 $uchars++;
1118                         }
1119                         elsif ($chr >= 97 and $chr < 123)
1120                         {
1121                                 $lchars++;
1122                         }
1123                         else
1124                         {
1125                                 next;
1126                         }
1127                         $retval .= chr ($chr);
1128                 }
1129
1130                 $retval = '' if (!$numbers or !$lchars or !$uchars);
1131         }
1132
1133         return ($retval);
1134 }
1135
1136 sub verify_fields
1137 {
1138         my @errors = ();
1139         for (param ('uri'))
1140         {
1141                 my $val = $_;
1142                 next unless ($val);
1143
1144                 if ($val !~ m#^[a-zA-Z]+://#)
1145                 {
1146                         push (@errors, 'URIs have to begin with a protocol, e.g. &quot;http://&quot;, &quot;ftp://&quot; etc.');
1147                         last;
1148                 }
1149         }
1150
1151         for (param ('homephone'), param ('cellphone'), param ('officephone'), param ('fax'))
1152         {
1153                 my $number = $_;
1154                 next unless ($number);
1155
1156                 if ($number !~ m/^\+[0-9 \-]+$/)
1157                 {
1158                         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;');
1159                         last;
1160                 }
1161         }
1162
1163         print qq(\t\t<div class="error">\n) if (@errors);
1164         for (my $i = 0; $i < scalar (@errors); $i++)
1165         {
1166                 my $e = $errors[$i];
1167
1168                 print "<br />\n" if ($i);
1169                 print "\t\t\t$e";
1170         }
1171         print qq(\n\t\t</div>\n\n) if (@errors);
1172
1173         return (scalar (@errors));
1174 }
1175
1176 sub get_contacts
1177 {
1178         my $contacts = @_ ? shift : {};
1179
1180         for (@MultiFields)
1181         {
1182                 my $field = $_;
1183                 my @values = grep { $_ } (param ($field));
1184
1185                 next unless (@values);
1186
1187                 if ($field eq 'homephone' or $field eq 'cellphone' or $field eq 'officephone' or $field eq 'fax')
1188                 {
1189                         for (@values)
1190                         {
1191                                 $_ =~ s/[^0-9 \-]//g;
1192                                 $_ = '+' . $_ if ($_);
1193                         }
1194                 }
1195
1196                 $contacts->{$field} = [@values] if (@values);
1197         }
1198
1199         return ($contacts);
1200 }