byterazor/qpsmtpd
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge pull request #101 from msimerson/tidy

Browse Source 
META updates, tidy, PBP tweaks
This commit is contained in:
Jared Johnson 2014-09-15 20:48:05 -05:00
commit 2a303538e5
9 changed files with 291 additions and 247 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
MANIFEST
View File

@ -143,6 +143,7 @@ plugins/stunnel
plugins/tls plugins/tls
plugins/tls_cert plugins/tls_cert
plugins/uribl plugins/uribl
plugins/user_config
plugins/virus/aveclient plugins/virus/aveclient
plugins/virus/bitdefender plugins/virus/bitdefender
plugins/virus/clamav plugins/virus/clamav
@ -205,6 +206,7 @@ t/plugin_tests/relay
t/plugin_tests/resolvable_fromhost t/plugin_tests/resolvable_fromhost
t/plugin_tests/sender_permitted_from t/plugin_tests/sender_permitted_from
t/plugin_tests/spamassassin t/plugin_tests/spamassassin
t/plugin_tests/user_config
t/plugin_tests/virus/clamdscan t/plugin_tests/virus/clamdscan
t/qpsmtpd-address.t t/qpsmtpd-address.t
t/qpsmtpd-smtp.t t/qpsmtpd-smtp.t

97
lib/Qpsmtpd.pm
View File

@ -1,5 +1,6 @@
package Qpsmtpd; package Qpsmtpd;
use strict; use strict;
#use warnings; #use warnings;
use vars qw($TraceLevel $Spool_dir $Size_threshold); use vars qw($TraceLevel $Spool_dir $Size_threshold);
@ -7,7 +8,7 @@ use Sys::Hostname;
use Qpsmtpd::Constants; use Qpsmtpd::Constants;
use Qpsmtpd::Address; use Qpsmtpd::Address;
our $VERSION = "0.94"; our $VERSION = "0.95";
my $git; my $git;
@ -91,7 +92,7 @@ sub load_logging {
sub trace_level { return $TraceLevel; } sub trace_level { return $TraceLevel; }
sub init_logger { # needed for compatibility purposes sub init_logger { # needed for compatibility purposes
shift->trace_level(); shift->trace_level();
} }
@ -103,17 +104,17 @@ sub log {
sub varlog { sub varlog {
my ($self, $trace) = (shift, shift); my ($self, $trace) = (shift, shift);
my ($hook, $plugin, @log); my ($hook, $plugin, @log);
if ($#_ == 0) { # log itself if ($#_ == 0) { # log itself
(@log) = @_; (@log) = @_;
} }
elsif ($#_ == 1) { # plus the hook elsif ($#_ == 1) { # plus the hook
($hook, @log) = @_; ($hook, @log) = @_;
} }
else { # called from plugin else { # called from plugin
($hook, $plugin, @log) = @_; ($hook, $plugin, @log) = @_;
} }
$self->load_logging; # in case we don't have this loaded yet $self->load_logging; # in case we don't have this loaded yet
my ($rc) = my ($rc) =
$self->run_hooks_no_respond("logging", $trace, $hook, $plugin, @log) $self->run_hooks_no_respond("logging", $trace, $hook, $plugin, @log)
@ -146,26 +147,34 @@ sub config {
$self->log(LOGDEBUG, "in config($c)"); $self->log(LOGDEBUG, "in config($c)");
# first run the hooks # first run the user_config hooks
my ($rc, @config); my ($rc, @config);
($rc, @config) = $self->run_hooks_no_respond('user_config',$type,$c) if (ref $type && $type->can('address')) {
if ref $type and $type->can('address'); ($rc, @config) = $self->run_hooks_no_respond('user_config', $type, $c);
return wantarray ? @config : $config[0] if (defined $rc && $rc == OK) {
if defined $rc and $rc == OK; return wantarray ? @config : $config[0];
($rc, @config) = $self->run_hooks_no_respond('config',$c); };
$self->log(LOGDEBUG, "config($c): hook returned (" };
. join( ',', map { defined $_ ? $_ : 'undef' } ($rc,@config) ) . ")");
return wantarray ? @config : $config[0]
if defined $rc and $rc == OK;
# and then get_qmail_config # then run the config hooks
($rc, @config) = $self->run_hooks_no_respond('config', $c);
$self->log(LOGDEBUG,
"config($c): hook returned ("
. join(',', map { defined $_ ? $_ : 'undef' } ($rc, @config))
. ")"
);
if (defined $rc && $rc == OK) {
return wantarray ? @config : $config[0];
};
# then get_qmail_config
@config = $self->get_qmail_config($c, $type); @config = $self->get_qmail_config($c, $type);
return wantarray ? @config : $config[0] return wantarray ? @config : $config[0] if @config;
if @config;
# finally we use the default if there is any: # then the default, if any
return wantarray ? ($defaults{$c}) : $defaults{$c} if (exists $defaults{$c}) {
if exists $defaults{$c}; return wantarray ? ($defaults{$c}) : $defaults{$c};
};
return; return;
} }
@ -205,7 +214,7 @@ sub get_qmail_config {
# CDB config support really should be moved to a plugin # CDB config support really should be moved to a plugin
if ($type and $type eq "map") { if ($type and $type eq "map") {
return $self->get_qmail_config_map($config, $configfile); return $self->get_qmail_config_map($config, $configfile);
}; }
return $self->_config_from_file($configfile, $config); return $self->_config_from_file($configfile, $config);
} }
@ -236,7 +245,7 @@ sub get_qmail_config_map {
# the data is in a CDB file in the first place because there's # the data is in a CDB file in the first place because there's
# lots of data and the cache hit ratio would be low. # lots of data and the cache hit ratio would be low.
return \%h; return \%h;
}; }
sub _config_from_file { sub _config_from_file {
my ($self, $configfile, $config, $visited) = @_; my ($self, $configfile, $config, $visited) = @_;
@ -357,13 +366,13 @@ sub _load_plugin {
my ($plugin_line, @plugin_dirs) = @_; my ($plugin_line, @plugin_dirs) = @_;
# untaint the config data before passing it to plugins # untaint the config data before passing it to plugins
my ($safe_line) = $plugin_line =~ /^([ -~]+)$/ # all ascii printable my ($safe_line) = $plugin_line =~ /^([ -~]+)$/ # all ascii printable
or die "unsafe characters in config line: $plugin_line\n"; or die "unsafe characters in config line: $plugin_line\n";
my ($plugin, @args) = split /\s+/, $safe_line; my ($plugin, @args) = split /\s+/, $safe_line;
if ($plugin =~ m/::/) { if ($plugin =~ m/::/) {
return $self->_load_package_plugin($plugin, $safe_line, \@args); return $self->_load_package_plugin($plugin, $safe_line, \@args);
}; }
# regular plugins/$plugin plugin # regular plugins/$plugin plugin
my $plugin_name = $plugin; my $plugin_name = $plugin;
@ -383,19 +392,19 @@ sub _load_plugin {
my $package = "Qpsmtpd::Plugin::$plugin_name"; my $package = "Qpsmtpd::Plugin::$plugin_name";
# don't reload plugins if they are already loaded # don't reload plugins if they are already loaded
unless (defined &{"${package}::plugin_name"}) { if (!defined &{"${package}::plugin_name"}) {
PLUGIN_DIR: for my $dir (@plugin_dirs) { PLUGIN_DIR: for my $dir (@plugin_dirs) {
if (-e "$dir/$plugin") { next if !-e "$dir/$plugin";
Qpsmtpd::Plugin->compile($plugin_name, $package, Qpsmtpd::Plugin->compile($plugin_name, $package,
"$dir/$plugin", $self->{_test_mode}, $plugin); "$dir/$plugin", $self->{_test_mode}, $plugin);
$self->log(LOGDEBUG, "Loading $safe_line from $dir/$plugin") if ($safe_line !~ /logging/) {
unless $safe_line =~ /logging/; $self->log(LOGDEBUG, "Loading $safe_line from $dir/$plugin");
last PLUGIN_DIR; };
} last PLUGIN_DIR;
} }
die "Plugin $plugin_name not found in our plugin dirs (", if (! defined &{"${package}::plugin_name"}) {
join(", ", @plugin_dirs), ")" die "Plugin $plugin_name not found in our plugin dirs (", join(', ', @plugin_dirs), ")";
unless defined &{"${package}::plugin_name"}; };
} }
my $plug = $package->new(); my $plug = $package->new();
@ -406,23 +415,25 @@ sub _load_plugin {
sub _load_package_plugin { sub _load_package_plugin {
my ($self, $plugin, $plugin_line, $args) = @_; my ($self, $plugin, $plugin_line, $args) = @_;
# "full" package plugin (My::Plugin) # "full" package plugin (My::Plugin)
my $package = $plugin; my $package = $plugin;
$package =~ s/[^_a-z0-9:]+//gi; $package =~ s/[^_a-z0-9:]+//gi;
my $eval = qq[require $package;\n] my $eval =
. qq[sub ${plugin}::plugin_name { '$plugin' }]; qq[require $package;\n] . qq[sub ${plugin}::plugin_name { '$plugin' }];
$eval =~ m/(.*)/s; $eval =~ m/(.*)/s;
$eval = $1; $eval = $1;
eval $eval; eval $eval;
die "Failed loading $package - eval $@" if $@; die "Failed loading $package - eval $@" if $@;
$self->log(LOGDEBUG, "Loading $package ($plugin_line)") if ($plugin_line !~ /logging/) {
unless $plugin_line =~ /logging/; $self->log(LOGDEBUG, "Loading $package ($plugin_line)");
};
my $plug = $package->new(); my $plug = $package->new();
$plug->_register($self, @$args); $plug->_register($self, @$args);
return $plug; return $plug;
}; }
sub transaction { return {}; } # base class implements empty transaction sub transaction { return {}; } # base class implements empty transaction

4
lib/Qpsmtpd/Address.pm
View File

@ -352,9 +352,9 @@ sub qp {
} }
sub config { sub config {
my ($self,$key) = @_; my ($self, $key) = @_;
my $qp = $self->qp or return; my $qp = $self->qp or return;
return $qp->config($key,$self); return $qp->config($key, $self);
} }
sub _addr_cmp { sub _addr_cmp {

73
lib/Qpsmtpd/SMTP.pm
View File

@ -4,6 +4,7 @@ use strict;
use base 'Qpsmtpd'; use base 'Qpsmtpd';
use Carp; use Carp;
#use Data::Dumper; #use Data::Dumper;
use POSIX qw(strftime); use POSIX qw(strftime);
use Mail::Header; use Mail::Header;
@ -30,10 +31,9 @@ sub new {
my $self = bless({args => \%args}, $class); my $self = bless({args => \%args}, $class);
# this list of valid commands should probably be a method or a set of methods # this list of valid commands should probably be a method or a set of methods
$self->{_commands} = { $self->{_commands} =
map { $_ => '' } qw(ehlo helo rset mail rcpt data help vrfy noop quit) {map { $_ => '' } qw(ehlo helo rset mail rcpt data help vrfy noop quit)};
};
$self->SUPER::_restart(%args) if $args{restart}; # calls Qpsmtpd::_restart() $self->SUPER::_restart(%args) if $args{restart}; # calls Qpsmtpd::_restart()
$self; $self;
@ -87,7 +87,7 @@ sub fault {
my ($name) = split /\s+/, $0, 2; my ($name) = split /\s+/, $0, 2;
print STDERR $name, "[$$]: $msg\n"; print STDERR $name, "[$$]: $msg\n";
print STDERR $name, "[$$]: Last system error: $!" print STDERR $name, "[$$]: Last system error: $!"
." (Likely irelevant--debug the crashed plugin to ensure it handles \$! properly)"; . " (Likely irelevant--debug the crashed plugin to ensure it handles \$! properly)";
return $self->respond(451, "Internal error - try again later - " . $msg); return $self->respond(451, "Internal error - try again later - " . $msg);
} }
@ -260,11 +260,12 @@ sub ehlo_respond {
} }
# Check if we should only offer AUTH after TLS is completed # Check if we should only offer AUTH after TLS is completed
my $tls_before_auth = my $tls_before_auth = (
($self->config('tls_before_auth') $self->config('tls_before_auth')
? ($self->config('tls_before_auth'))[0] ? ($self->config('tls_before_auth'))[0]
&& $self->transaction->notes('tls_enabled') && $self->transaction->notes('tls_enabled')
: 0); : 0
);
if (%auth_mechanisms && !$tls_before_auth) { if (%auth_mechanisms && !$tls_before_auth) {
push @capabilities, 'AUTH ' . join(" ", keys(%auth_mechanisms)); push @capabilities, 'AUTH ' . join(" ", keys(%auth_mechanisms));
$self->{_commands}->{'auth'} = ""; $self->{_commands}->{'auth'} = "";
@ -789,53 +790,57 @@ sub authentication_results {
my ($self) = @_; my ($self) = @_;
my @auth_list = $self->config('me'); my @auth_list = $self->config('me');
# $self->clean_authentication_results();
if ( ! defined $self->{_auth} ) { # $self->clean_authentication_results();
if (!defined $self->{_auth}) {
push @auth_list, 'auth=none'; push @auth_list, 'auth=none';
} }
else { else {
my $mechanism = "(" . $self->{_auth_mechanism} . ")"; my $mechanism = "(" . $self->{_auth_mechanism} . ")";
my $user = "smtp.auth=" . $self->{_auth_user}; my $user = "smtp.auth=" . $self->{_auth_user};
if ( $self->{_auth} == OK) { if ($self->{_auth} == OK) {
push @auth_list, "auth=pass $mechanism $user"; push @auth_list, "auth=pass $mechanism $user";
} }
else { else {
push @auth_list, "auth=fail $mechanism $user"; push @auth_list, "auth=fail $mechanism $user";
}; }
}; }
# RFC 5451: used in AUTH, DKIM, DOMAINKEYS, SENDERID, SPF # RFC 5451: used in AUTH, DKIM, DOMAINKEYS, SENDERID, SPF
if ( $self->connection->notes('authentication_results') ) { if ($self->connection->notes('authentication_results')) {
push @auth_list, $self->connection->notes('authentication_results'); push @auth_list, $self->connection->notes('authentication_results');
}; }
$self->log(LOGDEBUG, "adding auth results header" ); $self->log(LOGDEBUG, "adding auth results header");
$self->transaction->header->add('Authentication-Results', join('; ', @auth_list), 0); $self->transaction->header->add('Authentication-Results',
}; join('; ', @auth_list), 0);
}
sub clean_authentication_results { sub clean_authentication_results {
my $self = shift; my $self = shift;
# http://tools.ietf.org/html/draft-kucherawy-original-authres-00.html # http://tools.ietf.org/html/draft-kucherawy-original-authres-00.html
# On messages received from the internet, move Authentication-Results headers # On messages received from the internet, move Authentication-Results headers
# to Original-AR, so our downstream can trust the A-R header we insert. # to Original-AR, so our downstream can trust the A-R header we insert.
# TODO: Do not invalidate DKIM signatures. # TODO: Do not invalidate DKIM signatures.
# if $self->transaction->header->get('DKIM-Signature') # if $self->transaction->header->get('DKIM-Signature')
# Parse the DKIM signature(s) # Parse the DKIM signature(s)
# return if A-R header is signed; # return if A-R header is signed;
# } # }
my @ar_headers = $self->transaction->header->get('Authentication-Results'); my @ar_headers = $self->transaction->header->get('Authentication-Results');
for ( my $i = 0; $i < scalar @ar_headers; $i++ ) { for (my $i = 0 ; $i < scalar @ar_headers ; $i++) {
$self->transaction->header->delete('Authentication-Results', $i); $self->transaction->header->delete('Authentication-Results', $i);
$self->transaction->header->add('Original-Authentication-Results', $ar_headers[$i]); $self->transaction->header->add('Original-Authentication-Results',
$ar_headers[$i]);
} }
$self->log(LOGDEBUG, "Authentication-Results moved to Original-Authentication-Results" ); $self->log(LOGDEBUG,
}; "Authentication-Results moved to Original-Authentication-Results");
}
sub received_line { sub received_line {
my ($self) = @_; my ($self) = @_;
@ -883,7 +888,7 @@ sub received_line {
. ") with $sslheader$smtp; " . ") with $sslheader$smtp; "
. (strftime('%a, %d %b %Y %H:%M:%S %z', localtime)); . (strftime('%a, %d %b %Y %H:%M:%S %z', localtime));
} }
$self->transaction->header->add('Received', $header_str, 0 ); $self->transaction->header->add('Received', $header_str, 0);
} }
sub data_post_respond { sub data_post_respond {

2
packaging/rpm/VERSION
View File

@ -1 +1 @@
0.94 0.95

16
plugins/user_config
View File

@ -28,24 +28,26 @@ in separate directories similar to the global qpsmtpd config directory.
=cut =cut
sub init { sub init {
my ( $self, $qp, $pattern ) = @_; my ($self, $qp, $pattern) = @_;
$self->{pattern} = $pattern || '/home/%u/.qpsmtpd'; $self->{pattern} = $pattern || '/home/%u/.qpsmtpd';
} }
sub hook_user_config { sub hook_user_config {
my ($self,$txn,$addr,$conf) = @_; my ($self, $txn, $addr, $conf) = @_;
my $path = $self->{pattern} or return DECLINED; my $path = $self->{pattern} or return DECLINED;
my ( $user, $host, $address ) = ( $addr->user, $addr->host, $addr->address ); my ($user, $host, $address) = ($addr->user, $addr->host, $addr->address);
$path =~ s/%u/$user/g; $path =~ s/%u/$user/g;
$path =~ s/%h/$host/g; $path =~ s/%h/$host/g;
$path =~ s/%a/$address/g; $path =~ s/%a/$address/g;
my $filename = "$path/$conf"; my $filename = "$path/$conf";
return DECLINED unless -f $filename; return DECLINED unless -f $filename;
my $fh; my $fh;
unless (open $fh,$filename) {
$self->log(LOGNOTICE,"Couldn't open $filename:$!"); unless (open $fh, $filename) {
$self->log(LOGNOTICE, "Couldn't open $filename:$!");
return DECLINED; return DECLINED;
} }
map {chomp} (my @return = (<$fh>)); my @return = <$fh>;
return OK,@return; chomp @return;
return OK, @return;
} }

36
t/plugin_tests/user_config
View File

@ -19,32 +19,40 @@ sub register_tests {
} }
sub test_hook_user_config { sub test_hook_user_config {
my ( $self ) = @_; my ($self) = @_;
my $dirname = $self->qp->temp_dir; my $dirname = $self->qp->temp_dir;
$self->{pattern} = $dirname . '/%u_%h_%a'; $self->{pattern} = $dirname . '/%u_%h_%a';
$dirname .= '/testuser_testhost_testaddress'; $dirname .= '/testuser_testhost_testaddress';
-d $dirname -d $dirname
or mkdir($dirname, 0700) or mkdir($dirname, 0700)
or die "Could not create $dirname: $!"; or die "Could not create $dirname: $!";
open my $fh, '>', "$dirname/testfield"; open my $fh, '>', "$dirname/testfield";
print $fh "testdata"; print $fh "testdata";
close $fh; close $fh;
my $a = FakeAddress->new( user => 'testuser', host => 'testhost', address => 'testaddress' ); my $a = FakeAddress->new(
my ( $r, $value ) = $self->hook_user_config( $self->qp->transaction, $a, 'testfield' ); user => 'testuser',
is( $r, OK, 'hook_user_config returned OK when config file present' ); host => 'testhost',
is( $value, 'testdata', 'hook_user_config returned the correct value' ); address => 'testaddress'
( $r, $value ) = $self->hook_user_config( $self->qp->transaction, $a, 'noconfig' ); );
is( $r, DECLINED, 'hook_user_config returned DECLINED when no config file present' ); my ($r, $value) =
is( $value, undef, 'hook_user_config returned no value when no config file present' ); $self->hook_user_config($self->qp->transaction, $a, 'testfield');
is($r, OK, 'hook_user_config returned OK when config file present');
is($value, 'testdata', 'hook_user_config returned the correct value');
($r, $value) =
$self->hook_user_config($self->qp->transaction, $a, 'noconfig');
is($r, DECLINED,
'hook_user_config returned DECLINED when no config file present');
is($value, undef,
'hook_user_config returned no value when no config file present');
rmtree($dirname); rmtree($dirname);
} }
package FakeAddress; package FakeAddress;
sub new { sub new {
shift; shift;
return bless {@_}; return bless {@_};
} }
sub address { return shift->{address} } sub address { return shift->{address} }
sub user { return shift->{user} } sub user { return shift->{user} }
sub host { return shift->{host} } sub host { return shift->{host} }

112
t/qpsmtpd-address.t
View File

@ -22,29 +22,29 @@ sub __new {
my ($as, $ao); my ($as, $ao);
my @unsorted_list = map { Qpsmtpd::Address->new($_) } qw( my @unsorted_list = map { Qpsmtpd::Address->new($_) } qw(
"musa_ibrah@caramail.comandrea.luger"@wifo.ac.at "musa_ibrah@caramail.comandrea.luger"@wifo.ac.at
foo@example.com foo@example.com
ask@perl.org ask@perl.org
foo@foo.x.example.com foo@foo.x.example.com
jpeacock@cpan.org jpeacock@cpan.org
test@example.com test@example.com
); );
# NOTE that this is sorted by _host_ not by _domain_ # NOTE that this is sorted by _host_ not by _domain_
my @sorted_list = map { Qpsmtpd::Address->new($_) } qw( my @sorted_list = map { Qpsmtpd::Address->new($_) } qw(
jpeacock@cpan.org jpeacock@cpan.org
foo@example.com foo@example.com
test@example.com test@example.com
foo@foo.x.example.com foo@foo.x.example.com
ask@perl.org ask@perl.org
"musa_ibrah@caramail.comandrea.luger"@wifo.ac.at "musa_ibrah@caramail.comandrea.luger"@wifo.ac.at
); );
my @test_list = sort @unsorted_list; my @test_list = sort @unsorted_list;
is_deeply(\@test_list, \@sorted_list, "sort via overloaded 'cmp' operator"); is_deeply(\@test_list, \@sorted_list, "sort via overloaded 'cmp' operator");
# RT#38746 - non-RFC compliant address should return undef # RT#38746 - non-RFC compliant address should return undef
$as = '<user@example.com#>'; $as = '<user@example.com#>';
$ao = Qpsmtpd::Address->new($as); $ao = Qpsmtpd::Address->new($as);
@ -72,16 +72,16 @@ sub __parse {
is($ao->user, 'foo', 'user'); is($ao->user, 'foo', 'user');
is($ao->host, 'example.com', 'host'); is($ao->host, 'example.com', 'host');
# the \ before the @ in the local part is not required, but # the \ before the @ in the local part is not required, but
# allowed. For simplicity we add a backslash before all characters # allowed. For simplicity we add a backslash before all characters
# which are not allowed in a dot-string. # which are not allowed in a dot-string.
$as = '<"musa_ibrah@caramail.comandrea.luger"@wifo.ac.at>'; $as = '<"musa_ibrah@caramail.comandrea.luger"@wifo.ac.at>';
$ao = Qpsmtpd::Address->parse($as); $ao = Qpsmtpd::Address->parse($as);
ok($ao, "parse $as"); ok($ao, "parse $as");
is($ao->format, '<"musa_ibrah\@caramail.comandrea.luger"@wifo.ac.at>', is($ao->format, '<"musa_ibrah\@caramail.comandrea.luger"@wifo.ac.at>',
"format $as"); "format $as");
# email addresses with spaces # email addresses with spaces
$as = '<foo bar@example.com>'; $as = '<foo bar@example.com>';
$ao = Qpsmtpd::Address->parse($as); $ao = Qpsmtpd::Address->parse($as);
ok($ao, "parse $as"); ok($ao, "parse $as");
@ -106,7 +106,7 @@ sub __parse {
ok($ao = Qpsmtpd::Address->parse('<' . $as . '>'), "parse $as"); ok($ao = Qpsmtpd::Address->parse('<' . $as . '>'), "parse $as");
is($ao && $ao->address, $as, "address $as"); is($ao && $ao->address, $as, "address $as");
# Not sure why we can change the address like this, but we can so test it ... # Not sure why we can change the address like this, but we can so test it ...
is($ao && $ao->address('test@example.com'), is($ao && $ao->address('test@example.com'),
'test@example.com', 'address(test@example.com)'); 'test@example.com', 'address(test@example.com)');
@ -120,44 +120,48 @@ sub __parse {
ok($ao = Qpsmtpd::Address->parse("<$as>"), "parse <$as>"); ok($ao = Qpsmtpd::Address->parse("<$as>"), "parse <$as>");
is($ao && $ao->address, $as, "address $as"); is($ao && $ao->address, $as, "address $as");
ok($ao eq $as, "overloaded 'cmp' operator"); ok($ao eq $as, "overloaded 'cmp' operator");
}; }
sub __config { sub __config {
ok( my ($qp,$cxn) = Test::Qpsmtpd->new_conn(), "get new connection" ); ok(my ($qp, $cxn) = Test::Qpsmtpd->new_conn(), "get new connection");
ok( $qp->command('HELO test') ); ok($qp->command('HELO test'));
ok( $qp->command('MAIL FROM:<test@example.com>') ); ok($qp->command('MAIL FROM:<test@example.com>'));
my $sender = $qp->transaction->sender; my $sender = $qp->transaction->sender;
my @test_data = ( my @test_data = (
{ {
pref => 'size_threshold', pref => 'size_threshold',
result => [], result => [],
expected => 10000, expected => 10000,
descr => 'fall back to global config when user_config is absent', descr => 'fall back to global config when user_config is absent',
}, },
{ {
pref => 'test_config', pref => 'test_config',
result => [], result => [],
expected => undef, expected => undef,
descr => 'return nothing when no user_config plugins exist', descr => 'return nothing when no user_config plugins exist',
}, },
{ {
pref => 'test_config', pref => 'test_config',
result => [DECLINED], result => [DECLINED],
expected => undef, expected => undef,
descr => 'return nothing when user_config plugins return DECLINED', descr => 'return nothing when user_config plugins return DECLINED',
}, },
{ {
pref => 'test_config', pref => 'test_config',
result => [OK,'test value'], result => [OK, 'test value'],
expected => 'test value', expected => 'test value',
descr => 'return results when user_config plugin returns a value', descr => 'return results when user_config plugin returns a value',
}, },
); );
for (@test_data) { for (@test_data) {
$qp->hooks->{user_config} $qp->hooks->{user_config} = @{$_->{result}}
= @{ $_->{result} } ? [
? [{ name => 'test hook', code => sub { return @{ $_->{result} }} }] {
: undef; name => 'test hook',
is( $sender->config($_->{pref}), $_->{expected}, $_->{descr} ); code => sub { return @{$_->{result}} }
}
]
: undef;
is($sender->config($_->{pref}), $_->{expected}, $_->{descr});
} }
} }

194
t/qpsmtpd.t
View File

@ -5,7 +5,8 @@ use warnings;
use Data::Dumper; use Data::Dumper;
use Test::More; use Test::More;
use lib 'lib'; # test lib/Qpsmtpd (vs site_perl) use lib 'lib'; # test lib/Qpsmtpd (vs site_perl)
BEGIN { BEGIN {
use_ok('Qpsmtpd'); use_ok('Qpsmtpd');
use_ok('Qpsmtpd::Constants'); use_ok('Qpsmtpd::Constants');
@ -16,8 +17,8 @@ use_ok('Test::Qpsmtpd');
my $qp = bless {}, 'Qpsmtpd'; my $qp = bless {}, 'Qpsmtpd';
ok( $qp->version(), "version, " . $qp->version()); ok($qp->version(), "version, " . $qp->version());
is_deeply( Qpsmtpd::hooks(), {}, 'hooks, empty'); is_deeply(Qpsmtpd::hooks(), {}, 'hooks, empty');
__authenticated(); __authenticated();
__config_dir(); __config_dir();
@ -29,157 +30,168 @@ __load_logging();
done_testing(); done_testing();
sub __get_qmail_config { sub __get_qmail_config {
ok( !$qp->get_qmail_config('me'), "get_qmail_config, me"); ok(!$qp->get_qmail_config('me'), "get_qmail_config, me");
# TODO: add positive tests. # TODO: add positive tests.
}; }
sub __config_from_file { sub __config_from_file {
# $configfile, $config, $visited # $configfile, $config, $visited
}; }
sub __log { sub __log {
my $warned = ''; my $warned = '';
local $SIG{__WARN__} = sub { local $SIG{__WARN__} = sub {
if ( $_[0] eq "$$ test log message\n" ) { if ($_[0] eq "$$ test log message\n") {
$warned = join ' ', @_; $warned = join ' ', @_;
} }
else { else {
warn @_; warn @_;
} }
}; };
ok( $qp->log(LOGWARN, "test log message"), 'log'); ok($qp->log(LOGWARN, "test log message"), 'log');
is( $warned, "$$ test log message\n", 'LOGWARN emitted correct warning' ); is($warned, "$$ test log message\n", 'LOGWARN emitted correct warning');
} }
sub __config_dir { sub __config_dir {
my $dir = $qp->config_dir('logging'); my $dir = $qp->config_dir('logging');
ok( $dir, "config_dir, $dir"); ok($dir, "config_dir, $dir");
#warn Data::Dumper::Dumper($Qpsmtpd::config_dir_memo{logging}); #warn Data::Dumper::Dumper($Qpsmtpd::config_dir_memo{logging});
$dir = $Qpsmtpd::config_dir_memo{logging}; $dir = $Qpsmtpd::config_dir_memo{logging};
ok( $dir, "config_dir, $dir (memo)"); ok($dir, "config_dir, $dir (memo)");
}; }
sub __load_logging { sub __load_logging {
$Qpsmtpd::LOGGING_LOADED = 1; $Qpsmtpd::LOGGING_LOADED = 1;
ok( !$qp->load_logging(), "load_logging, loaded"); ok(!$qp->load_logging(), "load_logging, loaded");
$Qpsmtpd::LOGGING_LOADED = 0; $Qpsmtpd::LOGGING_LOADED = 0;
$Qpsmtpd::hooks->{logging} = 1; $Qpsmtpd::hooks->{logging} = 1;
ok( !$qp->load_logging(), "load_logging, logging hook"); ok(!$qp->load_logging(), "load_logging, logging hook");
$Qpsmtpd::hooks->{logging} = undef; # restore $Qpsmtpd::hooks->{logging} = undef; # restore
} }
sub __authenticated { sub __authenticated {
ok( ! $qp->authenticated(), "authenticated, undef"); ok(!$qp->authenticated(), "authenticated, undef");
$qp->{_auth} = 1; $qp->{_auth} = 1;
ok( $qp->authenticated(), "authenticated, true"); ok($qp->authenticated(), "authenticated, true");
$qp->{_auth} = 0; $qp->{_auth} = 0;
ok( !$qp->authenticated(), "authenticated, false"); ok(!$qp->authenticated(), "authenticated, false");
}; }
sub __config { sub __config {
my @r = $qp->config('badhelo'); my @r = $qp->config('badhelo');
ok( $r[0], "config, badhelo, @r"); ok($r[0], "config, badhelo, @r");
my $a = FakeAddress->new( test => 'test value' ); my $a = FakeAddress->new(test => 'test value');
ok( my ($qp,$cxn) = Test::Qpsmtpd->new_conn(), "get new connection" ); ok(my ($qp, $cxn) = Test::Qpsmtpd->new_conn(), "get new connection");
my @test_data = ( my @test_data = (
{ {
pref => 'size_threshold', pref => 'size_threshold',
hooks => { hooks => {
user_config => [], user_config => [],
config => [], config => [],
}, },
expected => { expected => {
user => 10000, user => 10000,
global => 10000, global => 10000,
}, },
descr => 'no user or global config hooks, fall back to config file', descr => 'no user or global config hooks, fall back to config file',
}, },
{ {
pref => 'timeout', pref => 'timeout',
hooks => { hooks => {
user_config => [], user_config => [],
config => [], config => [],
}, },
expected => { expected => {
user => 1200, user => 1200,
global => 1200, global => 1200,
}, },
descr => 'no user or global config hooks, fall back to defaults', descr => 'no user or global config hooks, fall back to defaults',
}, },
{ {
pref => 'timeout', pref => 'timeout',
hooks => { hooks => {
user_config => [DECLINED], user_config => [DECLINED],
config => [DECLINED], config => [DECLINED],
}, },
expected => { expected => {
user => 1200, user => 1200,
global => 1200, global => 1200,
}, },
descr => 'user and global config hooks decline, fall back to defaults', descr => 'user and global config hooks decline, fall back to defaults',
}, },
{ {
pref => 'timeout', pref => 'timeout',
hooks => { hooks => {
user_config => [DECLINED], user_config => [DECLINED],
config => [OK,1000], config => [OK, 1000],
}, },
expected => { expected => {
user => 1000, user => 1000,
global => 1000, global => 1000,
}, },
descr => 'user hook declines, global hook returns', descr => 'user hook declines, global hook returns',
}, },
{ {
pref => 'timeout', pref => 'timeout',
hooks => { hooks => {
user_config => [OK,500], user_config => [OK, 500],
config => [OK,undef], config => [OK, undef],
}, },
expected => { expected => {
user => 500, user => 500,
global => undef, global => undef,
}, },
descr => 'user hook returns int, global hook returns undef', descr => 'user hook returns int, global hook returns undef',
}, },
{ {
pref => 'timeout', pref => 'timeout',
hooks => { hooks => {
user_config => [OK,undef], user_config => [OK, undef],
config => [OK,1000], config => [OK, 1000],
}, },
expected => { expected => {
user => undef, user => undef,
global => 1000, global => 1000,
}, },
descr => 'user hook returns undef, global hook returns int', descr => 'user hook returns undef, global hook returns int',
}, },
); );
for my $t (@test_data) { for my $t (@test_data) {
for my $hook (qw( config user_config )) { for my $hook (qw( config user_config )) {
$qp->hooks->{$hook} $qp->hooks->{$hook} = @{$t->{hooks}{$hook}}
= @{ $t->{hooks}{$hook} } ? [
? [{ name => 'test hook', code => sub { return @{ $t->{hooks}{$hook} }} }] {
: undef; name => 'test hook',
code => sub { return @{$t->{hooks}{$hook}} }
}
]
: undef;
} }
is( $qp->config($t->{pref},$a), $t->{expected}{user}, "User config: $t->{descr}"); is(
is( $qp->config($t->{pref}), $t->{expected}{global}, "Global config: $t->{descr}"); $qp->config($t->{pref}, $a),
$t->{expected}{user},
"User config: $t->{descr}"
);
is($qp->config($t->{pref}),
$t->{expected}{global},
"Global config: $t->{descr}");
} }
} }
package FakeAddress; package FakeAddress;
sub new { sub new {
shift; shift;
return bless {@_}; return bless {@_};
} }
sub address { } # pass the can('address') conditional sub address { } # pass the can('address') conditional