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