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