#!/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 LiCoM::Config (qw(get_config set_config read_config));
use LiCoM::Connection ();
use LiCoM::Group ();
use LiCoM::Person ();
our $Debug = 0;
our @MultiFields = (qw(address homephone cellphone officephone fax mail uri));
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],
delete => [\&html_start, \&action_ask_del, \&html_end],
expunge => [\&html_start, \&action_do_del, \&html_end],
vcard => \&action_vcard
);
read_config ();
# make sure AuthLDAPRemoteUserIsDN is enabled.
die unless ($ENV{'REMOTE_USER'});
set_config ('base_dn', $ENV{'REMOTE_USER'});
die unless (defined (get_config ('uri'))
and defined (get_config ('base_dn'))
and defined (get_config ('bind_dn'))
and defined (get_config ('password')));
LiCoM::Connection->connect
(
uri => get_config ('uri'),
bind_dn => get_config ('bind_dn'),
password => get_config ('password')
) or die;
our ($UserCN, $UserID) = LiCoM::Person->get_user ($ENV{'REMOTE_USER'});
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}})
{
$_->();
}
}
LiCoM::Connection->disconnect ();
exit (0);
###
sub action_browse
{
my $group = param ('group');
$group = shift if (@_);
$group ||= '';
if (!$group)
{
my @groups = LiCoM::Group->all ();
print qq(\t\t
Contact Groups
\n\t\t
\n);
for (@groups)
{
my $group = $_;
my @members = $group->get_members ();
my $members = scalar (@members);
my $group_name = $group->name ();
my $group_esc = uri_escape ($group_name);
my $desc = $group->description ();
print qq#\t\t\t
\n);
}
}
sub action_detail
{
my $cn = param ('cn');
$cn = shift if (@_);
die unless ($cn);
my $person = LiCoM::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);
}
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 = LiCoM::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 <
Lastname
EOF
if ($UserID)
{
print qq(\t\t\t\t
\n);
}
else
{
print qq(\t\t\t\t
$lastname
\n);
}
print <
Firstname
EOF
if ($UserID)
{
print qq(\t\t\t\t
\n);
}
else
{
print qq(\t\t\t\t
$firstname
\n);
}
print "\t\t\t
\n";
for (@MultiFields)
{
my $field = $_;
my $print = defined ($FieldNames{$field}) ? $FieldNames{$field} : $field;
my @values = @{$contacts->{$field}};
next if ($field eq 'group');
push (@values, '');
for (@values)
{
my $value = $_;
print <
$print
EOF
}
}
if ($UserID)
{
my @all_groups = LiCoM::Group->all ();
if (@all_groups)
{
print "\t\t\t
\n",
"\t\t\t\t
Group(s)
\n",
qq(\t\t\t\t
\n",
"\t\t\t
\n";
}
print "\t\t\t
\n",
"\t\t\t\t
New Group
\n",
qq(\t\t\t\t
\n),
"\t\t\t
\n";
}
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 = LiCoM::Person->create (lastname => $lastname, firstname => $firstname, %$contacts);
if (!$person)
{
print qq(\t
Unable to save entry. Sorry.
\n);
return;
}
$cn = $person->name ();
for (param ('group'))
{
my $group_name = $_;
my $group = LiCoM::Group->load ($group_name);
if ($group)
{
$group->add_members ($cn);
}
else
{
print qq(\t
Group "$group_name" does not exist or could not be loaded.
\n);
}
}
if (param ('newgroup'))
{
# FIXME add error handling
my $group_name = param ('newgroup');
LiCoM::Group->create ($group_name, '', $cn);
}
if ($button eq 'apply')
{
action_edit (cn => $cn);
}
else
{
action_detail ($cn);
}
}
sub action_update
{
my $cn = $UserID ? param ('cn') : $UserCN;
my $person = LiCoM::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 ();
# FIXME Fix groups
}
my $contacts = get_contacts ();
for (@MultiFields)
{
my $field = $_;
next if (!$UserID and $field eq 'group');
if (defined ($contacts->{$field}))
{
my $values = $contacts->{$field};
$person->set ($field, $values);
}
else
{
$person->set ($field, []);
}
}
my %changed_groups = map { $_ => 1 } (param ('group'));
my @current_groups = LiCoM::Group->load_by_member ($cn);
for (@current_groups)
{
my $group_obj = $_;
my $group_name = $group_obj->name ();
if (!defined ($changed_groups{$group_name}))
{
$group_obj->del_members ($cn);
}
else
{
delete ($changed_groups{$group_name});
}
}
for (keys %changed_groups)
{
my $group_name = $_;
my $group_obj = LiCoM::Group->load ($group_name) or die;
$group_obj->add_members ($cn);
}
if (param ('newgroup'))
{
# FIXME add error handling
my $group_name = param ('newgroup');
LiCoM::Group->create ($group_name, '', $cn);
}
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 = LiCoM::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);
next unless ($vc_fld);
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 = LiCoM::Person->load ($cn);
die unless ($person);
my ($mail) = $person->get ('mail');
$mail ||= '';
my $message;
my $password = $person->get ('password');
if (!$password)
{
$password = pwgen ();
$person->set ('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 = LiCoM::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->get ('password');
my $host = $ENV{'HTTP_HOST'};
my $url = (defined ($ENV{'HTTPS'}) ? 'https://' : '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 <load ($cn);
$person or die;
my $cn_esc = uri_escape ($cn);
print <Really delete $cn?
You are about to delete $cn. Are you
totally, absolutely sure you want to do this?