Implemented the changes on the LDAP schema.

4 files changed, 341 insertions, 202 deletions

diff --git a/lib/Fripost/Schema.pm b/lib/Fripost/Schema.pm
index 5b57cd3..22c6064 100755
--- a/lib/Fripost/Schema.pm
+++ b/lib/Fripost/Schema.pm
@@ -6,6 +6,9 @@ use strict;
 
 use Fripost::Schema::Search;
 use Fripost::Schema::Type;
+use Fripost::Schema::Type::User;
+use Fripost::Schema::Type::Domain;
+use Fripost::Schema::Type::Alias;
 
 use base qw/Net::LDAP/;
 our $VERSION = '0.01';
@@ -55,13 +58,13 @@ sub search {
     my $self = shift;
     my $res;
     if ( $self->{_type} == MAILBOX ) {
-        $res = $self->_searchUser(@_)
+        $res = $self->Fripost::Schema::Type::User::search(@_)
     }
     elsif ( $self->{_type} == DOMAIN ) {
-        $res = $self->_searchDomain(@_)
+        $res = $self->Fripost::Schema::Type::Domain::search(@_)
     }
     elsif ( $self->{_type} == ALIAS ) {
-        $res = $self->_searchAlias(@_)
+        $res = $self->Fripost::Schema::Type::Alias::search(@_)
     }
     else {
         die "Something weird happened. Please report."
@@ -72,230 +75,46 @@ sub search {
 }
 
 
-# Add.
 sub add {
     my $self = shift;
     if ( $self->{_type} == MAILBOX ) {
-        $self->_addUser(@_)
+        $self->Fripost::Schema::Type::User::add(@_)
     }
     elsif ( $self->{_type} == DOMAIN ) {
-        $self->_addDomain(@_)
+        $self->Fripost::Schema::Type::Domain::add(@_)
     }
     elsif ( $self->{_type} == ALIAS ) {
-        $self->_addAlias(@_)
+        $self->Fripost::Schema::Type::Alias::add(@_)
     }
     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 {
-    my $self = shift;
-    
-    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(
-                  base   => $base,
-                  scope  => 'one',
-                  attrs  => [ 'uid', 'gn' , 'sn', 'maildir', 'isActive' ],
-                  filter => $filter
-            );
-    die "Error: " .$res->error. "\n" if $res->code;
-
-    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);
-        }
+        die "Something weird happened. Please report.";
     }
-    
-    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 {
+sub password {
     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];
+    if ( $self->{_type} == MAILBOX ) {
+        $self->Fripost::Schema::Type::User::pwd(@_);
     }
-    elsif ($#filters > 0) {
-        $filter = '(&' . (join '', @filters) . ')';
+    elsif ( $self->{_type} == DOMAIN ) {
+        die "Cannot change the password of a domain.";
     }
-
-    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 {
-    my $self = shift;
-    my $user = shift;
-
-    my $base = join ',', ('ou=mailboxes',$self->{_options}->{base_dn});
-
-    my $res = $self->{_ldap}->add( 'uid=' .$user->{username}. ',' .$base,
-                attrs => [ uid          => $user->{username},
-                           objectClass  => [ 'top', 'virtualMailbox' ],
-                           userPassword => $user->{userPassword},
-                           maildir      => $user->{maildir},
-                           isActive     => $user->{isActive}
-                         ]
-              );
-    die "Error: " .$res->error. "\n" if $res->code;
-    return $res;
-}
-
-
-# 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)
+    elsif ( $self->{_type} == ALIAS ) {
+        die "Cannot change the password of an alias.";
     }
     else {
-        $base = join ',', ('ou=domains',$base);
+        die "Something weird happened. Please report.";
     }
-
-    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;
+# Disconnect to the LDAP server.
+sub unbind {
+    $_[0]->{_ldap}->unbind();
 }
 
 
-
-#######################################################################
-# Miscellaneous
-
 # Debug print.
 sub _dsay {
     my $self = shift;
@@ -306,6 +125,8 @@ sub _dsay {
 }
 
 
+#######################################################################
+
 1;
 
 =head1 NAME
diff --git a/lib/Fripost/Schema/Type/Alias.pm b/lib/Fripost/Schema/Type/Alias.pm
new file mode 100644
index 0000000..fa78d6f
--- /dev/null
+++ b/lib/Fripost/Schema/Type/Alias.pm
@@ -0,0 +1,108 @@
+package Fripost::Schema::Type::Alias;
+
+use 5.010_000;
+use warnings;
+use strict;
+
+use base qw/Net::LDAP/;
+our $VERSION = '0.01';
+
+
+#######################################################################
+
+# Search an alias, and return the corresponding entries if found. If no
+# alias is given, returns all aliases. 
+# Filters on values of both keys `address' and `goto' (unless they are
+# undefined).
+sub search {
+    my $self = shift;
+
+    my $base = $self->{_options}->{base_dn};
+
+    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 the given alias
+sub add {
+    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 = join ',', ( 'mailTarget='.$alias->{goto}
+                         , 'dc='. (split /\@/, $alias->{address}, 2)[1]
+                         , 'ou=domains'
+                         , $self->{_options}->{base_dn} );
+
+    my @attrs = ( mailLocalAddress => $alias->{address}
+                , isActive         => $alias->{isActive} );
+    my $res;
+    if ($self->search($alias)->count) {
+        $res = $self->{_ldap}->modify( $base, add => [ @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;
+}
+
+
+#######################################################################
+
+1;
+
+=head1 NAME
+
+Fripost::Schema::Type::Alias - 
+
+=head1 AUTHOR
+
+Guilhem Moulin C<< <guilhem at fripost.org> >>
+
+=head1 COPYRIGHT
+
+Copyright 2012 Guilhem Moulin, all rights reserved.
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as perl itself.
+
+=cut
+
+1; # End of Alias.pm
+
+__END__
diff --git a/lib/Fripost/Schema/Type/Domain.pm b/lib/Fripost/Schema/Type/Domain.pm
new file mode 100644
index 0000000..f85ea87
--- /dev/null
+++ b/lib/Fripost/Schema/Type/Domain.pm
@@ -0,0 +1,110 @@
+package Fripost::Schema::Type::Domain;
+
+use 5.010_000;
+use warnings;
+use strict;
+
+use base qw/Net::LDAP/;
+our $VERSION = '0.01';
+
+
+#######################################################################
+
+# Search a domain, and return the corresponding entries if found. If no
+# domain is given, returns all domains.
+# Filters on values of both keys `domain' and `owner' (unless they are
+# undefined).
+sub search {
+    my $self = shift;
+
+    my ($base, $owner);
+    $base  = join ',', ('ou=domains',$self->{_options}->{base_dn});
+    $owner = join ',', ( 'uid='.$_[0]->{owner}
+                       , 'ou=mailboxes'
+                       , $self->{_options}->{base_dn} )
+       if defined $_[0]->{owner};
+
+    my @filters = ('(ObjectClass=virtualDomain)');
+    push @filters, "(dc=" .$_[0]->{domain}. ")" if defined $_[0]->{domain};
+    push @filters, "(owner=" .$owner. ")" if defined $_[0]->{owner};
+    my $filter;
+    if ($#filters == 0) {
+        $filter = $filters[0];
+    }
+    elsif ($#filters > 0) {
+        $filter = "(&" . (join '', @filters) . ")";
+    }
+
+    my $res = $self->{_ldap}->search(
+                  base   => $base,
+                  scope  => 'one',
+                  attrs  => [ 'dc', 'owner', 'isActive' ],
+                  filter => $filter
+            );
+    die "Error: " .$res->error. "\n" if $res->code;
+    return $res;
+}
+
+# Add the given domain. If it already exists, adds the new owner; Or
+# fails if the new domains is not self-manageable.
+sub add {
+    my $self = shift;
+    my $domain = shift;
+
+    my ($base, $owner);
+    $base  = join ',', ( 'dc='.$domain->{domain}
+                       , 'ou=domains'
+                       , $self->{_options}->{base_dn} );
+    $owner = join ',', ( 'uid='.$domain->{owner}
+                       , 'ou=mailboxes'
+                       , $self->{_options}->{base_dn} )
+       if defined $domain->{owner};
+
+    my $res;
+    if ($self->search({ domain => $domain->{domain} })->count) {
+        die "Error: Cannot create self-managed domain `"
+            .$domain->{domain}. "' since it already exists.\n"
+          unless defined $domain->{owner};
+        $res = $self->{_ldap}->modify( $base, add => [ owner => $owner ] );
+    }
+    else {
+        my @attrs = ( dc           => $domain->{domain},
+                    , objectClass  => [ 'top', 'virtualDomain' ],
+                    , isActive     => $domain->{isActive}
+                    );
+        push @attrs, (owner => $owner)
+            if defined $domain->{owner};
+        $res = $self->{_ldap}->add( $base, attrs => [ @attrs ] );
+    }
+    die "Error: " .$res->error. "\n" if $res->code;
+    return $res;
+}
+
+
+#######################################################################
+
+
+1;
+
+=head1 NAME
+
+Fripost::Schema::Type::Domain - 
+
+=head1 AUTHOR
+
+Guilhem Moulin C<< <guilhem at fripost.org> >>
+
+=head1 COPYRIGHT
+
+Copyright 2012 Guilhem Moulin, all rights reserved.
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as perl itself.
+
+=cut
+
+1; # End of Domain.pm
+
+__END__
diff --git a/lib/Fripost/Schema/Type/User.pm b/lib/Fripost/Schema/Type/User.pm
new file mode 100644
index 0000000..09c3aa0
--- /dev/null
+++ b/lib/Fripost/Schema/Type/User.pm
@@ -0,0 +1,100 @@
+package Fripost::Schema::Type::User;
+
+use 5.010_000;
+use warnings;
+use strict;
+
+use base qw/Net::LDAP/;
+our $VERSION = '0.01';
+
+
+#######################################################################
+
+# Search a user, and return the corresponding entries if found. If no
+# user is given, returns all users.
+# Filters on the value of the key `uid' only (unless it is undefined).
+sub search {
+    my $self = shift;
+    
+    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(
+                  base   => $base,
+                  scope  => 'one',
+                  attrs  => [ 'uid', 'gn' , 'sn', 'maildir', 'isActive' ],
+                  filter => $filter
+            );
+    die "Error: " .$res->error. "\n" if $res->code;
+    return $res;
+}
+
+
+# Add the given user
+sub add {
+    my $self = shift;
+    my $user = shift;
+
+    my $base = join ',', ( 'uid=' .$user->{username}
+                         , 'ou=mailboxes'
+                         , $self->{_options}->{base_dn} );
+
+    my $res = $self->{_ldap}->add( $base,
+                attrs => [ uid          => $user->{username},
+                           objectClass  => [ 'top', 'virtualMailbox' ],
+                           userPassword => $user->{userPassword},
+                           maildir      => $user->{maildir},
+                           isActive     => $user->{isActive}
+                         ]
+              );
+    die "Error: " .$res->error. "\n" if $res->code;
+    return $res;
+}
+
+
+# Change password
+sub pwd {
+    my $self = shift;
+    my $user = shift;
+
+    my $base = join ',', ( 'uid=' .$user->{username}
+                         , 'ou=mailboxes'
+                         , $self->{_options}->{base_dn} );
+
+    my $res = $self->{_ldap}->modify( $base,
+                  replace => [ userPassword => $user->{userPassword} ]
+              );
+    die "Error: " .$res->error. "\n" if $res->code;
+    return $res;
+}
+
+
+#######################################################################
+
+1;
+
+=head1 NAME
+
+Fripost::Schema::Type::User - 
+
+=head1 AUTHOR
+
+Guilhem Moulin C<< <guilhem at fripost.org> >>
+
+=head1 COPYRIGHT
+
+Copyright 2012 Guilhem Moulin, all rights reserved.
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as perl itself.
+
+=cut
+
+1; # End of User.pm
+
+__END__