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