licom.cgi

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