1#!perl 2 3use Test::More tests => 9; 4 5use FindBin qw($Bin); 6require "$Bin/../lib/common.pl"; 7 8use Authen::SASL qw(Perl); 9use_ok('Authen::SASL::Perl::LOGIN'); 10 11## base conf 12my $cconf = { 13 sasl => { 14 mechanism => 'LOGIN', 15 callback => { 16 user => 'yann', 17 pass => 'maelys', 18 }, 19 }, 20 host => 'localhost', 21 service => 'xmpp', 22}; 23my $Password = 'maelys'; 24my $sconf = { 25 sasl => { 26 mechanism => 'LOGIN', 27 callback => { 28 getsecret => sub { $_[2]->($Password) }, 29 }, 30 }, 31 host => 'localhost', 32 service => 'xmpp', 33}; 34 35## base negotiation should work 36negotiate($cconf, $sconf, sub { 37 my ($clt, $srv) = @_; 38 is $clt->mechanism, "LOGIN"; 39 is $srv->mechanism, "LOGIN"; 40 ok $clt->is_success, "client success" or diag $clt->error; 41 ok $srv->is_success, "server success" or diag $srv->error; 42}); 43 44## invalid password 45{ 46 # hey callback could just be a subref that returns a localvar 47 $Password = "wrong"; 48 49 negotiate($cconf, $sconf, sub { 50 my ($clt, $srv) = @_; 51 ok ! $srv->is_success, "wrong pass"; 52 like $srv->error, qr/match/, "error set"; 53 }); 54} 55 56## invalid password with different callback 57{ 58 local $sconf->{sasl}{callback}{checkpass} = sub { $_[2]->(0) }; 59 60 negotiate($cconf, $sconf, sub { 61 my ($clt, $srv) = @_; 62 ok ! $srv->is_success, "wrong pass"; 63 like $srv->error, qr/match/, "error set"; 64 }); 65} 66