| File: | lib/Authen/SASL/Perl/NTLM.pm |
| Coverage: | 95.7% |
| line | stmt | bran | cond | sub | pod | time | code |
|---|---|---|---|---|---|---|---|
| 1 | package Authen::SASL::Perl::NTLM; | ||||||
| 2 | # ABSTRACT: NTLM authentication plugin for Authen::SASL | ||||||
| 3 | |||||||
| 4 | 1 1 1 | 7000 0 0 | use 5.006; | ||||
| 5 | 1 1 1 | 0 0 0 | use strict; | ||||
| 6 | 1 1 1 | 0 0 0 | use warnings; | ||||
| 7 | |||||||
| 8 | 1 1 1 | 0 0 0 | use Authen::NTLM (); | ||||
| 9 | 1 1 1 | 0 0 0 | use MIME::Base64 (); | ||||
| 10 | |||||||
| 11 | 1 1 1 | 4000 1001 0 | use parent qw(Authen::SASL::Perl); | ||||
| 12 | |||||||
| 13 | # do we need these? | ||||||
| 14 | # sub _order { 1 } | ||||||
| 15 | # sub _secflags { 0 }; | ||||||
| 16 | |||||||
| 17 | 1 | 0 | 0 | sub mechanism { 'NTLM' } | |||
| 18 | |||||||
| 19 | # | ||||||
| 20 | # Initialises the NTLM object and sets the domain, host, user, and password. | ||||||
| 21 | # | ||||||
| 22 | sub client_start { | ||||||
| 23 | 4 | 0 | 0 | my ($self) = @_; | |||
| 24 | |||||||
| 25 | 4 | 0 | $self->{need_step} = 1; | ||||
| 26 | 4 | 0 | $self->{error} = undef; | ||||
| 27 | 4 | 0 | $self->{stage} = 0; | ||||
| 28 | |||||||
| 29 | 4 | 0 | my $user = $self->_call('user'); | ||||
| 30 | |||||||
| 31 | # Check for the domain in the username | ||||||
| 32 | 4 | 0 | my $domain; | ||||
| 33 | 4 | 0 | ( $domain, $user ) = split( /\\/, $user ) if index( $user, '\\' ) > -1; | ||||
| 34 | |||||||
| 35 | 4 | 0 | $self->{ntlm} = Authen::NTLM->new( | ||||
| 36 | host => $self->host, | ||||||
| 37 | domain => $domain, | ||||||
| 38 | user => $user, | ||||||
| 39 | password => $self->_call('pass'), | ||||||
| 40 | ); | ||||||
| 41 | |||||||
| 42 | 4 | 0 | return q{}; | ||||
| 43 | } | ||||||
| 44 | |||||||
| 45 | # | ||||||
| 46 | # If C<$challenge> is undefined, it will return a NTLM type 1 request | ||||||
| 47 | # message. | ||||||
| 48 | # Otherwise, C<$challenge> is assumed to be a NTLM type 2 challenge from | ||||||
| 49 | # which the NTLM type 3 response will be generated and returned. | ||||||
| 50 | # | ||||||
| 51 | sub client_step { | ||||||
| 52 | 8 | 0 | 0 | my ( $self, $challenge ) = @_; | |||
| 53 | |||||||
| 54 | 8 | 0 | if ( defined $challenge ) { | ||||
| 55 | # The challenge has been decoded but Authen::NTLM expects it encoded | ||||||
| 56 | 7 | 1000 | $challenge = MIME::Base64::encode_base64($challenge); | ||||
| 57 | |||||||
| 58 | # Empty challenge string needs to be undef if we want | ||||||
| 59 | # Authen::NTLM::challenge() to generate a type 1 message | ||||||
| 60 | 7 | 0 | $challenge = undef if $challenge eq ''; | ||||
| 61 | } | ||||||
| 62 | |||||||
| 63 | 8 | 0 | my $stage = ++$self->{stage}; | ||||
| 64 | 8 | 0 | if ( $stage == 1 ) { | ||||
| 65 | 4 | 0 | $self->set_error('No challenge must be given for type 1 request') | ||||
| 66 | if $challenge; | ||||||
| 67 | } | ||||||
| 68 | elsif ( $stage == 2 ) { | ||||||
| 69 | 3 | 0 | $self->set_success; # no more steps | ||||
| 70 | 3 | 0 | $self->set_error('No challenge was given for type 2 request') | ||||
| 71 | if !$challenge; | ||||||
| 72 | } | ||||||
| 73 | else { | ||||||
| 74 | 1 | 0 | $self->set_error('Invalid step'); | ||||
| 75 | } | ||||||
| 76 | 8 | 0 | return '' if $self->error; | ||||
| 77 | |||||||
| 78 | 5 | 1000 | my $response = $self->{ntlm}->challenge($challenge); | ||||
| 79 | |||||||
| 80 | # The caller expects the response to be unencoded but | ||||||
| 81 | # Authen::NTLM::challenge() has already encoded it | ||||||
| 82 | 5 | 462026 | return MIME::Base64::decode_base64($response); | ||||
| 83 | } | ||||||
| 84 | |||||||
| 85 | 1; | ||||||
| 86 | |||||||
| 87 - 144 | =head1 SYNOPSIS
use Authen::SASL qw(Perl);
$sasl = Authen::SASL->new(
mechanism => 'NTLM',
callback => {
user => $username, # or "$domain\\$username"
pass => $password,
},
);
$client = $sasl->client_new(...);
$client->client_start;
$client->client_step('');
$client->client_step($challenge);
=head1 DESCRIPTION
This module is a plugin for the L<Authen::SASL> framework that implements the
client procedures to do NTLM authentication.
Most users will probably only need this module indirectly, when you use
another module that depends on Authen::SASL with NTLM authentication.
E.g. connecting to an MS Exchange Server using Email::Sender, which
depends on Net::SMTP(S) which in turn depends on Authen::SASL.
You may see this when you get the following error message:
No SASL mechanism found
(Unfortunately, Authen::SASL currently doesn't tell you which SASL mechanism
is missing.)
=head1 CALLBACK
The callbacks used are:
=head2 Client
=for :list
= user
The username to be used for authentication. The domain may optionally be
specified as part of the C<user> string in the format C<"$domain\\$username">.
= pass
The user's password to be used for authentication.
=head2 Server
This module does not support server-side authentication.
=head1 SEE ALSO
L<Authen::SASL>, L<Authen::SASL::Perl>.
=for Pod::Coverage mechanism client_start client_step
=cut | ||||||