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         verify  => [\&html_start, \&action_verify,  \&html_end],
  45         vcard   => \&action_vcard
  46 );
  47
  48 read_config ();
  49
  50 # make sure AuthLDAPRemoteUserIsDN is enabled.
  51 die unless ($ENV{'REMOTE_USER'});
  52 $Config{'base_dn'} = $ENV{'REMOTE_USER'};
  53
  54 Person->connect
  55 (
  56         uri     => $Config{'uri'},
  57         base_dn => $Config{'base_dn'},
  58         bind_dn => $Config{'bind_dn'},
  59         password => $Config{'password'}
  60 ) or die;
  61
  62 our ($UserCN, $UserID) = Person->get_user ($Config{'base_dn'});
  63
  64 if (!$UserID and $Action ne 'save')
  65 {
  66         $Action = 'edit';
  67 }
  68
  69 if (!$UserCN)
  70 {
  71         die;
  72 }
  73
  74 if (!defined ($Actions{$Action}))
  75 {
  76         die;
  77 }
  78
  79 if (ref ($Actions{$Action}) eq 'CODE')
  80 {
  81         $Actions{$Action}->();
  82 }
  83 elsif (ref ($Actions{$Action}) eq 'ARRAY')
  84 {
  85         for (@{$Actions{$Action}})
  86         {
  87                 $_->();
  88         }
  89 }
  90
  91 #print qq#<div>Authenticated as ($UserCN, $UserID, #, $Config{'base_dn'}, qq#)</div>\n#;
  92
  93 Person->disconnect ();
  94
  95 exit (0);
  96
  97 ###
  98
  99 sub action_browse
 100 {
 101         my $group = param ('group');
 102         $group = shift if (@_);
 103         $group ||= '';
 104
 105         my @all;
 106         if ($group)
 107         {
 108                 @all = Person->search ([[group => $group]]);
 109         }
 110         else
 111         {
 112                 @all = Person->search ();
 113         }
 114
 115         if (!$group)
 116         {
 117                 my %groups = ();
 118                 for (@all)
 119                 {
 120                         my $person = $_;
 121                         my @g = $person->get ('group');
 122
 123                         $groups{$_} = (defined ($groups{$_}) ? $groups{$_} + 1 : 1) for (@g);
 124                 }
 125
 126                 print qq(\t\t<h2>Contact Groups</h2>\n\t\t<ul class="groups">\n);
 127                 for (sort (keys (%groups)))
 128                 {
 129                         my $group = $_;
 130                         my $group_esc = uri_escape ($group);
 131                         my $num = $groups{$group};
 132
 133                         print qq(\t\t\t<li><a href="$MySelf?action=browse&group=$group_esc">$group</a> ($num)</li>\n);
 134                 }
 135                 if (!%groups)
 136                 {
 137                         print qq(\t\t\t<li class="empty">There are no groups yet.</li>\n);
 138                 }
 139                 print qq(\t\t</ul>\n\n);
 140         }
 141
 142         if ($group)
 143         {
 144                 print qq(\t\t<h2>Contact Group &quot;$group&quot;</h2>\n);
 145         }
 146         else
 147         {
 148                 print qq(\t\t<h2>All Contacts</h2>\n);
 149         }
 150
 151         print qq(\t\t<ul class="results">\n);
 152         for (sort { $a->name () cmp $b->name () } (@all))
 153         {
 154                 my $person = $_;
 155                 my $cn = $person->name ();
 156                 my $cn_esc = uri_escape ($cn);
 157
 158                 print qq(\t\t\t<li><a href="$MySelf?action=detail&cn=$cn_esc">$cn</a></li>\n);
 159         }
 160         print qq(\t\t</ul>\n\n);
 161
 162         print qq(\t\t<div class="menu">[<a href="$MySelf?action=browse">back</a>]</div>\n) if ($group);
 163 }
 164
 165 sub action_detail
 166 {
 167         my $cn = param ('cn');
 168         $cn = shift if (@_);
 169         die unless ($cn);
 170
 171         my $person = Person->load ($cn);
 172         if (!$person)
 173         {
 174                 print qq(\t<div>Entry &quot;$cn&quot; could not be loaded from DB.</div>\n);
 175                 return;
 176         }
 177
 178         print qq(\t<h2>Details for $cn</h2>\n);
 179
 180         my $cn_esc = uri_escape ($cn);
 181
 182         print <<EOF;
 183         <table class="detail">
 184                 <tr>
 185                         <th>Name</th>
 186                         <td>$cn</td>
 187                 </tr>
 188 EOF
 189         for (@MultiFields)
 190         {
 191                 my $field = $_;
 192                 my $values = $person->get ($field);
 193                 my $num = scalar (@$values);
 194                 my $print = defined ($FieldNames{$field}) ? $FieldNames{$field} : $field;
 195
 196                 next unless ($num);
 197
 198                 print "\t\t<tr>\n";
 199                 if ($num > 1)
 200                 {
 201                         print qq(\t\t\t<th rowspan="$num">$print</th>\n);
 202                 }
 203                 else
 204                 {
 205                         print qq(\t\t\t<th>$print</th>\n);
 206                 }
 207
 208                 for (my $i = 0; $i < $num; $i++)
 209                 {
 210                         my $val = $values->[$i];
 211
 212                         if ($field eq 'group')
 213                         {
 214                                 my $val_esc = uri_escape ($val);
 215                                 $val = qq(<a href="$MySelf?action=browse&group=$val_esc">$val</a>);
 216                         }
 217                         elsif ($field eq 'uri')
 218                         {
 219                                 my $uri = $val;
 220                                 $uri = qq(http://$val) unless ($val =~ m#^[a-z]+://#);
 221                                 $val = qq(<a href="$uri" class="extern">$val</a>);
 222                         }
 223                         elsif ($field eq 'mail')
 224                         {
 225                                 $val = qq(<a href="mailto:$val" class="mail">$val</a>);
 226                         }
 227
 228                         print "\t\t<tr>\n" if ($i);
 229                         print "\t\t\t<td>$val</td>\n",
 230                         "\t\t</tr>\n";
 231                 }
 232         }
 233         print <<EOF;
 234                 <th colspan="2" class="menu">
 235                         [<a href="$MySelf?action=verify&cn=$cn_esc">Verify</a>]
 236                         [<a href="$MySelf?action=vcard&cn=$cn_esc">vCard</a>]
 237                         [<a href="$MySelf?action=edit&cn=$cn_esc">Edit</a>]
 238                 </th>
 239         </table>
 240 EOF
 241 }
 242
 243 sub action_search
 244 {
 245         my $search = param ('search');
 246
 247         $search ||= '';
 248         $search =~ s/[^\s\w]//g;
 249
 250         if (!$search)
 251         {
 252                 print qq(\t<div class="error">Sorry, the empty search is not allowed.</div>\n);
 253                 action_default ();
 254                 return;
 255         }
 256
 257         my @patterns = split (m/\s+/, $search);
 258         my @filter = ();
 259
 260         for (@patterns)
 261         {
 262                 my $pattern = "$_*";
 263                 push (@filter, [[lastname => $pattern], [firstname => $pattern]]);
 264         }
 265
 266         my @matches = Person->search (@filter);
 267
 268         if (!@matches)
 269         {
 270                 print qq(\t<div>No entries matched your search.</div>\n);
 271                 return;
 272         }
 273
 274         if (scalar (@matches) == 1)
 275         {
 276                 my $person = shift (@matches);
 277                 my $cn = $person->name ();
 278                 action_detail ($cn);
 279                 return;
 280         }
 281
 282         print qq(\t<ul class="result">\n);
 283         for (@matches)
 284         {
 285                 my $person = $_;
 286                 my $cn = $person->name ();
 287                 my $cn_esc = uri_escape ($cn);
 288
 289                 print qq(\t\t<li><a href="$MySelf?action=detail&cn=$cn_esc">$cn</a></li>\n);
 290         }
 291         print qq(\t</ul>\n);
 292 }
 293
 294 sub action_edit
 295 {
 296         my %opts = @_;
 297
 298         my $cn = param ('cn');
 299
 300         $cn = $opts{'cn'} if (defined ($opts{'cn'}));
 301         $cn ||= '';
 302
 303         if (!$UserID)
 304         {
 305                 $cn = $UserCN;
 306         }
 307
 308         my $person;
 309
 310         my $lastname;
 311         my $firstname;
 312
 313         my $contacts = {};
 314         $contacts->{$_} = [] for (@MultiFields);
 315
 316         if ($cn)
 317         {
 318                 $person = Person->load ($cn);
 319
 320                 if (!$person)
 321                 {
 322                         print qq(\t<div class="error">Unable to load CN &quot;$cn&quot;. Sorry.</div>\n);
 323                         return;
 324                 }
 325
 326                 $lastname    = $person->lastname ();
 327                 $firstname   = $person->firstname ();
 328
 329                 for (@MultiFields)
 330                 {
 331                         $contacts->{$_} = $person->get ($_);
 332                 }
 333         }
 334
 335         $lastname    = param ('lastname')    if (param ('lastname')  and $UserID);
 336         $firstname   = param ('firstname')   if (param ('firstname') and $UserID);
 337
 338         get_contacts ($contacts);
 339
 340         $lastname    =   $opts{'lastname'}     if (defined ($opts{'lastname'}));
 341         $firstname   =   $opts{'firstname'}    if (defined ($opts{'firstname'}));
 342         for (@MultiFields)
 343         {
 344                 my $field = $_;
 345                 @{$contacts->{$field}} = @{$opts{$field}} if (defined ($opts{$field}));
 346         }
 347
 348         if ($cn)
 349         {
 350                 print "\t\t<h2>Edit contact $cn</h2>\n";
 351         }
 352         else
 353         {
 354                 print "\t\t<h2>Create new contact</h2>\n";
 355         }
 356
 357         print <<EOF;
 358                 <form action="$MySelf" method="post">
 359                 <input type="hidden" name="action" value="save" />
 360                 <input type="hidden" name="cn" value="$cn" />
 361                 <table class="edit">
 362                         <tr>
 363                                 <th>Lastname</th>
 364 EOF
 365         if ($UserID)
 366         {
 367                 print qq(\t\t\t\t<td><input type="text" name="lastname" value="$lastname" /></td>\n);
 368         }
 369         else
 370         {
 371                 print qq(\t\t\t\t<td>$lastname</td>\n);
 372         }
 373         print <<EOF;
 374                         </tr>
 375                         <tr>
 376                                 <th>Firstname</th>
 377 EOF
 378         if ($UserID)
 379         {
 380                 print qq(\t\t\t\t<td><input type="text" name="firstname" value="$firstname" /></td>\n);
 381         }
 382         else
 383         {
 384                 print qq(\t\t\t\t<td>$firstname</td>\n);
 385         }
 386
 387         print "\t\t\t</tr>\n";
 388
 389         for (@MultiFields)
 390         {
 391                 my $field = $_;
 392                 my $print = defined ($FieldNames{$field}) ? $FieldNames{$field} : $field;
 393                 my @values = @{$contacts->{$field}};
 394
 395                 push (@values, '');
 396
 397                 for (@values)
 398                 {
 399                         my $value = $_;
 400
 401                         print <<EOF;
 402                         <tr>
 403                                 <th>$print</th>
 404                                 <td><input type="text" name="$field" value="$value" /></td>
 405                         </tr>
 406 EOF
 407                 }
 408         }
 409
 410         print <<EOF;
 411                         <tr>
 412                                 <th colspan="2" class="menu">
 413 EOF
 414         if ($UserID)
 415         {
 416                 print <<EOF;
 417                                         <input type="submit" name="button" value="Cancel" />
 418                                         <input type="submit" name="button" value="Apply" />
 419 EOF
 420         }
 421         print <<EOF;
 422                                         <input type="submit" name="button" value="Save" />
 423                                 </th>
 424                         </tr>
 425                 </table>
 426                 </form>
 427 EOF
 428 }
 429
 430 sub action_save
 431 {
 432         my $cn = $UserID ? param ('cn') : $UserCN;
 433
 434         if (verify_fields ())
 435         {
 436                 action_edit (cn => $cn);
 437                 return;
 438         }
 439
 440         if ($cn)
 441         {
 442                 action_update ();
 443                 return;
 444         }
 445
 446         die unless ($UserID);
 447
 448         my $button = lc (param ('button'));
 449         $button ||= 'save';
 450
 451         if ($button eq 'cancel')
 452         {
 453                 action_browse ();
 454                 return;
 455         }
 456
 457         if (!param ('lastname') or !param ('firstname'))
 458         {
 459                 print qq(\t<div class="error">You have to give both, first and lastname, to identify this record.</div>\n);
 460                 action_edit (cn => '');
 461                 return;
 462         }
 463
 464         my $lastname  = param ('lastname');
 465         my $firstname = param ('firstname');
 466
 467         my $contacts = get_contacts ();
 468
 469         my $person = Person->create (lastname => $lastname, firstname => $firstname, %$contacts);
 470
 471         if (!$person)
 472         {
 473                 print qq(\t<div class="error">Unable to save entry. Sorry.</div>\n);
 474                 return;
 475         }
 476
 477         $cn = $person->name ();
 478
 479         if ($button eq 'apply')
 480         {
 481                 action_edit (cn => $cn);
 482         }
 483         else
 484         {
 485                 action_detail ($cn);
 486         }
 487 }
 488
 489 sub action_update
 490 {
 491         my $cn = $UserID ? param ('cn') : $UserCN;
 492         my $person = Person->load ($cn);
 493
 494         die unless ($person);
 495
 496         my $button = lc (param ('button'));
 497         $button ||= 'save';
 498
 499         if ($UserID and $button eq 'cancel')
 500         {
 501                 action_detail ($cn);
 502                 return;
 503         }
 504
 505         if ($UserID)
 506         {
 507                 my $lastname  = param ('lastname');
 508                 my $firstname = param ('firstname');
 509
 510                 $person->lastname  ($lastname)  if ($lastname  and $lastname  ne $person->lastname ());
 511                 $person->firstname ($firstname) if ($firstname and $firstname ne $person->firstname ());
 512
 513                 $cn = $person->name ();
 514         }
 515
 516         my $contacts = get_contacts ();
 517
 518         for (@MultiFields)
 519         {
 520                 my $field = $_;
 521
 522                 if (defined ($contacts->{$field}))
 523                 {
 524                         my $values = $contacts->{$field};
 525                         $person->set ($field, $values);
 526                 }
 527                 else
 528                 {
 529                         $person->set ($field, []);
 530                 }
 531         }
 532
 533         if ($button eq 'apply' or !$UserID)
 534         {
 535                 action_edit (cn => $cn);
 536         }
 537         else
 538         {
 539                 action_detail ($cn);
 540         }
 541 }
 542
 543 sub action_vcard
 544 {
 545         my $cn = param ('cn');
 546         $cn = shift if (@_);
 547         die unless ($cn);
 548
 549         my $person = Person->load ($cn);
 550         die unless ($person);
 551
 552         my %vcard_types =
 553         (
 554                 homephone       => 'TEL;TYPE=home,voice',
 555                 cellphone       => 'TEL;TYPE=cell',
 556                 officephone     => 'TEL;TYPE=work,voice',
 557                 fax             => 'TEL;TYPE=fax',
 558                 mail            => 'EMAIL',
 559                 uri             => 'URL',
 560                 group           => 'ORG'
 561         );
 562
 563         my $sn = $person->lastname ();
 564         my $gn = $person->firstname ();
 565         my $cn_esc = uri_escape ($cn);
 566
 567         print <<EOF;
 568 Content-Type: text/x-vcard
 569 Content-Disposition: attachment; filename="$cn.vcf"
 570
 571 BEGIN:VCARD
 572 VERSION:3.0
 573 FN: $cn
 574 N: $sn;$gn
 575 EOF
 576
 577         for (@MultiFields)
 578         {
 579                 my $field = $_;
 580                 my $vc_fld = $vcard_types{$field};
 581                 my $values = $person->get ($field);
 582
 583                 for (@$values)
 584                 {
 585                         my $value = $_;
 586                         print "$vc_fld:$value\n";
 587                 }
 588         }
 589         print "END:VCARD\n";
 590 }
 591
 592 sub action_verify
 593 {
 594         my $cn = param ('cn');
 595         $cn = shift if (@_);
 596         die unless ($cn);
 597
 598         my $person = Person->load ($cn);
 599         die unless ($person);
 600
 601         my ($mail) = $person->get ('mail');
 602         $mail ||= '';
 603
 604         my $message;
 605         my $password = $person->password ();
 606
 607         if (!$password)
 608         {
 609                 $password = pwgen ();
 610                 $person->password ($password);
 611         }
 612
 613         $message = qq(The password for the record &quot;$cn&quot; is &quot;$password&quot;.);
 614
 615         if ($mail)
 616         {
 617                 action_verify_send_mail ($person);
 618                 $message .= qq( A request for verification has been sent to $mail.);
 619         }
 620         else
 621         {
 622                 $message .= q( There was no e-mail address, thus no verification request could be sent.);
 623         }
 624
 625         print qq(\t\t<div class="message">$message</div>\n);
 626
 627         action_detail ($cn);
 628 }
 629
 630 sub action_verify_send_mail
 631 {
 632         my $person = shift;
 633         my $owner = Person->load ($UserCN);
 634         my $smh;
 635
 636         my $max_width = 0;
 637         for (keys %FieldNames)
 638         {
 639                 $max_width = length $FieldNames{$_} if ($max_width < length $FieldNames{$_});
 640         }
 641         $max_width++;
 642
 643         my $person_name = $person->name ();
 644         my ($person_mail) = $person->get ('mail');
 645         my $person_gn = $person->firstname ();
 646         my $password = $person->password ();
 647
 648         my $owner_name = $owner->name ();
 649         my ($owner_mail) = $owner->get ('mail');
 650         $owner_mail ||= $ENV{'SERVER_ADMIN'};
 651
 652         my $host = $ENV{'HTTP_HOST'};
 653         my $url = 'http://' . $host . $MySelf;
 654
 655         open ($smh, '| /usr/sbin/sendmail -t') or die ("open pipe to sendmail: $!");
 656         print $smh <<EOM;
 657 To: $person_name <$person_mail>
 658 From: $owner_name <$owner_mail>
 659 Subject: Please verify our entry in my address book
 660
 661 Hello $person_gn,
 662
 663 the following is your entry in my address book:
 664 EOM
 665         for (@MultiFields)
 666         {
 667                 my $field = $_;
 668                 my $print = defined ($FieldNames{$field}) ? $FieldNames{$field} : $field;
 669                 my @values = $person->get ($field);
 670
 671                 for (@values)
 672                 {
 673                         printf $smh ('%'.$max_width."s: %-s\n", $print, $_);
 674                 }
 675         }
 676         print $smh <<EOM;
 677
 678 If this entry is outdated or incomplete, please take a minute and correct it.
 679   Address:  $url
 680  Username: $person_name
 681  Password: $password
 682
 683 Thank you very much :) Regards,
 684 $owner_name
 685 EOM
 686         close ($smh);
 687 }
 688
 689 sub html_start
 690 {
 691         my $title = shift;
 692         $title = q(Lightweight Contact Manager) unless ($title);
 693
 694         print <<EOF;
 695 Content-Type: text/html; charset=UTF-8
 696
 697 <html>
 698         <head>
 699                 <title>$title</title>
 700                 <style type="text/css">
 701                 <!--
 702 a
 703 {
 704         color: blue;
 705         background-color: inherit;
 706         text-decoration: none;
 707 }
 708
 709 a:hover
 710 {
 711         text-decoration: underline;
 712 }
 713
 714 a:visited
 715 {
 716         color: navy;
 717         background-color: inherit;
 718 }
 719
 720 body
 721 {
 722         color: black;
 723         background-color: white;
 724 }
 725
 726 div.error
 727 {
 728         color: red;
 729         background-color: yellow;
 730
 731         font-weight: bold;
 732         padding: 1ex;
 733         border: 2px solid red;
 734 }
 735
 736 div.foot
 737 {
 738         color: gray;
 739         background-color: white;
 740
 741         position: fixed;
 742         top: auto;
 743         right: 0px;
 744         bottom: 0px;
 745         left: 0px;
 746
 747         font-size: x-small;
 748         text-align: right;
 749         border-top: 1px solid black;
 750         width: 100%;
 751 }
 752
 753 div.foot a
 754 {
 755         color: black;
 756         background-color: inherit;
 757         text-decoration: none;
 758 }
 759
 760 div.foot a:hover
 761 {
 762         text-decoration: underline;
 763 }
 764
 765 div.menu form
 766 {
 767         display: inline;
 768         margin-right: 5ex;
 769 }
 770
 771 img
 772 {
 773         border: none;
 774 }
 775
 776 td
 777 {
 778         color: black;
 779         background-color: #cccccc;
 780 }
 781
 782 th
 783 {
 784         color: black;
 785         background-color: #999999;
 786         padding: 0.3ex;
 787         text-align: left;
 788         vertical-align: top;
 789 }
 790
 791 th.menu
 792 {
 793         text-align: right;
 794 }
 795
 796 .menu
 797 {
 798         font-weight: bold;
 799 }
 800
 801 .menu a
 802 {
 803         color: blue;
 804         background-color: transparent;
 805 }
 806                 //-->
 807                 </style>
 808         </head>
 809
 810         <body>
 811 EOF
 812         if ($UserID)
 813         {
 814                 my $search = param ('search') || '';
 815                 print <<EOF;
 816                 <div class="menu">
 817                         <form action="$MySelf" method="post">
 818                                 <input type="hidden" name="action" value="browse" />
 819                                 <input type="submit" name="button" value="Browse" />
 820                         </form>
 821                         <form action="$MySelf" method="post">
 822                                 <input type="hidden" name="action" value="search" />
 823                                 <input type="text" name="search" value="$search" />
 824                                 <input type="submit" name="button" value="Search" />
 825                         </form>
 826                         <form action="$MySelf" method="post">
 827                                 <input type="hidden" name="action" value="edit" />
 828                                 <input type="hidden" name="dn" value="" />
 829                                 <input type="submit" name="button" value="Add New" />
 830                         </form>
 831                 </div>
 832                 <hr />
 833 EOF
 834         }
 835         print "\t\t<h1>$title</h1>\n";
 836 }
 837
 838 sub html_end
 839 {
 840         print <<EOF;
 841                 <div class="foot">
 842                         &quot;Lightweight Contact Manager&quot;,
 843                         written 2005 by <a href="http://verplant.org/">Florian octo Forster</a>
 844                         &lt;octo at verplant.org&gt;
 845                 </div>
 846         </body>
 847 </html>
 848 EOF
 849 }
 850
 851 sub read_config
 852 {
 853         my $file = '/var/www/html/cgi.verplant.org/address/book.conf';
 854         my $fh;
 855
 856         open ($fh, "< $file") or die ("open ($file): $!");
 857         for (<$fh>)
 858         {
 859                 chomp;
 860                 my $line = $_;
 861
 862                 if ($line =~ m/^(\w+):\s*"(.+)"\s*$/)
 863                 {
 864                         my $key = lc ($1);
 865                         my $val = $2;
 866
 867                         $Config{$key} = $val;
 868                 }
 869         }
 870
 871         close ($fh);
 872
 873         for (qw(uri bind_dn password))
 874         {
 875                 die ("Not defined: $_") unless (defined ($Config{$_}));
 876         }
 877 }
 878
 879 sub pwgen
 880 {
 881         my $len = @_ ? shift : 6;
 882         my $retval = '';
 883
 884         while (!$retval)
 885         {
 886                 my $numbers = 0;
 887                 my $lchars  = 0;
 888                 my $uchars  = 0;
 889
 890                 while (length ($retval) < $len)
 891                 {
 892                         my $chr = int (rand (128));
 893
 894                         if ($chr >= 48 and $chr < 58)
 895                         {
 896                                 $numbers++;
 897                         }
 898                         elsif ($chr >= 65 and $chr < 91)
 899                         {
 900                                 $uchars++;
 901                         }
 902                         elsif ($chr >= 97 and $chr < 123)
 903                         {
 904                                 $lchars++;
 905                         }
 906                         else
 907                         {
 908                                 next;
 909                         }
 910                         $retval .= chr ($chr);
 911                 }
 912
 913                 $retval = '' if (!$numbers or !$lchars or !$uchars);
 914         }
 915
 916         return ($retval);
 917 }
 918
 919 sub verify_fields
 920 {
 921         my @errors = ();
 922         for (param ('uri'))
 923         {
 924                 my $val = $_;
 925                 next unless ($val);
 926
 927                 if ($val !~ m#^[a-zA-Z]+://#)
 928                 {
 929                         push (@errors, 'URIs have to begin with a protocol, e.g. &quot;http://&quot;, &quot;ftp://&quot; etc.');
 930                         last;
 931                 }
 932         }
 933
 934         for (param ('homephone'), param ('cellphone'), param ('officephone'), param ('fax'))
 935         {
 936                 my $number = $_;
 937                 next unless ($number);
 938
 939                 if ($number !~ m/^\+/)
 940                 {
 941                         push (@errors, 'Telephone numbers have to begin with the country code, e.g. &quot;+49 911 123456&quot;');
 942                         last;
 943                 }
 944         }
 945
 946         print qq(\t\t<div class="error">\n) if (@errors);
 947         for (my $i = 0; $i < scalar (@errors); $i++)
 948         {
 949                 my $e = $errors[$i];
 950
 951                 print "<br />\n" if ($i);
 952                 print "\t\t\t$e";
 953         }
 954         print qq(\n\t\t</div>\n\n) if (@errors);
 955
 956         return (scalar (@errors));
 957 }
 958
 959 sub get_contacts
 960 {
 961         my $contacts = @_ ? shift : {};
 962
 963         for (@MultiFields)
 964         {
 965                 my $field = $_;
 966                 my @values = grep { $_ } (param ($field));
 967
 968                 next unless (@values);
 969
 970                 if ($field eq 'homephone' or $field eq 'cellphone' or $field eq 'officephone' or $field eq 'fax')
 971                 {
 972                         for (@values)
 973                         {
 974                                 $_ =~ s/\D//g;
 975                                 $_ = '+' . $_;
 976                         }
 977                 }
 978
 979                 $contacts->{$field} = [@values] if (@values);
 980         }
 981
 982         return ($contacts);
 983 }