Makes sure that user callbacks are called

Even for dumb mechanisms like LOGIN and PLAIN
marschap · Jun 2, 2010 · c6462fd · c6462fd
1 parent 7ead99c
commit c6462fd
Show file tree

Hide file tree

Showing 4 changed files with 24 additions and 12 deletions.
diff --git a/lib/Authen/SASL/Perl/LOGIN.pm b/lib/Authen/SASL/Perl/LOGIN.pm
@@ -97,11 +97,11 @@ sub server_step {
       my $result = shift;
       unless ($result) {
         $self->set_error($error);
-        $user_cb->();
       }
       else {
-          $self->set_success;
+        $self->set_success;
       }
+      $user_cb->();
     };
     $checkpass->($self => $answers => $cb );
     return;

diff --git a/lib/Authen/SASL/Perl/PLAIN.pm b/lib/Authen/SASL/Perl/PLAIN.pm
@@ -61,11 +61,11 @@ sub server_start {
       my $result = shift;
       unless ($result) {
         $self->set_error($error);
-        $user_cb->();
       }
       else {
         $self->set_success;
       }
+      $user_cb->();
     };
     $checkpass->($self => { %parts } => $cb );
     return;

diff --git a/t/server/login.t b/t/server/login.t
@@ -2,7 +2,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 20;
+use Test::More tests => 32;
 
 use Authen::SASL qw(Perl);
 use_ok('Authen::SASL::Perl::LOGIN');
@@ -40,9 +40,13 @@ sub is_failure {
     my $creds = shift;
     my @steps = @_;
     ## wouldn't really work in an async environemnt
-    $server->server_start("");
+    my $cb;
+    $server->server_start("", sub { $cb = 1 });
+    ok $cb, "callback called";
     for (@steps) {
-        $server->server_step($_);
+        $cb = 0;
+        $server->server_step($_, sub { $cb = 1 });
+        ok $cb, "callback called";
     }
     ok !$server->is_success, "failure";
     ok ($server->need_step or $server->error), "no success means that";
@@ -68,7 +72,11 @@ sub is_failure {
 
 ok($ssasl = Authen::SASL->new( %params ), "new");
 $server = $ssasl->server_new("ldap","localhost");
-$server->server_start("");
+my $cb;
-$server->server_step("foo");
+$server->server_start("", sub { $cb = 1 });
-$server->server_step("bar");
+ok $cb, "callback called"; $cb = 0;
+$server->server_step("foo", sub { $cb = 1 });
+ok $cb, "callback called"; $cb = 0;
+$server->server_step("bar", sub { $cb = 1 });
+ok $cb, "callback called";
 ok $server->is_success, "success";
diff --git a/t/server/plain.t b/t/server/plain.t
@@ -2,7 +2,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 47;
+use Test::More tests => 67;
 
 use Authen::SASL qw(Perl);
 use_ok('Authen::SASL::Perl::PLAIN');
@@ -67,7 +67,9 @@ for my $authname ('', 'none') {
     is_failure("$authname\0yann\0\0maelys", "double null");
     is_failure("$authname\0yann\0maelys\0trailing", "trailing");
 
-    $server->server_start("$authname\0yann\0maelys");
+    my $cb;
+    $server->server_start("$authname\0yann\0maelys", sub { $cb = 1 });
+    ok $cb, "callback called";
     ok $server->is_success, "success finally";
 }
 
@@ -97,7 +99,9 @@ ok $server->is_success, "success";
 sub is_failure {
     my $creds = shift;
     my $msg   = shift;
-    $server->server_start($creds);
+    my $cb;
+    $server->server_start($creds, sub { $cb = 1 });
+    ok $cb, 'callback called';
     ok !$server->is_success, $msg || "failure";
     my $error = $server->error || "";
     like $error, qr/match/i, "failure";