File: | t/ntlm_client.t |
Coverage: | 100.0% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
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 | |||||||
30 | subtest '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 | |||||||
59 | subtest '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 | |||||||
67 | subtest '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 | |||||||
76 | subtest '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 | |||||||
81 | subtest '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 | |||||||
86 | subtest '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; |