You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

221 lines
5.1 KiB

10 years ago
package LDV::LDAP;
use strict;
use warnings;
use utf8;
use Net::LDAP;
use Net::LDAP::Util qw(ldap_error_name);
sub new {
my ($class, $opts) = @_;
my $self = {
server => undef,
binddn => undef,
bindpass => undef,
userbase => undef,
userfilter => "(class=InetOrgPerson)",
%$opts,
};
return bless($self, $class);
}
sub _connect {
my ($self) = @_;
my $conn = Net::LDAP->new($self->{server}, onerror => 'die');
$conn->bind($self->{binddn}, password => $self->{bindpass});
return $conn;
}
sub _escape {
my ($self, $str) = @_;
$str =~ s|\\|\\\\|go;
$str =~ s|\(|\\\(|go;
$str =~ s|\)|\\\)|go;
return $str;
}
sub _uid_to_dn {
my ($self, $uid) = @_;
return sprintf "uid=%s,%s", $uid, $self->{userbase};
}
10 years ago
sub _filter_username {
my ($self, $uid) = @_;
return bless({and =>
[{equalityMatch => {attributeDesc => 'objectClass',
assertionValue => 'inetOrgPerson'}},
{equalityMatch => {attributeDesc => 'uid',
assertionValue => $uid}}
]}, 'Net::LDAP::Filter');
};
10 years ago
sub auth {
my ($self, $uid, $pass) = @_;
return unless ($uid and $pass);
my $dn = $self->_uid_to_dn($uid);
my $conn = Net::LDAP->new($self->{server}, onerror => sub { return shift });
my $result = $conn->bind($dn, password => $pass);
$conn->unbind;
$conn->disconnect;
return if $result->code;
return 1;
}
10 years ago
sub create {
my ($self, $uid) = @_;
my $conn = $self->_connect();
$uid = $self->_escape($uid);
my $data = $self->get($uid);
return "User already exists"
if ($data);
my $dn = $self->_uid_to_dn($uid);
10 years ago
my $result = $conn->add($dn, attr => [
objectClass => ['inetOrgPerson'],
uid => $uid,
cn => 'just',
sn => 'created',
10 years ago
]);
$conn->unbind;
$conn->disconnect;
return $result->error if ($result->code);
10 years ago
return;
}
sub delete {
my ($self, $uid) = @_;
my $conn = $self->_connect();
$uid = $self->_escape($uid);
my $dn = $self->_uid_to_dn($uid);
10 years ago
my $result = $conn->delete($dn);
$conn->unbind;
$conn->disconnect;
return $result->error if ($result->code);
10 years ago
return;
}
sub get {
my ($self, $uid) = @_;
my $conn = $self->_connect();
my $filter = $self->_filter_username($uid);
my $mesg = $conn->search(base => $self->{userbase}, scope => 'one',
deref => 'never', filter => $filter);
$conn->unbind;
$conn->disconnect;
10 years ago
return unless $mesg->count;
my $entry = $mesg->pop_entry();
my $data = {};
foreach my $attr ($entry->attributes) {
$data->{$attr} = $entry->get_value($attr);
utf8::decode($data->{$attr});
10 years ago
}
delete $data->{objectClass};
10 years ago
return $data;
}
sub update {
my ($self, $uid, $attrs) = @_;
return "Attrs isn't HASH"
if (ref($attrs) ne 'HASH');
my $conn = $self->_connect();
$uid = $self->_escape($uid);
my $data = $self->get($uid);
return "No such user"
unless ($data);
my $dn = $self->_uid_to_dn($uid);
my %allowed = map { $_ => 1 } @{$self->{defattrs}};
my @chg = ();
while (my ($key, $value) = each(%$attrs)) {
next unless exists $allowed{$key};
next if ($key =~ m/uid/); # rename protection
next if ($key =~ m/objectClass/); # class protection
if ($value and not exists $data->{$key}) {
push @chg, add => [$key => $value];
next;
}
if ($data->{$key} and $value) {
push @chg, replace => [$key => $value];
next;
}
if ($data->{$key} and not $value) {
push @chg, delete => [$key => $value];
next;
}
}
my $result = $conn->modify($dn, changes => \@chg);
$conn->unbind;
$conn->disconnect;
return $result->error if ($result->code);
return;
}
10 years ago
1;
10 years ago
=pod
=head1 NAME
LDV::LDAP -- ldap routines
=head1 METHODS
=head2 C<new>
my $ldap = LDV::LDAP->new(\%opts);
* server -- server to connect to (ip-address, default: localhost)
* binddn -- auth as this DB (like cn=admin,dc=example,dc=com, default: unset)
* bindpass -- auth with this password (string, default: unset)
* userbase -- where to search for users, (like dc=example,dc=com, default: unset)
* userfilter -- objects that pass the filter, considered as users (default : "(class=InetOrgPerson)"
10 years ago
=head2 C<auth>
my $ldap = LDV::LDAP->new(\%opts);
my $result = $ldap->auth($username, $password);
Check user/pass pair against ldap server.
Returns 1 on success or undef on auth failure/error;
10 years ago
=head2 C<create>
my $ldap = LDV::LDAP->new(\%opts);
my $err = $ldap->create($username);
Returns nothing on success or scalar with text of error.
=head2 C<delete>
my $ldap = LDV::LDAP->new(\%opts);
my $err = $ldap->delete($username);
Returns nothing on success or scalar with text of error.
=head2 C<get>
my $ldap = LDV::LDAP->new(\%opts);
my $attrs = $ldap->get($username);
Get user attributes. Returns HASH on success or undef if not found.
=head2 C<update>
my $ldap = LDV::LDAP->new(\%opts);
my $err = $ldap->update($user, \%attrs);
10 years ago
Returns nothing on success or scalar with text on error.
See list of allowed keys in config, 'ldap/defattrs' parameter.
'uid' key will be ignored, because it's structural in our schema.
10 years ago
=cut