OO Perl library for our LDAP schema.

1 files changed, 228 insertions, 13 deletions

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 @_;
 }