refactored Qpsmtpd::Auth::SASL
unit tests for new methods are in t/auth.t
added PLAIN and LOGIN tests in auth_flat_file
Most tests are disabled unless an interactive terminal is detected and $ENV{QPSMTPD_DEVELOPER} is set.
This commit is contained in:
Matt Simerson
Robert
parent
ccf166a7e9
commit
5285774285
@ -1,11 +1,13 @@
|
||||
package Qpsmtpd::Auth;
|
||||
# See the documentation in 'perldoc README.authentication'
|
||||
|
||||
package Qpsmtpd::Auth;
|
||||
use Qpsmtpd::Constants;
|
||||
use MIME::Base64;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
sub e64
|
||||
{
|
||||
use MIME::Base64;
|
||||
use Qpsmtpd::Constants;
|
||||
|
||||
sub e64 {
|
||||
my ($arg) = @_;
|
||||
my $res = encode_base64($arg);
|
||||
chomp($res);
|
||||
@ -18,61 +20,17 @@ sub SASL {
|
||||
my ( $session, $mechanism, $prekey ) = @_;
|
||||
my ( $user, $passClear, $passHash, $ticket, $loginas );
|
||||
|
||||
if ( $mechanism eq "plain" ) {
|
||||
if (!$prekey) {
|
||||
$session->respond( 334, " " );
|
||||
$prekey= <STDIN>;
|
||||
}
|
||||
( $loginas, $user, $passClear ) = split /\x0/,
|
||||
decode_base64($prekey);
|
||||
|
||||
# Authorization ID must not be different from
|
||||
# Authentication ID
|
||||
if ( $loginas ne '' && $loginas ne $user ) {
|
||||
$session->respond(535, "Authentication invalid");
|
||||
return DECLINED;
|
||||
}
|
||||
if ( $mechanism eq 'plain' ) {
|
||||
($loginas, $user, $passClear) = get_auth_details_plain($session,$prekey);
|
||||
return DECLINED if ! $user || ! $passClear;
|
||||
}
|
||||
elsif ($mechanism eq "login") {
|
||||
|
||||
if ( $prekey ) {
|
||||
$user = decode_base64($prekey);
|
||||
}
|
||||
else {
|
||||
$session->respond(334, e64("Username:"));
|
||||
$user = decode_base64(<STDIN>);
|
||||
if ($user eq '*') {
|
||||
$session->respond(501, "Authentication canceled");
|
||||
return DECLINED;
|
||||
}
|
||||
}
|
||||
|
||||
$session->respond(334, e64("Password:"));
|
||||
$passClear = <STDIN>;
|
||||
$passClear = decode_base64($passClear);
|
||||
if ($passClear eq '*') {
|
||||
$session->respond(501, "Authentication canceled");
|
||||
return DECLINED;
|
||||
}
|
||||
elsif ( $mechanism eq 'login' ) {
|
||||
($user, $passClear) = get_auth_details_login($session,$prekey);
|
||||
return DECLINED if ! $user || ! $passClear;
|
||||
}
|
||||
elsif ( $mechanism eq "cram-md5" ) {
|
||||
|
||||
# rand() is not cryptographic, but we only need to generate a globally
|
||||
# unique number. The rand() is there in case the user logs in more than
|
||||
# once in the same second, of if the clock is skewed.
|
||||
$ticket = sprintf( '<%x.%x@%s>',
|
||||
rand(1000000), time(), $session->config("me") );
|
||||
|
||||
# We send the ticket encoded in Base64
|
||||
$session->respond( 334, encode_base64( $ticket, "" ) );
|
||||
my $line = <STDIN>;
|
||||
|
||||
if ( $line eq '*' ) {
|
||||
$session->respond( 501, "Authentication canceled" );
|
||||
return DECLINED;
|
||||
}
|
||||
|
||||
( $user, $passHash ) = split( ' ', decode_base64($line) );
|
||||
elsif ( $mechanism eq 'cram-md5' ) {
|
||||
( $ticket, $user, $passHash ) = get_auth_details_cram_md5($session);
|
||||
return DECLINED if ! $user || ! $passHash;
|
||||
}
|
||||
else {
|
||||
#this error is now caught in SMTP.pm's sub auth
|
||||
@ -80,12 +38,6 @@ sub SASL {
|
||||
return DECLINED;
|
||||
}
|
||||
|
||||
# Make sure that we have enough information to proceed
|
||||
unless ( $user && ($passClear || $passHash) ) {
|
||||
$session->respond(504, "Invalid authentication string");
|
||||
return DECLINED;
|
||||
}
|
||||
|
||||
# try running the specific hooks first
|
||||
my ( $rc, $msg ) =
|
||||
$session->run_hooks( "auth-$mechanism", $mechanism, $user, $passClear,
|
||||
@ -120,6 +72,93 @@ sub SASL {
|
||||
}
|
||||
}
|
||||
|
||||
sub get_auth_details_plain {
|
||||
my ( $session, $prekey ) = @_;
|
||||
|
||||
if ( ! $prekey) {
|
||||
$session->respond( 334, ' ' );
|
||||
$prekey= <STDIN>;
|
||||
}
|
||||
|
||||
my ( $loginas, $user, $passClear ) = split /\x0/, decode_base64($prekey);
|
||||
|
||||
if ( ! $user ) {
|
||||
if ( $loginas ) {
|
||||
$session->respond(535, "Authentication invalid ($loginas)");
|
||||
}
|
||||
else {
|
||||
$session->respond(535, "Authentication invalid");
|
||||
}
|
||||
return;
|
||||
};
|
||||
|
||||
# Authorization ID must not be different from Authentication ID
|
||||
if ( $loginas ne '' && $loginas ne $user ) {
|
||||
$session->respond(535, "Authentication invalid for $user");
|
||||
return;
|
||||
}
|
||||
|
||||
return ($loginas, $user, $passClear);
|
||||
};
|
||||
|
||||
sub get_auth_details_login {
|
||||
my ( $session, $prekey ) = @_;
|
||||
|
||||
my $user;
|
||||
|
||||
if ( $prekey ) {
|
||||
$user = decode_base64($prekey);
|
||||
}
|
||||
else {
|
||||
$user = get_base64_response($session,'Username:') or return;
|
||||
}
|
||||
|
||||
my $passClear = get_base64_response($session,'Password:') or return;
|
||||
|
||||
return ($user, $passClear);
|
||||
};
|
||||
|
||||
sub get_auth_details_cram_md5 {
|
||||
my ( $session, $ticket ) = @_;
|
||||
|
||||
if ( ! $ticket ) { # ticket is only passed in during testing
|
||||
# rand() is not cryptographic, but we only need to generate a globally
|
||||
# unique number. The rand() is there in case the user logs in more than
|
||||
# once in the same second, or if the clock is skewed.
|
||||
$ticket = sprintf( '<%x.%x@%s>',
|
||||
rand(1000000), time(), $session->config('me') );
|
||||
};
|
||||
|
||||
# send the base64 encoded ticket
|
||||
$session->respond( 334, encode_base64( $ticket, '' ) );
|
||||
my $line = <STDIN>;
|
||||
|
||||
if ( $line eq '*' ) {
|
||||
$session->respond( 501, "Authentication canceled" );
|
||||
return;
|
||||
};
|
||||
|
||||
my ( $user, $passHash ) = split( ' ', decode_base64($line) );
|
||||
unless ( $user && $passHash ) {
|
||||
$session->respond(504, "Invalid authentication string");
|
||||
return;
|
||||
}
|
||||
|
||||
return ($ticket, $user, $passHash);
|
||||
};
|
||||
|
||||
sub get_base64_response {
|
||||
my ($session, $question) = @_;
|
||||
|
||||
$session->respond(334, e64($question));
|
||||
my $answer = decode_base64( <STDIN> );
|
||||
if ($answer eq '*') {
|
||||
$session->respond(501, "Authentication canceled");
|
||||
return;
|
||||
}
|
||||
return $answer;
|
||||
};
|
||||
|
||||
# tag: qpsmtpd plugin that sets RELAYCLIENT when the user authentifies
|
||||
|
||||
1;
|
||||
|
||||
@ -35,41 +35,45 @@ use Digest::HMAC_MD5 qw(hmac_md5_hex);
|
||||
sub register {
|
||||
my ( $self, $qp ) = @_;
|
||||
|
||||
$self->register_hook("auth-cram-md5", "auth_flat_file");
|
||||
$self->register_hook('auth-plain', 'auth_flat_file');
|
||||
$self->register_hook('auth-login', 'auth_flat_file');
|
||||
$self->register_hook('auth-cram-md5', 'auth_flat_file');
|
||||
}
|
||||
|
||||
sub auth_flat_file {
|
||||
my ( $self, $transaction, $method, $user, $passClear, $passHash, $ticket ) =
|
||||
@_;
|
||||
|
||||
my ( $pw_name, $pw_domain ) = split "@", lc($user);
|
||||
if ( ! defined $passClear && ! defined $passHash ) {
|
||||
return ( DENY, "authflat - missing password" );
|
||||
}
|
||||
|
||||
my ( $pw_name, $pw_domain ) = split '@', lc($user);
|
||||
|
||||
unless ( defined $pw_domain ) {
|
||||
return DECLINED;
|
||||
}
|
||||
|
||||
$self->log(LOGINFO, "Authentication for: $pw_name\@$pw_domain");
|
||||
|
||||
my ($auth_line) = grep {/^$pw_name\@$pw_domain:/} $self->qp->config('flat_auth_pw');
|
||||
|
||||
unless (defined $auth_line) {
|
||||
if ( ! defined $auth_line) {
|
||||
$self->log(LOGINFO, "User not found: $pw_name\@$pw_domain");
|
||||
return DECLINED;
|
||||
}
|
||||
|
||||
$self->log(LOGINFO, "Authentication for: $pw_name\@$pw_domain");
|
||||
|
||||
my ($auth_user, $auth_pass) = split(/:/, $auth_line, 2);
|
||||
|
||||
# at this point we can assume the user name matched
|
||||
if (
|
||||
( defined $passClear
|
||||
and $auth_pass eq $passClear ) or
|
||||
( defined $passHash
|
||||
and $passHash eq hmac_md5_hex($ticket, $auth_pass) )
|
||||
)
|
||||
{
|
||||
return ( OK, "authflat/$method" );
|
||||
}
|
||||
else {
|
||||
return ( DENY, "authflat/$method - wrong password" );
|
||||
}
|
||||
if ( defined $passClear && $auth_pass eq $passClear ) {
|
||||
return ( OK, "authflat" );
|
||||
};
|
||||
|
||||
if ( defined $passHash && $passHash eq hmac_md5_hex($ticket, $auth_pass) ) {
|
||||
return ( OK, "authflat" );
|
||||
};
|
||||
|
||||
return ( DENY, "authflat - wrong password" );
|
||||
}
|
||||
|
||||
|
||||
143
t/auth.t
Normal file
143
t/auth.t
Normal file
@ -0,0 +1,143 @@
|
||||
#!/usr/bin/perl -w
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use lib 't';
|
||||
use lib 'lib';
|
||||
|
||||
use Data::Dumper;
|
||||
use Digest::HMAC_MD5 qw(hmac_md5_hex);
|
||||
use English qw/ -no_match_vars /;
|
||||
use File::Path;
|
||||
|
||||
use Qpsmtpd::Constants;
|
||||
use Scalar::Util qw( openhandle );
|
||||
use Test::More qw(no_plan);
|
||||
|
||||
use_ok('Test::Qpsmtpd');
|
||||
use_ok('Qpsmtpd::Auth');
|
||||
|
||||
my ($smtpd, $conn) = Test::Qpsmtpd->new_conn();
|
||||
|
||||
ok( $smtpd, "get new connection ($smtpd)");
|
||||
isa_ok( $conn, 'Qpsmtpd::Connection', "get new connection");
|
||||
|
||||
#warn Dumper($smtpd) and exit;
|
||||
#my $hooks = $smtpd->hooks;
|
||||
#warn Dumper($hooks) and exit;
|
||||
|
||||
my $r;
|
||||
my $user = 'good@example.com';
|
||||
my $pass = 'good_pass';
|
||||
my $enc_plain= Qpsmtpd::Auth::e64( join("\0", '', $user, $pass ) );
|
||||
|
||||
# get_auth_details_plain: plain auth method handles credentials properly
|
||||
my ($loginas,$ruser,$passClear) = Qpsmtpd::Auth::get_auth_details_plain($smtpd, $enc_plain);
|
||||
cmp_ok( $user, 'eq', $user, "get_auth_details_plain, user");
|
||||
cmp_ok( $passClear, 'eq', $pass, "get_auth_details_plain, password");
|
||||
|
||||
my $bad_auth = Qpsmtpd::Auth::e64( join("\0", 'loginas', 'user@foo', 'passer') );
|
||||
($loginas,$ruser,$passClear) = Qpsmtpd::Auth::get_auth_details_plain($smtpd, $bad_auth );
|
||||
ok( ! $loginas, "get_auth_details_plain, loginas -");
|
||||
ok( !$ruser, "get_auth_details_plain, user -");
|
||||
ok( !$passClear, "get_auth_details_plain, pass -");
|
||||
|
||||
# these plugins test against whicever loaded plugin provides their selected
|
||||
# auth type. Right now, they end up testing against auth_flat_file.
|
||||
|
||||
# PLAIN
|
||||
$r = Qpsmtpd::Auth::SASL($smtpd, 'plain', $enc_plain);
|
||||
cmp_ok( OK, '==', $r, "plain auth");
|
||||
|
||||
if ( $ENV{QPSMTPD_DEVELOPER} && is_interactive() ) {
|
||||
# same thing, but must be entered interactively
|
||||
print "answer: $enc_plain\n";
|
||||
$r = Qpsmtpd::Auth::SASL($smtpd, 'plain', '');
|
||||
cmp_ok( OK, '==', $r, "SASL, plain");
|
||||
};
|
||||
|
||||
|
||||
# LOGIN
|
||||
|
||||
if ( $ENV{QPSMTPD_DEVELOPER} && is_interactive() ) {
|
||||
|
||||
my $enc_user = Qpsmtpd::Auth::e64( $user );
|
||||
my $enc_pass = Qpsmtpd::Auth::e64( $pass );
|
||||
|
||||
# get_base64_response
|
||||
print "answer: $enc_user\n";
|
||||
$r = Qpsmtpd::Auth::get_base64_response( $smtpd, 'Username' );
|
||||
cmp_ok( $r, 'eq', $user, "get_base64_response +");
|
||||
|
||||
# get_auth_details_login
|
||||
print "answer: $enc_pass\n";
|
||||
($ruser,$passClear) = Qpsmtpd::Auth::get_auth_details_login( $smtpd, $enc_user );
|
||||
cmp_ok( $ruser, 'eq', $user, "get_auth_details_login, user +");
|
||||
cmp_ok( $passClear, 'eq', $pass, "get_auth_details_login, pass +");
|
||||
|
||||
print "encoded pass: $enc_pass\n";
|
||||
$r = Qpsmtpd::Auth::SASL($smtpd, 'login', $enc_user);
|
||||
cmp_ok( OK, '==', $r, "SASL, login");
|
||||
};
|
||||
|
||||
|
||||
# CRAM-MD5
|
||||
|
||||
if ( $ENV{QPSMTPD_DEVELOPER} && is_interactive() ) {
|
||||
print "starting SASL\n";
|
||||
|
||||
# since we don't have bidirection communication here, we pre-generate a ticket
|
||||
my $ticket = sprintf( '<%x.%x@%s>', rand(1000000), time(), $smtpd->config('me') );
|
||||
my $hash_pass = hmac_md5_hex( $ticket, $pass );
|
||||
my $enc_answer = Qpsmtpd::Auth::e64( join(' ', $user, $hash_pass ) );
|
||||
print "answer: $enc_answer\n";
|
||||
my (@r) = Qpsmtpd::Auth::get_auth_details_cram_md5( $smtpd, $ticket );
|
||||
cmp_ok( $r[0], 'eq', $ticket, "get_auth_details_cram_md5, ticket" );
|
||||
cmp_ok( $r[1], 'eq', $user, "get_auth_details_cram_md5, user" );
|
||||
cmp_ok( $r[2], 'eq', $hash_pass, "get_auth_details_cram_md5, passHash" );
|
||||
#warn Data::Dumper::Dumper(\@r);
|
||||
|
||||
# this isn't going to work without bidirection communication to get the ticket
|
||||
#$r = Qpsmtpd::Auth::SASL($smtpd, 'cram-md5' );
|
||||
#cmp_ok( OK, '==', $r, "login auth");
|
||||
};
|
||||
|
||||
|
||||
sub is_interactive {
|
||||
|
||||
## no critic
|
||||
# borrowed from IO::Interactive
|
||||
my ($out_handle) = ( @_, select ); # Default to default output handle
|
||||
|
||||
# Not interactive if output is not to terminal...
|
||||
return if not -t $out_handle;
|
||||
|
||||
# If *ARGV is opened, we're interactive if...
|
||||
if ( openhandle * ARGV ) {
|
||||
|
||||
# ...it's currently opened to the magic '-' file
|
||||
return -t *STDIN if defined $ARGV && $ARGV eq '-';
|
||||
|
||||
# ...it's at end-of-file and the next file is the magic '-' file
|
||||
return @ARGV > 0 && $ARGV[0] eq '-' && -t *STDIN if eof *ARGV;
|
||||
|
||||
# ...it's directly attached to the terminal
|
||||
return -t *ARGV;
|
||||
};
|
||||
|
||||
# If *ARGV isn't opened, it will be interactive if *STDIN is attached
|
||||
# to a terminal and either there are no files specified on the command line
|
||||
# or if there are files and the first is the magic '-' file
|
||||
return -t *STDIN && ( @ARGV == 0 || $ARGV[0] eq '-' );
|
||||
}
|
||||
|
||||
|
||||
__END__
|
||||
|
||||
if ( ref $r ) {
|
||||
} else {
|
||||
warn $r;
|
||||
}
|
||||
#print Data::Dumper::Dumper($conn);
|
||||
#print Data::Dumper::Dumper($smtpd);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user