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