auth_vpopmail_sql, refactor, log, tests

added strict and warnings pragma
refactored
added tests
added more logging
standard log prefixes
tests run pretests to assure tests can succeed
This commit is contained in:
Matt Simerson 2012-05-07 03:35:59 -04:00 committed by Robert
parent adbbfe6f67
commit 57d72b3cb4
2 changed files with 93 additions and 58 deletions

View File

@ -63,6 +63,9 @@ Please see the LICENSE file included with qpsmtpd for details.
=cut
use strict;
use warnings;
use DBI;
use Qpsmtpd::Constants;
use Digest::HMAC_MD5 qw(hmac_md5_hex);
@ -75,73 +78,89 @@ sub register {
$self->register_hook('auth-cram-md5', 'auth_vmysql');
}
sub auth_vmysql {
my ( $self, $transaction, $method, $user, $passClear, $passHash, $ticket ) = @_;
# $DB::single = 1;
sub get_db_handle {
my $self = shift;
my $dsn = $self->qp->config("vpopmail_mysql_dsn") || "dbi:mysql:dbname=vpopmail;host=127.0.0.1";
my $dbuser = $self->qp->config("vpopmail_mysql_user") || "vpopmailuser";
my $dbpass = $self->qp->config("vpopmail_mysql_pass") || "vpoppasswd";
my $dbh = DBI->connect( $dsn, $dbuser, $dbpass ) or do {
$self->log(LOGERROR, "auth_vpopmail_sql: db connection failed");
return DECLINED;
$self->log(LOGERROR, "skip: db connection failed");
return;
};
$dbh->{ShowErrorStatement} = 1;
return $dbh;
};
sub get_vpopmail_user {
my ( $self, $dbh, $user ) = @_;
my ( $pw_name, $pw_domain ) = split '@', lc($user);
return DECLINED if ! defined $pw_domain;
if ( ! defined $pw_domain ) {
$self->log(LOGINFO, "skip: missing domain: " . lc $user );
return;
};
$self->log(LOGDEBUG, "auth_vpopmail_sql: $pw_name\@$pw_domain");
$self->log(LOGDEBUG, "auth_vpopmail_sql: $user");
my $sth = $dbh->prepare(<<SQL);
SELECT *
my $query = "SELECT pw_passwd,pw_clear_passwd
FROM vpopmail
WHERE pw_name = ? AND pw_domain = ?
SQL
WHERE pw_name = ?
AND pw_domain = ?";
my $sth = $dbh->prepare( $query );
$sth->execute( $pw_name, $pw_domain );
my $passwd_hash = $sth->fetchrow_hashref;
my $userd_ref = $sth->fetchrow_hashref;
$sth->finish;
$dbh->disconnect;
return $userd_ref;
};
sub auth_vmysql {
my ( $self, $transaction, $method, $user, $passClear, $passHash, $ticket ) = @_;
my $dbh = $self->get_db_handle() or return DECLINED;
my $db_user = $self->get_vpopmail_user($dbh, $user) or return DECLINED;
# if vpopmail was not built with '--enable-clear-passwd=y'
# then pw_clear_passwd may not even exist
my $pw_clear_passwd = exists $passwd_hash->{'pw_clear_passwd'}
? $passwd_hash->{'pw_clear_passwd'}
: undef;
my $pw_passwd = $passwd_hash->{'pw_passwd'}; # this is always present
my $pw_clear_passwd = $db_user->{'pw_clear_passwd'};
my $pw_passwd = $db_user->{'pw_passwd'}; # always present
if ( # clear_passwd isn't defined so we cannot support CRAM-MD5
( $method =~ /CRAM-MD5/i and not defined $pw_clear_passwd )
or
# user doesn't exist in this domain
( not defined $pw_passwd )
) {
if ( ! $pw_passwd && ! $pw_clear_passwd ) {
$self->log(LOGINFO, "fail: no such user");
return ( DENY, "auth_vmysql - no such user" );
};
# at this point, the user name has matched
if ( ! $pw_clear_passwd && $method =~ /CRAM-MD5/i ) {
$self->log(LOGINFO, "skip: cram-md5 not supported w/o clear pass");
return ( DECLINED, "auth_vmysql" );
}
# at this point we can assume the user name matched
if (
( defined $passClear and
(
($pw_clear_passwd eq $passClear)
or ($pw_passwd eq crypt( $passClear, $pw_passwd ) )
)
)
or ( defined $passHash
and $passHash eq hmac_md5_hex( $ticket, $pw_clear_passwd ) )
)
{
if ( defined $passClear ) {
if ( $pw_clear_passwd && $pw_clear_passwd eq $passClear ) {
$self->log(LOGINFO, "pass: clear match");
return ( OK, "auth_vmysql" );
};
if ( $pw_passwd eq crypt( $passClear, $pw_passwd ) ) {
$self->log(LOGINFO, "pass: crypt match");
return ( OK, "auth_vmysql" );
}
else {
};
if ( defined $passHash && $pw_clear_passwd &&
$passHash eq hmac_md5_hex( $ticket, $pw_clear_passwd )
) {
$self->log(LOGINFO, "pass: hash match");
return ( OK, "auth_vmysql" );
};
$self->log(LOGINFO, "fail: wrong password");
return ( DENY, "auth_vmysql - wrong password" );
}
}

View File

@ -1,27 +1,43 @@
#!perl -w
use strict;
use warnings;
sub register_tests {
my $self = shift;
$self->register_test("auth_vpopmail_sql", 3);
}
my @u_list = qw ( good bad none );
my %u_data = (
good => [ 'postmaster@example.com', OK, 'Good Strong Passphrase' ],
bad => [ 'bad@example.com', DENY, 'not_bad_pass' ],
none => [ 'none@example.com', DECLINED, '' ],
);
sub auth_vpopmail_sql {
my $self = shift;
my ($tran, $ret, $note, $u, $r, $p, $a );
$tran = $self->qp->transaction;
for $u ( @u_list ) {
( $a,$r,$p ) = @{$u_data{$u}};
eval { ($ret, $note) = $self->auth_vmysql($tran,'PLAIN',$a,$p); };
defined $note or $note='auth_vpopmail_sql: No-Message';
is ($ret, $r, $note);
# - for debugging.
# warn "$note\n";
}
my ( $transaction, $method, $user, $passClear, $passHash, $ticket ) = @_;
my $dbh = $self->get_db_handle() or do {
foreach ( 0..2 ) {
ok( 1, "auth_vpopmail_sql, skipped (no DB)" );
};
return;
};
ok( $dbh, "auth_vpopmail_sql, got a dbh" );
my $vuser = $self->get_vpopmail_user( $dbh, 'postmaster@example.com' );
if ( ! $vuser || ! $vuser->{pw_passwd} ) {
foreach ( 0..1 ) {
ok( 1, "auth_vpopmail_sql, no example.com domain" );
};
return;
};
ok( ref $vuser, "auth_vpopmail_sql, found example.com domain" );
ok( $self->auth_vmysql(
$self->qp->transaction,
'PLAIN',
'postmaster@example.com',
$vuser->{pw_clear_passwd},
$vuser->{pw_passwd},
$ticket,
),
"auth_vpopmail_sql, postmaster"
);
}