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