--- /dev/null
+#!/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 <<HEADER;
+Content-Type: text/html; charset=UTF-8
+
+HEADER
+
+print_html_start ("octo's Address Book");
+
+if (!$UserCN)
+{
+ die;
+}
+
+if (!defined ($Actions{$Action}))
+{
+ die;
+}
+
+$Actions{$Action}->();
+
+print qq#<div>Authenticated as ($UserCN, $UserID, #, $Config{'base_dn'}, qq#)</div>\n#;
+
+print_html_end ();
+
+Person->disconnect ();
+
+exit (0);
+
+###
+
+sub action_default
+{
+ print "<code>action_default</code>\n";
+}
+
+sub action_search
+{
+ print "<code>action_search</code>\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<div class="error">Unable to load CN "$cn". Sorry.</div>\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 "<h2>Edit contact $cn</h2>\n";
+ }
+ else
+ {
+ print "<h2>Create new contact</h2>\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(<select name="c_type">\n);
+ for (@options)
+ {
+ my ($field, $print) = @$_;
+ my $sel = $field eq $selected ? ' selected="selected"' : '';
+ print qq(\t\t\t\t<option value="$field"$sel>$print</option>\n);
+ }
+ print qq(\t\t\t</select>);
+ };
+
+ print <<EOF;
+ <form action="$MySelf" method="post">
+ <input type="hidden" name="action" value="save" />
+ <input type="hidden" name="cn" value="$cn" />
+ <table class="edit">
+ <tr>
+ <td>Lastname</td>
+EOF
+ if ($UserID)
+ {
+ print qq(\t\t\t<td><input type="text" name="lastname" value="$lastname" /></td>\n);
+ }
+ else
+ {
+ print qq(\t\t\t<td>$lastname</td>\n);
+ }
+ print <<EOF;
+ </tr>
+ <tr>
+ <td>Firstname</td>
+EOF
+ if ($UserID)
+ {
+ print qq(\t\t\t<td><input type="text" name="firstname" value="$firstname" /></td>\n);
+ }
+ else
+ {
+ print qq(\t\t\t<td>$firstname</td>\n);
+ }
+
+ print "\t\t</tr>\n";
+
+ for (@MultiFields)
+ {
+ my $field = $_;
+ my @values = @{$contacts->{$field}};
+
+ @values = ('') unless (@values);
+
+ for (@values)
+ {
+ my $value = $_;
+ print "\t\t<tr>\n",
+ "\t\t\t<td>";
+ $selector->($field);
+ print "</td>\n", <<EOF;
+ <td><input type="text" name="c_value" value="$value" /></td>
+ </tr>
+EOF
+ }
+ }
+
+ print "\t\t<tr>\n",
+ "\t\t\t<td>";
+ $selector->();
+ print "</td>\n", <<EOF;
+ <td><input type="text" name="c_value" value="" /></td>
+ </tr>
+ <tr>
+ <td colspan="2"><input type="submit" name="button" value="Save" /></td>
+ </tr>
+ </table>
+ </form>
+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<div class="error">You have to give both, first and lastname, to identify this record.</div>\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<div class="error">Unable to save entry. Sorry.</div>\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 <<EOF;
+<html>
+<head>
+<title>$title</title>
+<style type="text/css">
+<!--
+body
+{
+ color: black;
+ background-color: white;
+}
+
+div.error
+{
+ color: red;
+ background-color: yellow;
+
+ font-weight: bold;
+ padding: 1ex;
+ border: 2px solid red;
+}
+
+div.foot
+{
+ color: gray;
+ background-color: white;
+
+ font-size: x-small;
+ text-align: right;
+ border-top: 1px solid black;
+ width: 100%;
+}
+
+div.menu form
+{
+ display: inline;
+ margin-right: 5ex;
+}
+
+img
+{
+ border: none;
+}
+
+td
+{
+ color: black;
+ background-color: #cccccc;
+}
+
+th
+{
+ color: black;
+ background-color: #999999;
+ text-align: left;
+}
+//-->
+</style>
+</head>
+
+<body>
+EOF
+ if ($UserID)
+ {
+ my $search = param ('search') || '';
+ print <<EOF;
+ <div class="menu">
+ <form action="$MySelf" method="post">
+ <input type="hidden" name="action" value="search" />
+ <input type="text" name="search" value="$search" />
+ <input type="submit" name="button" value="Search" />
+ </form>
+ <form action="$MySelf" method="post">
+ <input type="hidden" name="action" value="edit" />
+ <input type="hidden" name="dn" value="" />
+ <input type="submit" name="button" value="Add New" />
+ </form>
+ </div>
+ <hr />
+EOF
+ }
+ print "\t<h1>octo's lightweight address book</h1>\n";
+}
+
+sub print_html_end
+{
+ print <<EOF;
+ <div class="foot">octo's Address Book <octo at verplant.org></div>
+ </body>
+</html>
+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);
+}
--- /dev/null
+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-E<gt>B<connect> (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-E<gt>B<disconnect> ()
+
+Disconnect from the LDAP-Server.
+
+=cut
+
+sub disconnect
+{
+ $Ldap->unbind ();
+ $Ldap = undef;
+}
+
+=item Person-E<gt>B<new> (I<$ldap_entry>)
+
+Created a new I<Person>-object from the passed I<Net::LDAP::Entry>-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-E<gt>B<load> (I<$cn>)
+
+Loads the given CN and returns the B<Person>-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-E<gt>B<create> (B<lastname> =E<gt> I<$lastname>, B<firstname> =E<gt> I<$firstname>, ...)
+
+Create a new I<Net::LDAP::Entry>-object and return it's corresponding
+I<Person>-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->dump (*STDOUT);
+ 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-E<gt>B<search> (B<firstname> =E<gt> I<"Flor*">)
+
+Search for the given patterns. Returns a list of I<Person>-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>-E<gt>B<delete> ()
+
+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>-E<gt>B<lastname> ([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>-E<gt>B<firstname> ([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>-E<gt>B<name> ()
+
+Returns the CN.
+
+=cut
+
+sub name
+{
+ my $obj = shift;
+ return ($obj->{'cn'});
+}
+
+=item I<$obj>-E<gt>B<address> ([I<@address>])
+
+=item I<$obj>-E<gt>B<homephone> ([I<@homephone>])
+
+=item I<$obj>-E<gt>B<cellphone> ([I<@cellphone>])
+
+=item I<$obj>-E<gt>B<officephone> ([I<@officephone>])
+
+=item I<$obj>-E<gt>B<fax> ([I<@fax>])
+
+=item I<$obj>-E<gt>B<mail> ([I<@mail>])
+
+=item I<$obj>-E<gt>B<uri> ([I<@uri>])
+
+=item I<$obj>-E<gt>B<group> ([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 E<lt>octo at verplant.orgE<gt>
+
+=cut
projects / licom.git / commitdiff