From 1f365b29f094912fa8f6e9d7fe0348148eb60ccf Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem.moulin@fripost.org>
Date: Fri, 18 Jan 2013 21:24:39 +0100
Subject: Added the possibility to chooze the SASL mechanism (GSSAPI or
 DIGEST-MD5).

---
 lib/Fripost/Panel/Interface.pm |  3 +--
 lib/Fripost/Panel/Login.pm     |  6 +-----
 lib/Fripost/Schema.pm          | 31 +++++++++++++++++++++++--------
 3 files changed, 25 insertions(+), 15 deletions(-)

diff --git a/lib/Fripost/Panel/Interface.pm b/lib/Fripost/Panel/Interface.pm
index 18b9a48..fcd4f97 100644
--- a/lib/Fripost/Panel/Interface.pm
+++ b/lib/Fripost/Panel/Interface.pm
@@ -264,8 +264,7 @@ sub EditLocal : Runmode {
                         $fp = Fripost::Schema::->auth(
                                   $u,
                                   $q->param('oldpw'),
-                                  ldap_uri => $CFG{ldap_uri},
-                                  ldap_suffix => $CFG{ldap_suffix},
+                                  %CFG,
                                   -die => "Wrong password (for ‘".$u."’)." );
                     };
                     $error = $@ || $fp->user->passwd(
diff --git a/lib/Fripost/Panel/Login.pm b/lib/Fripost/Panel/Login.pm
index ef8474c..4f00f6b 100644
--- a/lib/Fripost/Panel/Login.pm
+++ b/lib/Fripost/Panel/Login.pm
@@ -65,11 +65,7 @@ sub cgiapp_init {
             }
             Encode::_utf8_on($u);
             $u = email_to_ascii($u);
-            my $fp = Fripost::Schema::->auth($u, $p,
-                                             ldap_uri => $CFG{ldap_uri},
-                                             ldap_suffix => $CFG{ldap_suffix},
-                                             -die => 0
-            );
+            my $fp = Fripost::Schema::->auth($u, $p, %CFG, -die => 0);
             return 0 unless defined $fp;
             $fp->done;
             return $u;
diff --git a/lib/Fripost/Schema.pm b/lib/Fripost/Schema.pm
index 9d6f4cb..236b407 100644
--- a/lib/Fripost/Schema.pm
+++ b/lib/Fripost/Schema.pm
@@ -50,16 +50,31 @@ sub SASLauth {
     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 ) );
+    return $self unless defined $cfg{ldap_SASL_mechanism};
 
-    my $sasl = Authen::SASL::->new(
-                   mechanism => 'GSSAPI',
-                   callback => { user => 'dn:'.$self->whoami }
-    );
-    my $conn = $sasl->client_new('ldap', $cfg{krb5_service_instance} );
+    $self->ldap( Net::LDAP::->new( $cfg{ldap_uri}, async => 0 ));
+
+    my $callback;
+    if ($cfg{ldap_SASL_mechanism} eq 'DIGEST-MD5') {
+        $callback = { user => $cfg{ldap_authcID}
+                    , pass => $cfg{ldap_authcPW}
+                    , authname => 'dn:'.$self->whoami
+                    };
+    }
+    elsif ($cfg{ldap_SASL_mechanism} eq 'GSSAPI') {
+        $callback = { user => 'dn:'.$self->whoami };
+    }
+    else {
+        die "Unknown SASL mechanism: ".$cfg{ldap_SASL_mechanism};
+    }
+
+    my $sasl = Authen::SASL::->new( mechanism => $cfg{ldap_SASL_mechanism}
+                                  , callback => $callback );
+    my $host = $cfg{krb5_service_instance} // 'localhost';
+    my $conn = $sasl->client_new( 'ldap', $host );
     die $conn->error if $conn->code;
 
-    my $mesg = $self->ldap->bind( '', sasl => $conn );
+    my $mesg = $self->ldap->bind( undef, sasl => $conn );
     # This is not supposed to happen.
     die $mesg->error if $mesg->code;
 
@@ -91,7 +106,7 @@ sub auth {
         $self->whoami( "fvu=$l,fvd=$d,".$self->suffix );
     }
 
-    $self->ldap( Net::LDAP::->new( $cfg{ldap_uri}, async => 1 ) );
+    $self->ldap( Net::LDAP::->new( $cfg{ldap_uri}, async => 0 ) );
 
     my $mesg = $self->ldap->bind( $self->whoami, password => $pw );
     if ($mesg->code) {
-- 
cgit v1.2.3