diff --git a/lib/Qpsmtpd.pm b/lib/Qpsmtpd.pm index 1afef1a..08fdbe1 100644 --- a/lib/Qpsmtpd.pm +++ b/lib/Qpsmtpd.pm @@ -6,7 +6,7 @@ our $VERSION = '0.95'; use vars qw($TraceLevel $Spool_dir $Size_threshold); use lib 'lib'; -use base 'Qpsmtpd::Base'; +use parent 'Qpsmtpd::Base'; use Qpsmtpd::Address; use Qpsmtpd::Config; use Qpsmtpd::Constants; @@ -30,7 +30,7 @@ sub _restart { } } -sub version { $VERSION . ($git ? "/$git" : "") } +sub version { $VERSION . ($git ? "/$git" : '') } sub git_version { return if !-e '.git'; @@ -56,35 +56,24 @@ sub hooks { sub load_logging { my $self = shift; - # avoid triggering log activity - return if ($LOGGING_LOADED || $hooks->{'logging'}); + return if $LOGGING_LOADED; # already done + return if $hooks->{'logging'}; # avoid triggering log activity - my $configdir = $self->config_dir("logging"); - my $configfile = "$configdir/logging"; - my @loggers = $self->conf->from_file($configfile, 'logging'); - - $configdir = $self->config_dir('plugin_dirs'); - $configfile = "$configdir/plugin_dirs"; - my @plugin_dirs = $self->conf->from_file($configfile, 'plugin_dirs'); - unless (@plugin_dirs) { + my @plugin_dirs = $self->conf->from_file('plugin_dirs'); + if (!@plugin_dirs) { my ($name) = ($0 =~ m!(.*?)/([^/]+)$!); @plugin_dirs = ("$name/plugins"); } - my @loaded; + my @loggers = $self->conf->from_file('logging'); for my $logger (@loggers) { - push @loaded, $self->_load_plugin($logger, @plugin_dirs); - } - - foreach my $logger (@loaded) { + $self->_load_plugin($logger, @plugin_dirs); $self->log(LOGINFO, "Loaded $logger"); } - $configdir = $self->config_dir("loglevel"); - $configfile = "$configdir/loglevel"; - $TraceLevel = $self->conf->from_file($configfile, 'loglevel'); + $TraceLevel = $self->conf->from_file('loglevel'); - unless (defined($TraceLevel) and $TraceLevel =~ /^\d+$/) { + unless (defined($TraceLevel) && $TraceLevel =~ /^\d+$/) { $TraceLevel = LOGWARN; # Default if no loglevel file found. } @@ -180,8 +169,7 @@ sub load_plugins { } sub _load_plugin { - my $self = shift; - my ($plugin_line, @plugin_dirs) = @_; + my ($self, $plugin_line, @plugin_dirs) = @_; # untaint the config data before passing it to plugins my ($safe_line) = $plugin_line =~ /^([ -~]+)$/ # all ascii printable @@ -204,7 +192,7 @@ sub _load_plugin { (/+) # directory (\d?) # package's first character }[ - "::" . (length $2 ? sprintf("_%2x",unpack("C",$2)) : "") + "::" . (length $2 ? sprintf("_%2x",unpack("C",$2)) : '') ]egx; my $package = "Qpsmtpd::Plugin::$plugin_name"; @@ -269,111 +257,96 @@ sub run_hooks { sub run_hooks_no_respond { my ($self, $hook) = (shift, shift); - if ($hooks->{$hook}) { - my @r; - for my $code ($self->hooks($hook)) { - eval { (@r) = $code->{code}->($self, $self->transaction, @_); }; - if ($@) { - warn("FATAL PLUGIN ERROR [" . $code->{name} . "]: ", $@); - next; - } - last unless $r[0] == DECLINED; + return (0, '') if !$hooks->{$hook}; + + my @r; + for my $code (@{$hooks->{$hook}}) { + eval { @r = $code->{code}->($self, $self->transaction, @_); }; + if ($@) { + warn("FATAL PLUGIN ERROR [" . $code->{name} . "]: ", $@); + next; } - $r[0] = DECLINED if not defined $r[0]; - return @r; + last if $r[0] != DECLINED; } - return (0, ''); + $r[0] = DECLINED if not defined $r[0]; + return @r; } sub run_continuation { my $self = shift; - die "No continuation in progress" unless $self->{_continuation}; + die "No continuation in progress\n" if !$self->{_continuation}; my $todo = $self->{_continuation}; $self->{_continuation} = undef; - my $hook = shift @$todo || die "No hook in the continuation"; - my $args = shift @$todo || die "No hook args in the continuation"; + my $hook = shift @$todo or die "No hook in the continuation"; + my $args = shift @$todo or die "No hook args in the continuation"; my @r; while (@$todo) { my $code = shift @$todo; + my $name = $code->{name}; - $self->varlog(LOGDEBUG, $hook, $code->{name}); + $self->varlog(LOGDEBUG, $hook, $name); my $tran = $self->transaction; - eval { (@r) = $code->{code}->($self, $tran, @$args); }; + eval { @r = $code->{code}->($self, $tran, @$args); }; if ($@) { - $self->log(LOGCRIT, "FATAL PLUGIN ERROR [" . $code->{name} . "]: ", - $@); + $self->log(LOGCRIT, "FATAL PLUGIN ERROR [$name]: ", $@); next; } - !defined $r[0] - and $self->log(LOGERROR, - "plugin " - . $code->{name} - . " running the $hook hook returned undef!" - ) - and next; + my $log_msg = "Plugin $name, hook $hook returned "; + if (!defined $r[0]) { + $self->log(LOGERROR, $log_msg . "undef!"); + next; + } - # note this is wrong as $tran is always true in the - # current code... if ($tran) { - my $tnotes = $tran->notes($code->{name}); - $tnotes->{"hook_$hook"}->{'return'} = $r[0] - if (!defined $tnotes || ref $tnotes eq "HASH"); + my $tnotes = $tran->notes($name); + if (!defined $tnotes || ref $tnotes eq 'HASH') { + $tnotes->{"hook_$hook"}{return} = $r[0]; + }; } else { - my $cnotes = $self->connection->notes($code->{name}); - $cnotes->{"hook_$hook"}->{'return'} = $r[0] - if (!defined $cnotes || ref $cnotes eq "HASH"); + my $cnotes = $self->connection->notes($name); + if (!defined $cnotes || ref $cnotes eq 'HASH') { + $cnotes->{"hook_$hook"}{return} = $r[0]; + }; } if ( $r[0] == DENY - or $r[0] == DENYSOFT - or $r[0] == DENY_DISCONNECT - or $r[0] == DENYSOFT_DISCONNECT) + || $r[0] == DENYSOFT + || $r[0] == DENY_DISCONNECT + || $r[0] == DENYSOFT_DISCONNECT) { - $r[1] = "" if not defined $r[1]; - $self->log(LOGDEBUG, - "Plugin " - . $code->{name} - . ", hook $hook returned " - . return_code($r[0]) - . ", $r[1]" - ); - $self->run_hooks_no_respond("deny", $code->{name}, $r[0], $r[1]) - unless ($hook eq "deny"); + $r[1] = '' if !defined $r[1]; + $self->log(LOGDEBUG, $log_msg . return_code($r[0]) . ", $r[1]"); + if ($hook ne 'deny') { + $self->run_hooks_no_respond('deny', $name, $r[0], $r[1]); + }; } else { - $r[1] = "" if not defined $r[1]; - $self->log(LOGDEBUG, - "Plugin " - . $code->{name} - . ", hook $hook returned " - . return_code($r[0]) - . ", $r[1]" - ); - $self->run_hooks_no_respond("ok", $code->{name}, $r[0], $r[1]) - unless ($hook eq "ok"); + $r[1] = '' if not defined $r[1]; + $self->log(LOGDEBUG, $log_msg . return_code($r[0]) . ", $r[1]"); + $self->run_hooks_no_respond('ok', $name, $r[0], $r[1]) if $hook ne 'ok'; } - last unless $r[0] == DECLINED; + last if $r[0] != DECLINED; } - $r[0] = DECLINED if not defined $r[0]; + $r[0] = DECLINED if ! defined $r[0]; # hook_*_parse() may return a CODE ref.. # ... which breaks when splitting as string: - @r = map { split /\n/ } @r unless (ref($r[1]) eq "CODE"); + if ('CODE' ne ref $r[1]) { + @r = map { split /\n/ } @r; + }; return $self->hook_responder($hook, \@r, $args); } sub hook_responder { my ($self, $hook, $msg, $args) = @_; - my $code = shift @$msg; - my $responder = $hook . '_respond'; - if (my $meth = $self->can($responder)) { + if (my $meth = $self->can($hook . '_respond')) { return $meth->($self, $code, $msg, $args); } return $code, @$msg; @@ -452,17 +425,17 @@ sub size_threshold { sub authenticated { my $self = shift; - return (defined $self->{_auth} ? $self->{_auth} : ""); + return (defined $self->{_auth} ? $self->{_auth} : ''); } sub auth_user { my $self = shift; - return (defined $self->{_auth_user} ? $self->{_auth_user} : ""); + return (defined $self->{_auth_user} ? $self->{_auth_user} : ''); } sub auth_mechanism { my $self = shift; - return (defined $self->{_auth_mechanism} ? $self->{_auth_mechanism} : ""); + return (defined $self->{_auth_mechanism} ? $self->{_auth_mechanism} : ''); } sub address { diff --git a/lib/Qpsmtpd/Config.pm b/lib/Qpsmtpd/Config.pm index d81c1cd..f628351 100644 --- a/lib/Qpsmtpd/Config.pm +++ b/lib/Qpsmtpd/Config.pm @@ -90,38 +90,35 @@ sub default { sub get_qmail { my ($self, $config, $type) = @_; $self->log(LOGDEBUG, "trying to get config for $config"); - my $configdir = $self->config_dir($config); - - my $configfile = "$configdir/$config"; # CDB config support really should be moved to a plugin if ($type and $type eq "map") { - return $self->get_qmail_map($config, $configfile); + return $self->get_qmail_map($config); } - return $self->from_file($configfile, $config); + return $self->from_file($config); } sub get_qmail_map { - my ($self, $config, $configfile) = @_; + my ($self, $config, $file) = @_; - if (!-e $configfile . ".cdb") { - $self->log(LOGDEBUG, "File $configfile.cdb does not exist"); + $file ||= $self->config_dir($config) . "/$config.cdb"; + + if (!-e $file) { + $self->log(LOGDEBUG, "File $file does not exist"); $config_cache{$config} ||= []; return +{}; } eval { require CDB_File }; if ($@) { - $self->log(LOGERROR, -"No CDB Support! Did NOT read $configfile.cdb, could not load CDB_File module: $@" - ); + $self->log(LOGERROR, "No CDB Support! Did NOT read $file, could not load CDB_File: $@"); return +{}; } my %h; - unless (tie(%h, 'CDB_File', "$configfile.cdb")) { - $self->log(LOGERROR, "tie of $configfile.cdb failed: $!"); + unless (tie(%h, 'CDB_File', $file)) { + $self->log(LOGERROR, "tie of $file failed: $!"); return +{}; } @@ -132,17 +129,19 @@ sub get_qmail_map { } sub from_file { - my ($self, $configfile, $config, $visited) = @_; - if (!-e $configfile) { + my ($self, $config, $file, $visited) = @_; + $file ||= $self->config_dir($config) . "/$config"; + + if (!-e $file) { $config_cache{$config} ||= []; return; } $visited ||= []; - push @$visited, $configfile; + push @$visited, $file; - open my $CF, '<', $configfile or do { - warn "$$ could not open configfile $configfile: $!"; + open my $CF, '<', $file or do { + warn "$$ could not open configfile $file: $!"; return; }; my @config = <$CF>; @@ -180,8 +179,8 @@ sub from_file { } push @{$visited}, $inclusion; - for my $inc ($self->expand_inclusion($inclusion, $configfile)) { - my @insertion = $self->from_file($inc, $config, $visited); + for my $inc ($self->expand_inclusion($inclusion, $file)) { + my @insertion = $self->from_file($config, $inc, $visited); splice @config, $pos, 0, @insertion; # insert the inclusion $pos += @insertion; } diff --git a/lib/Qpsmtpd/Plugin.pm b/lib/Qpsmtpd/Plugin.pm index 7a76ccb..6ed6a4d 100644 --- a/lib/Qpsmtpd/Plugin.pm +++ b/lib/Qpsmtpd/Plugin.pm @@ -99,7 +99,7 @@ sub adjust_log_level { sub transaction { - # not sure if this will work in a non-forking or a threaded daemon + # does this work in a non-forking or a threaded daemon? shift->qp->transaction; } @@ -137,7 +137,7 @@ sub temp_dir { # usage: # sub init { # my $self = shift; -# $self->isa_plugin("rhsbl"); +# $self->isa_plugin('rhsbl'); # $self->SUPER::register(@_); # } sub isa_plugin { @@ -164,30 +164,29 @@ sub isa_plugin { $self->compile($self->plugin_name . "_isa_$cleanParent", $newPackage, "$parent_dir/$parent"); warn "---- $newPackage\n"; - no strict 'refs'; + no strict 'refs'; ## no critic (strict) push @{"${currentPackage}::ISA"}, $newPackage; } -# why isn't compile private? it's only called from Plugin and Qpsmtpd. sub compile { my ($class, $plugin, $package, $file, $test_mode, $orig_name) = @_; my $sub; - open F, $file or die "could not open $file: $!"; + open my $F, '<', $file or die "could not open $file: $!"; { local $/ = undef; - $sub = ; + $sub = <$F>; } - close F; + close $F; my $line = "\n#line 0 $file\n"; if ($test_mode) { - if (open(F, "t/plugin_tests/$orig_name")) { + if (open(my $F, '<', "t/plugin_tests/$orig_name")) { local $/ = undef; $sub .= "#line 1 t/plugin_tests/$orig_name\n"; - $sub .= ; - close F; + $sub .= <$F>; + close $F; } } @@ -206,12 +205,10 @@ sub compile { "\n", # last line comment without newline? ); - #warn "eval: $eval"; - $eval =~ m/(.*)/s; $eval = $1; - eval $eval; + eval $eval; ## no critic (Eval) die "eval $@" if $@; } @@ -355,8 +352,8 @@ sub _register_standard_hooks { for my $hook (@hooks) { my $hooksub = "hook_$hook"; $hooksub =~ s/\W/_/g; + next if !$plugin->can($hooksub); $plugin->register_hook($hook, $hooksub) - if ($plugin->can($hooksub)); } } diff --git a/t/qpsmtpd-config.t b/t/qpsmtpd-config.t index b580251..cfb462e 100644 --- a/t/qpsmtpd-config.t +++ b/t/qpsmtpd-config.t @@ -94,7 +94,7 @@ sub __get_qmail { sub __get_qmail_map { eval "require CDB_File"; ## no critic (StringyEval) if (!$@) { - my $r = $config->get_qmail_map('users', 't/config/users'); + my $r = $config->get_qmail_map('users', 't/config/users.cdb'); ok(keys %$r, 'get_qmail_map("users.cdb")'); ok($r->{'!example.com-'}, "get_qmail_map, known entry"); }; @@ -102,7 +102,7 @@ sub __get_qmail_map { sub __from_file { my $test_file = 't/config/test_config_file'; - my @r = $config->from_file($test_file, 'test_config_file'); + my @r = $config->from_file('test_config_file', $test_file); ok( @r, "from_file, $test_file"); cmp_ok('1st line with content', 'eq', $r[0], "from_file string compare"); ok( !$r[1], "from_file"); diff --git a/t/qpsmtpd.t b/t/qpsmtpd.t index b18a6a5..56448cb 100644 --- a/t/qpsmtpd.t +++ b/t/qpsmtpd.t @@ -24,6 +24,13 @@ __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(); @@ -40,6 +47,33 @@ __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; @@ -47,7 +81,6 @@ sub __hooks { $r = $qp->hooks('connect'); ok(@$r, "hooks, populated, connect"); - #warn Data::Dumper::Dumper($r); my @r = $qp->hooks('connect'); ok(@r, "hooks, populated, connect, wants array"); @@ -61,6 +94,43 @@ sub __hooks_none { is_deeply($r, [], 'hooks, empty, specified'); } +sub __run_continuation { + my $r; + eval { $smtpd->run_continuation }; + ok($@, "run_continuation w/o continuation: " . $@); + + my @local_hooks = @{$Qpsmtpd::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]); +} + +sub __hook_responder { + my ($code, $msg) = $qp->hook_responder('test-hook', ['test code','test mesg']); + is($code, 'test code', "hook_responder, code"); + is($msg, 'test mesg', "hook_responder, test msg"); + + ($code, $msg) = $smtpd->hook_responder('connect', ['test code','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 { @@ -172,7 +242,6 @@ 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)"); }