From: octo Date: Sun, 24 Apr 2005 15:54:23 +0000 (+0000) Subject: Renamed book.cgi to licom.cgi X-Git-Tag: Release-0.1~8 X-Git-Url: https://git.verplant.org/?a=commitdiff_plain;h=0b46496344123e462825844a676997b77823b365;p=licom.git Renamed book.cgi to licom.cgi --- diff --git a/book.cgi b/book.cgi deleted file mode 100755 index 4af14ad..0000000 --- a/book.cgi +++ /dev/null @@ -1,1160 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; -use lib (qw(lib)); - -use CGI (':cgi'); -use CGI::Carp (qw(fatalsToBrowser)); -use URI::Escape; -use Data::Dumper; - -use Person; - -our $Debug = 0; -our %Config = (); - -our @MultiFields = (qw(address homephone cellphone officephone fax mail uri group)); - -our %FieldNames = -( - address => 'Address', - homephone => 'Home Phone', - cellphone => 'Cell Phone', - officephone => 'Office Phone', - fax => 'FAX', - mail => 'E-Mail', - uri => 'URI (Homepage)', - group => 'Group' -); - -our $MySelf = $ENV{'SCRIPT_NAME'}; - -our $Action = param ('action'); -$Action ||= 'default'; - -our %Actions = -( - browse => [\&html_start, \&action_browse, \&html_end], - default => [\&html_start, \&action_browse, \&html_end], - detail => [\&html_start, \&action_detail, \&html_end], - edit => [\&html_start, \&action_edit, \&html_end], - list => [\&html_start, \&action_list, \&html_end], - save => [\&html_start, \&action_save, \&html_end], - search => [\&html_start, \&action_search, \&html_end], - verify => [\&html_start, \&action_verify, \&html_end], - vcard => \&action_vcard -); - -read_config (); - -# make sure AuthLDAPRemoteUserIsDN is enabled. -die unless ($ENV{'REMOTE_USER'}); -$Config{'base_dn'} = $ENV{'REMOTE_USER'}; - -Person->connect -( - uri => $Config{'uri'}, - base_dn => $Config{'base_dn'}, - bind_dn => $Config{'bind_dn'}, - password => $Config{'password'} -) or die; - -our ($UserCN, $UserID) = Person->get_user ($Config{'base_dn'}); - -if (!$UserID and $Action ne 'save') -{ - $Action = 'edit'; -} - -if (!$UserCN) -{ - die; -} - -if (!defined ($Actions{$Action})) -{ - die; -} - -if (ref ($Actions{$Action}) eq 'CODE') -{ - $Actions{$Action}->(); -} -elsif (ref ($Actions{$Action}) eq 'ARRAY') -{ - for (@{$Actions{$Action}}) - { - $_->(); - } -} - -#print qq#
Authenticated as ($UserCN, $UserID, #, $Config{'base_dn'}, qq#)
\n#; - -Person->disconnect (); - -exit (0); - -### - -sub action_browse -{ - my $group = param ('group'); - $group = shift if (@_); - $group ||= ''; - - my @all; - if ($group) - { - @all = Person->search ([[group => $group]]); - } - else - { - @all = Person->search (); - } - - if (!$group) - { - my %groups = (); - for (@all) - { - my $person = $_; - my @g = $person->get ('group'); - - $groups{$_} = (defined ($groups{$_}) ? $groups{$_} + 1 : 1) for (@g); - } - - print qq(\t\t

Contact Groups

\n\t\t\n\n); - } - - if ($group) - { - print qq(\t\t

Contact Group "$group"

\n); - } - else - { - print qq(\t\t

All Contacts

\n); - } - - print qq(\t\t\n\n); - - print qq(\t\t\n); -} - -sub action_list -{ - my $group = param ('group'); - $group = shift if (@_); - $group ||= ''; - - my $title = $group ? "List of group "$group"" : 'List of all addresses'; - my @fields = (qw(address homephone cellphone officephone fax mail)); - - my @all = (); - if ($group) - { - @all = Person->search ([[group => $group]]); - } - else - { - @all = Person->search (); - } - - print <$title - - - - -EOF - for (@fields) - { - print "\t\t\t\t\n"; - } - print "\t\t\t\n"; - - for (sort { $a->name () cmp $b->name () } (@all)) - { - my $person = $_; - my $sn = $person->lastname (); - my $gn = $person->firstname (); - - print "\t\t\t\n", - "\t\t\t\t\n"; - - for (@fields) - { - my $field = $_; - my @values = $person->get ($field); - print "\t\t\t\t\n"; - } - - print "\t\t\t\n"; - } - print "\t\t
Name" . (defined ($FieldNames{$_}) ? $FieldNames{$_} : $_) . "
$sn, $gn" . join ('
', @values) . "
\n\n"; - - if ($group) - { - my $group_esc = uri_escape ($group); - print qq(\t\t\n); - } - else - { - print qq(\t\t\n); - } -} - -sub action_detail -{ - my $cn = param ('cn'); - $cn = shift if (@_); - die unless ($cn); - - my $person = Person->load ($cn); - if (!$person) - { - print qq(\t
Entry "$cn" could not be loaded from DB.
\n); - return; - } - - print qq(\t\t

Details for $cn

\n); - - my $cn_esc = uri_escape ($cn); - - print < - - Name - $cn - -EOF - for (@MultiFields) - { - my $field = $_; - my $values = $person->get ($field); - my $num = scalar (@$values); - my $print = defined ($FieldNames{$field}) ? $FieldNames{$field} : $field; - - next unless ($num); - - print "\t\t\t\n"; - if ($num > 1) - { - print qq(\t\t\t\t$print\n); - } - else - { - print qq(\t\t\t\t$print\n); - } - - for (my $i = 0; $i < $num; $i++) - { - my $val = $values->[$i]; - - if ($field eq 'group') - { - my $val_esc = uri_escape ($val); - $val = qq($val); - } - elsif ($field eq 'uri') - { - my $uri = $val; - $uri = qq(http://$val) unless ($val =~ m#^[a-z]+://#); - $val = qq($val); - } - elsif ($field eq 'mail') - { - $val = qq($val); - } - - print "\t\t\t\n" if ($i); - print "\t\t\t\t$val\n", - "\t\t\t\n"; - } - } - print < - - - -EOF -} - -sub action_search -{ - my $search = param ('search'); - - $search ||= ''; - $search =~ s/[^\s\w]//g; - - if (!$search) - { - print qq(\t
Sorry, the empty search is not allowed.
\n); - action_default (); - return; - } - - my @patterns = split (m/\s+/, $search); - my @filter = (); - - for (@patterns) - { - my $pattern = "$_*"; - push (@filter, [[lastname => $pattern], [firstname => $pattern]]); - } - - my @matches = Person->search (@filter); - - if (!@matches) - { - print qq(\t
No entries matched your search.
\n); - return; - } - - if (scalar (@matches) == 1) - { - my $person = shift (@matches); - my $cn = $person->name (); - action_detail ($cn); - return; - } - - print qq(\t
    \n); - for (@matches) - { - my $person = $_; - my $cn = $person->name (); - my $cn_esc = uri_escape ($cn); - - print qq(\t\t
  • $cn
  • \n); - } - print qq(\t
\n); -} - -sub action_edit -{ - my %opts = @_; - - my $cn = param ('cn'); - - $cn = $opts{'cn'} if (defined ($opts{'cn'})); - $cn ||= ''; - - if (!$UserID) - { - $cn = $UserCN; - } - - my $person; - - my $lastname; - my $firstname; - - my $contacts = {}; - $contacts->{$_} = [] for (@MultiFields); - - if ($cn) - { - $person = Person->load ($cn); - - if (!$person) - { - print qq(\t
Unable to load CN "$cn". Sorry.
\n); - return; - } - - $lastname = $person->lastname (); - $firstname = $person->firstname (); - - for (@MultiFields) - { - $contacts->{$_} = $person->get ($_); - } - } - - $lastname = param ('lastname') if (param ('lastname') and $UserID); - $firstname = param ('firstname') if (param ('firstname') and $UserID); - - get_contacts ($contacts); - - $lastname = $opts{'lastname'} if (defined ($opts{'lastname'})); - $firstname = $opts{'firstname'} if (defined ($opts{'firstname'})); - for (@MultiFields) - { - my $field = $_; - @{$contacts->{$field}} = @{$opts{$field}} if (defined ($opts{$field})); - } - - if ($cn) - { - print "\t\t

Edit contact $cn

\n"; - } - else - { - print "\t\t

Create new contact

\n"; - } - - print < - - - - - -EOF - if ($UserID) - { - print qq(\t\t\t\t\n); - } - else - { - print qq(\t\t\t\t\n); - } - print < - - -EOF - if ($UserID) - { - print qq(\t\t\t\t\n); - } - else - { - print qq(\t\t\t\t\n); - } - - print "\t\t\t\n"; - - for (@MultiFields) - { - my $field = $_; - my $print = defined ($FieldNames{$field}) ? $FieldNames{$field} : $field; - my @values = @{$contacts->{$field}}; - - push (@values, ''); - - for (@values) - { - my $value = $_; - - print < - - - -EOF - } - } - - print < - - -
Lastname$lastname
Firstname$firstname
$print
-EOF - if ($UserID) - { - print < - -EOF - } - print < -
- -EOF -} - -sub action_save -{ - my $cn = $UserID ? param ('cn') : $UserCN; - - if (verify_fields ()) - { - action_edit (cn => $cn); - return; - } - - if ($cn) - { - action_update (); - return; - } - - die unless ($UserID); - - my $button = lc (param ('button')); - $button ||= 'save'; - - if ($button eq 'cancel') - { - action_browse (); - return; - } - - if (!param ('lastname') or !param ('firstname')) - { - print qq(\t
You have to give both, first and lastname, to identify this record.
\n); - action_edit (cn => ''); - return; - } - - my $lastname = param ('lastname'); - my $firstname = param ('firstname'); - - my $contacts = get_contacts (); - - my $person = Person->create (lastname => $lastname, firstname => $firstname, %$contacts); - - if (!$person) - { - print qq(\t
Unable to save entry. Sorry.
\n); - return; - } - - $cn = $person->name (); - - if ($button eq 'apply') - { - action_edit (cn => $cn); - } - else - { - action_detail ($cn); - } -} - -sub action_update -{ - my $cn = $UserID ? param ('cn') : $UserCN; - my $person = Person->load ($cn); - - die unless ($person); - - my $button = lc (param ('button')); - $button ||= 'save'; - - if ($UserID and $button eq 'cancel') - { - action_detail ($cn); - return; - } - - if ($UserID) - { - my $lastname = param ('lastname'); - my $firstname = param ('firstname'); - - $person->lastname ($lastname) if ($lastname and $lastname ne $person->lastname ()); - $person->firstname ($firstname) if ($firstname and $firstname ne $person->firstname ()); - - $cn = $person->name (); - } - - my $contacts = get_contacts (); - - for (@MultiFields) - { - my $field = $_; - - if (defined ($contacts->{$field})) - { - my $values = $contacts->{$field}; - $person->set ($field, $values); - } - else - { - $person->set ($field, []); - } - } - - if ($button eq 'apply' or !$UserID) - { - action_edit (cn => $cn); - } - else - { - action_detail ($cn); - } -} - -sub action_vcard -{ - my $cn = param ('cn'); - $cn = shift if (@_); - die unless ($cn); - - my $person = Person->load ($cn); - die unless ($person); - - my %vcard_types = - ( - homephone => 'TEL;TYPE=home,voice', - cellphone => 'TEL;TYPE=cell', - officephone => 'TEL;TYPE=work,voice', - fax => 'TEL;TYPE=fax', - mail => 'EMAIL', - uri => 'URL', - group => 'ORG' - ); - - my $sn = $person->lastname (); - my $gn = $person->firstname (); - my $cn_esc = uri_escape ($cn); - - print <get ($field); - - for (@$values) - { - my $value = $_; - print "$vc_fld:$value\n"; - } - } - print "END:VCARD\n"; -} - -sub action_verify -{ - my $cn = param ('cn'); - $cn = shift if (@_); - die unless ($cn); - - my $person = Person->load ($cn); - die unless ($person); - - my ($mail) = $person->get ('mail'); - $mail ||= ''; - - my $message; - my $password = $person->password (); - - if (!$password) - { - $password = pwgen (); - $person->password ($password); - } - - $message = qq(The password for the record "$cn" is "$password".); - - if ($mail) - { - if (action_verify_send_mail ($person)) - { - $message .= qq( A request for verification has been sent to $mail.); - } - } - else - { - $message .= q( There was no e-mail address, thus no verification request could be sent.); - } - - print qq(\t\t
$message
\n); - - action_detail ($cn); -} - -sub action_verify_send_mail -{ - my $person = shift; - my $owner = Person->load ($UserCN); - my $smh; - - my ($owner_mail) = $owner->get ('mail'); - if (!$owner_mail) - { - my $cn = uri_escape ($UserCN); - print qq(\t\t
You have no email set in your own profile. Edit it now!
\n); - return (0); - } - - my $max_width = 0; - for (keys %FieldNames) - { - $max_width = length $FieldNames{$_} if ($max_width < length $FieldNames{$_}); - } - $max_width++; - - my $person_name = $person->name (); - my ($person_mail) = $person->get ('mail'); - my $person_gn = $person->firstname (); - my $password = $person->password (); - - my $host = $ENV{'HTTP_HOST'}; - my $url = 'http://' . $host . $MySelf; - - open ($smh, "| /usr/sbin/sendmail -t -f $owner_mail") or die ("open pipe to sendmail: $!"); - print $smh < -From: $UserCN <$owner_mail> -Subject: Please verify our entry in my address book - -Hello $person_gn, - -the following is your entry in my address book: -EOM - for (@MultiFields) - { - my $field = $_; - my $print = defined ($FieldNames{$field}) ? $FieldNames{$field} : $field; - my @values = $person->get ($field); - - for (@values) - { - printf $smh ('%'.$max_width."s: %-s\n", $print, $_); - } - } - print $smh < - - $title - - - - -EOF - if ($UserID) - { - my $search = param ('search') || ''; - print < -
- - -
-
- - - -
-
- - - -
- -EOF - } - print "\t\t

$title

\n"; -} - -sub html_end -{ - print < - "Lightweight Contact Manager", - written 2005 by Florian octo Forster - <octo at verplant.org> - - - -EOF -} - -sub read_config -{ - my $file = '/var/www/html/cgi.verplant.org/address/book.conf'; - my $fh; - - open ($fh, "< $file") or die ("open ($file): $!"); - for (<$fh>) - { - chomp; - my $line = $_; - - if ($line =~ m/^(\w+):\s*"(.+)"\s*$/) - { - my $key = lc ($1); - my $val = $2; - - $Config{$key} = $val; - } - } - - close ($fh); - - for (qw(uri bind_dn password)) - { - die ("Not defined: $_") unless (defined ($Config{$_})); - } -} - -sub pwgen -{ - my $len = @_ ? shift : 6; - my $retval = ''; - - while (!$retval) - { - my $numbers = 0; - my $lchars = 0; - my $uchars = 0; - - while (length ($retval) < $len) - { - my $chr = int (rand (128)); - - if ($chr >= 48 and $chr < 58) - { - $numbers++; - } - elsif ($chr >= 65 and $chr < 91) - { - $uchars++; - } - elsif ($chr >= 97 and $chr < 123) - { - $lchars++; - } - else - { - next; - } - $retval .= chr ($chr); - } - - $retval = '' if (!$numbers or !$lchars or !$uchars); - } - - return ($retval); -} - -sub verify_fields -{ - my @errors = (); - for (param ('uri')) - { - my $val = $_; - next unless ($val); - - if ($val !~ m#^[a-zA-Z]+://#) - { - push (@errors, 'URIs have to begin with a protocol, e.g. "http://", "ftp://" etc.'); - last; - } - } - - for (param ('homephone'), param ('cellphone'), param ('officephone'), param ('fax')) - { - my $number = $_; - next unless ($number); - - if ($number !~ m/^\+/) - { - push (@errors, 'Telephone numbers have to begin with the country code, e.g. "+49 911 123456"'); - last; - } - } - - print qq(\t\t
\n) if (@errors); - for (my $i = 0; $i < scalar (@errors); $i++) - { - my $e = $errors[$i]; - - print "
\n" if ($i); - print "\t\t\t$e"; - } - print qq(\n\t\t
\n\n) if (@errors); - - return (scalar (@errors)); -} - -sub get_contacts -{ - my $contacts = @_ ? shift : {}; - - for (@MultiFields) - { - my $field = $_; - my @values = grep { $_ } (param ($field)); - - next unless (@values); - - if ($field eq 'homephone' or $field eq 'cellphone' or $field eq 'officephone' or $field eq 'fax') - { - for (@values) - { - $_ =~ s/\D//g; - $_ = '+' . $_; - } - } - - $contacts->{$field} = [@values] if (@values); - } - - return ($contacts); -} diff --git a/licom.cgi b/licom.cgi new file mode 100755 index 0000000..4af14ad --- /dev/null +++ b/licom.cgi @@ -0,0 +1,1160 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use lib (qw(lib)); + +use CGI (':cgi'); +use CGI::Carp (qw(fatalsToBrowser)); +use URI::Escape; +use Data::Dumper; + +use Person; + +our $Debug = 0; +our %Config = (); + +our @MultiFields = (qw(address homephone cellphone officephone fax mail uri group)); + +our %FieldNames = +( + address => 'Address', + homephone => 'Home Phone', + cellphone => 'Cell Phone', + officephone => 'Office Phone', + fax => 'FAX', + mail => 'E-Mail', + uri => 'URI (Homepage)', + group => 'Group' +); + +our $MySelf = $ENV{'SCRIPT_NAME'}; + +our $Action = param ('action'); +$Action ||= 'default'; + +our %Actions = +( + browse => [\&html_start, \&action_browse, \&html_end], + default => [\&html_start, \&action_browse, \&html_end], + detail => [\&html_start, \&action_detail, \&html_end], + edit => [\&html_start, \&action_edit, \&html_end], + list => [\&html_start, \&action_list, \&html_end], + save => [\&html_start, \&action_save, \&html_end], + search => [\&html_start, \&action_search, \&html_end], + verify => [\&html_start, \&action_verify, \&html_end], + vcard => \&action_vcard +); + +read_config (); + +# make sure AuthLDAPRemoteUserIsDN is enabled. +die unless ($ENV{'REMOTE_USER'}); +$Config{'base_dn'} = $ENV{'REMOTE_USER'}; + +Person->connect +( + uri => $Config{'uri'}, + base_dn => $Config{'base_dn'}, + bind_dn => $Config{'bind_dn'}, + password => $Config{'password'} +) or die; + +our ($UserCN, $UserID) = Person->get_user ($Config{'base_dn'}); + +if (!$UserID and $Action ne 'save') +{ + $Action = 'edit'; +} + +if (!$UserCN) +{ + die; +} + +if (!defined ($Actions{$Action})) +{ + die; +} + +if (ref ($Actions{$Action}) eq 'CODE') +{ + $Actions{$Action}->(); +} +elsif (ref ($Actions{$Action}) eq 'ARRAY') +{ + for (@{$Actions{$Action}}) + { + $_->(); + } +} + +#print qq#
Authenticated as ($UserCN, $UserID, #, $Config{'base_dn'}, qq#)
\n#; + +Person->disconnect (); + +exit (0); + +### + +sub action_browse +{ + my $group = param ('group'); + $group = shift if (@_); + $group ||= ''; + + my @all; + if ($group) + { + @all = Person->search ([[group => $group]]); + } + else + { + @all = Person->search (); + } + + if (!$group) + { + my %groups = (); + for (@all) + { + my $person = $_; + my @g = $person->get ('group'); + + $groups{$_} = (defined ($groups{$_}) ? $groups{$_} + 1 : 1) for (@g); + } + + print qq(\t\t

Contact Groups

\n\t\t
    \n); + for (sort (keys (%groups))) + { + my $group = $_; + my $group_esc = uri_escape ($group); + my $num = $groups{$group}; + + print qq(\t\t\t
  • $group ($num)
  • \n); + } + if (!%groups) + { + print qq(\t\t\t
  • There are no groups yet.
  • \n); + } + print qq(\t\t
\n\n); + } + + if ($group) + { + print qq(\t\t

Contact Group "$group"

\n); + } + else + { + print qq(\t\t

All Contacts

\n); + } + + print qq(\t\t
    \n); + for (sort { $a->name () cmp $b->name () } (@all)) + { + my $person = $_; + my $cn = $person->name (); + my $cn_esc = uri_escape ($cn); + + print qq(\t\t\t
  • $cn
  • \n); + } + print qq(\t\t
\n\n); + + print qq(\t\t\n); +} + +sub action_list +{ + my $group = param ('group'); + $group = shift if (@_); + $group ||= ''; + + my $title = $group ? "List of group "$group"" : 'List of all addresses'; + my @fields = (qw(address homephone cellphone officephone fax mail)); + + my @all = (); + if ($group) + { + @all = Person->search ([[group => $group]]); + } + else + { + @all = Person->search (); + } + + print <$title + + + + +EOF + for (@fields) + { + print "\t\t\t\t\n"; + } + print "\t\t\t\n"; + + for (sort { $a->name () cmp $b->name () } (@all)) + { + my $person = $_; + my $sn = $person->lastname (); + my $gn = $person->firstname (); + + print "\t\t\t\n", + "\t\t\t\t\n"; + + for (@fields) + { + my $field = $_; + my @values = $person->get ($field); + print "\t\t\t\t\n"; + } + + print "\t\t\t\n"; + } + print "\t\t
Name" . (defined ($FieldNames{$_}) ? $FieldNames{$_} : $_) . "
$sn, $gn" . join ('
', @values) . "
\n\n"; + + if ($group) + { + my $group_esc = uri_escape ($group); + print qq(\t\t\n); + } + else + { + print qq(\t\t\n); + } +} + +sub action_detail +{ + my $cn = param ('cn'); + $cn = shift if (@_); + die unless ($cn); + + my $person = Person->load ($cn); + if (!$person) + { + print qq(\t
Entry "$cn" could not be loaded from DB.
\n); + return; + } + + print qq(\t\t

Details for $cn

\n); + + my $cn_esc = uri_escape ($cn); + + print < + + Name + $cn + +EOF + for (@MultiFields) + { + my $field = $_; + my $values = $person->get ($field); + my $num = scalar (@$values); + my $print = defined ($FieldNames{$field}) ? $FieldNames{$field} : $field; + + next unless ($num); + + print "\t\t\t\n"; + if ($num > 1) + { + print qq(\t\t\t\t$print\n); + } + else + { + print qq(\t\t\t\t$print\n); + } + + for (my $i = 0; $i < $num; $i++) + { + my $val = $values->[$i]; + + if ($field eq 'group') + { + my $val_esc = uri_escape ($val); + $val = qq($val); + } + elsif ($field eq 'uri') + { + my $uri = $val; + $uri = qq(http://$val) unless ($val =~ m#^[a-z]+://#); + $val = qq($val); + } + elsif ($field eq 'mail') + { + $val = qq($val); + } + + print "\t\t\t\n" if ($i); + print "\t\t\t\t$val\n", + "\t\t\t\n"; + } + } + print < + + + +EOF +} + +sub action_search +{ + my $search = param ('search'); + + $search ||= ''; + $search =~ s/[^\s\w]//g; + + if (!$search) + { + print qq(\t
Sorry, the empty search is not allowed.
\n); + action_default (); + return; + } + + my @patterns = split (m/\s+/, $search); + my @filter = (); + + for (@patterns) + { + my $pattern = "$_*"; + push (@filter, [[lastname => $pattern], [firstname => $pattern]]); + } + + my @matches = Person->search (@filter); + + if (!@matches) + { + print qq(\t
No entries matched your search.
\n); + return; + } + + if (scalar (@matches) == 1) + { + my $person = shift (@matches); + my $cn = $person->name (); + action_detail ($cn); + return; + } + + print qq(\t
    \n); + for (@matches) + { + my $person = $_; + my $cn = $person->name (); + my $cn_esc = uri_escape ($cn); + + print qq(\t\t
  • $cn
  • \n); + } + print qq(\t
\n); +} + +sub action_edit +{ + my %opts = @_; + + my $cn = param ('cn'); + + $cn = $opts{'cn'} if (defined ($opts{'cn'})); + $cn ||= ''; + + if (!$UserID) + { + $cn = $UserCN; + } + + my $person; + + my $lastname; + my $firstname; + + my $contacts = {}; + $contacts->{$_} = [] for (@MultiFields); + + if ($cn) + { + $person = Person->load ($cn); + + if (!$person) + { + print qq(\t
Unable to load CN "$cn". Sorry.
\n); + return; + } + + $lastname = $person->lastname (); + $firstname = $person->firstname (); + + for (@MultiFields) + { + $contacts->{$_} = $person->get ($_); + } + } + + $lastname = param ('lastname') if (param ('lastname') and $UserID); + $firstname = param ('firstname') if (param ('firstname') and $UserID); + + get_contacts ($contacts); + + $lastname = $opts{'lastname'} if (defined ($opts{'lastname'})); + $firstname = $opts{'firstname'} if (defined ($opts{'firstname'})); + for (@MultiFields) + { + my $field = $_; + @{$contacts->{$field}} = @{$opts{$field}} if (defined ($opts{$field})); + } + + if ($cn) + { + print "\t\t

Edit contact $cn

\n"; + } + else + { + print "\t\t

Create new contact

\n"; + } + + print < + + + + + +EOF + if ($UserID) + { + print qq(\t\t\t\t\n); + } + else + { + print qq(\t\t\t\t\n); + } + print < + + +EOF + if ($UserID) + { + print qq(\t\t\t\t\n); + } + else + { + print qq(\t\t\t\t\n); + } + + print "\t\t\t\n"; + + for (@MultiFields) + { + my $field = $_; + my $print = defined ($FieldNames{$field}) ? $FieldNames{$field} : $field; + my @values = @{$contacts->{$field}}; + + push (@values, ''); + + for (@values) + { + my $value = $_; + + print < + + + +EOF + } + } + + print < + + +
Lastname$lastname
Firstname$firstname
$print
+EOF + if ($UserID) + { + print < + +EOF + } + print < +
+ +EOF +} + +sub action_save +{ + my $cn = $UserID ? param ('cn') : $UserCN; + + if (verify_fields ()) + { + action_edit (cn => $cn); + return; + } + + if ($cn) + { + action_update (); + return; + } + + die unless ($UserID); + + my $button = lc (param ('button')); + $button ||= 'save'; + + if ($button eq 'cancel') + { + action_browse (); + return; + } + + if (!param ('lastname') or !param ('firstname')) + { + print qq(\t
You have to give both, first and lastname, to identify this record.
\n); + action_edit (cn => ''); + return; + } + + my $lastname = param ('lastname'); + my $firstname = param ('firstname'); + + my $contacts = get_contacts (); + + my $person = Person->create (lastname => $lastname, firstname => $firstname, %$contacts); + + if (!$person) + { + print qq(\t
Unable to save entry. Sorry.
\n); + return; + } + + $cn = $person->name (); + + if ($button eq 'apply') + { + action_edit (cn => $cn); + } + else + { + action_detail ($cn); + } +} + +sub action_update +{ + my $cn = $UserID ? param ('cn') : $UserCN; + my $person = Person->load ($cn); + + die unless ($person); + + my $button = lc (param ('button')); + $button ||= 'save'; + + if ($UserID and $button eq 'cancel') + { + action_detail ($cn); + return; + } + + if ($UserID) + { + my $lastname = param ('lastname'); + my $firstname = param ('firstname'); + + $person->lastname ($lastname) if ($lastname and $lastname ne $person->lastname ()); + $person->firstname ($firstname) if ($firstname and $firstname ne $person->firstname ()); + + $cn = $person->name (); + } + + my $contacts = get_contacts (); + + for (@MultiFields) + { + my $field = $_; + + if (defined ($contacts->{$field})) + { + my $values = $contacts->{$field}; + $person->set ($field, $values); + } + else + { + $person->set ($field, []); + } + } + + if ($button eq 'apply' or !$UserID) + { + action_edit (cn => $cn); + } + else + { + action_detail ($cn); + } +} + +sub action_vcard +{ + my $cn = param ('cn'); + $cn = shift if (@_); + die unless ($cn); + + my $person = Person->load ($cn); + die unless ($person); + + my %vcard_types = + ( + homephone => 'TEL;TYPE=home,voice', + cellphone => 'TEL;TYPE=cell', + officephone => 'TEL;TYPE=work,voice', + fax => 'TEL;TYPE=fax', + mail => 'EMAIL', + uri => 'URL', + group => 'ORG' + ); + + my $sn = $person->lastname (); + my $gn = $person->firstname (); + my $cn_esc = uri_escape ($cn); + + print <get ($field); + + for (@$values) + { + my $value = $_; + print "$vc_fld:$value\n"; + } + } + print "END:VCARD\n"; +} + +sub action_verify +{ + my $cn = param ('cn'); + $cn = shift if (@_); + die unless ($cn); + + my $person = Person->load ($cn); + die unless ($person); + + my ($mail) = $person->get ('mail'); + $mail ||= ''; + + my $message; + my $password = $person->password (); + + if (!$password) + { + $password = pwgen (); + $person->password ($password); + } + + $message = qq(The password for the record "$cn" is "$password".); + + if ($mail) + { + if (action_verify_send_mail ($person)) + { + $message .= qq( A request for verification has been sent to $mail.); + } + } + else + { + $message .= q( There was no e-mail address, thus no verification request could be sent.); + } + + print qq(\t\t
$message
\n); + + action_detail ($cn); +} + +sub action_verify_send_mail +{ + my $person = shift; + my $owner = Person->load ($UserCN); + my $smh; + + my ($owner_mail) = $owner->get ('mail'); + if (!$owner_mail) + { + my $cn = uri_escape ($UserCN); + print qq(\t\t
You have no email set in your own profile. Edit it now!
\n); + return (0); + } + + my $max_width = 0; + for (keys %FieldNames) + { + $max_width = length $FieldNames{$_} if ($max_width < length $FieldNames{$_}); + } + $max_width++; + + my $person_name = $person->name (); + my ($person_mail) = $person->get ('mail'); + my $person_gn = $person->firstname (); + my $password = $person->password (); + + my $host = $ENV{'HTTP_HOST'}; + my $url = 'http://' . $host . $MySelf; + + open ($smh, "| /usr/sbin/sendmail -t -f $owner_mail") or die ("open pipe to sendmail: $!"); + print $smh < +From: $UserCN <$owner_mail> +Subject: Please verify our entry in my address book + +Hello $person_gn, + +the following is your entry in my address book: +EOM + for (@MultiFields) + { + my $field = $_; + my $print = defined ($FieldNames{$field}) ? $FieldNames{$field} : $field; + my @values = $person->get ($field); + + for (@values) + { + printf $smh ('%'.$max_width."s: %-s\n", $print, $_); + } + } + print $smh < + + $title + + + + +EOF + if ($UserID) + { + my $search = param ('search') || ''; + print < +
+ + +
+
+ + + +
+
+ + + +
+ +EOF + } + print "\t\t

$title

\n"; +} + +sub html_end +{ + print < + "Lightweight Contact Manager", + written 2005 by Florian octo Forster + <octo at verplant.org> + + + +EOF +} + +sub read_config +{ + my $file = '/var/www/html/cgi.verplant.org/address/book.conf'; + my $fh; + + open ($fh, "< $file") or die ("open ($file): $!"); + for (<$fh>) + { + chomp; + my $line = $_; + + if ($line =~ m/^(\w+):\s*"(.+)"\s*$/) + { + my $key = lc ($1); + my $val = $2; + + $Config{$key} = $val; + } + } + + close ($fh); + + for (qw(uri bind_dn password)) + { + die ("Not defined: $_") unless (defined ($Config{$_})); + } +} + +sub pwgen +{ + my $len = @_ ? shift : 6; + my $retval = ''; + + while (!$retval) + { + my $numbers = 0; + my $lchars = 0; + my $uchars = 0; + + while (length ($retval) < $len) + { + my $chr = int (rand (128)); + + if ($chr >= 48 and $chr < 58) + { + $numbers++; + } + elsif ($chr >= 65 and $chr < 91) + { + $uchars++; + } + elsif ($chr >= 97 and $chr < 123) + { + $lchars++; + } + else + { + next; + } + $retval .= chr ($chr); + } + + $retval = '' if (!$numbers or !$lchars or !$uchars); + } + + return ($retval); +} + +sub verify_fields +{ + my @errors = (); + for (param ('uri')) + { + my $val = $_; + next unless ($val); + + if ($val !~ m#^[a-zA-Z]+://#) + { + push (@errors, 'URIs have to begin with a protocol, e.g. "http://", "ftp://" etc.'); + last; + } + } + + for (param ('homephone'), param ('cellphone'), param ('officephone'), param ('fax')) + { + my $number = $_; + next unless ($number); + + if ($number !~ m/^\+/) + { + push (@errors, 'Telephone numbers have to begin with the country code, e.g. "+49 911 123456"'); + last; + } + } + + print qq(\t\t
\n) if (@errors); + for (my $i = 0; $i < scalar (@errors); $i++) + { + my $e = $errors[$i]; + + print "
\n" if ($i); + print "\t\t\t$e"; + } + print qq(\n\t\t
\n\n) if (@errors); + + return (scalar (@errors)); +} + +sub get_contacts +{ + my $contacts = @_ ? shift : {}; + + for (@MultiFields) + { + my $field = $_; + my @values = grep { $_ } (param ($field)); + + next unless (@values); + + if ($field eq 'homephone' or $field eq 'cellphone' or $field eq 'officephone' or $field eq 'fax') + { + for (@values) + { + $_ =~ s/\D//g; + $_ = '+' . $_; + } + } + + $contacts->{$field} = [@values] if (@values); + } + + return ($contacts); +}