| 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; | ||||