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