File Coverage

blib/lib/Authen/Simple/IMAP.pm

Criterion	Covered	Total	%
statement	57	85	67.0
branch	18	54	33.3
condition	0	4	0.0
subroutine	9	12	75.0
pod	2	3	66.6
total	86	158	54.4

package Authen::Simple::IMAP;

use 5.8.6;
use warnings;
use strict;
use Carp;
use base 'Authen::Simple::Adapter';
#use Data::Dumper;
use Params::Validate qw(validate_pos :types);

our $VERSION = '0.1.2';

__PACKAGE__->options({
	host => {
		type     => Params::Validate::SCALAR,
		optional => 1,
		depends  => [ 'protocol' ],
	},
	protocol => {
		type     => Params::Validate::SCALAR,
		default  => 'IMAP',
		optional => 1,
		depends  => [ 'host' ],
	},
	imap => {
		type     => Params::Validate::OBJECT,
		can		 => ['login','errstr'],
		optional => 1,
	},
	timeout => {
		type 	=> Params::Validate::SCALAR,
		optional => 1,
	},
	escape_slash => {
		type 	 => Params::Validate::SCALAR,
		optional => 1,
		default  => 1,
	},
});

sub init {
	my ($self, $args) = @_;
	if ( $args->{log} ) {
		$self->log($args->{log});
	}
	$self->log->info("Starting init routine for Authen::Simple::IMAP");
	$self->log->debug("Starting init routine\n") if $self->log;
	my $is_user_provided_object;
	my @imap_args = $args->{host};
	if ( defined($args->{timeout}) ) {
		push(@imap_args, timeout => $args->{timeout});
	}
	if ( defined($args->{imap}) ) {
		$self->log->info("setting up with user provided IMAP object ".
			ref($args->{imap})."\n") if $self->log;
		$is_user_provided_object = 1;
	}
	elsif ( $args->{protocol} eq 'IMAPS' ) {
		require Net::IMAP::Simple::SSL;
	}
	elsif ( $args->{protocol} eq 'IMAP' ) {
		require Net::IMAP::Simple;
	}
	elsif ( defined($args->{protocol}) ) {
		croak "Valid protocols are 'IMAP' and 'IMAPS', not '".$args->{protocol}."'";
	}
	else {
		croak "A protocol or an imap object is required";
	}
	my $obj = $self->SUPER::init($args);
	$obj->{imap_args} = \@imap_args;
	if ( $is_user_provided_object ) {
		$obj->{user_provided_object} = $args->{imap};
	}
	return $obj;
}

sub connect {
	my $self = shift;
	die 'Should never happen' if !defined($self->{imap_args});
	if ( $self->{user_provided_object} ) {
		$self->{imap} = $self->{user_provided_object};
		return;
	}
	my @imap_args = @{$self->{imap_args}};
	#warn 'imap args  '.join(", ",@imap_args)."\n";
	my $host = shift(@imap_args);
	my $args = { @imap_args };
	unshift(@imap_args,$host);

	local( $SIG{ALRM} ) = sub { croak "timeout while connecting to server" };
	if ( defined($args->{timeout}) ) {
		alarm $args->{timeout};
	}
	else {
		alarm 90;
	}
	if ( defined($self->{imap}) ) {
		$self->log->info("already have a user provided IMAP object ".
			ref($self->{imap})."\n") if $self->log;
	}
	elsif ( $self->{protocol} eq 'IMAPS' ) {
		local( $SIG{ALRM} ) = sub {
			croak "timeout while connecting to IMAPS server at $host"
		};
		$self->log->info("connecting to ".$host." with IMAPS\n")
			 if $self->log;
		$self->{imap} = Net::IMAP::Simple::SSL->new(@imap_args) ||
			die "Unable to connect to IMAPS: $Net::IMAP::Simple::SSL::errstr\n";
	}
	elsif ( $self->{protocol} eq 'IMAP' ) {
		local( $SIG{ALRM} ) = sub {
			croak "timeout while connecting to IMAP server at $host"
		};
		$self->log->info("connecting to ".$host." with IMAP (no SSL)\n")
			 if $self->log;
		$self->{imap} = Net::IMAP::Simple->new(@imap_args) ||
			die "Unable to connect to IMAP: $Net::IMAP::Simple::errstr\n";
	}
	else {
		croak 'This should never happen!';
	}
	alarm 0;
	return $self->{imap};
}


sub check {
	my @params = validate_pos(@_,
		{
			type => OBJECT,
			isa  => 'Authen::Simple::IMAP',
		},
		{
			type => SCALAR,
		},
		{
			type => SCALAR,
		},
	);
	my ($self,$username,$password) = @params;
	$self->log->debug("Starting check routine\n") if $self->log;
	#$self->log->debug("Username = '$username'");
	#$self->log->debug("Password = '$password'");

	if ( $self->escape_slash ) {
		$password =~ s[\\][\\\\]g;
	}
	#$self->log->debug("Password post escape_slash = '$password'");

	#delete($self->{imap}) if exists($self->{imap});

	$self->connect;

	$self->log->info('Attempting to authenticate user \''.$username.'\''."\n")
		if $self->log;
	if ( $self->imap->login($username,$password) ) {
		$self->log->info("Successfully logged in '".$username."'\n")
			if $self->log;
		$self->imap->quit() if  $self->imap->can('quit');
		$self->imap(undef);
		return 1;
	}
	my $fail = 'Failed to authenticate user \''.$username.'\'';
	$fail .= ': '.$self->imap->errstr if $self->imap->errstr;
	$self->log->info($fail) if $self->log;
	$self->imap->quit() if  $self->imap->can('quit');
	$self->imap(undef);
	return 0;
}

1; # Magic true value required at end of module
__END__