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                 if (!%groups)
 126                 {
 127                         print qq(\t\t<li class="empty">There are no groups yet.</li>\n);
 128                 }
 129                 print qq(\t</ul>\n);
 130         }
 131         else
 132         {
 133                 print qq(\t<h2>Contact Group &quot;$group&quot;</h2>\n\t<ul class="results">\n);
 134                 for (@all)
 135                 {
 136                         my $person = $_;
 137                         my $cn = $person->name ();
 138                         my $cn_esc = uri_escape ($cn);
 139
 140                         print qq(\t\t<li><a href="$MySelf?action=detail&cn=$cn_esc">$cn</a></li>\n);
 141                 }
 142                 print qq(\t</ul>\n);
 143         }
 144 }
 145
 146 sub action_detail
 147 {
 148         my $cn = param ('cn');
 149         $cn = shift if (@_);
 150         die unless ($cn);
 151
 152         my $person = Person->load ($cn);
 153         if (!$person)
 154         {
 155                 print qq(\t<div>Entry &quot;$cn&quot; could not be loaded from DB.</div>\n);
 156                 return;
 157         }
 158
 159         print qq(\t<h2>Details for $cn</h2>\n);
 160
 161         my $cn_esc = uri_escape ($cn);
 162
 163         print <<EOF;
 164         <table class="detail">
 165                 <tr>
 166                         <th>Name</th>
 167                         <td>$cn</td>
 168                 </tr>
 169 EOF
 170         for (@MultiFields)
 171         {
 172                 my $field = $_;
 173                 my $values = $person->get ($field);
 174                 my $num = scalar (@$values);
 175                 my $print = defined ($FieldNames{$field}) ? $FieldNames{$field} : $field;
 176
 177                 next unless ($num);
 178
 179                 print "\t\t<tr>\n";
 180                 if ($num > 1)
 181                 {
 182                         print qq(\t\t\t<th rowspan="$num">$print</th>\n);
 183                 }
 184                 else
 185                 {
 186                         print qq(\t\t\t<th>$print</th>\n);
 187                 }
 188
 189                 for (my $i = 0; $i < $num; $i++)
 190                 {
 191                         my $val = $values->[$i];
 192                         print "\t\t<tr>\n" if ($i);
 193                         print "\t\t\t<td>$val</td>\n",
 194                         "\t\t</tr>\n";
 195                 }
 196         }
 197         print <<EOF;
 198         </table>
 199         <div class="detail menu">
 200                 [<a href="$MySelf?action=edit&cn=$cn_esc">edit</a>]
 201                 [<a href="$MySelf?action=vcard&cn=$cn_esc">vCard</a>]
 202         </div>
 203 EOF
 204 }
 205
 206 sub action_search
 207 {
 208         my $search = param ('search');
 209
 210         $search ||= '';
 211         $search =~ s/[^\s\w]//g;
 212
 213         if (!$search)
 214         {
 215                 print qq(\t<div class="error">Sorry, the empty search is not allowed.</div>\n);
 216                 action_default ();
 217                 return;
 218         }
 219
 220         my @patterns = split (m/\s+/, $search);
 221         my @filter = ();
 222
 223         for (@patterns)
 224         {
 225                 my $pattern = "$_*";
 226                 push (@filter, [[lastname => $pattern], [firstname => $pattern]]);
 227         }
 228
 229         my @matches = Person->search (@filter);
 230
 231         if (!@matches)
 232         {
 233                 print qq(\t<div>No entries matched your search.</div>\n);
 234                 return;
 235         }
 236
 237         if (scalar (@matches) == 1)
 238         {
 239                 my $person = shift (@matches);
 240                 my $cn = $person->name ();
 241                 action_detail ($cn);
 242                 return;
 243         }
 244
 245         print qq(\t<ul class="result">\n);
 246         for (@matches)
 247         {
 248                 my $person = $_;
 249                 my $cn = $person->name ();
 250                 my $cn_esc = uri_escape ($cn);
 251
 252                 print qq(\t\t<li><a href="$MySelf?action=detail&cn=$cn_esc">$cn</a></li>\n);
 253         }
 254         print qq(\t</ul>\n);
 255 }
 256
 257 sub action_edit
 258 {
 259         my %opts = @_;
 260
 261         my $cn = param ('cn');
 262
 263         $cn = $opts{'cn'} if (defined ($opts{'cn'}));
 264         $cn ||= '';
 265
 266         if (!$UserID)
 267         {
 268                 $cn = $UserCN;
 269         }
 270
 271         my $person;
 272
 273         my $lastname;
 274         my $firstname;
 275
 276         my $contacts = {};
 277         $contacts->{$_} = [] for (@MultiFields);
 278
 279         if ($cn)
 280         {
 281                 $person = Person->load ($cn);
 282
 283                 if (!$person)
 284                 {
 285                         print qq(\t<div class="error">Unable to load CN &quot;$cn&quot;. Sorry.</div>\n);
 286                         return;
 287                 }
 288
 289                 $lastname    = $person->lastname ();
 290                 $firstname   = $person->firstname ();
 291
 292                 for (@MultiFields)
 293                 {
 294                         $contacts->{$_} = $person->get ($_);
 295                 }
 296         }
 297
 298         $lastname    = param ('lastname')    if (param ('lastname')  and $UserID);
 299         $firstname   = param ('firstname')   if (param ('firstname') and $UserID);
 300
 301         for (@MultiFields)
 302         {
 303                 my $field = $_;
 304                 my @values = grep { $_ } (param ($field));
 305                 $contacts->{$field} = [@values] if (@values);
 306         }
 307
 308         $lastname    =   $opts{'lastname'}     if (defined ($opts{'lastname'}));
 309         $firstname   =   $opts{'firstname'}    if (defined ($opts{'firstname'}));
 310         for (@MultiFields)
 311         {
 312                 my $field = $_;
 313                 @{$contacts->{$field}} = @{$opts{$field}} if (defined ($opts{$field}));
 314         }
 315
 316         if ($cn)
 317         {
 318                 print "\t\t<h2>Edit contact $cn</h2>\n";
 319         }
 320         else
 321         {
 322                 print "\t\t<h2>Create new contact</h2>\n";
 323         }
 324
 325         print <<EOF;
 326                 <form action="$MySelf" method="post">
 327                 <input type="hidden" name="action" value="save" />
 328                 <input type="hidden" name="cn" value="$cn" />
 329                 <table class="edit">
 330                         <tr>
 331                                 <td>Lastname</td>
 332 EOF
 333         if ($UserID)
 334         {
 335                 print qq(\t\t\t\t<td><input type="text" name="lastname" value="$lastname" /></td>\n);
 336         }
 337         else
 338         {
 339                 print qq(\t\t\t\t<td>$lastname</td>\n);
 340         }
 341         print <<EOF;
 342                         </tr>
 343                         <tr>
 344                                 <td>Firstname</td>
 345 EOF
 346         if ($UserID)
 347         {
 348                 print qq(\t\t\t\t<td><input type="text" name="firstname" value="$firstname" /></td>\n);
 349         }
 350         else
 351         {
 352                 print qq(\t\t\t\t<td>$firstname</td>\n);
 353         }
 354
 355         print "\t\t\t</tr>\n";
 356
 357         for (@MultiFields)
 358         {
 359                 my $field = $_;
 360                 my $print = defined ($FieldNames{$field}) ? $FieldNames{$field} : $field;
 361                 my @values = @{$contacts->{$field}};
 362
 363                 push (@values, '');
 364
 365                 for (@values)
 366                 {
 367                         my $value = $_;
 368
 369                         print <<EOF;
 370                         <tr>
 371                                 <td>$print</td>
 372                                 <td><input type="text" name="$field" value="$value" /></td>
 373                         </tr>
 374 EOF
 375                 }
 376         }
 377
 378         print <<EOF;
 379                         <tr>
 380                                 <td colspan="2">
 381 EOF
 382         print qq(\t\t\t\t\t<input type="submit" name="button" value="Update" />\n) if ($UserID);
 383         print <<EOF;
 384                                         <input type="submit" name="button" value="Save" />
 385                                 </td>
 386                         </tr>
 387                 </table>
 388                 </form>
 389 EOF
 390 }
 391
 392 sub action_save
 393 {
 394         my $cn = $UserID ? param ('cn') : $UserCN;
 395
 396         if ($cn)
 397         {
 398                 action_update ();
 399                 return;
 400         }
 401
 402         die unless ($UserID);
 403
 404         if (!param ('lastname') or !param ('firstname'))
 405         {
 406                 print qq(\t<div class="error">You have to give both, first and lastname, to identify this record.</div>\n);
 407                 action_edit (cn => '');
 408                 return;
 409         }
 410
 411         my $lastname  = param ('lastname');
 412         my $firstname = param ('firstname');
 413
 414         my $contacts = {};
 415         for (@MultiFields)
 416         {
 417                 my $field = $_;
 418                 my @values = grep { $_ } (param ($field));
 419                 $contacts->{$field} = [@values] if (@values);
 420         }
 421
 422         my $person = Person->create (lastname => $lastname, firstname => $firstname, %$contacts);
 423
 424         if (!$person)
 425         {
 426                 print qq(\t<div class="error">Unable to save entry. Sorry.</div>\n);
 427                 return;
 428         }
 429
 430         $cn = $person->name ();
 431
 432         if (param ('button') eq 'Update')
 433         {
 434                 action_edit (cn => $cn);
 435         }
 436         else
 437         {
 438                 action_detail ($cn);
 439         }
 440 }
 441
 442 sub action_update
 443 {
 444         my $cn = $UserID ? param ('cn') : $UserCN;
 445         my $person = Person->load ($cn);
 446
 447         die unless ($person);
 448
 449         if ($UserID)
 450         {
 451                 my $lastname  = param ('lastname');
 452                 my $firstname = param ('firstname');
 453
 454                 $person->lastname  ($lastname)  if ($lastname  and $lastname  ne $person->lastname ());
 455                 $person->firstname ($firstname) if ($firstname and $firstname ne $person->firstname ());
 456
 457                 $cn = $person->name ();
 458         }
 459
 460         my $contacts = {};
 461         for (@MultiFields)
 462         {
 463                 my $field = $_;
 464                 my @values = grep { $_ } (param ($field));
 465                 $contacts->{$field} = [@values] if (@values);
 466         }
 467
 468         for (@MultiFields)
 469         {
 470                 my $field = $_;
 471
 472                 if (defined ($contacts->{$field}))
 473                 {
 474                         my $values = $contacts->{$field};
 475                         $person->set ($field, $values);
 476                 }
 477                 else
 478                 {
 479                         $person->set ($field, []);
 480                 }
 481         }
 482
 483         if (param ('button') eq 'Update' or !$UserID)
 484         {
 485                 action_edit (cn => $cn);
 486         }
 487         else
 488         {
 489                 action_detail ($cn);
 490         }
 491 }
 492
 493 sub action_vcard
 494 {
 495         my $cn = param ('cn');
 496         $cn = shift if (@_);
 497         die unless ($cn);
 498
 499         my $person = Person->load ($cn);
 500         die unless ($person);
 501
 502         my %vcard_types =
 503         (
 504                 homephone       => 'TEL;TYPE=home,voice',
 505                 cellphone       => 'TEL;TYPE=cell',
 506                 officephone     => 'TEL;TYPE=work,voice',
 507                 fax             => 'TEL;TYPE=fax',
 508                 mail            => 'EMAIL',
 509                 uri             => 'URL',
 510                 group           => 'ORG'
 511         );
 512
 513         my $sn = $person->lastname ();
 514         my $gn = $person->firstname ();
 515         my $cn_esc = uri_escape ($cn);
 516
 517         print <<EOF;
 518 Content-Type: text/x-vcard
 519 Content-Disposition: attachment; filename="$cn.vcf"
 520
 521 BEGIN:VCARD
 522 VERSION:3.0
 523 FN: $cn
 524 N: $sn;$gn
 525 EOF
 526
 527         for (@MultiFields)
 528         {
 529                 my $field = $_;
 530                 my $vc_fld = $vcard_types{$field};
 531                 my $values = $person->get ($field);
 532
 533                 for (@$values)
 534                 {
 535                         my $value = $_;
 536                         print "$vc_fld:$value\n";
 537                 }
 538         }
 539         print "END:VCARD\n";
 540 }
 541
 542 sub html_start
 543 {
 544         my $title = shift;
 545         $title = q(octo's Lightweight Address Book) unless ($title);
 546
 547         print <<EOF;
 548 Content-Type: text/html; charset=UTF-8
 549
 550 <html>
 551         <head>
 552                 <title>$title</title>
 553                 <style type="text/css">
 554                 <!--
 555 body
 556 {
 557         color: black;
 558         background-color: white;
 559 }
 560
 561 div.error
 562 {
 563         color: red;
 564         background-color: yellow;
 565
 566         font-weight: bold;
 567         padding: 1ex;
 568         border: 2px solid red;
 569 }
 570
 571 div.foot
 572 {
 573         color: gray;
 574         background-color: white;
 575
 576         position: absolute;
 577         top: auto;
 578         right: 0px;
 579         bottom: 0px;
 580         left: 0px;
 581
 582         font-size: x-small;
 583         text-align: right;
 584         border-top: 1px solid black;
 585         width: 100%;
 586 }
 587
 588 div.menu form
 589 {
 590         display: inline;
 591         margin-right: 5ex;
 592 }
 593
 594 img
 595 {
 596         border: none;
 597 }
 598
 599 td
 600 {
 601         color: black;
 602         background-color: #cccccc;
 603 }
 604
 605 th
 606 {
 607         color: black;
 608         background-color: #999999;
 609         padding: 0.3ex;
 610         text-align: left;
 611         vertical-align: top;
 612 }
 613                 //-->
 614                 </style>
 615         </head>
 616
 617         <body>
 618 EOF
 619         if ($UserID)
 620         {
 621                 my $search = param ('search') || '';
 622                 print <<EOF;
 623                 <div class="menu">
 624                         <form action="$MySelf" method="post">
 625                                 <input type="hidden" name="action" value="browse" />
 626                                 <input type="submit" name="button" value="Browse" />
 627                         </form>
 628                         <form action="$MySelf" method="post">
 629                                 <input type="hidden" name="action" value="search" />
 630                                 <input type="text" name="search" value="$search" />
 631                                 <input type="submit" name="button" value="Search" />
 632                         </form>
 633                         <form action="$MySelf" method="post">
 634                                 <input type="hidden" name="action" value="edit" />
 635                                 <input type="hidden" name="dn" value="" />
 636                                 <input type="submit" name="button" value="Add New" />
 637                         </form>
 638                 </div>
 639                 <hr />
 640 EOF
 641         }
 642         print "\t\t<h1>octo's Lightweight Address Book</h1>\n";
 643 }
 644
 645 sub html_end
 646 {
 647         print <<EOF;
 648                 <div class="foot">octo's Lightweight Address Book &lt;octo at verplant.org&gt;</div>
 649         </body>
 650 </html>
 651 EOF
 652 }
 653
 654 sub read_config
 655 {
 656         my $file = '/var/www/html/cgi.verplant.org/address/book.conf';
 657         my $fh;
 658
 659         open ($fh, "< $file") or die ("open ($file): $!");
 660         for (<$fh>)
 661         {
 662                 chomp;
 663                 my $line = $_;
 664
 665                 if ($line =~ m/^(\w+):\s*"(.+)"\s*$/)
 666                 {
 667                         my $key = lc ($1);
 668                         my $val = $2;
 669
 670                         $Config{$key} = $val;
 671                 }
 672         }
 673
 674         close ($fh);
 675
 676         for (qw(uri bind_dn password))
 677         {
 678                 die ("Not defined: $_") unless (defined ($Config{$_}));
 679         }
 680 }