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 ($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         if ($UserID)
 503         {
 504                 my %c_groups = map { $_ => 1 } (@{$contacts->{'group'}});
 505                 my %a_groups = ();
 506                 my @a_persons = LiCoM::Person->search ();
 507
 508                 for (@a_persons)
 509                 {
 510                         $a_groups{$_} = 1 for ($_->get ('group'));
 511                 }
 512
 513                 print "\t\t\t<tr>\n",
 514                 "\t\t\t\t<th>", $FieldNames{'group'}, "</th>\n",
 515                 qq(\t\t\t\t<td><select name="group" multiple="multiple">\n);
 516                 for (sort (keys %a_groups))
 517                 {
 518                         my $group = $_;
 519                         my $selec = defined ($c_groups{$group}) ? ' selected="selected"' : '';
 520
 521                         print qq(\t\t\t\t\t<option value="$group"$selec>$group</option>\n);
 522                 }
 523                 print "\t\t\t\t</select></td>\n",
 524                 "\t\t\t</tr>\n";
 525         }
 526
 527         print <<EOF;
 528                         <tr>
 529                                 <th colspan="2" class="menu">
 530 EOF
 531         if ($UserID)
 532         {
 533                 print <<EOF;
 534                                         <input type="submit" name="button" value="Cancel" />
 535                                         <input type="submit" name="button" value="Apply" />
 536 EOF
 537         }
 538         print <<EOF;
 539                                         <input type="submit" name="button" value="Save" />
 540                                 </th>
 541                         </tr>
 542                 </table>
 543                 </form>
 544 EOF
 545 }
 546
 547 sub action_save
 548 {
 549         my $cn = $UserID ? param ('cn') : $UserCN;
 550
 551         if (verify_fields ())
 552         {
 553                 action_edit (cn => $cn);
 554                 return;
 555         }
 556
 557         if ($cn)
 558         {
 559                 action_update ();
 560                 return;
 561         }
 562
 563         die unless ($UserID);
 564
 565         my $button = lc (param ('button'));
 566         $button ||= 'save';
 567
 568         if ($button eq 'cancel')
 569         {
 570                 action_browse ();
 571                 return;
 572         }
 573
 574         if (!param ('lastname') or !param ('firstname'))
 575         {
 576                 print qq(\t<div class="error">You have to give both, first and lastname, to identify this record.</div>\n);
 577                 action_edit (cn => '');
 578                 return;
 579         }
 580
 581         my $lastname  = param ('lastname');
 582         my $firstname = param ('firstname');
 583
 584         my $contacts = get_contacts ();
 585
 586         my $person = LiCoM::Person->create (lastname => $lastname, firstname => $firstname, %$contacts);
 587
 588         if (!$person)
 589         {
 590                 print qq(\t<div class="error">Unable to save entry. Sorry.</div>\n);
 591                 return;
 592         }
 593
 594         $cn = $person->name ();
 595
 596         if ($button eq 'apply')
 597         {
 598                 action_edit (cn => $cn);
 599         }
 600         else
 601         {
 602                 action_detail ($cn);
 603         }
 604 }
 605
 606 sub action_update
 607 {
 608         my $cn = $UserID ? param ('cn') : $UserCN;
 609         my $person = LiCoM::Person->load ($cn);
 610
 611         die unless ($person);
 612
 613         my $button = lc (param ('button'));
 614         $button ||= 'save';
 615
 616         if ($UserID and $button eq 'cancel')
 617         {
 618                 action_detail ($cn);
 619                 return;
 620         }
 621
 622         if ($UserID)
 623         {
 624                 my $lastname  = param ('lastname');
 625                 my $firstname = param ('firstname');
 626
 627                 $person->lastname  ($lastname)  if ($lastname  and $lastname  ne $person->lastname ());
 628                 $person->firstname ($firstname) if ($firstname and $firstname ne $person->firstname ());
 629
 630                 $cn = $person->name ();
 631         }
 632
 633         my $contacts = get_contacts ();
 634
 635         for (@MultiFields)
 636         {
 637                 my $field = $_;
 638
 639                 next if (!$UserID and $field eq 'group');
 640
 641                 if (defined ($contacts->{$field}))
 642                 {
 643                         my $values = $contacts->{$field};
 644                         $person->set ($field, $values);
 645                 }
 646                 else
 647                 {
 648                         $person->set ($field, []);
 649                 }
 650         }
 651
 652         if ($button eq 'apply' or !$UserID)
 653         {
 654                 action_edit (cn => $cn);
 655         }
 656         else
 657         {
 658                 action_detail ($cn);
 659         }
 660 }
 661
 662 sub action_vcard
 663 {
 664         my $cn = param ('cn');
 665         $cn = shift if (@_);
 666         die unless ($cn);
 667
 668         my $person = LiCoM::Person->load ($cn);
 669         die unless ($person);
 670
 671         my %vcard_types =
 672         (
 673                 homephone       => 'TEL;TYPE=home,voice',
 674                 cellphone       => 'TEL;TYPE=cell',
 675                 officephone     => 'TEL;TYPE=work,voice',
 676                 fax             => 'TEL;TYPE=fax',
 677                 mail            => 'EMAIL',
 678                 uri             => 'URL',
 679                 group           => 'ORG'
 680         );
 681
 682         my $sn = $person->lastname ();
 683         my $gn = $person->firstname ();
 684         my $cn_esc = uri_escape ($cn);
 685
 686         print <<EOF;
 687 Content-Type: text/x-vcard
 688 Content-Disposition: attachment; filename="$cn.vcf"
 689
 690 BEGIN:VCARD
 691 VERSION:3.0
 692 FN: $cn
 693 N: $sn;$gn
 694 EOF
 695
 696         for (@MultiFields)
 697         {
 698                 my $field = $_;
 699                 my $vc_fld = $vcard_types{$field};
 700                 my $values = $person->get ($field);
 701
 702                 next unless ($vc_fld);
 703
 704                 for (@$values)
 705                 {
 706                         my $value = $_;
 707                         print "$vc_fld:$value\n";
 708                 }
 709         }
 710         print "END:VCARD\n";
 711 }
 712
 713 sub action_verify
 714 {
 715         my $cn = param ('cn');
 716         $cn = shift if (@_);
 717         die unless ($cn);
 718
 719         my $person = LiCoM::Person->load ($cn);
 720         die unless ($person);
 721
 722         my ($mail) = $person->get ('mail');
 723         $mail ||= '';
 724
 725         my $message;
 726         my $password = $person->get ('password');
 727
 728         if (!$password)
 729         {
 730                 $password = pwgen ();
 731                 $person->set ('password', $password);
 732         }
 733
 734         $message = qq(The password for the record &quot;$cn&quot; is &quot;$password&quot;.);
 735
 736         if ($mail)
 737         {
 738                 if (action_verify_send_mail ($person))
 739                 {
 740                         $message .= qq( A request for verification has been sent to $mail.);
 741                 }
 742         }
 743         else
 744         {
 745                 $message .= q( There was no e-mail address, thus no verification request could be sent.);
 746         }
 747
 748         print qq(\t\t<div class="message">$message</div>\n);
 749
 750         action_detail ($cn);
 751 }
 752
 753 sub action_verify_send_mail
 754 {
 755         my $person = shift;
 756         my $owner = LiCoM::Person->load ($UserCN);
 757         my $smh;
 758
 759         my ($owner_mail) = $owner->get ('mail');
 760         if (!$owner_mail)
 761         {
 762                 my $cn = uri_escape ($UserCN);
 763                 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);
 764                 return (0);
 765         }
 766
 767         my $max_width = 0;
 768         for (keys %FieldNames)
 769         {
 770                 $max_width = length $FieldNames{$_} if ($max_width < length $FieldNames{$_});
 771         }
 772         $max_width++;
 773
 774         my $person_name = $person->name ();
 775         my ($person_mail) = $person->get ('mail');
 776         my $person_gn = $person->firstname ();
 777         my $password = $person->get ('password');
 778
 779         my $host = $ENV{'HTTP_HOST'};
 780         my $url = (defined ($ENV{'HTTPS'}) ? 'https://' : 'http://') . $host . $MySelf;
 781
 782         open ($smh, "| /usr/sbin/sendmail -t -f $owner_mail") or die ("open pipe to sendmail: $!");
 783         print $smh <<EOM;
 784 To: $person_name <$person_mail>
 785 From: $UserCN <$owner_mail>
 786 Subject: Please verify our entry in my address book
 787
 788 Hello $person_gn,
 789
 790 the following is your entry in my address book:
 791 EOM
 792         for (@MultiFields)
 793         {
 794                 my $field = $_;
 795                 my $print = defined ($FieldNames{$field}) ? $FieldNames{$field} : $field;
 796                 my @values = $person->get ($field);
 797
 798                 for (@values)
 799                 {
 800                         printf $smh ('%'.$max_width."s: %-s\n", $print, $_);
 801                 }
 802         }
 803         print $smh <<EOM;
 804
 805 If this entry is outdated or incomplete, please take a minute and correct it.
 806   Address: $url
 807  Username: $person_name
 808  Password: $password
 809
 810 Thank you very much :)
 811
 812 Regards,
 813 $UserCN
 814 --
 815 This message was automatically generated by LiCoM,
 816 http://verplant.org/licom/
 817 EOM
 818         close ($smh);
 819
 820         return (1);
 821 }
 822
 823 sub action_ask_del
 824 {
 825         my $cn = param ('cn');
 826         $cn or die;
 827
 828         my $person = LiCoM::Person->load ($cn);
 829         $person or die;
 830
 831         my $cn_esc = uri_escape ($cn);
 832
 833         print <<EOF;
 834                 <h2>Really delete $cn?</h2>
 835
 836                 <div>
 837                         You are about to delete <strong>$cn</strong>. Are you
 838                         totally, absolutely sure you want to do this?
 839                 </div>
 840
 841                 <div class="menu">
 842                         [<a href="$MySelf?action=expunge&cn=$cn_esc">Yes, delete</a>]
 843                         [<a href="$MySelf?action=detail&cn=$cn_esc">No, keep</a>]
 844                 </div>
 845
 846 EOF
 847 }
 848
 849 sub action_do_del
 850 {
 851         my $cn = param ('cn');
 852         $cn or die;
 853
 854         my $person = LiCoM::Person->load ($cn);
 855         $person or die;
 856
 857         $person->delete ();
 858
 859         print <<EOF;
 860                 <div>$cn has been deleted.</div>
 861
 862 EOF
 863         action_browse ();
 864 }
 865
 866 sub html_start
 867 {
 868         my $title = shift;
 869         $title = q(Lightweight Contact Manager) unless ($title);
 870
 871         print <<EOF;
 872 Content-Type: text/html; charset=UTF-8
 873
 874 <html>
 875         <head>
 876                 <title>$title</title>
 877                 <style type="text/css">
 878                 <!--
 879                 \@media screen
 880                 {
 881                         a
 882                         {
 883                                 color: blue;
 884                                 background-color: inherit;
 885                                 text-decoration: none;
 886                         }
 887
 888                         a:hover
 889                         {
 890                                 text-decoration: underline;
 891                         }
 892
 893                         a:visited
 894                         {
 895                                 color: navy;
 896                                 background-color: inherit;
 897                         }
 898
 899                         body
 900                         {
 901                                 color: black;
 902                                 background-color: white;
 903                         }
 904
 905                         div.error
 906                         {
 907                                 color: red;
 908                                 background-color: yellow;
 909
 910                                 font-weight: bold;
 911                                 padding: 1ex;
 912                                 border: 2px solid red;
 913                         }
 914
 915                         div.foot
 916                         {
 917                                 color: gray;
 918                                 background-color: white;
 919
 920                                 position: fixed;
 921                                 top: auto;
 922                                 right: 0px;
 923                                 bottom: 0px;
 924                                 left: 0px;
 925
 926                                 font-size: x-small;
 927                                 text-align: right;
 928                                 border-top: 1px solid black;
 929                                 width: 100%;
 930                         }
 931
 932                         div.foot a
 933                         {
 934                                 color: black;
 935                                 background-color: inherit;
 936                                 text-decoration: none;
 937                         }
 938
 939                         div.foot a:hover
 940                         {
 941                                 text-decoration: underline;
 942                         }
 943
 944                         div.menu
 945                         {
 946                                 border-top: 1px solid black;
 947                                 margin-top: 1ex;
 948                                 font-weight: bold;
 949                         }
 950
 951                         div.menu a
 952                         {
 953                                 color: blue;
 954                                 background-color: transparent;
 955                         }
 956
 957                         div.topmenu
 958                         {
 959                                 margin-bottom: 1ex;
 960                                 padding-bottom: 1ex;
 961                                 border-bottom: 1px solid black;
 962                         }
 963
 964                         div.topmenu form
 965                         {
 966                                 display: inline;
 967                                 margin-right: 5ex;
 968                         }
 969
 970                         h1
 971                         {
 972                                 position: absolute;
 973                                 top: 1ex;
 974                                 right: 1ex;
 975                                 bottom: auto;
 976                                 left: auto;
 977
 978                                 font-size: 100%;
 979                                 font-weight: bold;
 980                         }
 981
 982                         img
 983                         {
 984                                 border: none;
 985                         }
 986
 987                         table.list
 988                         {
 989                                 width: 100%;
 990                         }
 991
 992                         table.list td
 993                         {
 994                                 empty-cells: show;
 995                         }
 996
 997                         td
 998                         {
 999                                 color: black;
1000                                 background-color: #cccccc;
1001                                 vertical-align: top;
1002                         }
1003
1004                         th
1005                         {
1006                                 color: black;
1007                                 background-color: #999999;
1008                                 padding: 0.3ex;
1009                                 text-align: left;
1010                                 vertical-align: top;
1011                         }
1012                 }
1013
1014                 \@media print
1015                 {
1016                         a
1017                         {
1018                                 color: inherit;
1019                                 background-color: inherit;
1020                                 text-decoration: underline;
1021                         }
1022
1023                         div.topmenu, div.menu
1024                         {
1025                                 display: none;
1026                         }
1027
1028                         div.foot
1029                         {
1030                                 font-size: 50%;
1031                                 text-align: right;
1032                         }
1033
1034                         h1
1035                         {
1036                                 display: none;
1037                         }
1038
1039                         h2
1040                         {
1041                                 font-size: 100%;
1042                         }
1043
1044                         table
1045                         {
1046                                 border-collapse: collapse;
1047                         }
1048
1049                         table.list
1050                         {
1051                                 width: 100%;
1052                         }
1053
1054                         table.list td
1055                         {
1056                                 empty-cells: show;
1057                         }
1058
1059                         table.list th
1060                         {
1061                                 border-bottom-width: 2px;
1062                         }
1063
1064                         td, th
1065                         {
1066                                 border: 1px solid black;
1067                                 vertical-align: top;
1068                         }
1069
1070                         th
1071                         {
1072                                 font-weight: bold;
1073                                 text-align: center;
1074                         }
1075                 }
1076                 //-->
1077                 </style>
1078         </head>
1079
1080         <body>
1081 EOF
1082
1083         if ($UserID)
1084         {
1085                 my $search = param ('search') || '';
1086                 print <<EOF;
1087                 <div class="topmenu">
1088                         <form action="$MySelf" method="post">
1089                                 <input type="hidden" name="action" value="browse" />
1090                                 <input type="submit" name="button" value="Browse" />
1091                         </form>
1092                         <form action="$MySelf" method="post">
1093                                 <input type="hidden" name="action" value="search" />
1094                                 <input type="text" name="search" value="$search" />
1095                                 <input type="submit" name="button" value="Search" />
1096                         </form>
1097                         <form action="$MySelf" method="post">
1098                                 <input type="hidden" name="action" value="edit" />
1099                                 <input type="hidden" name="dn" value="" />
1100                                 <input type="submit" name="button" value="Add New" />
1101                         </form>
1102                 </div>
1103 EOF
1104         }
1105         print "\t\t<h1>$title</h1>\n";
1106 }
1107
1108 sub html_end
1109 {
1110         print <<EOF;
1111                 <div class="foot">
1112                         &quot;Lightweight Contact Manager&quot;,
1113                         written 2005 by <a href="http://verplant.org/">Florian octo Forster</a>
1114                         &lt;octo at verplant.org&gt;
1115                 </div>
1116         </body>
1117 </html>
1118 EOF
1119 }
1120
1121 sub pwgen
1122 {
1123         my $len = @_ ? shift : 6;
1124         my $retval = '';
1125
1126         while (!$retval)
1127         {
1128                 my $numbers = 0;
1129                 my $lchars  = 0;
1130                 my $uchars  = 0;
1131
1132                 while (length ($retval) < $len)
1133                 {
1134                         my $chr = int (rand (128));
1135
1136                         if ($chr >= 48 and $chr < 58)
1137                         {
1138                                 $numbers++;
1139                         }
1140                         elsif ($chr >= 65 and $chr < 91)
1141                         {
1142                                 $uchars++;
1143                         }
1144                         elsif ($chr >= 97 and $chr < 123)
1145                         {
1146                                 $lchars++;
1147                         }
1148                         else
1149                         {
1150                                 next;
1151                         }
1152                         $retval .= chr ($chr);
1153                 }
1154
1155                 $retval = '' if (!$numbers or !$lchars or !$uchars);
1156         }
1157
1158         return ($retval);
1159 }
1160
1161 sub verify_fields
1162 {
1163         my @errors = ();
1164         for (param ('uri'))
1165         {
1166                 my $val = $_;
1167                 next unless ($val);
1168
1169                 if ($val !~ m#^[a-zA-Z]+://#)
1170                 {
1171                         push (@errors, 'URIs have to begin with a protocol, e.g. &quot;http://&quot;, &quot;ftp://&quot; etc.');
1172                         last;
1173                 }
1174         }
1175
1176         for (param ('homephone'), param ('cellphone'), param ('officephone'), param ('fax'))
1177         {
1178                 my $number = $_;
1179                 next unless ($number);
1180
1181                 if ($number !~ m/^\+[0-9 \-]+$/)
1182                 {
1183                         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;');
1184                         last;
1185                 }
1186         }
1187
1188         print qq(\t\t<div class="error">\n) if (@errors);
1189         for (my $i = 0; $i < scalar (@errors); $i++)
1190         {
1191                 my $e = $errors[$i];
1192
1193                 print "<br />\n" if ($i);
1194                 print "\t\t\t$e";
1195         }
1196         print qq(\n\t\t</div>\n\n) if (@errors);
1197
1198         return (scalar (@errors));
1199 }
1200
1201 sub get_contacts
1202 {
1203         my $contacts = @_ ? shift : {};
1204
1205         for (@MultiFields)
1206         {
1207                 my $field = $_;
1208                 my @values = grep { $_ } (param ($field));
1209
1210                 next unless (@values);
1211
1212                 if ($field eq 'homephone' or $field eq 'cellphone' or $field eq 'officephone' or $field eq 'fax')
1213                 {
1214                         for (@values)
1215                         {
1216                                 $_ =~ s/[^0-9 \-]//g;
1217                                 $_ = '+' . $_ if ($_);
1218                         }
1219                 }
1220
1221                 $contacts->{$field} = [@values] if (@values);
1222         }
1223
1224         return ($contacts);
1225 }