From: octo Date: Fri, 22 Apr 2005 16:17:36 +0000 (+0000) Subject: Initial import X-Git-Tag: Release-0.1~15 X-Git-Url: https://git.verplant.org/?a=commitdiff_plain;h=6333caf0b25222e22ccae4e103b10a366d8155f5;p=licom.git Initial import --- 6333caf0b25222e22ccae4e103b10a366d8155f5 diff --git a/book.cgi b/book.cgi new file mode 100755 index 0000000..c6de51e --- /dev/null +++ b/book.cgi @@ -0,0 +1,482 @@ +#!/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 $MySelf = $ENV{'SCRIPT_NAME'}; + +our $Action = param ('action'); +$Action ||= 'default'; + +our %Actions = +( + default => \&action_default, + edit => \&action_edit, + save => \&action_save, + search => \&action_search +); + +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'; +} + +print <(); + +print qq#
Authenticated as ($UserCN, $UserID, #, $Config{'base_dn'}, qq#)
\n#; + +print_html_end (); + +Person->disconnect (); + +exit (0); + +### + +sub action_default +{ + print "action_default\n"; +} + +sub action_search +{ + print "action_search\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 (); + $contacts->{'address'} = $person->address (); + $contacts->{'homephone'} = $person->homephone (); + $contacts->{'cellphone'} = $person->cellphone (); + $contacts->{'officephone'} = $person->officephone (); + $contacts->{'fax'} = $person->fax (); + $contacts->{'mail'} = $person->mail (); + $contacts->{'uri'} = $person->uri (); + $contacts->{'group'} = $person->group (); + } + + $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 "

Edit contact $cn

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

Create new contact

\n"; + } + + my $selector = sub + { + my $selected = @_ ? shift : ''; + + my @options = + ( + [none => '-- Contact --'], + [address => 'Address'], + [homephone => 'Home Phone'], + [cellphone => 'Cellphone'], + [officephone => 'Office Phone'], + [fax => 'FAX'], + [mail => 'E-Mail'], + [uri => 'URI (Homepage)'], + [group => 'Group'] + ); + + print qq(); + }; + + print < + + + + + +EOF + if ($UserID) + { + print qq(\t\t\t\n); + } + else + { + print qq(\t\t\t\n); + } + print < + + +EOF + if ($UserID) + { + print qq(\t\t\t\n); + } + else + { + print qq(\t\t\t\n); + } + + print "\t\t\n"; + + for (@MultiFields) + { + my $field = $_; + my @values = @{$contacts->{$field}}; + + @values = ('') unless (@values); + + for (@values) + { + my $value = $_; + print "\t\t\n", + "\t\t\t\n", < + +EOF + } + } + + print "\t\t\n", + "\t\t\t\n", < + + + + +
Lastname$lastname
Firstname$firstname
"; + $selector->($field); + print "
"; + $selector->(); + 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 = 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 (); + + action_edit (cn => $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); + $person->firstname ($firstname) if ($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, []); + } + } + + action_edit (cn => $cn); +} + +sub print_html_start +{ + my $title = shift; + $title = 'Search for names' unless ($title); + + print < + +$title + + + + +EOF + if ($UserID) + { + my $search = param ('search') || ''; + print < +
+ + + +
+
+ + + +
+ +
+EOF + } + print "\t

octo's lightweight address book

\n"; +} + +sub print_html_end +{ + print <octo's 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{$_})); + } +} + +sub get_contacts +{ + my $contacts = @_ ? shift : {}; + + if (param ('c_value')) + { + my @c_values = param ('c_value'); + my @c_types = param ('c_type'); + + my %cts = (); + + die if (scalar (@c_values) != scalar (@c_types)); + + for (my $i = 0; $i < scalar (@c_values); $i++) + { + my $type = $c_types[$i]; + my $value = $c_values[$i]; + + $cts{$type} = [] unless (defined ($cts{$type})); + push (@{$cts{$type}}, $value) if ($value); + } + + for (@MultiFields) + { + my $type = $_; + @{$contacts->{$type}} = @{$cts{$type}} if (defined ($cts{$type})); + } + } + + return ($contacts); +} diff --git a/lib/Person.pm b/lib/Person.pm new file mode 100644 index 0000000..79ed9f7 --- /dev/null +++ b/lib/Person.pm @@ -0,0 +1,529 @@ +package Person; + +use strict; +use warnings; + +use Net::LDAP; +use Net::LDAP::Filter; + +=head1 NAME + +Person - High level interface for address books using an LDAP-backend. + +=cut + +our %Config = +( + base_dn => undef +); + +our %ValidFields = +( + telephoneNumber => 1, + facsimileTelephoneNumber => 1, + sn => 0, + cn => 0, + givenName => 0, + homePhone => 1, + homePostalAddress => 1, + labeledURI => 1, + mail => 1, + mobile => 1, + o => 1 +); + +our %ExternalNames = +( + officephone => 'telephoneNumber', + fax => 'facsimileTelephoneNumber', + lastname => 'sn', + name => 'cn', + firstname => 'givenName', + homephone => 'homePhone', + address => 'homePostalAddress', + uri => 'labeledURI', + mail => 'mail', + cellphone => 'mobile', + group => 'o' +); + +our $Ldap; + +return (1); + +=head1 METHODS + +=over 4 + +=item Person-EB (I<$server>, I<$bind_dn>, I<$password>, I<$base_dn>, [I<$port>]) + +Connects to the LDAP-Server given. + +=cut + +sub connect +{ + my $pkg = shift; + my %opts = @_; + + my $bind_dn = $opts{'bind_dn'}; + my $base_dn = $opts{'base_dn'}; + my $uri = $opts{'uri'}; + my $passwd = $opts{'password'}; + + my $msg; + + $Ldap = Net::LDAP->new ($uri); + + $msg = $Ldap->bind ($bind_dn, password => $passwd); + if ($msg->is_error ()) + { + warn ('LDAP bind failed: ' . $msg->error_text ()); + return (0); + } + + $Config{'base_dn'} = $base_dn; + + return (1); +} + +=item Person-EB () + +Disconnect from the LDAP-Server. + +=cut + +sub disconnect +{ + $Ldap->unbind (); + $Ldap = undef; +} + +=item Person-EB (I<$ldap_entry>) + +Created a new I-object from the passed I-object. + +=cut + +sub new +{ + my $pkg = shift; + my $entry = shift; + my $obj = {}; + + $obj->{'dn'} = $entry->dn (); + $obj->{'ldap'} = $entry; + + for (keys %ValidFields) + { + my $key = $_; + $obj->{$key} = $entry->get_value ($key, asref => $ValidFields{$key}); + } + + return (bless ($obj, $pkg)); +} + +=item Person-EB (I<$cn>) + +Loads the given CN and returns the B-object. + +=cut + +sub load +{ + my $pkg = shift; + my $cn = shift; + + my ($retval) = search ($pkg, cn => $cn); + + if (!$retval) + { + warn ("CN '$cn' could not be found"); + return (undef); + } + + return ($retval); +} + +=item Person-EB (B =E I<$lastname>, B =E I<$firstname>, ...) + +Create a new I-object and return it's corresponding +I-object. + +=cut + +sub create +{ + my $pkg = shift; + + my %hash = @_; + my $entry = Net::LDAP::Entry->new (); + my $dn; + my $ou; + + $entry->add (objectClass => [qw(top organizationalUnit person organizationalPerson inetOrgPerson)]); + + for (keys %hash) + { + my $key = $_; + my $val = $hash{$key}; + my $field = defined ($ExternalNames{$key}) ? $ExternalNames{$key} : $key; + + if (!defined ($ValidFields{$field})) + { + warn ("Invalid field $field"); + next; + } + + if ($ValidFields{$field}) + { + if (ref ($val) eq 'ARRAY') + { + $entry->add ($field => [@$val]); + } + elsif (!ref ($val)) + { + $entry->add ($field => [$val]); + } + else + { + warn ("You cannot pass ref-type " . ref ($val)); + } + } + else + { + my $temp; + if (ref ($val) eq 'ARRAY') + { + $temp = $val->[0]; + } + elsif (!ref ($val)) + { + $temp = $val; + } + else + { + warn ("You cannot pass ref-type " . ref ($val)); + } + + $entry->add ($field => $val) if (defined ($val) and $val); + } + } + + my $sn = $entry->get_value ('sn'); + my $gn = $entry->get_value ('givenName'); + + if (!defined ($sn) or !defined ($gn)) + { + warn ("sn or givenName not given"); + return (undef); + } + + $dn = "cn=$sn $gn," . $Config{'base_dn'}; + ($ou) = $Config{'base_dn'} =~ m/\bou\s*=\s*([^,]+)/i; + + $entry->add (cn => "$sn $gn", ou => $ou); + $entry->dn ($dn); + + print "\n"; + + $entry->changetype ('add'); + my $mesg = $entry->update ($Ldap); + + if ($mesg->is_error ()) + { + warn ("Error while creating entry '$dn' on LDAP server: " . $mesg->error_text ()); + return (undef); + } + + return (new ($pkg, $entry)); +} + +=item Person-EB (B =E I<"Flor*">) + +Search for the given patterns. Returns a list of I-objects. + +=cut + +sub search +{ + my $pkg = shift; + my %patterns = @_; + my %filter = (); + my $filter = '(objectclass=inetOrgPerson)'; + my $mesg; + my @retval = (); + + for (keys %patterns) + { + my $key = $_; + my $val = $patterns{$key}; + + $key = $ExternalNames{$key} if (defined ($ExternalNames{$key})); + if (!defined ($ValidFields{$key})) + { + warn ("Not a valid field: $key"); + next; + } + + $filter{$key} = $val; + } + + if (%filter) + { + if (scalar (keys %filter) == 1) + { + my ($key) = keys (%filter); + my $val = $filter{$key}; + $filter = "(& $filter ($key=$val))"; + } + else + { + my $tmp = join (' ', map { '(' . $_ . '=' . $filter->{$_} . ')' } (keys (%$filter))); + $filter = "(& $filter (| $tmp))"; + } + } + + $mesg = $Ldap->search + ( + base => $Config{'base_dn'}, + filter => $filter + ); + + if ($mesg->is_error ()) + { + warn ("Error while querying LDAP server: " . $mesg->error_text ()); + return (qw()); + } + + for ($mesg->entries ()) + { + my $entry = $_; + my $obj = new ($pkg, $entry); + + push (@retval, $obj); + } + + return (@retval); +} + +=item I<$obj>-EB () + +Deletes the record. + +=cut + +sub delete +{ + my $obj = shift; + my $entry = $obj->{'ldap'}; + + $entry->changetype ('delete'); + $entry->delete (); + $entry->update ($Ldap); + + %$obj = (); +} + +=item I<$obj>-EB ([I<$lastname>]) + +Get or set the lastname. + +=cut + +sub _update_dn +{ + my $obj = shift; + my $entry = $obj->{'ldap'}; + my $sn = $obj->{'sn'}; + my $gn = $obj->{'givenName'}; + my $cn = "$sn $gn"; + my $dn = "cn=$cn," . $Config{'base_dn'}; + + $obj->{'cn'} = $cn; + + $entry->changetype ('modify'); + $entry->replace (sn => $sn, givenName => $gn, cn => $cn); + $entry->dn ($dn); + $entry->update ($Ldap); +} + +sub lastname +{ + my $obj = shift; + + if (@_) + { + $obj->{'sn'} = shift; + _update_dn ($obj); + } + + return ($obj->{'sn'}); +} + +=item I<$obj>-EB ([I<$firstname>]) + +Get or set the firstname. + +=cut + +sub firstname +{ + my $obj = shift; + + if (@_) + { + $obj->{'givenName'} = shift; + _update_dn ($obj); + } + + return ($obj->{'givenName'}); +} + +=item I<$obj>-EB () + +Returns the CN. + +=cut + +sub name +{ + my $obj = shift; + return ($obj->{'cn'}); +} + +=item I<$obj>-EB
([I<@address>]) + +=item I<$obj>-EB ([I<@homephone>]) + +=item I<$obj>-EB ([I<@cellphone>]) + +=item I<$obj>-EB ([I<@officephone>]) + +=item I<$obj>-EB ([I<@fax>]) + +=item I<$obj>-EB ([I<@mail>]) + +=item I<$obj>-EB ([I<@uri>]) + +=item I<$obj>-EB ([I<@groups>]) + +Get or set the attribute. + +=cut + +sub AUTOLOAD +{ + my $obj = shift; + my @values = @_; + my $field = $Person::AUTOLOAD; + $field =~ s/.*:://; + + return (set ($obj, $field, @values ? [@values] : undef)) +} + +sub get +{ + my $obj = shift; + my $field = shift; + + return (set ($obj, $field, undef)); +} + +sub set +{ + my $obj = shift; + my $field = shift; + my $value = @_ ? shift : undef; + my $entry = $obj->{'ldap'}; + + if (defined ($ExternalNames{$field})) + { + $field = $ExternalNames{$field}; + } + if (!defined ($ValidFields{$field})) + { + return (undef); + } + + if (defined ($value)) + { + $entry->changetype ('modify'); + + if ($ValidFields{$field}) + { + $entry->replace ($field, [@$value]); + $obj->{$field} = $value; + } + else + { + splice (@$value, 1) if (scalar (@$value) > 1); + $entry->replace ($field, $value); + $obj->{$field} = $value->[0]; + } + + $entry->update ($Ldap); + } + + $obj->{$field} = [] unless (defined ($obj->{$field})); + + if (wantarray () and $ValidFields{$field}) + { + return (@{$obj->{$field}}); + } + else + { + return ($obj->{$field}); + } +} + +sub get_user +{ + my $pkg = shift; + my $dn = shift; + my ($search) = $dn =~ m/cn\s*=\s*([^,]+)/i; + + die unless ($search); + + my $cn = ''; + my $id = ''; + + my $mesg = $Ldap->search + ( + base => $Config{'base_dn'}, + filter => "(cn=$search)" + ); + + if ($mesg->is_error ()) + { + warn ("Error while querying LDAP server: " . $mesg->error_text ()); + return (''); + } + + for ($mesg->entries ()) + { + my $e = $_; + my ($t_cn) = $e->get_value ('cn', asref => 0); + my ($t_id) = $e->get_value ('uid', asref => 0); + + print STDERR "LDAP result: $t_cn, $t_id"; + + if (!$id or $t_id) + { + $cn = $t_cn; + $id = $t_id; + } + } + + return ($cn, $id); +} + +=back + +=head1 AUTHOR + +Florian octo Forster Eocto at verplant.orgE + +=cut