Updating the library to the new LDAP schema.

9 files changed, 146 insertions, 80 deletions

diff --git a/fripost-newdomain b/fripost-newdomain
index 6156459..6ce7923 100755
--- a/fripost-newdomain
+++ b/fripost-newdomain
@@ -22,8 +22,8 @@ If I<domain> is not given, the user is prompted for it.
 By default, B<fripost-newdomain> prompts for the owner of the new
 domain; Use B<--owner=>I<''> to create a "global" domain, only managed
 by the administrators.
-Several users can manage the same domain together. (TODO: is that what we
-want?) If B<fripost-newdomain> warns if it is asked to register an existing
+Several users can manage the same domain together. 
+If B<fripost-newdomain> warns if it is asked to register an existing
 domain to a new owner.
 
 =head1 OPTIONS
diff --git a/fripost-searchdomain b/fripost-searchdomain
index bbd59a3..8653eb1 100755
--- a/fripost-searchdomain
+++ b/fripost-searchdomain
@@ -17,12 +17,11 @@ B<fripost-searchdomain> [B<--debug>] [I<domain> [I<owner>]]
 
 B<fripost-seardomain> list virtual domains matching exactly I<domain>,
 and whose owner is I<owner>.
-Wildcards I<*> can appear in I<domain> or I<owner>, to match zero or more
-characters.
+Wildcards I<*> can appear in I<domain>, to match zero or more characters.
 If no I<owner> is given, list all domains I<domain>, regardless of the
 owner; If I<owner> is the empty string I<''>, list only the non
 self-managed domains.
-If neither I<domain> nor I<owner> are given, B<fripost-searchdomain> list
+If neither I<domain> nor I<owner> are given, B<fripost-searchdomain> lists
 all existing virtual domains.
 
 =head1 OPTIONS
diff --git a/fripost-searchuser b/fripost-searchuser
index 30df331..549e511 100755
--- a/fripost-searchuser
+++ b/fripost-searchuser
@@ -17,8 +17,10 @@ B<fripost-searchuser> [B<--debug>] [I<username>]
 
 B<fripost-searchuser> list virtual mailboxes whose username exactly matches
 I<username>.
-Wildcards I<*> can appear in I<username>, to match zero or more characters.
+Wildcards I<*> can appear in the login part of I<username>, to match zero or
+more characters.
 If no I<username> is given, B<fripost-searchuser> list all existing mailboxes.
+If I<username> has no domain part, lists matching users for any domains.
 
 =head1 OPTIONS
 
@@ -116,7 +118,6 @@ $user{username} = $ARGV[0] if defined $ARGV[0];
 
 foreach my $user ($ldap->user->search( \%user )->entries) {
     say "User:     " . $user->{username};
-    say "Maildir:  " . $user->{maildir};
     say "IsActive: " . $user->{isActive};
     say "--------------------------------"
 }
diff --git a/fripost.yml.template b/fripost.yml.template
index 7d3ac6c..bb71780 100644
--- a/fripost.yml.template
+++ b/fripost.yml.template
@@ -3,6 +3,6 @@
 ---
 server_host: ldap://127.0.0.1:389
 admin_email: admin@fripost.org
-bind_dn: cn=admin,ou=managers,dc=mail,dc=fripost,dc=org
+bind_dn: cn=guilhem,ou=managers,o=mailHosting,dc=guilhem,dc=org
 bind_pw: xxxxxx
-base_dn: dc=mail,dc=fripost,dc=org
+base_dn: ou=domains,o=mailHosting,dc=guilhem,dc=org
diff --git a/lib/Fripost/Schema/Search.pm b/lib/Fripost/Schema/Search.pm
index 3dc2efa..67815bd 100644
--- a/lib/Fripost/Schema/Search.pm
+++ b/lib/Fripost/Schema/Search.pm
@@ -5,6 +5,7 @@ use warnings;
 use strict;
 
 use Fripost::Schema::Type;
+use Fripost::Schema::Utils; 
 
 use base qw/Net::LDAP::Search/;
 our $VERSION = '0.01';
@@ -41,9 +42,10 @@ sub entries {
 sub _userEntry {
     my $entry = shift;
     my %user;
-    &_get_values( $entry, \%user, 'username', 'uid');
+    $user{username} = Fripost::Schema::Utils::fromDN ($entry->dn);
+    &_get_values( $entry, \%user, 'uid');
     map { &_get_values($entry, \%user, $_) }
-        qw /maildir isActive userPassword/;
+        qw /isActive userPassword/;
     return \%user;
 }
 
@@ -56,7 +58,7 @@ sub _domainEntry {
     if (defined $domain{owner}) {
         $domain{owner} = [ $domain{owner} ]
             unless (ref $domain{owner}) eq 'ARRAY';
-        $domain{owner} = [ map { (split /=/, (split /,/, $_, 2)[0], 2)[1] }
+        $domain{owner} = [ map { Fripost::Schema::Utils::fromDN($_) }
                                @{$domain{owner}} ];
     }
     return \%domain;
@@ -65,10 +67,14 @@ sub _domainEntry {
 sub _aliasEntry {
     my $entry = shift;
     my %alias;
+    my $domain = (split /=/, (split /,/, $entry->dn, 3)[1], 2)[1];
+
     &_get_values( $entry, \%alias, 'address', 'mailLocalAddress');
     if (defined $alias{address}) {
         $alias{address} = [ $alias{address} ]
             unless (ref $alias{address}) eq 'ARRAY';
+        $alias{address} = [ map { $_ . '@' . $domain }
+                                @{$alias{address}} ];
     }
     &_get_values( $entry, \%alias, 'goto', 'mailTarget');
     &_get_values( $entry, \%alias, 'isActive');
diff --git a/lib/Fripost/Schema/Type/Alias.pm b/lib/Fripost/Schema/Type/Alias.pm
index 7949b4b..5ee334d 100644
--- a/lib/Fripost/Schema/Type/Alias.pm
+++ b/lib/Fripost/Schema/Type/Alias.pm
@@ -18,31 +18,27 @@ our $VERSION = '0.01';
 # this domain only.
 sub search {
     my $self = shift;
+    my $alias = shift;
 
-    my $base = join ',', ( 'ou=domains'
-                         , $self->{_options}->{base_dn} );
-    $base = 'dc='.$_[0]->{domain} .','. $base
-        if defined $_[0]->{domain};
+    my ($username, $domain);
+    ($username, $domain) = split /\@/, $alias->{address}, 2
+        if defined $alias->{address};
+
+    my $base  = $self->{_options}->{base_dn};
+    $base  = join ',', ( 'dc='.$domain, $base )
+        if defined $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) . ')';
-    }
+    push @filters, '(mailLocalAddress=' .$username. ')'
+        if defined $username;
+    push @filters, '(mailTarget=' .$alias->{goto}. ')'
+        if defined $alias->{goto};
 
     my $res = $self->{_ldap}->search(
                   base   => $base,
                   scope  => 'subtree',
                   attrs  => [ 'mailLocalAddress', 'mailTarget', 'isActive' ],
-                  filter => $filter
+                  filter => Fripost::Schema::Utils::mkAndFilter( @filters )
             );
     die "Error: " .$res->error. "\n" if $res->code;
 
@@ -59,22 +55,19 @@ sub add {
         "' targetting to itself.\n"
         if $alias->{address} eq $alias->{goto};
 
-    my $domain = (split /\@/, $alias->{address}, 2)[1];
+    my ($username, $domain) = split /\@/, $alias->{address}, 2;
     my $base = join ',', ( 'mailTarget='.$alias->{goto}
                          , 'dc='. $domain
-                         , 'ou=domains'
                          , $self->{_options}->{base_dn} );
 
-    my @attrs = ( mailLocalAddress => $alias->{address} );
+    my @attrs = ( mailLocalAddress => $username );
     my $res;
     if ($self->search({ goto => $alias->{goto}, domain => $domain })->count) {
         $res = $self->{_ldap}->modify( $base, add => [ @attrs ] );
     }
     else {
         $res = $self->{_ldap}->add( $base,
-                 attrs => [ mailTarget       => $alias->{goto}
-                          , objectClass      => [ 'top',
-                                                  'inetLocalMailRecipient',
+                 attrs => [ objectClass      => [ 'inetLocalMailRecipient',
                                                   'virtualAliases' ]
                           , @attrs
                           , isActive         => $alias->{isActive}
diff --git a/lib/Fripost/Schema/Type/Domain.pm b/lib/Fripost/Schema/Type/Domain.pm
index 0d2be17..2b803ac 100644
--- a/lib/Fripost/Schema/Type/Domain.pm
+++ b/lib/Fripost/Schema/Type/Domain.pm
@@ -5,6 +5,8 @@ use warnings;
 use strict;
 
 use base qw/Net::LDAP/;
+use Fripost::Schema::Utils; 
+
 our $VERSION = '0.01';
 
 
@@ -14,41 +16,31 @@ our $VERSION = '0.01';
 # domain is given, returns all domains.
 # Filters on values of both keys `domain' and `owner' (unless they are
 # undefined).
-# If `owner' is the empty string, serch for non self-managed domains
+# If `owner' is the empty string, search for non self-managed domains
 # only.
 sub search {
     my $self = shift;
+    my $domain = 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 $owner;
+    $owner = Fripost::Schema::Utils::mkDN ( $self->{_options}, $domain->{owner} )
+        if defined $domain->{owner};
 
     my @filters = ('(ObjectClass=virtualDomain)');
-    push @filters, "(dc=" .$_[0]->{domain}. ")" if defined $_[0]->{domain};
-    if (defined $_[0]->{owner}) {
-        if ($_[0]->{owner} eq '') {
+    push @filters, "(dc=" .$domain->{domain}. ")" if defined $domain->{domain};
+    if (defined $domain->{owner}) {
+        if ($domain->{owner} eq '') {
             push @filters, "(!(owner=*))";
         }
         else {
             push @filters, "(owner=" .$owner. ")";
         }
     }
-    my $filter;
-    if ($#filters == 0) {
-        $filter = $filters[0];
-    }
-    elsif ($#filters > 0) {
-        $filter = "(&" . (join '', @filters) . ")";
-    }
-
     my $res = $self->{_ldap}->search(
-                  base   => $base,
+                  base   => $self->{_options}->{base_dn},
                   scope  => 'one',
                   attrs  => [ 'dc', 'owner', 'isActive' ],
-                  filter => $filter
+                  filter => Fripost::Schema::Utils::mkAndFilter( @filters )
             );
     die "Error: " .$res->error. "\n" if $res->code;
     return $res;
@@ -61,13 +53,9 @@ sub add {
     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};
+    $base = Fripost::Schema::Utils::mkDN ( $self->{_options}, $domain->{domain} );
+    $owner = Fripost::Schema::Utils::mkDN ( $self->{_options}, $domain->{owner} )
+        if defined $domain->{owner};
 
     my $res;
     if ($self->search({ domain => $domain->{domain} })->count) {
@@ -77,8 +65,7 @@ sub add {
         $res = $self->{_ldap}->modify( $base, add => [ owner => $owner ] );
     }
     else {
-        my @attrs = ( dc           => $domain->{domain},
-                    , objectClass  => [ 'top', 'virtualDomain' ],
+        my @attrs = ( objectClass  => 'virtualDomain',
                     , isActive     => $domain->{isActive}
                     );
         push @attrs, (owner => $owner)
diff --git a/lib/Fripost/Schema/Type/User.pm b/lib/Fripost/Schema/Type/User.pm
index b21c2e1..f5b6ce2 100644
--- a/lib/Fripost/Schema/Type/User.pm
+++ b/lib/Fripost/Schema/Type/User.pm
@@ -5,6 +5,8 @@ use warnings;
 use strict;
 
 use base qw/Net::LDAP/;
+use Fripost::Schema::Utils; 
+
 our $VERSION = '0.01';
 
 
@@ -12,20 +14,26 @@ 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).
+# If the user has no domain part, returns matching users for any
+# domains.
 sub search {
     my $self = shift;
-    
-    my $base = join ',', ('ou=mailboxes',$self->{_options}->{base_dn});
+    my $user = shift;
 
+    my ($username, $domain) = split /\@/, $user->{username}, 2;
+
+    my $base  = $self->{_options}->{base_dn};
+    $base  = join ',', ( 'dc='.$domain, $base )
+        if defined $domain;
+    
     my $filter = "(ObjectClass=virtualMailbox)";
-    $filter = "(&" .$filter. "(uid=" .$_[0]->{username}. ")" .")"
-        if defined $_[0]->{username};
+    $filter = "(&" .$filter. "(uid=" .$username. ")" .")"
+        if defined $username;
 
     my $res = $self->{_ldap}->search(
                   base   => $base,
-                  scope  => 'one',
-                  attrs  => [ 'uid', 'gn' , 'sn', 'maildir', 'isActive' ],
+                  scope  => 'sub',
+                  attrs  => [ 'uid', 'gn' , 'sn', 'isActive' ],
                   filter => $filter
             );
     die "Error: " .$res->error. "\n" if $res->code;
@@ -38,15 +46,12 @@ sub add {
     my $self = shift;
     my $user = shift;
 
-    my $base = join ',', ( 'uid=' .$user->{username}
-                         , 'ou=mailboxes'
-                         , $self->{_options}->{base_dn} );
+    my $base = Fripost::Schema::Utils::mkDN ( $self->{_options}
+                                            , $user->{username} );
 
     my $res = $self->{_ldap}->add( $base,
-                attrs => [ uid          => $user->{username},
-                           objectClass  => [ 'top', 'virtualMailbox' ],
+                attrs => [ objectClass  => 'virtualMailbox',
                            userPassword => $user->{userPassword},
-                           maildir      => $user->{maildir},
                            isActive     => $user->{isActive}
                          ]
               );
@@ -60,9 +65,8 @@ sub passwd {
     my $self = shift;
     my $user = shift;
 
-    my $base = join ',', ( 'uid=' .$user->{username}
-                         , 'ou=mailboxes'
-                         , $self->{_options}->{base_dn} );
+    my $base = Fripost::Schema::Utils::mkDN ( $self->{_options}
+                                            , $user->{username} );
 
     my $res = $self->{_ldap}->modify( $base,
                   replace => [ userPassword => $user->{userPassword} ]
diff --git a/lib/Fripost/Schema/Utils.pm b/lib/Fripost/Schema/Utils.pm
new file mode 100644
index 0000000..382da1c
--- /dev/null
+++ b/lib/Fripost/Schema/Utils.pm
@@ -0,0 +1,76 @@
+package Fripost::Schema::Utils;
+
+use 5.010_000;
+use warnings;
+use strict;
+
+our $VERSION = '0.01';
+
+
+#######################################################################
+
+sub mkDN {
+    my $config = shift;
+
+    my ($user, $domain) = split /\@/, $_[0], 2;
+
+    my $dn;
+    if (defined $domain) {
+        $dn = join ',', ( 'uid='. $user
+                        , 'dc='. $domain
+                        , $config->{base_dn} );
+    }
+    elsif (defined $user) {
+        $dn = join ',', ( 'dc='. $user
+                        , $config->{base_dn} );
+    }
+    else {
+        $dn = $config->{base_dn};
+    }
+    return $dn;
+}
+
+sub fromDN {
+    my ($u,$d) = split /,/, $_[0], 3;
+    join '@', ( map { (split /=/, $_, 2)[1] } ($u,$d) );
+}
+
+sub mkAndFilter {
+    my @filters = @_;
+
+    my $filter;
+    if ($#filters == 0) {
+        $filter = $filters[0];
+    }
+    elsif ($#filters > 0) {
+        $filter = "(&" . (join '', @filters) . ")";
+    }
+}
+
+
+#######################################################################
+
+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 Utils.pm
+
+__END__