From 8663144f1f5a3d163119f17a7f9c06655e32727a Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Tue, 17 Apr 2012 01:25:28 +0200 Subject: OO Perl library for our LDAP schema. --- lib/Fripost/Schema.pm | 241 +++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 228 insertions(+), 13 deletions(-) (limited to 'lib/Fripost/Schema.pm') diff --git a/lib/Fripost/Schema.pm b/lib/Fripost/Schema.pm index 8124a54..5b57cd3 100755 --- a/lib/Fripost/Schema.pm +++ b/lib/Fripost/Schema.pm @@ -1,17 +1,33 @@ package Fripost::Schema; use 5.010_000; +use warnings; use strict; +use Fripost::Schema::Search; +use Fripost::Schema::Type; + use base qw/Net::LDAP/; our $VERSION = '0.01'; -# Initialize a connection to the LDAP host. + +####################################################################### +# Public methods + + +# Change the context of the object. +sub user { $_[0]->Fripost::Schema::Type::_set_type(MAILBOX); } +sub domain { $_[0]->Fripost::Schema::Type::_set_type(DOMAIN); } +sub alias { $_[0]->Fripost::Schema::Type::_set_type(ALIAS); } + + +# Create the oject, and initialize a connection to the LDAP +# host. sub new { my $class = shift; my $h = shift; - my $self = {options => $h}; + my $self = {_options => $h}; bless $self, $class; my $ldap = Net::LDAP->new ( $h->{server_host} ) @@ -29,23 +45,72 @@ sub new { } die "Error: " .$mesg->error. "\n" if $mesg->code; - $self->{ldap} = $ldap; + $self->{_ldap} = $ldap; return $self; } +# Search. Returns a `Fripost::Schema::Search'. +sub search { + my $self = shift; + my $res; + if ( $self->{_type} == MAILBOX ) { + $res = $self->_searchUser(@_) + } + elsif ( $self->{_type} == DOMAIN ) { + $res = $self->_searchDomain(@_) + } + elsif ( $self->{_type} == ALIAS ) { + $res = $self->_searchAlias(@_) + } + else { + die "Something weird happened. Please report." + } + my $result = {_res => $res, _type => $self->{_type}}; + bless $result, 'Fripost::Schema::Search'; + return $result; +} + + +# Add. +sub add { + my $self = shift; + if ( $self->{_type} == MAILBOX ) { + $self->_addUser(@_) + } + elsif ( $self->{_type} == DOMAIN ) { + $self->_addDomain(@_) + } + elsif ( $self->{_type} == ALIAS ) { + $self->_addAlias(@_) + } + else { + die "Something weird happened. Please report." + } +} + + +# Disconnect to the LDAP server. +sub unbind { + $_[0]->{_ldap}->unbind(); +} + + +####################################################################### +# Search + # Search a user, and return the corresponding entries if found. If no # user is given, returns all users. -sub searchUser { +sub _searchUser { my $self = shift; - my $base = join ',', ('ou=mailboxes',$self->{options}->{base_dn}); + my $base = join ',', ('ou=mailboxes',$self->{_options}->{base_dn}); my $filter = "(ObjectClass=virtualMailbox)"; $filter = "(&" .$filter. "(uid=" .$_[0]. ")" .")" if defined $_[0]; - my $res = $self->{ldap}->search( + my $res = $self->{_ldap}->search( base => $base, scope => 'one', attrs => [ 'uid', 'gn' , 'sn', 'maildir', 'isActive' ], @@ -56,14 +121,99 @@ sub searchUser { return $res; } + +# Search a domain, and return the corresponding entries if found. If no +# domain is given, returns all domains. If the given domain has a +# defined owner, scope the search for this very owner only. If the +# owner is undefined, but still exists, scope the search to the "global" +# domains only. +sub _searchDomain { + my $self = shift; + + my $base = $self->{_options}->{base_dn}; + if (exists $_[0]->{owner}) { + if (defined $_[0]->{owner}) { + $base = join ',', ('uid='.$_[0]->{owner},'ou=mailboxes',$base); + } + else { + $base = join ',', ('ou=domains',$base); + } + } + + my $filter = '(ObjectClass=virtualDomain)'; + $filter = "(&" .$filter. "(dc=" .$_[0]->{domain}. ")" .")" + if defined $_[0]->{domain}; + + my $res = $self->{_ldap}->search( + base => $base, + scope => 'subtree', + attrs => [ 'dc', 'isActive' ], + filter => $filter + ); + die "Error: " .$res->error. "\n" if $res->code; + + return $res; +} + + +# Search an alias, and return the corresponding entries if found. If no +# alias is given, returns all aliases. If the given alias has a +# defined owner, scope the search for this very owner only. If the +# owner is undefined, but still exists, scope the search to the "global" +# domains only. +sub _searchAlias { + my $self = shift; + + my $base = $self->{_options}->{base_dn}; + if (exists $_[0]->{owner}) { + if (defined $_[0]->{owner}) { + $base = join ',', ('uid='.$_[0]->{owner},'ou=mailboxes',$base); + } + else { + $base = join ',', ('ou=domains',$base); + } + } + $base = 'dc=' .$_[0]->{domain}. ',' .$base + if (exists $_[0]->{owner}) and (defined $_[0]->{domain}); + + my @filters = '(ObjectClass=virtualAliases)'; + push @filters, '(mailLocalAddress=' .$_[0]->{address}. ')' + if defined $_[0]->{address}; + push @filters, '(mailTarget=' .$_[0]->{goto}. ')' + if defined $_[0]->{goto}; + + my $filter; + if ($#filters == 0 ) { + $filter = $filters[0]; + } + elsif ($#filters > 0) { + $filter = '(&' . (join '', @filters) . ')'; + } + + my $res = $self->{_ldap}->search( + base => $base, + scope => 'subtree', + attrs => [ 'mailLocalAddress', 'mailTarget', 'isActive' ], + filter => $filter + ); + die "Error: " .$res->error. "\n" if $res->code; + + return $res; +} + + + +####################################################################### +# Add + # Add a user -sub addUser { +sub _addUser { my $self = shift; my $user = shift; - my $base = join ',', ('ou=mailboxes',$self->{options}->{base_dn}); + my $base = join ',', ('ou=mailboxes',$self->{_options}->{base_dn}); - my $res = $self->{ldap}->add( 'uid=' .$user->{username}. ',' .$base, + my $res = $self->{_ldap}->add( 'uid=' .$user->{username}. ',' .$base, attrs => [ uid => $user->{username}, objectClass => [ 'top', 'virtualMailbox' ], userPassword => $user->{userPassword}, @@ -76,16 +226,81 @@ sub addUser { } -# Disconnect to the LDAP server. -sub unbind { - $_[0]->{ldap}->unbind(); +# Add a domain. +sub _addDomain { + my $self = shift; + my $domain = shift; + + my $base = $self->{_options}->{base_dn}; + if (defined $domain->{owner}) { + $base = join ',', ('uid=' .$domain->{owner},'ou=mailboxes',$base) + } + else { + $base = join ',', ('ou=domains',$base); + } + + my $res = $self->{_ldap}->add( 'dc=' .$domain->{domain}. ',' .$base, + attrs => [ dc => $domain->{domain}, + objectClass => [ 'top', 'virtualDomain' ], + isActive => $domain->{isActive} + ] + ); + die "Error: " .$res->error. "\n" if $res->code; + return $res; } +# Add an alias +sub _addAlias { + my $self = shift; + my $alias = shift; + + # TODO: detect cycles + die "Error: Cannot create alias `" .$alias->{address}. + "' targetting to itself.\n" + if $alias->{address} eq $alias->{goto}; + + my $base = $self->{_options}->{base_dn}; + if (defined $alias->{owner}) { + $base = join ',', ('uid=' .$alias->{owner},'ou=mailboxes',$base) + } + else { + $base = join ',', ('ou=domains',$base); + } + $base = 'mailTarget='.$alias->{goto}. + ','.'dc='. (split /\@/, $alias->{address}, 2)[1]. + ','.$base; + + my @attrs = ( mailLocalAddress => $alias->{address} + , isActive => $alias->{isActive} ); + my $res; + if ($self->_searchAlias($alias)->count) { + $res = $self->{_ldap}->modify( $base, attrs => [ @attrs ] ); + } + else { + $res = $self->{_ldap}->add( $base, + attrs => [ mailTarget => $alias->{goto} + , objectClass => [ 'top', + 'inetLocalMailRecipient', + 'virtualAliases' ], + @attrs + ] + ); + } + die "Error: " .$res->error. "\n" if $res->code; + return $res; +} + + + +####################################################################### +# Miscellaneous + # Debug print. sub _dsay { my $self = shift; - return unless (exists $self->{options}->{debug}) and $self->{options}->{debug}; + return unless (exists $self->{_options}->{debug}) + and $self->{_options}->{debug}; print STDERR "Debug: "; say STDERR @_; } -- cgit v1.2.3