From 99b3ecbaf20b4e47ee6a403fd30268939e6e1244 Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem.moulin@fripost.org>
Date: Fri, 25 Jan 2013 02:49:26 +0100
Subject: Updated and redocumented Fripost::Schema::Domain.

---
 lib/Fripost/Schema/Auth.pm | 24 ++++++++++++++----------
 1 file changed, 14 insertions(+), 10 deletions(-)

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

diff --git a/lib/Fripost/Schema/Auth.pm b/lib/Fripost/Schema/Auth.pm
index 2df1a7e..c6325b8 100644
--- a/lib/Fripost/Schema/Auth.pm
+++ b/lib/Fripost/Schema/Auth.pm
@@ -68,7 +68,7 @@ the virtual entries.
 
 =back
 
-Errors can be caught with options B<-die> and B<-errors>, see
+Errors can be caught with options B<-die> and B<-error>, see
 B<Fripost::Schema::Util> for details.
 
 =cut
@@ -82,7 +82,7 @@ sub SASLauth {
     my $self = bless {}, $class;
 
     $self->suffix( ldap_explode_dn(@{$options{ldap_suffix}}) );
-    $self->whoami( $self->mkdn($user) );
+    $self->whoami( $self->mail2dn($user) );
     $self->ldap( Net::LDAP::->new( $options{ldap_uri} // 'ldap://127.0.0.1:389/'
                                  , async => 0 ) );
     assert( $self->ldap, -die => "Couldn't connect to the LDAP server." );
@@ -109,7 +109,7 @@ sub SASLauth {
                                   , callback => $callback );
     my $host = $options{ldap_SASL_service_instance} // 'localhost';
     my $conn = $sasl->client_new( 'ldap', $host );
-    ldap_error ($conn, %options);
+    ldap_error ($conn, %options) // return;
 
     my $mesg = $self->ldap->bind( undef, sasl => $conn );
     ldap_error ($mesg, %options) // return;
@@ -145,7 +145,7 @@ the virtual entries.
 
 =back
 
-Errors can be caught with options B<-die> and B<-errors>, see
+Errors can be caught with options B<-die> and B<-error>, see
 B<Fripost::Schema::Util> for details.
 
 =cut
@@ -164,7 +164,7 @@ sub auth {
     }
     else {
         return unless defined $user;
-        $self->whoami( $self->mkdn($user) );
+        $self->whoami( $self->mail2dn($user) );
     }
 
     $self->ldap( Net::LDAP::->new( $options{ldap_uri} // 'ldap://127.0.0.1:389/'
@@ -189,14 +189,14 @@ attribute of the DN associated with I<username>.
 If I<newpassword> is left undefined, the new password is generated at
 random, and returned upon success.
 
-Errors can be caught with options B<-die> and B<-errors>, see
+Errors can be caught with options B<-die> and B<-error>, see
 B<Fripost::Schema::Util> for details.
 
 =cut
 
 sub passwd {
     my $self = shift;
-    my $user = $self->mkdn(shift) // $self->whoami;
+    my $user = $self->mail2dn(shift) // $self->whoami;
     my $oldpw = shift;
     my $newpw = shift;
     my %options = @_;
@@ -243,7 +243,7 @@ of hashes), defined in B<Net::LDAP::Util>.
 sub suffix { shift->_set_or_get('_suffix',@_); }
 
 
-=item B<mkdn> ({I<username>|I<domainname>})
+=item B<mail2dn> ({I<username>|I<domainname>})
 
 Create the Distinguished Name associated with the I<username> (may be an
 alias or a list name regardless) or I<domainname>. The argument is first
@@ -251,12 +251,16 @@ converted to ASCII.
 
 =cut
 
-sub mkdn {
+sub mail2dn {
     my $self = shift;
     my $user = shift // return;
+
+    $user =~ s/^([^\@]+)$/\@$1/;
     my ($l,$d) = split_addr($user, -encode => 'ascii');
+
     my @dn = ({fvd => $d}, @{$self->suffix});
-    unshift @dn, {fvl => $l} if defined $l and $l ne '';
+    unshift @dn, {fvl => $l} if $l;
+
     canonical_dn( @dn );
 }
 
-- 
cgit v1.2.3