From: octo Date: Sun, 24 Apr 2005 20:53:01 +0000 (+0000) Subject: Changed structure of perl modules to be more useful. X-Git-Tag: Release-0.1~7 X-Git-Url: https://git.verplant.org/?a=commitdiff_plain;h=fb2741ec9a3da3376994f3f70f8d0c17bbe70931;p=licom.git Changed structure of perl modules to be more useful. Added basic mutt-ldap script. --- diff --git a/lib/LiCoM/Config.pm b/lib/LiCoM/Config.pm new file mode 100644 index 0000000..1c561a2 --- /dev/null +++ b/lib/LiCoM/Config.pm @@ -0,0 +1,37 @@ +package LiCoM::Config; + +use strict; +use warnings; + +use Exporter; + +@LiCoM::Config::EXPORT_OK = ('get_config'); +@LiCoM::Config::ISA = ('Exporter'); + +return (1); + +sub get_config +{ + my $file = @_ ? shift : '/etc/licom/licom.conf'; + my $fh; + my $config = {}; + + 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); + + return ($config); +} diff --git a/lib/LiCoM/Person.pm b/lib/LiCoM/Person.pm new file mode 100644 index 0000000..d51ad28 --- /dev/null +++ b/lib/LiCoM/Person.pm @@ -0,0 +1,567 @@ +package LiCoM::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]) if (@$val); + } + elsif (!ref ($val)) + { + $entry->add ($field => [$val]) if ($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. + + @filter = + ( + [ + [field => value], # OR + [field => value] + ], # AND + ... + ); + +=cut + +sub search +{ + my $pkg = shift; + + my @patterns = @_; + my @konjunct = (); + my $filter; + + my $mesg; + my @retval = (); + + for (@patterns) + { + my $dj = $_; + my @disjunc = (); + + for (@$dj) + { + my $field = $_->[0]; + my $value = $_->[1]; + + $field = $ExternalNames{$field} if (defined ($ExternalNames{$field})); + if (!defined ($ValidFields{$field})) + { + warn ("Not a valid field: $field"); + next; + } + + $value =~ s/([\(\)\\])/\\$1/g; + + push (@disjunc, "($field=$value)"); + } + + if (@disjunc) + { + push (@konjunct, join ('', '(|', @disjunc, ')')); + } + } + + if (@konjunct) + { + $filter = join ('', '(&(objectclass=inetOrgPerson)', @konjunct, ')'); + } + else + { + $filter = '(objectclass=inetOrgPerson)'; + } + + print STDERR "Debug: using filter: $filter"; + + $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; + + print STDERR "This is _update_dn, trying to set dn=$dn"; + + $entry->changetype ('modify'); + $entry->replace (sn => $sn, givenName => $gn, cn => $cn); + $entry->update ($Ldap); + $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); + + if (!$id or $t_id) + { + $cn = $t_cn; + $id = $t_id; + } + } + + return ($cn, $id); +} + +sub password +{ + my $obj = shift; + my $entry = $obj->{'ldap'}; + my $pwd; + + if (@_) + { + $pwd = shift; + $entry->changetype ('modify'); + $entry->replace (userPassword => $pwd); + $entry->update ($Ldap); + } + + $pwd = $entry->get_value ('userPassword'); +} + +=back + +=head1 AUTHOR + +Florian octo Forster Eocto at verplant.orgE + +=cut diff --git a/lib/Person.pm b/lib/Person.pm deleted file mode 100644 index 25df303..0000000 --- a/lib/Person.pm +++ /dev/null @@ -1,567 +0,0 @@ -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]) if (@$val); - } - elsif (!ref ($val)) - { - $entry->add ($field => [$val]) if ($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. - - @filter = - ( - [ - [field => value], # OR - [field => value] - ], # AND - ... - ); - -=cut - -sub search -{ - my $pkg = shift; - - my @patterns = @_; - my @konjunct = (); - my $filter; - - my $mesg; - my @retval = (); - - for (@patterns) - { - my $dj = $_; - my @disjunc = (); - - for (@$dj) - { - my $field = $_->[0]; - my $value = $_->[1]; - - $field = $ExternalNames{$field} if (defined ($ExternalNames{$field})); - if (!defined ($ValidFields{$field})) - { - warn ("Not a valid field: $field"); - next; - } - - $value =~ s/([\(\)\\])/\\$1/g; - - push (@disjunc, "($field=$value)"); - } - - if (@disjunc) - { - push (@konjunct, join ('', '(|', @disjunc, ')')); - } - } - - if (@konjunct) - { - $filter = join ('', '(&(objectclass=inetOrgPerson)', @konjunct, ')'); - } - else - { - $filter = '(objectclass=inetOrgPerson)'; - } - - print STDERR "Debug: using filter: $filter"; - - $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; - - print STDERR "This is _update_dn, trying to set dn=$dn"; - - $entry->changetype ('modify'); - $entry->replace (sn => $sn, givenName => $gn, cn => $cn); - $entry->update ($Ldap); - $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); - - if (!$id or $t_id) - { - $cn = $t_cn; - $id = $t_id; - } - } - - return ($cn, $id); -} - -sub password -{ - my $obj = shift; - my $entry = $obj->{'ldap'}; - my $pwd; - - if (@_) - { - $pwd = shift; - $entry->changetype ('modify'); - $entry->replace (userPassword => $pwd); - $entry->update ($Ldap); - } - - $pwd = $entry->get_value ('userPassword'); -} - -=back - -=head1 AUTHOR - -Florian octo Forster Eocto at verplant.orgE - -=cut diff --git a/licom.cgi b/licom.cgi index 4af14ad..5abb2e6 100755 --- a/licom.cgi +++ b/licom.cgi @@ -9,10 +9,11 @@ use CGI::Carp (qw(fatalsToBrowser)); use URI::Escape; use Data::Dumper; -use Person; +use LiCoM::Config (qw(get_config)); +use LiCoM::Person; our $Debug = 0; -our %Config = (); +our $Config = {}; our @MultiFields = (qw(address homephone cellphone officephone fax mail uri group)); @@ -46,21 +47,24 @@ our %Actions = vcard => \&action_vcard ); -read_config (); +$Config = get_config (); # make sure AuthLDAPRemoteUserIsDN is enabled. die unless ($ENV{'REMOTE_USER'}); -$Config{'base_dn'} = $ENV{'REMOTE_USER'}; +$Config->{'base_dn'} = $ENV{'REMOTE_USER'}; -Person->connect +die unless (defined ($Config->{'uri'}) and defined ($Config->{'base_dn'}) + and defined ($Config->{'bind_dn'}) and defined ($Config->{'password'})); + +LiCoM::Person->connect ( - uri => $Config{'uri'}, - base_dn => $Config{'base_dn'}, - bind_dn => $Config{'bind_dn'}, - password => $Config{'password'} + 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'}); +our ($UserCN, $UserID) = LiCoM::Person->get_user ($Config->{'base_dn'}); if (!$UserID and $Action ne 'save') { @@ -89,9 +93,7 @@ elsif (ref ($Actions{$Action}) eq 'ARRAY') } } -#print qq#
Authenticated as ($UserCN, $UserID, #, $Config{'base_dn'}, qq#)
\n#; - -Person->disconnect (); +LiCoM::Person->disconnect (); exit (0); @@ -106,15 +108,16 @@ sub action_browse my @all; if ($group) { - @all = Person->search ([[group => $group]]); + @all = LiCoM::Person->search ([[group => $group]]); } else { - @all = Person->search (); + @all = LiCoM::Person->search (); } if (!$group) { + my @nogroup = (); my %groups = (); for (@all) { @@ -122,7 +125,10 @@ sub action_browse my @g = $person->get ('group'); $groups{$_} = (defined ($groups{$_}) ? $groups{$_} + 1 : 1) for (@g); + + push (@nogroup, $person) if (!@g); } + @all = @nogroup; print qq(\t\t

Contact Groups

\n\t\t
    \n); for (sort (keys (%groups))) @@ -146,7 +152,7 @@ sub action_browse } else { - print qq(\t\t

    All Contacts

    \n); + print qq(\t\t

    Contacts without a group

    \n); } print qq(\t\t
      \n); @@ -158,6 +164,10 @@ sub action_browse print qq(\t\t\t
    • $cn
      • \n); } + if (!@all) + { + print "\t\t\t
    • There are no matching entries.
      • \n"; + } print qq(\t\t
    \n\n); print qq(\t\t
    \n); @@ -186,11 +196,11 @@ sub action_list my @all = (); if ($group) { - @all = Person->search ([[group => $group]]); + @all = LiCoM::Person->search ([[group => $group]]); } else { - @all = Person->search (); + @all = LiCoM::Person->search (); } print <load ($cn); + my $person = LiCoM::Person->load ($cn); if (!$person) { print qq(\t
    Entry "$cn" could not be loaded from DB.
    \n); @@ -340,7 +350,7 @@ sub action_search push (@filter, [[lastname => $pattern], [firstname => $pattern]]); } - my @matches = Person->search (@filter); + my @matches = LiCoM::Person->search (@filter); if (!@matches) { @@ -357,7 +367,7 @@ sub action_search } print qq(\t
      \n); - for (@matches) + for (sort { $a->name () cmp $b->name () } (@matches)) { my $person = $_; my $cn = $person->name (); @@ -392,7 +402,7 @@ sub action_edit if ($cn) { - $person = Person->load ($cn); + $person = LiCoM::Person->load ($cn); if (!$person) { @@ -543,7 +553,7 @@ sub action_save my $contacts = get_contacts (); - my $person = Person->create (lastname => $lastname, firstname => $firstname, %$contacts); + my $person = LiCoM::Person->create (lastname => $lastname, firstname => $firstname, %$contacts); if (!$person) { @@ -566,7 +576,7 @@ sub action_save sub action_update { my $cn = $UserID ? param ('cn') : $UserCN; - my $person = Person->load ($cn); + my $person = LiCoM::Person->load ($cn); die unless ($person); @@ -623,7 +633,7 @@ sub action_vcard $cn = shift if (@_); die unless ($cn); - my $person = Person->load ($cn); + my $person = LiCoM::Person->load ($cn); die unless ($person); my %vcard_types = @@ -672,7 +682,7 @@ sub action_verify $cn = shift if (@_); die unless ($cn); - my $person = Person->load ($cn); + my $person = LiCoM::Person->load ($cn); die unless ($person); my ($mail) = $person->get ('mail'); @@ -709,7 +719,7 @@ sub action_verify sub action_verify_send_mail { my $person = shift; - my $owner = Person->load ($UserCN); + my $owner = LiCoM::Person->load ($UserCN); my $smh; my ($owner_mail) = $owner->get ('mail'); @@ -1025,34 +1035,6 @@ sub html_end 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; diff --git a/mutt-licom.pl b/mutt-licom.pl new file mode 100755 index 0000000..e3991f8 --- /dev/null +++ b/mutt-licom.pl @@ -0,0 +1,56 @@ +#! /usr/bin/perl -Tw +# 2005-02-24: Fixed for AD/Exchange 2003 & Unicode characters, +# anders@bsdconsulting.no If you find this script useful, let me know. :-) +# +# 2000/2001: Original version obtained from Andreas Plesner Jacobsen at +# World Online Denmark. Worked for me with Exchange versions prior to Exchange +# 2000. +# +# Use it with mutt by putting in your .muttrc: +# set query_command = "/home/user/bin/mutt-ldap.pl '%s'" +# +# Then you can search for your users by name directly from mutt. Press ^t +# after having typed parts of the name. Remember to edit configuration +# variables below. + +use strict; +use Encode qw/encode decode/; +use vars qw { $ldapserver $domain $username $password $basedn }; + +# --- configuration --- +$ldapserver = "domaincontroller.yourdomain.com"; +$domain = "YOURDOMAIN"; +$username = "myuser"; +$password = "mypassword"; +$basedn = "ou=companyxy,dc=companyxy,dc=tld"; +# --- end configuration --- + +#my $search=shift; +my $search=encode("UTF-8", join(" ", @ARGV)); + +if (!$search=~/[\.\*\w\s]+/) { + print("Invalid search parameters\n"); + exit 1; +} + +use Net::LDAP; + +my $ldap = Net::LDAP->new($ldapserver) or die "$@"; + +$ldap->bind("$domain\\$username", password=>$password); + +my $mesg = $ldap->search (base => $basedn, + filter => "(|(cn=*$search*) (rdn=*$search*) (uid=*$search*) (mail=*$search*))", + attrs => ['mail','cn']); + +$mesg->code && die $mesg->error; + +print(scalar($mesg->all_entries), " entries found\n"); + +foreach my $entry ($mesg->all_entries) { + if ($entry->get_value('mail')) { + print($entry->get_value('mail'),"\t", + decode("UTF-8", $entry->get_value('cn')),"\tFrom Exchange LDAP database\n"); + } + } +$ldap->unbind;