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.
119 lines
2.5 KiB
119 lines
2.5 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 _filter_username {
|
||
|
|
my ($self, $uid) = @_;
|
||
|
|
return bless({and =>
|
||
|
|
[{equalityMatch => {attributeDesc => 'objectClass',
|
||
|
|
assertionValue => 'inetOrgPerson'}},
|
||
|
|
{equalityMatch => {attributeDesc => 'uid',
|
||
|
|
assertionValue => $uid}}
|
||
|
|
]}, 'Net::LDAP::Filter');
|
||
|
|
};
|
||
|
|
|
||
|
|
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 = sprintf "uid=%s,%s", $uid, $self->{userbase};
|
||
|
|
my $result = $conn->add($dn, attr => [
|
||
|
|
objectClass => ['inetOrgPerson'],
|
||
|
|
uid => $uid,
|
||
|
|
sn => 'just',
|
||
|
|
cn => 'created',
|
||
|
|
]);
|
||
|
|
return $result->error if ($result->code);
|
||
|
|
$conn->unbind;
|
||
|
|
return;
|
||
|
|
}
|
||
|
|
|
||
|
|
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 = sprintf "uid=%s,%s", $uid, $self->{userbase};
|
||
|
|
foreach my $key (keys($attrs)) {
|
||
|
|
...
|
||
|
|
}
|
||
|
|
|
||
|
|
return;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub delete {
|
||
|
|
my ($self, $uid) = @_;
|
||
|
|
my $conn = $self->_connect();
|
||
|
|
$uid = $self->_escape($uid);
|
||
|
|
my $dn = sprintf "uid=%s,%s", $uid, $self->{userbase};
|
||
|
|
my $result = $conn->delete($dn);
|
||
|
|
$conn->unbind;
|
||
|
|
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;
|
||
|
|
return unless $mesg->count;
|
||
|
|
my $entry = $mesg->pop_entry();
|
||
|
|
my $data = {};
|
||
|
|
foreach my $attr ($entry->attributes) {
|
||
|
|
$data->{$attr} = $entry->get_value($attr);
|
||
|
|
}
|
||
|
|
|
||
|
|
delete $data->{userPassword};
|
||
|
|
return $data;
|
||
|
|
}
|
||
|
|
|
||
|
|
1;
|