File Coverage

blib/lib/Authen/SASL/Perl/NTLM.pm

Criterion	Covered	Total	%
statement	40	40	100.0
branch	16	16	100.0
condition			n/a
subroutine	9	9	100.0
pod	0	3	0.0
total	65	68	95.5

package Authen::SASL::Perl::NTLM;
# ABSTRACT: NTLM authentication plugin for Authen::SASL
$Authen::SASL::Perl::NTLM::VERSION = '0.003';
use 5.006;
use strict;
use warnings;

use Authen::NTLM ();
use MIME::Base64 ();

use parent qw(Authen::SASL::Perl);

# do we need these?
# sub _order { 1 }
# sub _secflags { 0 };

sub mechanism { 'NTLM' } ## no critic (RequireFinalReturn)

#
# Initialises the NTLM object and sets the domain, host, user, and password.
#
sub client_start {
    my ($self) = @_;

    $self->{need_step} = 1;
    $self->{error}     = undef;
    $self->{stage}     = 0;

    my $user = $self->_call('user');

    # Check for the domain in the username
    my $domain;
    ( $domain, $user ) = split m{ \\ }xms, $user
      if index( $user, q{\\} ) > -1;

    $self->{ntlm} = Authen::NTLM->new(
        host     => $self->host,
        domain   => $domain,
        user     => $user,
        password => $self->_call('pass'),
    );

    return q{};
}

#
# If C<$challenge> is undefined, it will return a NTLM type 1 request
# message.
# Otherwise, C<$challenge> is assumed to be a NTLM type 2 challenge from
# which the NTLM type 3 response will be generated and returned.
#
sub client_step {
    my ( $self, $challenge ) = @_;

    if ( defined $challenge ) {
        # The challenge has been decoded but Authen::NTLM expects it encoded
        $challenge = MIME::Base64::encode_base64($challenge);

        # Empty challenge string needs to be undef if we want
        # Authen::NTLM::challenge() to generate a type 1 message
        $challenge = undef if $challenge eq q{};
    }

    my $stage = ++$self->{stage};
    if ( $stage == 1 ) {
        $self->set_error('Challenge must not be given for type 1 request')
          if $challenge;
    }
    elsif ( $stage == 2 ) {
        $self->set_success; # no more steps
        $self->set_error('No challenge was given for type 2 request')
          if !$challenge;
    }
    else {
        $self->set_error('Invalid step');
    }
    return q{} if $self->error;

    my $response = $self->{ntlm}->challenge($challenge);

    # The caller expects the response to be unencoded but
    # Authen::NTLM::challenge() has already encoded it
    return MIME::Base64::decode_base64($response);
}

1;

__END__