1#!perl 2use strict; 3use warnings; 4 5use Test::More tests => 32; 6 7use Authen::SASL qw(Perl); 8use_ok('Authen::SASL::Perl::LOGIN'); 9 10my %params = ( 11 mechanism => 'LOGIN', 12 callback => { 13 getsecret => sub { use Carp; Carp::confess("x") unless $_[2]; $_[2]->('secret') }, 14 }, 15); 16 17ok(my $ssasl = Authen::SASL->new( %params ), "new"); 18 19is($ssasl->mechanism, 'LOGIN', 'sasl mechanism'); 20 21my $server = $ssasl->server_new("xmpp","localhost"); 22is($server->mechanism, 'LOGIN', 'server mechanism'); 23 24is_failure(); 25is_failure("", ""); 26is_failure("xxx", "yyy", "zzz"); 27is_failure("a", "a", "a"); 28 29my $response; my $cb = sub { $response = shift }; 30$server->server_start("", $cb), 31is $response, "Username:"; 32$server->server_step("user", $cb); 33is $response, "Password:"; 34$server->server_step("secret", $cb); 35 36ok !$server->error, "no error" or diag $server->error; 37ok $server->is_success, "success finally"; 38 39sub is_failure { 40 my $creds = shift; 41 my @steps = @_; 42 ## wouldn't really work in an async environemnt 43 my $cb; 44 $server->server_start("", sub { $cb = 1 }); 45 ok $cb, "callback called"; 46 for (@steps) { 47 $cb = 0; 48 $server->server_step($_, sub { $cb = 1 }); 49 ok $cb, "callback called"; 50 } 51 ok !$server->is_success, "failure"; 52 ok ($server->need_step or $server->error), "no success means that"; 53} 54 55 56## testing checkpass callback, which takes precedence 57## over getsecret when specified 58%params = ( 59 mechanism => 'LOGIN', 60 callback => { 61 getsecret => "incorrect", 62 checkpass => sub { 63 my $self = shift; 64 my ($args, $cb) = @_; 65 is $args->{user}, "foo", "username correct"; 66 is $args->{pass}, "bar", "correct password"; 67 $cb->(1); 68 return; 69 } 70 }, 71); 72 73ok($ssasl = Authen::SASL->new( %params ), "new"); 74$server = $ssasl->server_new("ldap","localhost"); 75my $cb; 76$server->server_start("", sub { $cb = 1 }); 77ok $cb, "callback called"; $cb = 0; 78$server->server_step("foo", sub { $cb = 1 }); 79ok $cb, "callback called"; $cb = 0; 80$server->server_step("bar", sub { $cb = 1 }); 81ok $cb, "callback called"; 82ok $server->is_success, "success"; 83