File Coverage

blib/lib/Net/POP3_auth.pm

Criterion	Covered	Total	%
statement	33	79	41.7
branch	0	38	0.0
condition	0	2	0.0
subroutine	11	16	68.7
pod	3	3	100.0
total	47	138	34.0

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

# Net::POP3_auth is a small extension to G. Barr's Net::POP3
# to authenticate to an POP3 server using one of the AUTH methods
# APOP and SASL (Authen::SASL). This module can be expanded and is a
# very first implementation.

package Net::POP3_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::POP3;
use MIME::Base64;
use Digest::HMAC_MD5 qw(hmac_md5_hex);
use Authen::SASL;

$VERSION = "0.04";

@ISA = qw(Net::POP3);

# all other method taken from Net::SMTP

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

  return undef
     unless $me->_CAPA;

  my @auth;
  foreach (@{$me->read_until_dot}) {
    push @auth, "APOP" if /^APOP/;
    push @auth, split(/\s+/, $1) if /^SASL (.+)$/;
  }
  return undef unless @auth;
  return wantarray ? @auth : join " ", @auth;
}


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

  ## conventional (rfc1939)
  if (uc($auth) eq "APOP") {
    return $me->apop($user, $pass);
  }

  elsif (uc($auth) eq "PLAIN") { # standard authentication (user/pass)
    return $me->login($user, $pass);
  }

  ## sasl (rfc1734)
  else {

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

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

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

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

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


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


sub response
{
 my $cmd = shift;
 my $str = $cmd->getline() || return undef;
 my $code = "500";

 $cmd->debug_print(0,$str)
   if ($cmd->debug);

 if ($str =~ s/^\+OK\s+//io)  { $code = "200" }
 elsif ($str =~ s/^\+\s+//io) { $code = "201" } ## for auth
 else                         { $str =~ s/^-ERR\s+//io; }

 ${*$cmd}{'net_cmd_resp'} = [ $str ];
 ${*$cmd}{'net_cmd_code'} = $code;

 substr($code,0,1);
}

1;


__END__