851e1b54ee
* update manifest * perltidy * replace postfix if/unless with brackets * reduce useless indention by exiting sooner
198 lines
4.9 KiB
Perl
198 lines
4.9 KiB
Perl
#!/usr/bin/perl
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Data::Dumper;
|
|
use Test::More;
|
|
|
|
use lib 'lib'; # test lib/Qpsmtpd (vs site_perl)
|
|
|
|
BEGIN {
|
|
use_ok('Qpsmtpd');
|
|
use_ok('Qpsmtpd::Constants');
|
|
}
|
|
|
|
use lib 't';
|
|
use_ok('Test::Qpsmtpd');
|
|
|
|
my $qp = bless {}, 'Qpsmtpd';
|
|
|
|
ok($qp->version(), "version, " . $qp->version());
|
|
is_deeply(Qpsmtpd::hooks(), {}, 'hooks, empty');
|
|
|
|
__authenticated();
|
|
__config_dir();
|
|
__get_qmail_config();
|
|
__config();
|
|
__log();
|
|
__load_logging();
|
|
|
|
done_testing();
|
|
|
|
sub __get_qmail_config {
|
|
ok(!$qp->get_qmail_config('me'), "get_qmail_config, me");
|
|
|
|
# TODO: add positive tests.
|
|
}
|
|
|
|
sub __config_from_file {
|
|
|
|
# $configfile, $config, $visited
|
|
|
|
}
|
|
|
|
sub __log {
|
|
my $warned = '';
|
|
local $SIG{__WARN__} = sub {
|
|
if ($_[0] eq "$$ test log message\n") {
|
|
$warned = join ' ', @_;
|
|
}
|
|
else {
|
|
warn @_;
|
|
}
|
|
};
|
|
ok($qp->log(LOGWARN, "test log message"), 'log');
|
|
is($warned, "$$ test log message\n", 'LOGWARN emitted correct warning');
|
|
}
|
|
|
|
sub __config_dir {
|
|
my $dir = $qp->config_dir('logging');
|
|
ok($dir, "config_dir, $dir");
|
|
|
|
#warn Data::Dumper::Dumper($Qpsmtpd::config_dir_memo{logging});
|
|
$dir = $Qpsmtpd::config_dir_memo{logging};
|
|
ok($dir, "config_dir, $dir (memo)");
|
|
}
|
|
|
|
sub __load_logging {
|
|
$Qpsmtpd::LOGGING_LOADED = 1;
|
|
ok(!$qp->load_logging(), "load_logging, loaded");
|
|
|
|
$Qpsmtpd::LOGGING_LOADED = 0;
|
|
$Qpsmtpd::hooks->{logging} = 1;
|
|
ok(!$qp->load_logging(), "load_logging, logging hook");
|
|
|
|
$Qpsmtpd::hooks->{logging} = undef; # restore
|
|
}
|
|
|
|
sub __authenticated {
|
|
|
|
ok(!$qp->authenticated(), "authenticated, undef");
|
|
|
|
$qp->{_auth} = 1;
|
|
ok($qp->authenticated(), "authenticated, true");
|
|
|
|
$qp->{_auth} = 0;
|
|
ok(!$qp->authenticated(), "authenticated, false");
|
|
}
|
|
|
|
sub __config {
|
|
my @r = $qp->config('badhelo');
|
|
ok($r[0], "config, badhelo, @r");
|
|
my $a = FakeAddress->new(test => 'test value');
|
|
ok(my ($qp, $cxn) = Test::Qpsmtpd->new_conn(), "get new connection");
|
|
my @test_data = (
|
|
{
|
|
pref => 'size_threshold',
|
|
hooks => {
|
|
user_config => [],
|
|
config => [],
|
|
},
|
|
expected => {
|
|
user => 10000,
|
|
global => 10000,
|
|
},
|
|
descr => 'no user or global config hooks, fall back to config file',
|
|
},
|
|
{
|
|
pref => 'timeout',
|
|
hooks => {
|
|
user_config => [],
|
|
config => [],
|
|
},
|
|
expected => {
|
|
user => 1200,
|
|
global => 1200,
|
|
},
|
|
descr => 'no user or global config hooks, fall back to defaults',
|
|
},
|
|
{
|
|
pref => 'timeout',
|
|
hooks => {
|
|
user_config => [DECLINED],
|
|
config => [DECLINED],
|
|
},
|
|
expected => {
|
|
user => 1200,
|
|
global => 1200,
|
|
},
|
|
descr => 'user and global config hooks decline, fall back to defaults',
|
|
},
|
|
{
|
|
pref => 'timeout',
|
|
hooks => {
|
|
user_config => [DECLINED],
|
|
config => [OK, 1000],
|
|
},
|
|
expected => {
|
|
user => 1000,
|
|
global => 1000,
|
|
},
|
|
descr => 'user hook declines, global hook returns',
|
|
},
|
|
{
|
|
pref => 'timeout',
|
|
hooks => {
|
|
user_config => [OK, 500],
|
|
config => [OK, undef],
|
|
},
|
|
expected => {
|
|
user => 500,
|
|
global => undef,
|
|
},
|
|
descr => 'user hook returns int, global hook returns undef',
|
|
},
|
|
{
|
|
pref => 'timeout',
|
|
hooks => {
|
|
user_config => [OK, undef],
|
|
config => [OK, 1000],
|
|
},
|
|
expected => {
|
|
user => undef,
|
|
global => 1000,
|
|
},
|
|
descr => 'user hook returns undef, global hook returns int',
|
|
},
|
|
);
|
|
for my $t (@test_data) {
|
|
for my $hook (qw( config user_config )) {
|
|
$qp->hooks->{$hook} = @{$t->{hooks}{$hook}}
|
|
? [
|
|
{
|
|
name => 'test hook',
|
|
code => sub { return @{$t->{hooks}{$hook}} }
|
|
}
|
|
]
|
|
: undef;
|
|
}
|
|
is(
|
|
$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;
|
|
|
|
sub new {
|
|
shift;
|
|
return bless {@_};
|
|
}
|
|
|
|
sub address { } # pass the can('address') conditional
|