use strict;
use warnings;
+use Carp (qw(cluck confess));
+use Encode (qw(encode decode is_utf8));
+
+use LiCoM::Config (qw(get_config));
+use LiCoM::Connection (qw($Ldap));
+
use Net::LDAP;
use Net::LDAP::Filter;
=cut
-our %Config =
-(
- base_dn => undef
-);
-
our %ValidFields =
(
telephoneNumber => 1,
labeledURI => 1,
mail => 1,
mobile => 1,
- o => 1
+ userPassword => 0
);
our %ExternalNames =
uri => 'labeledURI',
mail => 'mail',
cellphone => 'mobile',
- group => 'o'
+ password => 'userPassword'
);
-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;
for (keys %ValidFields)
{
my $key = $_;
- $obj->{$key} = $entry->get_value ($key, asref => $ValidFields{$key});
+ my $val = $entry->get_value ($key, asref => $ValidFields{$key});
+
+ if (ref ($val))
+ {
+ $obj->{$key} = [map { decode ('UTF-8', $_) } (@$val)];
+ }
+ else
+ {
+ $obj->{$key} = decode ('UTF-8', $val);
+ }
}
return (bless ($obj, $pkg));
}
-=item Person-E<gt>B<load> (I<$cn>)
+=head1 STATIC FUNCTIONS
+
+=over 4
+
+=item LiCoM::Person-E<gt>B<load> (I<$cn>)
Loads the given CN and returns the B<Person>-object.
if (!$retval)
{
- warn ("CN '$cn' could not be found");
- return (undef);
+ cluck ("CN '$cn' could not be found");
+ return;
}
return ($retval);
}
-=item Person-E<gt>B<create> (B<lastname> =E<gt> I<$lastname>, B<firstname> =E<gt> I<$firstname>, ...)
+=item LiCoM::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.
my $dn;
my $ou;
- $entry->add (objectClass => [qw(top organizationalUnit person organizationalPerson inetOrgPerson)]);
+ $entry->add (objectClass => [qw(person organizationalPerson inetOrgPerson)]);
for (keys %hash)
{
{
if (ref ($val) eq 'ARRAY')
{
- $entry->add ($field => [@$val]) if (@$val);
+ $entry->add ($field => [map { encode ('UTF-8', $_) } (@$val)]) if (@$val);
}
elsif (!ref ($val))
{
- $entry->add ($field => [$val]) if ($val);
+ $entry->add ($field => [encode ('UTF-8', $val)]) if ($val);
}
else
{
my $temp;
if (ref ($val) eq 'ARRAY')
{
- $temp = $val->[0];
+ $temp = encode ('UTF-8', $val->[0]);
}
elsif (!ref ($val))
{
- $temp = $val;
+ $temp = encode ('UTF-8', $val);
}
else
{
warn ("You cannot pass ref-type " . ref ($val));
}
- $entry->add ($field => $val) if (defined ($val) and $val);
+ $entry->add ($field => $temp) if (defined ($temp) and $temp);
}
}
+ # $sn and $gn are UTF-8
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);
+ return;
}
- $dn = "cn=$sn $gn," . $Config{'base_dn'};
- ($ou) = $Config{'base_dn'} =~ m/\bou\s*=\s*([^,]+)/i;
+ $ou = encode ('UTF-8', 'Person');
+ $dn = "cn=$sn $gn,ou=$ou," . encode ('UTF-8', get_config ('base_dn'));
$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);
+ my $tmp = decode ('UTF-8', $dn);
+ warn ("Error while creating entry '$tmp' on LDAP server: " . $mesg->error_text ());
+ return;
}
return (new ($pkg, $entry));
}
-=item Person-E<gt>B<search> (B<firstname> =E<gt> I<"Flor*">)
+=item LiCoM::Person-E<gt>B<search> (B<firstname> =E<gt> I<"Flor*">)
Search for the given patterns. Returns a list of I<Person>-objects.
$value =~ s/([\(\)\\])/\\$1/g;
+ confess ("Value is not UTF-8 encoded: `$value'") if (!is_utf8 ($value));
+
push (@disjunc, "($field=$value)");
}
if (@disjunc)
{
- push (@konjunct, join ('', '(|', @disjunc, ')'));
+ my $tmp;
+ if (scalar (@disjunc) == 1)
+ {
+ $tmp = $disjunc[0];
+ }
+ else
+ {
+ $tmp = join ('', '(|', @disjunc, ')');
+ }
+ push (@konjunct, $tmp);
}
}
$filter = '(objectclass=inetOrgPerson)';
}
- #print STDERR "Debug: using filter: $filter";
-
$mesg = $Ldap->search
(
- base => $Config{'base_dn'},
- filter => $filter
+ base => 'ou=Person,' . get_config ('base_dn'),
+ filter => encode ('UTF-8', $filter)
);
if ($mesg->is_error ())
return (@retval);
}
+=item LiCoM::Person-E<gt>B<get_user> (I<$dn>)
+
+Returns the cn and, if defined, the user-id of this dn.
+
+=cut
+
+sub get_user
+{
+ my $pkg = shift;
+ my $dn = shift;
+ my ($search) = $dn =~ m/cn\s*=\s*([^,]+)/i;
+
+ return unless ($search);
+
+ my $cn = '';
+ my $id = '';
+
+ my $mesg = $Ldap->search
+ (
+ base => 'ou=Person,' . get_config ('base_dn'),
+ filter => "(cn=$search)"
+ );
+
+ if ($mesg->is_error ())
+ {
+ cluck ("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);
+}
+
+=back
+
+=head1 METHODS
+
+=over 4
+
=item I<$obj>-E<gt>B<delete> ()
Deletes the record.
sub _update_dn
{
+ confess ("Wrong number of arguments") if (@_ != 3);
my $obj = shift;
+
+ my $obj_new;
+ my %hash_new;
+
+ my $sn = shift;
+ my $gn = 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;
+ if (($sn eq $obj->{'sn'}) && ($gn eq $obj->{'givenName'}))
+ {
+ return;
+ }
- print STDERR "This is _update_dn, trying to set dn=$dn";
+ $hash_new{$_} = $obj->{$_} for (keys %ValidFields);
+ $hash_new{'sn'} = $sn;
+ $hash_new{'givenName'} = $gn;
+ delete ($hash_new{'cn'});
- $entry->changetype ('modify');
- $entry->replace (sn => $sn, givenName => $gn, cn => $cn);
- $entry->update ($Ldap);
- $entry->dn ($dn);
- $entry->update ($Ldap);
+ $obj_new = LiCoM::Person->create (%hash_new)
+ or confess ("Cannot duplicate LDAP entry");
+
+ $obj->delete ();
+
+ %$obj = %$obj_new;
+
+ return ($obj->{'dn'});
}
sub lastname
if (@_)
{
- $obj->{'sn'} = shift;
- _update_dn ($obj);
+ _update_dn ($obj, shift, $obj->{'givenName'});
}
return ($obj->{'sn'});
if (@_)
{
- $obj->{'givenName'} = shift;
- _update_dn ($obj);
+ _update_dn ($obj, $obj->{'sn'}, shift);
}
return ($obj->{'givenName'});
=item I<$obj>-E<gt>B<uri> ([I<@uri>])
-=item I<$obj>-E<gt>B<group> ([I<@groups>])
-
-Get or set the attribute.
+Get or set the attribute. This is the same as calling S<I<$obj>-E<gt>B<set>
+(I<$field>, I<\@values>)> or S<I<$obj>-E<gt>B<get> (I<$field>)>.
=cut
return (set ($obj, $field, @values ? [@values] : undef))
}
+=item I<$obj>-E<gt>B<get> (I<$field>)
+
+Returs the value(s) of field I<$field>.
+
+=cut
+
sub get
{
my $obj = shift;
my $field = shift;
- return (set ($obj, $field, undef));
+ if (wantarray ())
+ {
+ return (set ($obj, $field, undef));
+ }
+ else
+ {
+ return (scalar (set ($obj, $field, undef)));
+ }
}
+=item I<$obj>-E<gt>B<set> (I<$field>, I<\@values>)
+
+Sets the field I<$field> to the value(s) I<\@valued>. Pass an empty array-ref
+to delete the field.
+
+=cut
+
sub set
{
my $obj = shift;
}
if (!defined ($ValidFields{$field}))
{
- return (undef);
+ return;
}
if (defined ($value))
{
+ $_ = encode ('UTF-8', $_) for (@$value);
+
$entry->changetype ('modify');
if ($ValidFields{$field})
$entry->update ($Ldap);
}
- $obj->{$field} = [] unless (defined ($obj->{$field}));
+ if (!defined ($obj->{$field}) and $ValidFields{$field})
+ {
+ $obj->{$field} = [];
+ }
if (wantarray () and $ValidFields{$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
projects / licom.git / blobdiff