#!/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], save => [\&html_start, \&action_save, \&html_end], search => [\&html_start, \&action_search, \&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 = Person->search ([[group => $group]]); if ($group eq '*') { my %groups = (); for (@all) { my $person = $_; my @g = $person->get ('group'); $groups{$_} = 1 for (@g); } print qq(\t

Contact Groups

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

Contact Group "$group"

\n\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

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\n"; if ($num > 1) { print qq(\t\t\t$print\n); } else { print qq(\t\t\t$print\n); } for (my $i = 0; $i < $num; $i++) { my $val = $values->[$i]; print "\t\t\n" if ($i); print "\t\t\t$val\n", "\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); } 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); for (@MultiFields) { my $field = $_; my @values = grep { $_ } (param ($field)); $contacts->{$field} = [@values] if (@values); } $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 print qq(\t\t\t\t\t\n) if ($UserID); print <
EOF } sub action_save { my $cn = $UserID ? param ('cn') : $UserCN; if ($cn) { action_update (); return; } die unless ($UserID); 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 = {}; for (@MultiFields) { my $field = $_; my @values = grep { $_ } (param ($field)); $contacts->{$field} = [@values] if (@values); } 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 (param ('button') eq 'Update') { 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); 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 = {}; for (@MultiFields) { my $field = $_; my @values = grep { $_ } (param ($field)); $contacts->{$field} = [@values] if (@values); } for (@MultiFields) { my $field = $_; if (defined ($contacts->{$field})) { my $values = $contacts->{$field}; $person->set ($field, $values); } else { $person->set ($field, []); } } if (param ('button') eq 'Update' 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 html_start { my $title = shift; $title = q(octo's Lightweight Address Book) unless ($title); print < $title EOF if ($UserID) { my $search = param ('search') || ''; print <

EOF } print "\t\t

octo's Lightweight Address Book

\n"; } sub html_end { print <octo's Lightweight Address Book <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{$_})); } }