File Coverage

File:t/ntlm_client.t
Coverage:100.0%

linestmtbrancondsubpodtimecode
1
1
1
1
23001
0
0
use strict;
2
1
1
1
0
0
0
use warnings;
3
4
1
1
1
3000
104006
0
use Test::More;
5
6
1
1
1
3000
3001
0
use Authen::SASL qw(Perl);
7
1
1
1
24001
4000
0
use MIME::Base64 qw(decode_base64);
8
1
1
1
3000
64004
0
use Authen::NTLM;
9
10
1
1
1
0
0
0
use constant HOST => 'localhost';
11
1
1
1
0
0
1000
use constant DOMAIN => 'domain';
12
1
1
1
0
0
0
use constant USER => 'user';
13
1
1
1
0
0
9001
use constant PASS => 'pass';
14
15
1
249014
use_ok('Authen::SASL::Perl::NTLM');
16
17
1
1000
my $challenge =
18  'TlRMTVNTUAACAAAABAAEADAAAAAFggEAQUJDREVGR0gAAAAAAAAAAAAAAAAAAAAA';
19
20
1
0
my $ntlm = Authen::NTLM->new(
21    host => HOST,
22    user => USER,
23    password => PASS,
24);
25
1
0
my $msg1 = $ntlm->challenge;
26
1
1000
my $msg2 = $ntlm->challenge($challenge);
27
28
1
243014
my $conn;
29
30subtest 'simple' => sub {
31
1
6000
    my $sasl = new_ok(
32        'Authen::SASL', [
33            mechanism => 'NTLM',
34            callback => {
35                user => USER,
36                pass => PASS,
37            },
38        ]
39    );
40
41
1
2000
    $conn = $sasl->client_new( 'ldap', 'localhost' );
42
43
1
1000
    isa_ok( $conn, 'Authen::SASL::Perl::NTLM' );
44
45
1
1000
    is( $conn->mechanism, 'NTLM', 'conn mechanism' );
46
47
1
2000
    is( $conn->client_start, q{}, 'client start' );
48
1
2001
    ok( !$conn->is_success, 'needs step' );
49
50
1
3000
    is( $conn->client_step(), decode_base64($msg1),
51        'initial message is correct (from undef challenge string)' );
52
1
2000
    ok( !$conn->is_success, 'still needs step' );
53
54
1
2000
    is( $conn->client_step( decode_base64($challenge) ),
55        decode_base64($msg2), 'challenge response is correct' );
56
1
2000
    ok( $conn->is_success, 'success' );
57
1
0
};
58
59subtest 'step 1 error is detected' => sub {
60
1
4001
    is( $conn->client_start, q{}, 'client restart' );
61
1
2000
    ok( $conn->need_step, 'needs step' );
62
63
1
1000
    is( $conn->client_step($challenge), q{}, 'empty response' );
64
1
1000
    like( $conn->error, qr/type 1/, 'error is set' );
65
1
7000
};
66
67subtest 'empty challenge string for step 1 is accepted' => sub {
68
1
3001
    is( $conn->client_start, q{}, 'client restart' );
69
1
1000
    ok( $conn->need_step, 'needs step' );
70
71
1
2000
    is( $conn->client_step(''), decode_base64($msg1),
72        'initial message is correct (from empty challenge string)' );
73
1
1000
    ok( $conn->need_step, 'still needs step' );
74
1
5000
};
75
76subtest 'step 2 error is detected' => sub {
77
1
2000
    is( $conn->client_step(''), q{}, 'empty response' );
78
1
1000
    like( $conn->error, qr/type 2/, 'error is set' );
79
1
6000
};
80
81subtest 'invalid step error is detected' => sub {
82
1
4000
    is( $conn->client_step($challenge), q{}, 'empty response' );
83
1
1000
    like( $conn->error, qr/Invalid step/, 'error is set' );
84
1
7001
};
85
86subtest 'domain specified with user' => sub {
87
1
3000
    my $ntlm = Authen::NTLM->new(
88        host => HOST,
89        domain => DOMAIN,
90        user => USER,
91        password => PASS,
92    );
93
1
0
    my $msg1 = $ntlm->challenge;
94
1
0
    my $msg2 = $ntlm->challenge($challenge);
95
96
1
232013
    my $sasl = new_ok(
97        'Authen::SASL', [
98            mechanism => 'NTLM',
99            callback => {
100                user => ( DOMAIN . '\\' . USER ),
101                pass => PASS,
102            },
103        ]
104    );
105
106
1
3000
    my $conn = $sasl->client_new( 'ldap', 'localhost' );
107
108
1
1000
    is( $conn->client_start, q{}, 'client_start' );
109
110
1
2001
    ok( $msg1, 'initial message has a response' );
111
112
1
2000
    is( $conn->client_step(''), decode_base64($msg1), 'initial message' );
113
114
1
1000
    is( $conn->client_step( decode_base64($challenge) ),
115        decode_base64($msg2), 'challenge response' );
116
1
7001
};
117
118
1
7001
done_testing;