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', ]); $conn->unbind; return $result->error if ($result->code); 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 $result->error if ($result->code); 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; } 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; } 1; =pod =head1 NAME LDV::LDAP -- ldap routines =head1 METHODS =head2 C 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)" =head2 C my $ldap = LDV::LDAP->new(\%opts); my $err = $ldap->create($username); Returns nothing on success or scalar with text of error. =head2 C my $ldap = LDV::LDAP->new(\%opts); my $err = $ldap->delete($username); Returns nothing on success or scalar with text of error. =head2 C 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 my $ldap = LDV::LDAP->new(\%opts); TODO =cut