File Coverage

File:lib/Authen/SASL/Perl/NTLM.pm
Coverage:95.7%

linestmtbrancondsubpodtimecode
1package 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#
22sub 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#
51sub 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
851;
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