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