Added basic mutt-ldap script.
--- /dev/null
+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);
+}
--- /dev/null
+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-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]) 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->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.
+
+ @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>-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;
+
+ 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>-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);
+
+ 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 E<lt>octo at verplant.orgE<gt>
+
+=cut
+++ /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]) 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->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.
-
- @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>-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;
-
- 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>-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);
-
- 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 E<lt>octo at verplant.orgE<gt>
-
-=cut
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));
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')
{
}
}
-#print qq#<div>Authenticated as ($UserCN, $UserID, #, $Config{'base_dn'}, qq#)</div>\n#;
-
-Person->disconnect ();
+LiCoM::Person->disconnect ();
exit (0);
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)
{
my @g = $person->get ('group');
$groups{$_} = (defined ($groups{$_}) ? $groups{$_} + 1 : 1) for (@g);
+
+ push (@nogroup, $person) if (!@g);
}
+ @all = @nogroup;
print qq(\t\t<h2>Contact Groups</h2>\n\t\t<ul class="groups">\n);
for (sort (keys (%groups)))
}
else
{
- print qq(\t\t<h2>All Contacts</h2>\n);
+ print qq(\t\t<h2>Contacts without a group</h2>\n);
}
print qq(\t\t<ul class="results">\n);
print qq(\t\t\t<li><a href="$MySelf?action=detail&cn=$cn_esc">$cn</a></li>\n);
}
+ if (!@all)
+ {
+ print "\t\t\t<li>There are no matching entries.</li>\n";
+ }
print qq(\t\t</ul>\n\n);
print qq(\t\t<div class="menu">\n);
my @all = ();
if ($group)
{
- @all = Person->search ([[group => $group]]);
+ @all = LiCoM::Person->search ([[group => $group]]);
}
else
{
- @all = Person->search ();
+ @all = LiCoM::Person->search ();
}
print <<EOF;
$cn = shift if (@_);
die unless ($cn);
- my $person = Person->load ($cn);
+ my $person = LiCoM::Person->load ($cn);
if (!$person)
{
print qq(\t<div>Entry "$cn" could not be loaded from DB.</div>\n);
push (@filter, [[lastname => $pattern], [firstname => $pattern]]);
}
- my @matches = Person->search (@filter);
+ my @matches = LiCoM::Person->search (@filter);
if (!@matches)
{
}
print qq(\t<ul class="result">\n);
- for (@matches)
+ for (sort { $a->name () cmp $b->name () } (@matches))
{
my $person = $_;
my $cn = $person->name ();
if ($cn)
{
- $person = Person->load ($cn);
+ $person = LiCoM::Person->load ($cn);
if (!$person)
{
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)
{
sub action_update
{
my $cn = $UserID ? param ('cn') : $UserCN;
- my $person = Person->load ($cn);
+ my $person = LiCoM::Person->load ($cn);
die unless ($person);
$cn = shift if (@_);
die unless ($cn);
- my $person = Person->load ($cn);
+ my $person = LiCoM::Person->load ($cn);
die unless ($person);
my %vcard_types =
$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');
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');
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;
--- /dev/null
+#! /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;
projects / licom.git / commitdiff