licom.cgi

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