File Coverage

blib/lib/Net/SMTP_auth.pm

Criterion	Covered	Total	%
statement	33	77	42.8
branch	0	34	0.0
condition			n/a
subroutine	11	14	78.5
pod	2	2	100.0
total	46	127	36.2

# Net::SMTP_auth.pm
#
# alex pleiner 2001, 2003, 2006 zeitform Internet Dienste
# thanks to Graham Barr  for Net::SMTP
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

# Net::SMTP_auth is a small extension to G. Barr's Net::SMTP
# to authenticate to an SMTP server using one of the AUTH
# methods provided by Authen::SASL and Authen::NTLM (see RFC2554 for details).
# This module can be expanded and is a very first implementation.

package Net::SMTP_auth;

require 5.001;

use strict;
use vars qw($VERSION @ISA);
use Socket 1.3;
use Carp;
use IO::Socket;
use Net::Cmd;
use Net::Config;
use Net::SMTP;
use MIME::Base64;
use Digest::HMAC_MD5 qw(hmac_md5_hex);
use Authen::SASL;

$VERSION = "0.08";

@ISA = qw(Net::SMTP);

# all other method taken from Net::SMTP

sub auth_types {
  @_ == 1 or croak 'usage: $pop3->auth_types()';
  my $me = shift;

  if (exists ${*$me}{'net_smtp_esmtp'}) {

    my $esmtp = ${*$me}{'net_smtp_esmtp'};

    if(exists $esmtp->{AUTH}) {
      return wantarray ? split(/\s+/, $esmtp->{AUTH}) : $esmtp->{AUTH};
    }
  }

  return;
}


sub auth {
  @_ == 4 or croak 'usage: $smtp->auth( AUTH, USER, PASS )';
  my ($me, $auth, $user, $pass) = @_;

  # code by James Fryman
  if ($auth eq "NTLM") {

    eval "require Authen::NTLM"
      or croak 'NTLM not supported. Install Authen::NTLM.';

    my $host = ${*$me}{'net_smtp_host'};
    Authen::NTLM::ntlm_user($user);    ## Init NTLM Variables
    Authen::NTLM::ntlm_password($pass);
    my $ntlm_chal = Authen::NTLM::ntlm();

    $me->_AUTH("$auth $ntlm_chal");

    if ( $me->code() == 334 ) {
      my $chal = $me->message();
      my $ntlm_chal_resp = Authen::NTLM::ntlm($chal);
      $me->command($ntlm_chal_resp)->response();
      Authen::NTLM::ntlm_reset();
      return 1 if $me->code() == 235;
      return   if $me->code() == 535;
    }
    return;
  }

  my $sasl = Authen::SASL->new(
			       mechanism => uc($auth),
			       callback => {
					    authname => $user,
					    user     => $user,
					    pass     => $pass,
					   },
			      );
  return unless $sasl;
  my $host = ${*$me}{'net_smtp_host'};
  my $conn = $sasl->client_new("smtp", $host);#, "noplaintext noanonymous");

  $me->_AUTH($auth) or return;

  if ( $me->code() == 334 ) {

    if (my $initial = $conn->client_start)
      {
	$me->command(encode_base64($initial, ''))->response();
	return 1 if $me->code() == 235;
      }

    while ( $me->code() == 334 )
      {
	my $message = decode_base64($me->message());
	my $return = $conn->client_step($message);
	$me->command(encode_base64($return, ''))->response();
	return 1 if $me->code() == 235;
	return   if $me->code() == 535;
      }

  }
}


sub _AUTH { shift->command("AUTH", @_)->response()  == CMD_MORE }

1;


__END__