Abstracting the LDAP stuff in an OO library.

1 files changed, 202 insertions, 0 deletions

diff --git a/lib/Fripost/Schema.pm b/lib/Fripost/Schema.pm
new file mode 100644
index 0000000..36b7d54
--- /dev/null
+++ b/lib/Fripost/Schema.pm
@@ -0,0 +1,202 @@
+package Fripost::Schema;
+
+=head1 NAME
+
+Schema.pm -
+
+=cut
+
+=head1 DESCRIPTION
+
+Schema.pm abstracts the LDAP schema definition and provides methods to
+add, list or delete virtual domains, mailboxes, aliases or lists.
+
+=cut
+
+use 5.010_000;
+use strict;
+use warnings;
+use utf8;
+
+use Net::LDAP;
+use Authen::SASL;
+use Fripost::Schema::Domain;
+use Fripost::Schema::Mailbox;
+use Fripost::Schema::Alias;
+use Fripost::Schema::List;
+use Fripost::Schema::Local;
+
+
+=head1 METHODS
+
+=over 4
+
+=item B<SASLauth> (I<username>, I<CFG>)
+
+Start a LDAP connection, and SASL-authenticate using proxy
+authentication for the given (fully-qualified) user. I<CFG> should
+contain definitions for the LDAP suffix and the authentication ID.
+
+=cut
+
+sub SASLauth {
+    my $class = shift;
+    my ($l,$d) = split /\@/, shift, 2;
+    my %cfg = @_;
+
+    my $self = bless {}, $class;
+    $self->suffix( join ',', @{$cfg{ldap_suffix}} );
+    $self->whoami( "fvu=$l,fvd=$d,".$self->suffix );
+    $self->ldap( Net::LDAP::->new( $cfg{ldap_uri}, async => 1 ) );
+
+    my $sasl = Authen::SASL::->new(
+                   mechanism => 'DIGEST-MD5',
+                   callback => { user => $cfg{ldap_authcID}
+                               , pass => $cfg{ldap_authcPW}
+                               , authname => 'dn:'.$self->whoami }
+    );
+    my $mesg = $self->ldap->bind( sasl => $sasl );
+    # This is not supposed to happen.
+    die $mesg->error if $mesg->code;
+
+    return $self;
+}
+
+
+=item B<auth> (I<username>, I<password>, I<CFG>)
+
+Start a LDAP connection, and (simples-) binds the given user.
+I<CFG> should contain definitions for the LDAP suffix and URI.
+
+=cut
+
+sub auth {
+    my $class = shift;
+    my ($l,$d) = split /\@/, shift, 2;
+    my $pw = shift;
+    my %cfg = @_;
+
+    my $self = bless {}, $class;
+    $self->suffix( join ',', @{$cfg{ldap_suffix}} );
+    $self->whoami( "fvu=$l,fvd=$d,".$self->suffix );
+    $self->ldap( Net::LDAP::->new( $cfg{ldap_uri}, async => 1 ) );
+
+    my $mesg = $self->ldap->bind( $self->whoami, password => $pw );
+    if ($mesg->code) {
+        die $cfg{'-die'}."\n" if defined $cfg{'-die'};
+        die $mesg->error;
+    }
+    return $self;
+}
+
+
+
+# The DN of the authorization ID
+sub whoami { shift->_set_or_get('_whoami',@_); }
+
+# The LDAP object (of class Net::LDAP)
+sub ldap { shift->_set_or_get('_ldap',@_); }
+
+# The suffix under which virtual domains are.
+sub suffix { shift->_set_or_get('_suffix',@_); }
+
+
+# Set or get a key (the first argument), depending on whether a second
+# argument is given or not.
+sub _set_or_get {
+    my $self = shift;
+    my $what = shift;
+
+    if (@_) {
+        $self->{$what} = $_[0];
+    }
+    else {
+        return $self->{$what};
+    }
+}
+
+
+
+=item B<domain>
+
+Bless the object to C<Fripost::Schema::Domain>, to access
+domain-specific methods.
+
+=cut
+
+sub domain { bless shift, 'Fripost::Schema::Domain'; }
+
+
+=item B<mailbox>
+
+Bless the object to C<Fripost::Schema::Mailbox>, to access
+mailbox-specific methods.
+
+=cut
+
+sub mailbox { bless shift, 'Fripost::Schema::Mailbox'; }
+
+
+=item B<alias>
+
+Bless the object to C<Fripost::Schema::Alias>, to access
+alias-specific methods.
+
+=cut
+
+sub alias { bless shift, 'Fripost::Schema::Alias'; }
+
+
+=item B<list>
+
+Bless the object to C<Fripost::Schema::List>, to access
+list-specific methods.
+
+=cut
+
+sub list { bless shift, 'Fripost::Schema::List'; }
+
+
+=item B<local>
+
+Bless the object to C<Fripost::Schema::Local>, to access
+local-specific (mailboxes, aliases and lists) methods.
+
+=cut
+
+sub local { bless shift, 'Fripost::Schema::Local'; }
+
+
+
+=item B<done>
+
+Unbinds from the LDAP server.
+
+=cut
+
+sub done {
+    my $self = shift;
+    $self->ldap->unbind if defined $self and defined $self->ldap;
+}
+
+
+=back
+
+=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__