From 4a0d87e642c4d97ee2a026f1207e25a001518f3a Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem.moulin@fripost.org>
Date: Sat, 8 Sep 2012 19:49:11 +0200
Subject: Abstracting the LDAP stuff in an OO library.

---
 lib/Fripost/Schema/Mailbox.pm | 203 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 203 insertions(+)
 create mode 100644 lib/Fripost/Schema/Mailbox.pm

(limited to 'lib/Fripost/Schema/Mailbox.pm')

diff --git a/lib/Fripost/Schema/Mailbox.pm b/lib/Fripost/Schema/Mailbox.pm
new file mode 100644
index 0000000..61d86a0
--- /dev/null
+++ b/lib/Fripost/Schema/Mailbox.pm
@@ -0,0 +1,203 @@
+package Fripost::Schema::Mailbox;
+
+=head1 NAME
+
+Mailbox.pm -
+
+=head1 DESCRIPTION
+
+Mailbox.pm abstracts the LDAP schema definition and provides methods to
+add, list or delete virtual mailboxes.
+
+=cut
+
+use 5.010_000;
+use strict;
+use warnings;
+use utf8;
+
+use parent 'Fripost::Schema';
+use Fripost::Schema::Misc qw/concat explode must_attrs email_valid/;
+
+
+=head1 METHODS
+
+=over 4
+
+=item B<search> (I<domain>, I<OPTIONS>)
+
+List every known (and visible) mailbox under the given domain. The
+output is a array of hash references, sorted by mailbox.
+
+=cut
+
+sub search {
+    my $self = shift;
+    my $domain = shift;
+    my %options = @_;
+    my $concat = $options{'-concat'};
+
+    my $mailboxes = $self->ldap->search(
+                        base => "fvd=$domain,".$self->suffix,
+                        scope => 'one',
+                        deref => 'never',
+                        filter => 'objectClass=FripostVirtualMailbox',
+                        attrs => [ qw/fvu description fripostIsStatusActive
+                                      fripostOptionalMaildrop
+                                      fripostMailboxQuota/ ]
+                  );
+    if ($mailboxes->code) {
+        die $options{'-die'}."\n" if defined $options{'-die'};
+        die $mailboxes->error;
+    }
+    return map { { user => $_->get_value('fvu')
+                 , isactive => $_->get_value('fripostIsStatusActive') eq 'TRUE'
+                 , description => concat($concat, $_->get_value('description'))
+                 , forwards => concat($concat, $_->get_value('fripostOptionalMaildrop'))
+                 , quota => $_->get_value('fripostMailboxQuota') // undef
+                 }
+               }
+               $mailboxes->sorted('fvu')
+}
+
+
+=item B<replace> (I<mailbox>, I<OPTIONS>)
+
+Replace an existing account with the given one.
+
+=cut
+
+sub replace {
+    my $self = shift;
+    my $m = shift;
+    my %options = @_;
+
+    foreach (qw/description forwards/) {
+        $m->{$_} = explode ($options{'-concat'}, $m->{$_})
+            if defined $m->{$_};
+    }
+
+    my ($l,$d) = split /\@/, $m->{user}, 2;
+
+    eval {
+        &_is_valid($m);
+        my $mesg = $self->ldap->modify(
+                       "fvu=$l,fvd=$d,".$self->suffix,
+                       replace => { fripostIsStatusActive => $m->{isactive} ?
+                                        'TRUE' : 'FALSE'
+                                  , description => $m->{description}
+                                  , fripostOptionalMaildrop => $m->{forwards}
+                   } );
+        die $mesg->error."\n" if $mesg->code;
+    };
+    return $@;
+}
+
+
+=item B<passwd> (I<username>, I<password>, I<OPTIONS>)
+
+Change the password of the given user. I<password> is used raw, so you
+may want to hash it before hand.
+
+=cut
+
+sub passwd {
+    my $self = shift;
+    my ($l,$d) = split /\@/, shift, 2;
+    my $pw = shift;
+    my %options = @_;
+
+    my $mesg = $self->ldap->modify(
+                   "fvu=$l,fvd=$d,".$self->suffix,
+                   replace => { userPassword => $pw } );
+    return "Cannot change password" if $mesg->code;
+}
+
+
+
+=item B<add> (I<mailbox>, I<OPTIONS>)
+
+Add the given account.
+
+=cut
+
+sub add {
+    my $self = shift;
+    my $m = shift;
+    my %options = @_;
+
+    foreach (qw/description forwards/) {
+        $m->{$_} = explode ($options{'-concat'}, $m->{$_})
+            if defined $m->{$_};
+    }
+
+    my ($l,$d) = split /\@/, $m->{user}, 2;
+
+    eval {
+        die "Missing user name\n" if $l eq '';
+        &_is_valid($m);
+        die "‘".$m->{user}."‘ alread exists\n"
+            if $self->local->exists($l,$d,%options);
+
+        my %attrs = ( objectClass => 'FripostVirtualMailbox' 
+                    , fripostIsStatusActive => $m->{isactive} ? 'TRUE' : 'FALSE'
+                    , userPassword => $m->{password}
+                    );
+        $attrs{description} = $m->{description}
+            if defined $m->{description} and @{$m->{description}};
+        $attrs{fripostMailboxQuota} = $m->{quota} if defined $m->{quota};
+        $attrs{fripostOptionalMaildrop} = $m->{forwards}
+            if defined $m->{forwards} and @{$m->{forwards}};
+
+        my $mesg = $self->ldap->add( "fvu=$l,fvd=$d,".$self->suffix,
+                                     attrs => [ %attrs ] );
+        if ($mesg->code) {
+            die $options{'-die'}."\n" if defined $options{'-die'};
+            die $mesg->error;
+        }
+    };
+    return $@;
+}
+
+
+=back
+
+=head1 GLOBAL OPTIONS
+
+If the B<-concat> option is present, it will intersperse multi-valued
+attributes. Otherwise, an array reference containing every values will
+be returned for these attributes.
+
+The B<-die> option, if present, overides LDAP croaks and errors.
+
+=cut
+
+
+# Ensure that the given mailbox is valid.
+sub _is_valid {
+    my $m = shift;
+    must_attrs( $m, qw/user isactive/ );
+    email_valid( $m->{user}, -exact => 1);
+    $m->{forwards} = [ map { email_valid($_) } @{$m->{forwards}} ];
+    # TODO: match 'quota' against the Dovecot specifications
+}
+
+
+=head1 AUTHOR
+
+Guilhem Moulin C<< <guilhem at fripost.org> >>
+
+=head1 COPYRIGHT
+
+Copyright 2012 Guilhem Moulin.
+
+=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__
-- 
cgit v1.2.3