Abstracting the LDAP stuff in an OO library.

1 files changed, 177 insertions, 0 deletions

diff --git a/lib/Fripost/Schema/Alias.pm b/lib/Fripost/Schema/Alias.pm
new file mode 100644
index 0000000..c413257
--- /dev/null
+++ b/lib/Fripost/Schema/Alias.pm
@@ -0,0 +1,177 @@
+package Fripost::Schema::Alias;
+
+=head1 NAME
+
+Alias.pm -
+
+=head1 DESCRIPTION
+
+Alias.pm abstracts the LDAP schema definition and provides methods to
+add, list or delete virtual aliases.
+
+=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) alias under the given domain. The output
+is a array of hash references, sorted by alias.
+
+=cut
+
+sub search {
+    my $self = shift;
+    my $domain = shift;
+    my %options = @_;
+    my $concat = $options{'-concat'};
+
+    my $aliases = $self->ldap->search(
+                      base => "fvd=$domain,".$self->suffix,
+                      scope => 'one',
+                      deref => 'never',
+                      filter => 'objectClass=FripostVirtualAlias',
+                      attrs => [ qw/fva description fripostIsStatusActive
+                                    fripostMaildrop/ ]
+                  );
+    if ($aliases->code) {
+        die $options{'-die'}."\n" if defined $options{'-die'};
+        die $aliases->error;
+    }
+    return map { { alias => $_->get_value('fva')
+                 , isactive => $_->get_value('fripostIsStatusActive') eq 'TRUE'
+                 , description => concat($concat, $_->get_value('description'))
+                 , maildrop => concat($concat, $_->get_value('fripostMaildrop'))
+                 }
+               }
+               $aliases->sorted('fva')
+}
+
+
+=item B<replace> (I<alias>, I<OPTIONS>)
+
+Replace an existing alias with the given one.
+
+=cut
+
+sub replace {
+    my $self = shift;
+    my $a = shift;
+    my %options = @_;
+
+    foreach (qw/description maildrop/) {
+        $a->{$_} = explode ($options{'-concat'}, $a->{$_})
+            if defined $a->{$_};
+    }
+
+    my ($l,$d) = split /\@/, $a->{alias}, 2;
+
+    eval {
+        &_is_valid($a);
+        my $mesg = $self->ldap->modify(
+                       "fva=$l,fvd=$d,".$self->suffix,
+                       replace => { fripostIsStatusActive => $a->{isactive} ?
+                                        'TRUE' : 'FALSE'
+                                  , description => $a->{description}
+                                  , fripostMaildrop => $a->{maildrop}
+                   } );
+        die $mesg->error."\n" if $mesg->code;
+    };
+    return $@;
+}
+
+
+=item B<add> (I<alias>, I<OPTIONS>)
+
+Add the given alias.
+
+=cut
+
+sub add {
+    my $self = shift;
+    my $a = shift;
+    my %options = @_;
+
+    foreach (qw/description maildrop/) {
+        $a->{$_} = explode ($options{'-concat'}, $a->{$_})
+            if defined $a->{$_};
+    }
+
+    my ($l,$d) = split /\@/, $a->{alias}, 2;
+
+    eval {
+        die "Missing alias name\n" if $l eq '';
+        &_is_valid($a);
+        die "‘".$a->{alias}."‘ alread exists\n"
+            if $self->local->exists($l,$d,%options);
+
+        my %attrs = ( objectClass => 'FripostVirtualAlias'
+                    , fripostIsStatusActive => $a->{isactive} ? 'TRUE' : 'FALSE'
+                    , fripostMaildrop => $a->{maildrop}
+                    , fripostOwner => $self->whoami
+                    );
+        $attrs{description} = $a->{description}
+            if defined $a->{description} and @{$a->{description}};
+
+        my $mesg = $self->ldap->add( "fva=$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 alias is valid.
+sub _is_valid {
+    my $a = shift;
+    must_attrs( $a, qw/alias isactive maildrop/ );
+    email_valid( $a->{alias}, -exact => 1 );
+    $a->{maildrop} = [ map { email_valid($_) } @{$a->{maildrop}} ];
+    # TODO: check for cycles?
+}
+
+
+=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__