book.cgi

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5 use lib (qw(lib));
   6
   7 use CGI (':cgi');
   8 use CGI::Carp (qw(fatalsToBrowser));
   9 use URI::Escape;
  10 use Data::Dumper;
  11
  12 use Person;
  13
  14 our $Debug = 0;
  15 our %Config = ();
  16
  17 our @MultiFields = (qw(address homephone cellphone officephone fax mail uri group));
  18
  19 our %FieldNames =
  20 (
  21         address         => 'Address',
  22         homephone       => 'Home Phone',
  23         cellphone       => 'Cell Phone',
  24         officephone     => 'Office Phone',
  25         fax             => 'FAX',
  26         mail            => 'E-Mail',
  27         uri             => 'URI (Homepage)',
  28         group           => 'Group'
  29 );
  30
  31 our $MySelf = $ENV{'SCRIPT_NAME'};
  32
  33 our $Action = param ('action');
  34 $Action ||= 'default';
  35
  36 our %Actions =
  37 (
  38         browse  => [\&html_start, \&action_browse, \&html_end],
  39         default => [\&html_start, \&action_browse, \&html_end],
  40         detail  => [\&html_start, \&action_detail,  \&html_end],
  41         edit    => [\&html_start, \&action_edit,    \&html_end],
  42         save    => [\&html_start, \&action_save,    \&html_end],
  43         search  => [\&html_start, \&action_search,  \&html_end],
  44         vcard   => \&action_vcard
  45 );
  46
  47 read_config ();
  48
  49 # make sure AuthLDAPRemoteUserIsDN is enabled.
  50 die unless ($ENV{'REMOTE_USER'});
  51 $Config{'base_dn'} = $ENV{'REMOTE_USER'};
  52
  53 Person->connect
  54 (
  55         uri     => $Config{'uri'},
  56         base_dn => $Config{'base_dn'},
  57         bind_dn => $Config{'bind_dn'},
  58         password => $Config{'password'}
  59 ) or die;
  60
  61 our ($UserCN, $UserID) = Person->get_user ($Config{'base_dn'});
  62
  63 if (!$UserID and $Action ne 'save')
  64 {
  65         $Action = 'edit';
  66 }
  67
  68 if (!$UserCN)
  69 {
  70         die;
  71 }
  72
  73 if (!defined ($Actions{$Action}))
  74 {
  75         die;
  76 }
  77
  78 if (ref ($Actions{$Action}) eq 'CODE')
  79 {
  80         $Actions{$Action}->();
  81 }
  82 elsif (ref ($Actions{$Action}) eq 'ARRAY')
  83 {
  84         for (@{$Actions{$Action}})
  85         {
  86                 $_->();
  87         }
  88 }
  89
  90 #print qq#<div>Authenticated as ($UserCN, $UserID, #, $Config{'base_dn'}, qq#)</div>\n#;
  91
  92 Person->disconnect ();
  93
  94 exit (0);
  95
  96 ###
  97
  98 sub action_browse
  99 {
 100         my $group = param ('group');
 101         $group = shift if (@_);
 102         $group ||= '*';
 103
 104         my @all = Person->search ([[group => $group]]);
 105
 106         if ($group eq '*')
 107         {
 108                 my %groups = ();
 109                 for (@all)
 110                 {
 111                         my $person = $_;
 112                         my @g = $person->get ('group');
 113
 114                         $groups{$_} = 1 for (@g);
 115                 }
 116
 117                 print qq(\t<h2>Contact Groups</h2>\n\t<ul class="groups">\n);
 118                 for (sort (keys (%groups)))
 119                 {
 120                         my $group = $_;
 121                         my $group_esc = uri_escape ($group);
 122
 123                         print qq(\t\t<li><a href="$MySelf?action=browse&group=$group_esc">$group</a></li>\n);
 124                 }
 125                 print qq(\t</ul>\n);
 126         }
 127         else
 128         {
 129                 print qq(\t<h2>Contact Group &quot;$group&quot;</h2>\n\t<ul class="results">\n);
 130                 for (@all)
 131                 {
 132                         my $person = $_;
 133                         my $cn = $person->name ();
 134                         my $cn_esc = uri_escape ($cn);
 135
 136                         print qq(\t\t<li><a href="$MySelf?action=detail&cn=$cn_esc">$cn</a></li>\n);
 137                 }
 138                 print qq(\t</ul>\n);
 139         }
 140 }
 141
 142 sub action_detail
 143 {
 144         my $cn = param ('cn');
 145         $cn = shift if (@_);
 146         die unless ($cn);
 147
 148         my $person = Person->load ($cn);
 149         if (!$person)
 150         {
 151                 print qq(\t<div>Entry &quot;$cn&quot; could not be loaded from DB.</div>\n);
 152                 return;
 153         }
 154
 155         print qq(\t<h2>Details for $cn</h2>\n);
 156
 157         my $cn_esc = uri_escape ($cn);
 158
 159         print <<EOF;
 160         <table class="detail">
 161                 <tr>
 162                         <th>Name</th>
 163                         <td>$cn</td>
 164                 </tr>
 165 EOF
 166         for (@MultiFields)
 167         {
 168                 my $field = $_;
 169                 my $values = $person->get ($field);
 170                 my $num = scalar (@$values);
 171                 my $print = defined ($FieldNames{$field}) ? $FieldNames{$field} : $field;
 172
 173                 next unless ($num);
 174
 175                 print "\t\t<tr>\n";
 176                 if ($num > 1)
 177                 {
 178                         print qq(\t\t\t<th rowspan="$num">$print</th>\n);
 179                 }
 180                 else
 181                 {
 182                         print qq(\t\t\t<th>$print</th>\n);
 183                 }
 184
 185                 for (my $i = 0; $i < $num; $i++)
 186                 {
 187                         my $val = $values->[$i];
 188                         print "\t\t<tr>\n" if ($i);
 189                         print "\t\t\t<td>$val</td>\n",
 190                         "\t\t</tr>\n";
 191                 }
 192         }
 193         print <<EOF;
 194         </table>
 195         <div class="detail menu">
 196                 [<a href="$MySelf?action=edit&cn=$cn_esc">edit</a>]
 197                 [<a href="$MySelf?action=vcard&cn=$cn_esc">vCard</a>]
 198         </div>
 199 EOF
 200 }
 201
 202 sub action_search
 203 {
 204         my $search = param ('search');
 205
 206         $search ||= '';
 207         $search =~ s/[^\s\w]//g;
 208
 209         if (!$search)
 210         {
 211                 print qq(\t<div class="error">Sorry, the empty search is not allowed.</div>\n);
 212                 action_default ();
 213                 return;
 214         }
 215
 216         my @patterns = split (m/\s+/, $search);
 217         my @filter = ();
 218
 219         for (@patterns)
 220         {
 221                 my $pattern = "$_*";
 222                 push (@filter, [[lastname => $pattern], [firstname => $pattern]]);
 223         }
 224
 225         my @matches = Person->search (@filter);
 226
 227         if (!@matches)
 228         {
 229                 print qq(\t<div>No entries matched your search.</div>\n);
 230                 return;
 231         }
 232
 233         if (scalar (@matches) == 1)
 234         {
 235                 my $person = shift (@matches);
 236                 my $cn = $person->name ();
 237                 action_detail ($cn);
 238                 return;
 239         }
 240
 241         print qq(\t<ul class="result">\n);
 242         for (@matches)
 243         {
 244                 my $person = $_;
 245                 my $cn = $person->name ();
 246                 my $cn_esc = uri_escape ($cn);
 247
 248                 print qq(\t\t<li><a href="$MySelf?action=detail&cn=$cn_esc">$cn</a></li>\n);
 249         }
 250         print qq(\t</ul>\n);
 251 }
 252
 253 sub action_edit
 254 {
 255         my %opts = @_;
 256
 257         my $cn = param ('cn');
 258
 259         $cn = $opts{'cn'} if (defined ($opts{'cn'}));
 260         $cn ||= '';
 261
 262         if (!$UserID)
 263         {
 264                 $cn = $UserCN;
 265         }
 266
 267         my $person;
 268
 269         my $lastname;
 270         my $firstname;
 271
 272         my $contacts = {};
 273         $contacts->{$_} = [] for (@MultiFields);
 274
 275         if ($cn)
 276         {
 277                 $person = Person->load ($cn);
 278
 279                 if (!$person)
 280                 {
 281                         print qq(\t<div class="error">Unable to load CN &quot;$cn&quot;. Sorry.</div>\n);
 282                         return;
 283                 }
 284
 285                 $lastname    = $person->lastname ();
 286                 $firstname   = $person->firstname ();
 287                 $contacts->{'address'}     = $person->address ();
 288                 $contacts->{'homephone'}   = $person->homephone ();
 289                 $contacts->{'cellphone'}   = $person->cellphone ();
 290                 $contacts->{'officephone'} = $person->officephone ();
 291                 $contacts->{'fax'}         = $person->fax ();
 292                 $contacts->{'mail'}        = $person->mail ();
 293                 $contacts->{'uri'}         = $person->uri ();
 294                 $contacts->{'group'}       = $person->group ();
 295         }
 296
 297         $lastname    = param ('lastname')    if (param ('lastname')  and $UserID);
 298         $firstname   = param ('firstname')   if (param ('firstname') and $UserID);
 299
 300         get_contacts ($contacts);
 301
 302         $lastname    =   $opts{'lastname'}     if (defined ($opts{'lastname'}));
 303         $firstname   =   $opts{'firstname'}    if (defined ($opts{'firstname'}));
 304         for (@MultiFields)
 305         {
 306                 my $field = $_;
 307                 @{$contacts->{$field}} = @{$opts{$field}} if (defined ($opts{$field}));
 308         }
 309
 310         if ($cn)
 311         {
 312                 print "\t<h2>Edit contact $cn</h2>\n";
 313         }
 314         else
 315         {
 316                 print "\t<h2>Create new contact</h2>\n";
 317         }
 318
 319         my $selector = sub
 320         {
 321                 my $selected = @_ ? shift : '';
 322
 323                 my @options = ([none => '-- Contact --']);
 324
 325                 for (@MultiFields)
 326                 {
 327                         my $field = $_;
 328                         my $print = defined ($FieldNames{$field}) ? $FieldNames{$field} : $field;
 329                         push (@options, [$field, $print]);
 330                 }
 331
 332                 print qq(<select name="c_type">\n);
 333                 for (@options)
 334                 {
 335                         my ($field, $print) = @$_;
 336                         my $sel = $field eq $selected ? ' selected="selected"' : '';
 337                         print qq(\t\t\t\t<option value="$field"$sel>$print</option>\n);
 338                 }
 339                 print qq(\t\t\t</select>);
 340         };
 341
 342         print <<EOF;
 343         <form action="$MySelf" method="post">
 344         <input type="hidden" name="action" value="save" />
 345         <input type="hidden" name="cn" value="$cn" />
 346         <table class="edit">
 347                 <tr>
 348                         <td>Lastname</td>
 349 EOF
 350         if ($UserID)
 351         {
 352                 print qq(\t\t\t<td><input type="text" name="lastname" value="$lastname" /></td>\n);
 353         }
 354         else
 355         {
 356                 print qq(\t\t\t<td>$lastname</td>\n);
 357         }
 358         print <<EOF;
 359                 </tr>
 360                 <tr>
 361                         <td>Firstname</td>
 362 EOF
 363         if ($UserID)
 364         {
 365                 print qq(\t\t\t<td><input type="text" name="firstname" value="$firstname" /></td>\n);
 366         }
 367         else
 368         {
 369                 print qq(\t\t\t<td>$firstname</td>\n);
 370         }
 371
 372         print "\t\t</tr>\n";
 373
 374         for (@MultiFields)
 375         {
 376                 my $field = $_;
 377                 my @values = @{$contacts->{$field}};
 378
 379                 @values = ('') unless (@values);
 380
 381                 for (@values)
 382                 {
 383                         my $value = $_;
 384                         print "\t\t<tr>\n",
 385                         "\t\t\t<td>";
 386                         $selector->($field);
 387                         print "</td>\n", <<EOF;
 388                         <td><input type="text" name="c_value" value="$value" /></td>
 389                 </tr>
 390 EOF
 391                 }
 392         }
 393
 394         print "\t\t<tr>\n",
 395         "\t\t\t<td>";
 396         $selector->();
 397         print "</td>\n", <<EOF;
 398                         <td><input type="text" name="c_value" value="" /></td>
 399                 </tr>
 400                 <tr>
 401                         <td colspan="2"><input type="submit" name="button" value="Save" /></td>
 402                 </tr>
 403         </table>
 404         </form>
 405 EOF
 406 }
 407
 408 sub action_save
 409 {
 410         my $cn = $UserID ? param ('cn') : $UserCN;
 411
 412         if ($cn)
 413         {
 414                 action_update ();
 415                 return;
 416         }
 417
 418         die unless ($UserID);
 419
 420         if (!param ('lastname') or !param ('firstname'))
 421         {
 422                 print qq(\t<div class="error">You have to give both, first and lastname, to identify this record.</div>\n);
 423                 action_edit (cn => '');
 424                 return;
 425         }
 426
 427         my $lastname  = param ('lastname');
 428         my $firstname = param ('firstname');
 429
 430         my $contacts = get_contacts ();
 431
 432         my $person = Person->create (lastname => $lastname, firstname => $firstname, %$contacts);
 433
 434         if (!$person)
 435         {
 436                 print qq(\t<div class="error">Unable to save entry. Sorry.</div>\n);
 437                 return;
 438         }
 439
 440         $cn = $person->name ();
 441
 442         action_detail ($cn);
 443 }
 444
 445 sub action_update
 446 {
 447         my $cn = $UserID ? param ('cn') : $UserCN;
 448         my $person = Person->load ($cn);
 449
 450         die unless ($person);
 451
 452         if ($UserID)
 453         {
 454                 my $lastname  = param ('lastname');
 455                 my $firstname = param ('firstname');
 456
 457                 $person->lastname  ($lastname)  if ($lastname  and $lastname  ne $person->lastname ());
 458                 $person->firstname ($firstname) if ($firstname and $firstname ne $person->firstname ());
 459
 460                 $cn = $person->name ();
 461         }
 462
 463         my $contacts = get_contacts ();
 464
 465         for (@MultiFields)
 466         {
 467                 my $field = $_;
 468
 469                 if (defined ($contacts->{$field}))
 470                 {
 471                         my $values = $contacts->{$field};
 472                         $person->set ($field, $values);
 473                 }
 474                 else
 475                 {
 476                         $person->set ($field, []);
 477                 }
 478         }
 479
 480         if ($UserID)
 481         {
 482                 action_detail ($cn);
 483         }
 484         else
 485         {
 486                 action_edit (cn => $cn);
 487         }
 488 }
 489
 490 sub action_vcard
 491 {
 492         my $cn = param ('cn');
 493         $cn = shift if (@_);
 494         die unless ($cn);
 495
 496         my $person = Person->load ($cn);
 497         die unless ($person);
 498
 499         my %vcard_types =
 500         (
 501                 homephone       => 'TEL;TYPE=home,voice',
 502                 cellphone       => 'TEL;TYPE=cell',
 503                 officephone     => 'TEL;TYPE=work,voice',
 504                 fax             => 'TEL;TYPE=fax',
 505                 mail            => 'EMAIL',
 506                 uri             => 'URL',
 507                 group           => 'ORG'
 508         );
 509
 510         my $sn = $person->lastname ();
 511         my $gn = $person->firstname ();
 512         my $cn_esc = uri_escape ($cn);
 513
 514         print <<EOF;
 515 Content-Type: text/x-vcard
 516 Content-Disposition: attachment; filename="$cn.vcf"
 517
 518 BEGIN:VCARD
 519 VERSION:3.0
 520 FN: $cn
 521 N: $sn;$gn
 522 EOF
 523
 524         for (@MultiFields)
 525         {
 526                 my $field = $_;
 527                 my $vc_fld = $vcard_types{$field};
 528                 my $values = $person->get ($field);
 529
 530                 for (@$values)
 531                 {
 532                         my $value = $_;
 533                         print "$vc_fld:$value\n";
 534                 }
 535         }
 536         print "END:VCARD\n";
 537 }
 538
 539 sub html_start
 540 {
 541         my $title = shift;
 542         $title = q(octo's Lightweight Address Book) unless ($title);
 543
 544         print <<EOF;
 545 Content-Type: text/html; charset=UTF-8
 546
 547 <html>
 548         <head>
 549                 <title>$title</title>
 550                 <style type="text/css">
 551                 <!--
 552 body
 553 {
 554         color: black;
 555         background-color: white;
 556 }
 557
 558 div.error
 559 {
 560         color: red;
 561         background-color: yellow;
 562
 563         font-weight: bold;
 564         padding: 1ex;
 565         border: 2px solid red;
 566 }
 567
 568 div.foot
 569 {
 570         color: gray;
 571         background-color: white;
 572
 573         position: absolute;
 574         top: auto;
 575         right: 0px;
 576         bottom: 0px;
 577         left: 0px;
 578
 579         font-size: x-small;
 580         text-align: right;
 581         border-top: 1px solid black;
 582         width: 100%;
 583 }
 584
 585 div.menu form
 586 {
 587         display: inline;
 588         margin-right: 5ex;
 589 }
 590
 591 img
 592 {
 593         border: none;
 594 }
 595
 596 td
 597 {
 598         color: black;
 599         background-color: #cccccc;
 600 }
 601
 602 th
 603 {
 604         color: black;
 605         background-color: #999999;
 606         padding: 0.3ex;
 607         text-align: left;
 608         vertical-align: top;
 609 }
 610                 //-->
 611                 </style>
 612         </head>
 613
 614         <body>
 615 EOF
 616         if ($UserID)
 617         {
 618                 my $search = param ('search') || '';
 619                 print <<EOF;
 620                 <div class="menu">
 621                         <form action="$MySelf" method="post">
 622                                 <input type="hidden" name="action" value="browse" />
 623                                 <input type="submit" name="button" value="Browse" />
 624                         </form>
 625                         <form action="$MySelf" method="post">
 626                                 <input type="hidden" name="action" value="search" />
 627                                 <input type="text" name="search" value="$search" />
 628                                 <input type="submit" name="button" value="Search" />
 629                         </form>
 630                         <form action="$MySelf" method="post">
 631                                 <input type="hidden" name="action" value="edit" />
 632                                 <input type="hidden" name="dn" value="" />
 633                                 <input type="submit" name="button" value="Add New" />
 634                         </form>
 635                 </div>
 636                 <hr />
 637 EOF
 638         }
 639         print "\t\t<h1>octo's Lightweight Address Book</h1>\n";
 640 }
 641
 642 sub html_end
 643 {
 644         print <<EOF;
 645                 <div class="foot">octo's Lightweight Address Book &lt;octo at verplant.org&gt;</div>
 646         </body>
 647 </html>
 648 EOF
 649 }
 650
 651 sub read_config
 652 {
 653         my $file = '/var/www/html/cgi.verplant.org/address/book.conf';
 654         my $fh;
 655
 656         open ($fh, "< $file") or die ("open ($file): $!");
 657         for (<$fh>)
 658         {
 659                 chomp;
 660                 my $line = $_;
 661
 662                 if ($line =~ m/^(\w+):\s*"(.+)"\s*$/)
 663                 {
 664                         my $key = lc ($1);
 665                         my $val = $2;
 666
 667                         $Config{$key} = $val;
 668                 }
 669         }
 670
 671         close ($fh);
 672
 673         for (qw(uri bind_dn password))
 674         {
 675                 die ("Not defined: $_") unless (defined ($Config{$_}));
 676         }
 677 }
 678
 679 sub get_contacts
 680 {
 681         my $contacts = @_ ? shift : {};
 682
 683         if (param ('c_value'))
 684         {
 685                 my @c_values = param ('c_value');
 686                 my @c_types  = param ('c_type');
 687
 688                 my %cts = ();
 689
 690                 die if (scalar (@c_values) != scalar (@c_types));
 691
 692                 for (my $i = 0; $i < scalar (@c_values); $i++)
 693                 {
 694                         my $type  = $c_types[$i];
 695                         my $value = $c_values[$i];
 696
 697                         $cts{$type} = [] unless (defined ($cts{$type}));
 698                         push (@{$cts{$type}}, $value) if ($value);
 699                 }
 700
 701                 for (@MultiFields)
 702                 {
 703                         my $type = $_;
 704                         @{$contacts->{$type}} = @{$cts{$type}} if (defined ($cts{$type}));
 705                 }
 706         }
 707
 708         return ($contacts);
 709 }