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