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                 $person->lastname  ($lastname)  if ($lastname  and $lastname  ne $person->lastname ());
 741                 $person->firstname ($firstname) if ($firstname and $firstname ne $person->firstname ());
 742
 743                 $cn = $person->name ();
 744
 745                 # Change the cn's saved in the groups
 746                 if ($old_cn ne $cn)
 747                 {
 748                         my @groups = LiCoM::Group->load_by_member ($old_cn);
 749                         for (@groups)
 750                         {
 751                                 # ->del_members automatically deleted the
 752                                 # group, if no more members exist. So this
 753                                 # order is important.
 754                                 $_->add_members ($cn);
 755                                 $_->del_members ($old_cn);
 756                         }
 757                 } # if ($old_cn ne $cn)
 758         }
 759
 760         my $contacts = get_contacts ();
 761
 762         for (@MultiFields)
 763         {
 764                 my $field = $_;
 765
 766                 next if (!$UserID and $field eq 'group');
 767
 768                 if (defined ($contacts->{$field}))
 769                 {
 770                         my $values = $contacts->{$field};
 771                         $person->set ($field, $values);
 772                 }
 773                 else
 774                 {
 775                         $person->set ($field, []);
 776                 }
 777         }
 778
 779         # only `authorized' users may see and change groups
 780         if ($UserID)
 781         {
 782                 my %changed_groups = map { $_ => 1 } (param_utf8 ('group'));
 783                 my @current_groups = LiCoM::Group->load_by_member ($cn);
 784
 785                 for (@current_groups)
 786                 {
 787                         my $group_obj = $_;
 788                         my $group_name = $group_obj->name ();
 789
 790                         if (!defined ($changed_groups{$group_name}))
 791                         {
 792                                 $group_obj->del_members ($cn);
 793                         }
 794                         else
 795                         {
 796                                 delete ($changed_groups{$group_name});
 797                         }
 798                 }
 799                 for (keys %changed_groups)
 800                 {
 801                         my $group_name = $_;
 802                         my $group_obj = LiCoM::Group->load ($group_name) or die;
 803
 804                         $group_obj->add_members ($cn);
 805                 }
 806
 807                 if (param_utf8 ('newgroup'))
 808                 {
 809                         # FIXME add error handling
 810                         my $group_name = param_utf8 ('newgroup');
 811                         LiCoM::Group->create ($group_name, '', $cn);
 812                 }
 813         }
 814
 815         if (!$UserID)
 816         {
 817                 print <<HTML;
 818                 <h3>Your changes have been saved.</h3>
 819                 <p>Thank you very much for taking the time to keep this record up to date.</p>
 820
 821 HTML
 822         }
 823
 824         if ($button eq 'apply' or !$UserID)
 825         {
 826                 action_edit (cn => $cn);
 827         }
 828         else
 829         {
 830                 action_detail ($cn);
 831         }
 832 }
 833
 834 sub action_vcard
 835 {
 836         my $cn = param_utf8 ('cn');
 837         $cn = shift if (@_);
 838         die unless ($cn);
 839
 840         my $person = LiCoM::Person->load ($cn);
 841         die unless ($person);
 842
 843         my %vcard_types =
 844         (
 845                 homephone       => 'TEL;TYPE=home,voice',
 846                 cellphone       => 'TEL;TYPE=cell',
 847                 officephone     => 'TEL;TYPE=work,voice',
 848                 fax             => 'TEL;TYPE=fax',
 849                 mail            => 'EMAIL',
 850                 uri             => 'URL',
 851                 group           => 'ORG'
 852         );
 853
 854         my $sn = $person->lastname ();
 855         my $gn = $person->firstname ();
 856         my $cn_esc = uri_escape_utf8 ($cn);
 857
 858         print <<EOF;
 859 Content-Type: text/x-vcard
 860 Content-Disposition: attachment; filename="$cn.vcf"
 861
 862 BEGIN:VCARD
 863 VERSION:3.0
 864 FN: $cn
 865 N: $sn;$gn
 866 EOF
 867
 868         for (@MultiFields)
 869         {
 870                 my $field = $_;
 871                 my $vc_fld = $vcard_types{$field};
 872                 my $values = $person->get ($field);
 873
 874                 next unless ($vc_fld);
 875
 876                 for (@$values)
 877                 {
 878                         my $value = $_;
 879                         print "$vc_fld:$value\n";
 880                 }
 881         }
 882         print "END:VCARD\n";
 883 }
 884
 885 sub action_verify
 886 {
 887         my $cn = param_utf8 ('cn');
 888         $cn = shift if (@_);
 889         die unless ($cn);
 890
 891         my $cn_html = encode_entities ($cn);
 892
 893         my $person = LiCoM::Person->load ($cn);
 894         die unless ($person);
 895
 896         my ($mail) = $person->get ('mail');
 897         $mail ||= '';
 898
 899         my $message;
 900         my ($password) = $person->get ('password');
 901         my $password_html;
 902
 903         if (!$password)
 904         {
 905                 $password = pwgen ();
 906                 $person->set ('password', [$password]);
 907         }
 908         $password_html = encode_entities ($password);
 909
 910         $message = qq(The password for the record &quot;$cn_html&quot; is &quot;$password_html&quot;.);
 911
 912         if ($mail)
 913         {
 914                 if (action_verify_send_mail ($person))
 915                 {
 916                         my $mail_html = encode_entities ($mail);
 917                         $message .= qq( A request for verification has been sent to $mail_html.);
 918                 }
 919         }
 920         else
 921         {
 922                 $message .= q( There was no e-mail address, thus no verification request could be sent.);
 923         }
 924
 925         print qq(\t\t<div class="message">$message</div>\n);
 926
 927         action_detail ($cn);
 928 }
 929
 930 sub action_verify_send_mail
 931 {
 932         my $person = shift;
 933         my $owner = LiCoM::Person->load ($UserCN);
 934         my $smh;
 935
 936         my ($owner_mail) = $owner->get ('mail');
 937         if (!$owner_mail)
 938         {
 939                 my $cn_uri = uri_escape_utf8 ($UserCN);
 940                 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);
 941                 return (0);
 942         }
 943
 944         my $max_width = 0;
 945         for (keys %FieldNames)
 946         {
 947                 $max_width = length $FieldNames{$_} if ($max_width < length $FieldNames{$_});
 948         }
 949         $max_width++;
 950
 951         my $person_name   = $person->name ();
 952         my ($person_mail) = $person->get ('mail');
 953         my $person_gn     = $person->firstname ();
 954         my ($password)    = $person->get ('password');
 955
 956         my $host = $ENV{'HTTP_HOST'};
 957         my $url = (defined ($ENV{'HTTPS'}) ? 'https://' : 'http://') . $host . $MySelf;
 958
 959         open ($smh, '|-', '/usr/sbin/sendmail', '-t', '-f', $owner_mail) or die ("open (sendmail): $!");
 960         print $smh <<EOM;
 961 To: $person_name <$person_mail>
 962 From: $UserCN <$owner_mail>
 963 Subject: Please verify our entry in my address book
 964
 965 Hello $person_gn,
 966
 967 the following is your entry in my address book:
 968 EOM
 969         for (@MultiFields)
 970         {
 971                 my $field = $_;
 972                 my $print = defined ($FieldNames{$field}) ? $FieldNames{$field} : $field;
 973                 my @values = $person->get ($field);
 974
 975                 for (@values)
 976                 {
 977                         printf $smh ('%'.$max_width."s: %-s\n", $print, $_);
 978                 }
 979         }
 980         print $smh <<EOM;
 981
 982 If this entry is outdated or incomplete, please take a minute and correct it.
 983   Address: $url
 984  Username: $person_name
 985  Password: $password
 986
 987 Thank you very much :)
 988
 989 Regards,
 990 $UserCN
 991 --
 992 This message was automatically generated by LiCoM,
 993 http://verplant.org/licom/
 994 EOM
 995         close ($smh);
 996
 997         return (1);
 998 }
 999
1000 sub action_ask_del
1001 {
1002         my $cn = param_utf8 ('cn');
1003         $cn or die;
1004
1005         my $person = LiCoM::Person->load ($cn);
1006         $person or die;
1007
1008         my $cn_uri  = uri_escape_utf8 ($cn);
1009         my $cn_html = encode_entities ($cn);
1010
1011         print <<EOF;
1012                 <h2>Really delete $cn_html?</h2>
1013
1014                 <div>
1015                         You are about to delete <strong>$cn_html</strong>.
1016                         Are you totally, absolutely sure you want to do this?
1017                 </div>
1018
1019                 <div class="menu">
1020                         [<a href="$MySelf?action=expunge&cn=$cn_uri">Yes, delete</a>]
1021                         [<a href="$MySelf?action=detail&cn=$cn_uri">No, keep</a>]
1022                 </div>
1023
1024 EOF
1025 }
1026
1027 sub action_do_del
1028 {
1029         my $cn = param_utf8 ('cn');
1030         $cn or die;
1031
1032         my $cn_html = encode_entities ($cn);
1033
1034         my $person = LiCoM::Person->load ($cn);
1035         $person or die;
1036
1037         $person->delete ();
1038
1039         print <<EOF;
1040                 <div>$cn_html has been deleted.</div>
1041
1042 EOF
1043         action_browse ();
1044 }
1045
1046 sub action_edit_group
1047 {
1048         my $group_name = param_utf8 ('group') or die;
1049
1050         my $group_name_html = encode_entities ($group_name);
1051
1052         my $group_obj = LiCoM::Group->load ($group_name);
1053
1054         if (!$group_obj)
1055         {
1056                 print qq(\t<div class="error">Group &quot;$group_name_html&quot; does not exist or could not be loaded.</div>\n);
1057                 return;
1058         }
1059
1060         $group_name_html = encode_entities ($group_obj->name ());
1061
1062         my $desc_html = encode_entities ($group_obj->description () || '');
1063
1064         print <<HTML;
1065         <h2>Edit contact group &quot;$group_name_html&quot;</h2>
1066         <form action="$MySelf" method="post" accept-charset="UTF-8">
1067           <input type="hidden" name="action" value="save_group" />
1068           <input type="hidden" name="group" value="$group_name_html" />
1069           <table>
1070             <tr>
1071               <th>Group Name</th>
1072               <td>$group_name_html</td>
1073             </tr>
1074             <tr>
1075               <th>Description</th>
1076               <td><input type="text" name="description" value="$desc_html"
1077                       onChange="updateTextbox ('description');"
1078                       onKeyUp="updateTextbox ('description');"
1079                       onBlur="updateTextbox ('description');"
1080               /></td>
1081             </tr>
1082             <tr>
1083               <th colspan="2"><input type="submit" name="button" value="Save" /></th>
1084             </tr>
1085           </table>
1086         </form>
1087 HTML
1088 }
1089
1090 sub action_save_group
1091 {
1092         my $group_name = param_utf8 ('group') or die;
1093
1094         my $group_name_html = encode_entities ($group_name);
1095
1096         my $group_obj = LiCoM::Group->load ($group_name);
1097
1098         if (!$group_obj)
1099         {
1100                 print qq(\t<div class="error">Group &quot;$group_name_html&quot; does not exist or could not be loaded.</div>\n);
1101                 return;
1102         }
1103
1104         my $desc = param_utf8 ('description');
1105         $group_obj->description ($desc);
1106
1107         action_browse ();
1108         return;
1109 }
1110
1111 sub html_start
1112 {
1113         my $title = shift;
1114         $title = q(Lightweight Contact Manager) unless ($title);
1115
1116         $title = encode_entities ($title);
1117
1118         print <<EOF;
1119 Content-Type: text/html; charset=UTF-8
1120
1121 <html>
1122         <head>
1123                 <title>$title</title>
1124                 <link rel="stylesheet" type="text/css" href="style.screen.css" media="screen" />
1125                 <link rel="stylesheet" type="text/css" href="style.print.css" media="print" />
1126                 <script type="text/javascript" src="html_entities.js"></script>
1127                 <script type="text/javascript">
1128 function updateTextbox (name)
1129 {
1130         var arrTb = document.getElementsByName (name);
1131         var objTb;
1132         var objStr;
1133
1134         if (!arrTb || (arrTb.length < 1))
1135                 return (true);
1136
1137         for (var i = 0; i < arrTb.length; i++)
1138         {
1139                 objStr = decode_entities (arrTb[i].value);
1140                 if (arrTb[i].value != objStr)
1141                 {
1142                         arrTb[i].value = objStr;
1143                         /* arrTb[i].focus (); */
1144                 }
1145         }
1146
1147         return (true);
1148 }
1149                 </script>
1150         </head>
1151
1152         <body>
1153 EOF
1154
1155         if ($UserID)
1156         {
1157                 my $search = param_utf8 ('search') || '';
1158                 $search = encode_entities ($search);
1159                 print <<EOF;
1160                 <div class="topmenu">
1161                         <form action="$MySelf" method="post" accept-charset="UTF-8">
1162                                 <input type="hidden" name="action" value="browse" />
1163                                 <input type="submit" name="button" value="Browse" />
1164                         </form>
1165                         <form action="$MySelf" method="post" accept-charset="UTF-8">
1166                                 <input type="hidden" name="action" value="search" />
1167                                 <input type="text" name="search" value="$search"
1168                                         onChange="updateTextbox ('search');"
1169                                         onKeyUp="updateTextbox ('search');"
1170                                         onBlur="updateTextbox ('search');"
1171                                 />
1172                                 <input type="submit" name="button" value="Search" />
1173                         </form>
1174                         <form action="$MySelf" method="post" accept-charset="UTF-8">
1175                                 <input type="hidden" name="action" value="edit" />
1176                                 <input type="hidden" name="dn" value="" />
1177                                 <input type="submit" name="button" value="Add New" />
1178                         </form>
1179                 </div>
1180 EOF
1181         }
1182         print "\t\t<h1>$title</h1>\n";
1183 }
1184
1185 sub html_end
1186 {
1187         print <<EOF;
1188                 <div class="foot">
1189                         &quot;Lightweight Contact Manager&quot;,
1190                         written 2005-2006 by <a href="http://verplant.org/">Florian octo Forster</a>
1191                         &lt;octo at verplant.org&gt;
1192                 </div>
1193         </body>
1194 </html>
1195 EOF
1196 }
1197
1198 sub pwgen
1199 {
1200         my $len = @_ ? shift : 6;
1201         my $retval = '';
1202
1203         while (!$retval)
1204         {
1205                 my $numbers = 0;
1206                 my $lchars  = 0;
1207                 my $uchars  = 0;
1208
1209                 while (length ($retval) < $len)
1210                 {
1211                         my $chr = int (rand (128));
1212
1213                         if ($chr >= 48 and $chr < 58)
1214                         {
1215                                 $numbers++;
1216                         }
1217                         elsif ($chr >= 65 and $chr < 91)
1218                         {
1219                                 $uchars++;
1220                         }
1221                         elsif ($chr >= 97 and $chr < 123)
1222                         {
1223                                 $lchars++;
1224                         }
1225                         else
1226                         {
1227                                 next;
1228                         }
1229                         $retval .= chr ($chr);
1230                 }
1231
1232                 $retval = '' if (!$numbers or !$lchars or !$uchars);
1233         }
1234
1235         return ($retval);
1236 }
1237
1238 sub verify_fields
1239 {
1240         my @errors = ();
1241         for (param_utf8 ('uri'))
1242         {
1243                 my $val = $_;
1244                 next unless ($val);
1245
1246                 if ($val !~ m#^[a-zA-Z]+://#)
1247                 {
1248                         push (@errors, 'URIs have to begin with a protocol, e.g. &quot;http://&quot;, &quot;ftp://&quot; etc.');
1249                         last;
1250                 }
1251         }
1252
1253         for (param_utf8 ('homephone'), param_utf8 ('cellphone'), param_utf8 ('officephone'), param_utf8 ('fax'))
1254         {
1255                 my $number = $_;
1256                 next unless ($number);
1257
1258                 if ($number !~ m/^\+[0-9 \-]+$/)
1259                 {
1260                         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;');
1261                         last;
1262                 }
1263         }
1264
1265         print qq(\t\t<div class="error">\n) if (@errors);
1266         for (my $i = 0; $i < scalar (@errors); $i++)
1267         {
1268                 my $e = $errors[$i];
1269
1270                 print "<br />\n" if ($i);
1271                 print "\t\t\t$e";
1272         }
1273         print qq(\n\t\t</div>\n\n) if (@errors);
1274
1275         return (scalar (@errors));
1276 }
1277
1278 sub markup_field
1279 {
1280         my $field = shift;
1281         my $value = shift;
1282
1283         my $value_uri  = uri_escape_utf8 ($value);
1284         my $value_html = encode_entities ($value);
1285
1286         if ($field eq 'group')
1287         {
1288                 return (qq(<a href="$MySelf?action=browse&group=$value_uri">$value_html</a>));
1289         }
1290         elsif ($field eq 'uri')
1291         {
1292                 if ($value =~ m#^([a-z]+)://(.+)$#)
1293                 {
1294                         $value_uri = $1 . '://' . uri_escape_utf8 ($2);
1295                         $value_uri =~ s#%2f#/#gi;
1296                 }
1297                 else
1298                 {
1299                         $value_uri = 'http://' . uri_escape_utf8 ($value);
1300                 }
1301                 return (qq(<a href="$value_uri" class="extern">$value_html</a>));
1302         }
1303         elsif ($field eq 'mail')
1304         {
1305                 $value_uri =~ s/%40/@/g;
1306                 return (qq(<a href="mailto:$value_uri" class="mail">$value_html</a>));
1307         }
1308         return ($value_html);
1309 }
1310
1311 sub get_contacts
1312 {
1313         my $contacts = @_ ? shift : {};
1314
1315         for (@MultiFields)
1316         {
1317                 my $field = $_;
1318                 my @values = grep { $_ } (param_utf8 ($field));
1319
1320                 next unless (@values);
1321
1322                 if ($field eq 'homephone' or $field eq 'cellphone' or $field eq 'officephone' or $field eq 'fax')
1323                 {
1324                         for (@values)
1325                         {
1326                                 $_ =~ s/[^0-9 \-]//g;
1327                                 $_ = '+' . $_ if ($_);
1328                         }
1329                 }
1330
1331                 $contacts->{$field} = [@values] if (@values);
1332         }
1333
1334         return ($contacts);
1335 }
1336
1337 sub is_valid_utf8
1338 {
1339         my $str = join ('', @_);
1340
1341         # Taken from here: <http://www.w3.org/International/questions/qa-forms-utf-8>
1342         return ($str =~ m/^(
1343      [\x09\x0A\x0D\x20-\x7E]            # ASCII
1344    | [\xC2-\xDF][\x80-\xBF]             # non-overlong 2-byte
1345    |  \xE0[\xA0-\xBF][\x80-\xBF]        # excluding overlongs
1346    | [\xE1-\xEC\xEE\xEF][\x80-\xBF]{2}  # straight 3-byte
1347    |  \xED[\x80-\x9F][\x80-\xBF]        # excluding surrogates
1348    |  \xF0[\x90-\xBF][\x80-\xBF]{2}     # planes 1-3
1349    | [\xF1-\xF3][\x80-\xBF]{3}          # planes 4-15
1350    |  \xF4[\x80-\x8F][\x80-\xBF]{2}     # plane 16
1351   )*$/x);
1352 }
1353
1354 sub param_utf8
1355 {
1356         my @args = @_;
1357         my @ret = ();
1358
1359         @ret = grep { is_valid_utf8 ($_) } (param (@args));
1360         $_ = decode ('UTF-8', $_) for (@ret);
1361         return (wantarray () ? @ret : $ret[0]);
1362 }
1363
1364 sub uri_escape_utf8
1365 {
1366         return (uri_escape (encode ('UTF-8', shift)));
1367 }