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