File Coverage

Authen/CyrusSASL.pm

Criterion	Covered	Total	%
statement	21	47	44.6
branch	4	26	15.3
condition	1	3	33.3
subroutine	5	10	50.0
pod	4	7	57.1
total	35	93	37.6

#############################################################################
#                                                                           #
# Sasl Auth Daemon Client module for Perl                                   #
#                                                                           #
# Author: Piotr Klaban  (c)2001
# All Rights Reserved. See the Perl Artistic License for copying & usage    #
# policy.                                                                   #
#                                                                           #
# See the file 'Changes' in the distrution archive.                         #
#                                                                           #
#############################################################################

package Authen::CyrusSASL;

use IO::Socket;
use IO::Select;

use vars qw($VERSION @ISA @EXPORT);

require Exporter;
require AutoLoader;

@ISA = qw(Exporter AutoLoader);
@EXPORT = qw(SASL_OK SASL_BADAUTH SASL_FAIL SASL_PWCHECK SASL_AUTHD);
$VERSION = '0.01';

sub SASL_OK       { 0; }  # values from the sasl.h cyrus-sasl's file
sub SASL_BADAUTH  { -13; }
sub SASL_FAIL     { -1; }

sub SASL_PWCHECK  { 1; }
sub SASL_AUTHD    { 2; }

sub new {
	my $class = shift;
	my %h = @_;
	my ($pwpath);
	my $self = {};

	bless $self, $class;

	if (!defined($h{'Type'})) {
		die('Define Type attribute for Authen::CyrusSASL object');
	}

	# default values
	my ($sock_type, $def_dir, $def_file) =
	    ($h{'Type'} == SASL_AUTHD)   ? (SOCK_STREAM, '/var/run/saslauthd', 'mux')
	  : ($h{'Type'} == SASL_PWCHECK) ? (SOCK_DGRAM, '/var/run/pwcheck', 'pwcheck')
	  : die ('Unknown Authen::CyrusSASL object type, use SASL_AUTHD or SASL_PWCHECK');

	$h{'Dir'} = $def_dir if not defined $h{'Dir'};

	if (defined($h{'Dir'}) && !-d $h{'Dir'}) {
		$! = 'Directory ' . $h{'Dir'} . ': not found';
		return undef;
	}

	$h{'Path'} = $h{'Dir'} . '/' . $def_file if not defined $h{'Path'};

	$pwpath = $h{'Path'};

	if (!-e $pwpath) {
		$! = 'File ' . $pwpath . ': file not found';
		return undef;
	}

	$self->{'type'} = $h{'Type'};
	$self->{'timeout'} = $h{'TimeOut'} ? $h{'TimeOut'} : 5;
	$self->{'sock'} = new IO::Socket::UNIX(
				Type => SOCK_STREAM,
				Peer => $pwpath
	) or return undef;

	$self;
}

sub check_pwd {
	my ($self, $name, $pwd) = @_;
	my ($req, $res, $sh);

	$req = "$name\0$pwd\0";
	$res = ' ' x 1024;

	# send request
	$self->{'sock'}->send ($req) || return SASL_FAIL;

	# recv response
	$sh = new IO::Select($self->{'sock'}) or return SASL_FAIL;
	$sh->can_read($self->{'timeout'}) or return SASL_FAIL;

	recv( $self->{'sock'}, $res, 1024, 0 );
	# sock->recv does not work
	#$self->{'sock'}->recv ($res, 1024, 0) or return SASL_FAIL;

	if (substr($res, 0, 2) ne 'OK') {
	  $! = substr($res, 3);
	  return SASL_BADAUTH;
	}

	return SASL_OK;
}

1;
__END__