#!/usr/bin/perl use strict; use warnings; use Cwd; use Data::Dumper; use File::Path; use Test::More; use lib 'lib'; # test lib/Qpsmtpd (vs site_perl) use lib 't'; BEGIN { use_ok('Qpsmtpd'); use_ok('Qpsmtpd::Constants'); use_ok('Test::Qpsmtpd'); } my $qp = bless {}, 'Qpsmtpd'; ok($qp->version(), "version, " . $qp->version()); __hooks_none(); ok(my ($smtpd, $conn) = Test::Qpsmtpd->new_conn(), "get new connection"); __hooks(); __run_hooks_no_respond(); __run_hooks(); __register_hook(); __hook_responder(); __run_continuation(); __temp_file(); __temp_dir(); __size_threshold(); __authenticated(); __auth_user(); __auth_mechanism(); __spool_dir(); __log(); __load_logging(); __config_dir(); __config(); done_testing(); sub __run_hooks { my @r = $qp->run_hooks('nope'); is($r[0], 0, "run_hooks, invalid hook"); @r = $smtpd->run_hooks('nope'); is($r[0], 0, "run_hooks, invalid hook"); foreach my $hook (qw/ connect helo rset /) { my $r = $smtpd->run_hooks('connect'); is($r->[0], 220, "run_hooks, $hook code"); ok($r->[1] =~ /ready/, "run_hooks, $hook result"); } } sub __run_hooks_no_respond { my @r = $qp->run_hooks_no_respond('nope'); is($r[0], 0, "run_hooks_no_respond, invalid hook"); @r = $smtpd->run_hooks_no_respond('nope'); is($r[0], 0, "run_hooks_no_respond, invalid hook"); foreach my $hook (qw/ connect helo rset /) { @r = $smtpd->run_hooks_no_respond('connect'); is($r[0], 909, "run_hooks_no_respond, $hook hook"); } } sub __hooks { ok(Qpsmtpd::hooks(), "hooks, populated"); my $r = $qp->hooks; ok(%$r, "hooks, populated returns a hashref"); $r = $qp->hooks('connect'); ok(@$r, "hooks, populated, connect"); my @r = $qp->hooks('connect'); ok(@r, "hooks, populated, connect, wants array"); } sub __hooks_none { is_deeply(Qpsmtpd::hooks(), {}, 'hooks, empty'); is_deeply($qp->hooks, {}, 'hooks, empty'); my $r = $qp->hooks('connect'); is_deeply($r, [], 'hooks, empty, specified'); } sub __run_continuation { my $r; eval { $smtpd->run_continuation }; is( $@, "No continuation in progress\n", 'run_continuation dies without continuation'); $smtpd->{_continuation} = []; eval { $smtpd->run_continuation }; ok( $@ =~ /^No hook in the continuation/, 'run_continuation dies without hook'); $smtpd->{_continuation} = ['connect']; eval { $smtpd->run_continuation }; ok( $@ =~ /^No hook args in the continuation/, 'run_continuation dies without hook'); my @local_hooks = @{ $smtpd->hooks->{connect} }; $smtpd->{_continuation} = ['connect', [DECLINED, "test mess"], @local_hooks]; eval { $r = $smtpd->run_continuation }; ok(!$@, "run_continuation with a continuation doesn't throw exception"); is($r->[0], 220, "hook_responder, code"); ok($r->[1] =~ /ESMTP qpsmtpd/, "hook_responder, message: ". $r->[1]); my @test_data = ( { hooks => [[DENY, 'noway']], expected_response => '550/noway', disconnected => 0, descr => 'DENY', }, { hooks => [[DENY_DISCONNECT, 'boo']], expected_response => '550/boo', disconnected => 1, descr => 'DENY_DISCONNECT', }, { hooks => [[DENYSOFT, 'comeback']], expected_response => '450/comeback', disconnected => 0, descr => 'DENYSOFT', }, { hooks => [[DENYSOFT_DISCONNECT, 'wah']], expected_response => '450/wah', disconnected => 1, descr => 'DENYSOFT_DISCONNECT', }, { hooks => [ [DECLINED,'nm'], [DENY, 'gotcha'] ], expected_response => '550/gotcha', disconnected => 0, descr => 'DECLINED -> DENY', }, { hooks => [ [123456,undef], [DENY, 'goaway'] ], expected_response => '550/goaway', disconnected => 0, logged => 'LOGERROR:Plugin ___FakeHook___, hook helo returned 123456', descr => 'INVALID -> DENY', }, { hooks => [ sub { die "dead\n" }, [DENY, 'begone'] ], expected_response => '550/begone', disconnected => 0, logged => 'LOGCRIT:FATAL PLUGIN ERROR [___FakeHook___]: dead', descr => 'fatal error -> DENY', }, { hooks => [ [undef], [DENY, 'nm'] ], expected_response => '550/nm', disconnected => 0, logged => 'LOGERROR:Plugin ___FakeHook___, hook helo returned undef!', descr => 'undef -> DENY', }, { hooks => [ [OK, 'bemyguest'], [DENY, 'seeya'] ], expected_response => '250/fqdn Hi test@localhost [127.0.0.1];' . ' I am so happy to meet you.', disconnected => 0, descr => 'OK -> DENY', }, ); for my $t (@test_data) { $smtpd->fake_config( me => 'fqdn' ); for my $h ( reverse @{ $t->{hooks} } ) { my $sub = ( ref $h eq 'ARRAY' ? sub { return @$h } : $h ); $smtpd->fake_hook( 'helo', $sub ); } $smtpd->{_continuation} = [ 'helo', ['somearg'], @{ $smtpd->hooks->{helo} } ]; delete $smtpd->{_response}; delete $smtpd->{_logged}; $smtpd->connection->notes( disconnected => undef ); $smtpd->run_continuation; my $response = join '/', @{ $smtpd->{_response} || [] }; is( $response, $t->{expected_response}, "run_continuation(): Respond to $t->{descr} with $t->{expected_response}" ); if ( $t->{disconnected} ) { ok( $smtpd->connection->notes('disconnected'), "run_continuation() disconnects on $t->{descr}" ); } else { ok( ! $smtpd->connection->notes('disconnected'), "run_continuation() does not disconnect on $t->{descr}" ); } if ( $t->{logged} ) { is( join("\n", @{ $smtpd->{_logged} || [] }), $t->{logged}, "run_continuation() logging on $t->{descr}" ); } $smtpd->unfake_hook('helo'); $smtpd->unfake_config(); } } sub __hook_responder { my ($code, $msg) = $qp->hook_responder('test-hook', [OK,'test mesg']); is($code, OK, "hook_responder, code"); is($msg, 'test mesg', "hook_responder, test msg"); ($code, $msg) = $smtpd->hook_responder('connect', [OK,'test mesg']); is($code->[0], 220, "hook_responder, code"); ok($code->[1] =~ /ESMTP qpsmtpd/, "hook_responder, message: ". $code->[1]); my $rej_msg = 'Your father smells of elderberries'; ($code, $msg) = $smtpd->hook_responder('connect', [DENY, $rej_msg]); is($code, undef, "hook_responder, disconnected yields undef code"); is($msg, undef, "hook_responder, disconnected yields undef msg"); } sub __register_hook { my $hook = 'test'; is( $Qpsmtpd::hooks->{'test'}, undef, "_register_hook, test hook is undefined"); $smtpd->_register_hook('test', 'fake-code-ref'); is_deeply( $Qpsmtpd::hooks->{'test'}, ['fake-code-ref'], "test hook is registered"); } sub __log { my $warned = ''; local $SIG{__WARN__} = sub { if ($_[0] eq "$$ test log message\n") { $warned = join ' ', @_; } else { warn @_; } }; $qp->log(LOGWARN, "test log message"); ok(-f 't/tmp/test-warn.log', 'log'); is($warned, "$$ test log message\n", 'LOGWARN emitted correct warning'); } 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 __spool_dir { my $dir = $qp->spool_dir(); ok($dir, "spool_dir is at $dir"); my $cwd = getcwd; chomp $cwd; open my $SD, '>', "./config.sample/spool_dir"; print $SD "$cwd/t/tmp"; close $SD; my $spool_dir = $smtpd->spool_dir(); ok($spool_dir =~ m!/tmp/$!, "Located the spool directory") or diag ("spool_dir: $spool_dir instead of tmp"); my $tempfile = $smtpd->temp_file(); my $tempdir = $smtpd->temp_dir(); ok($tempfile =~ /^$spool_dir/, "Temporary filename"); ok($tempdir =~ /^$spool_dir/, "Temporary directory"); ok(-d $tempdir, "And that directory exists"); unlink "./config.sample/spool_dir"; rmtree($spool_dir); } sub __temp_file { my $r = $qp->temp_file(); ok( $r, "temp_file at $r"); if ($r && -f $r) { unlink $r; ok( unlink $r, "cleaned up temp file $r"); } } sub __temp_dir { my $r = $qp->temp_dir(); ok( $r, "temp_dir at $r"); if ($r && -d $r) { File::Path::rmtree($r); } $r = $qp->temp_dir('0775'); ok( $r, "temp_dir with mask, $r"); if ($r && -d $r) { File::Path::rmtree($r); } } sub __size_threshold { is( $qp->size_threshold(), 10000, "size_threshold from t/config is 1000") or warn "size_threshold: " . $qp->size_threshold; $Qpsmtpd::Size_threshold = 5; cmp_ok( 5, '==', $qp->size_threshold(), "size_threshold equals 5"); $Qpsmtpd::Size_threshold = undef; } sub __authenticated { ok( ! $qp->authenticated(), "authenticated is undefined"); $qp->{_auth} = 1; ok($qp->authenticated(), "authenticated is true"); $qp->{_auth} = 0; ok(! $qp->authenticated(), "authenticated is false"); } sub __auth_user { ok( ! $qp->auth_user(), "auth_user is undefined"); $qp->{_auth_user} = 'matt'; cmp_ok('matt', 'eq', $qp->auth_user(), "auth_user set"); $qp->{_auth_user} = undef; } sub __auth_mechanism { ok( ! $qp->auth_mechanism(), "auth_mechanism is undefined"); $qp->{_auth_mechanism} = 'MD5'; cmp_ok('MD5', 'eq', $qp->auth_mechanism(), "auth_mechanism set"); $qp->{_auth_mechanism} = undef; } sub __config_dir { my $dir = $qp->config_dir('logging'); ok($dir, "config_dir, $dir"); $dir = $Qpsmtpd::Config::dir_memo{logging}; ok($dir, "config_dir, $dir (memo)"); } 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 => undef, config => undef, }, expected => { user => 10000, global => 10000, }, descr => 'no user or global config hooks, fall back to config file', }, { pref => 'timeout', hooks => { user_config => undef, config => undef, }, 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 ( grep { $t->{hooks}{$_} } qw( config user_config ) ) { $qp->fake_hook( $hook, sub { return @{ $t->{hooks}{$hook} } } ); } 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}"); } $qp->unfake_hook($_) for qw( config user_config ); } 1; package FakeAddress; sub new { my $class = shift; return bless {@_}, $class; } sub address { } # pass the can('address') conditional 1;