From b22d037c393be81d1208a74872874010ecf1119e Mon Sep 17 00:00:00 2001 From: Jared Johnson Date: Tue, 9 Sep 2014 18:08:09 -0500 Subject: [PATCH 01/19] Add hook_user_config This adds a hook_user_config for plugins designed to return per-user configuration directives. Qpsmtpd::Address::config() triggers a hook_user_config plugin. --- docs/hooks.pod | 29 +++++++++++++++++++++++++++++ lib/Qpsmtpd.pm | 7 +++++-- lib/Qpsmtpd/Address.pm | 13 +++++++++++++ lib/Qpsmtpd/Plugin.pm | 2 +- lib/Qpsmtpd/SMTP.pm | 2 ++ 5 files changed, 50 insertions(+), 3 deletions(-) diff --git a/docs/hooks.pod b/docs/hooks.pod index 3dd7b5a..3c7b6f6 100644 --- a/docs/hooks.pod +++ b/docs/hooks.pod @@ -732,6 +732,35 @@ is called. It's probably best not to try acessing it. Example plugin is F from the qpsmtpd distribution. +=head2 hook_user_config + +Called when a per-user configuration directive is requested, for example +if someone calls Cconfig($cfg_name);>. +Allowed return codes are + +=over 4 + +=item DECLINED + +plugin didn't find the requested value + +=item OK + +requested values as C<@list>, example: + + return (OK, @{$config{$value}}) + if exists $config{$value}; + return (DECLINED); + +=back + +Arguments: + + my ($self,$transaction,$user,$value) = @_; + # $value: the requested config item(s) + +Example plugin is F from the qpsmtpd distribution. + =head2 hook_unrecognized_command This is called if the client sent a command unknown to the core of qpsmtpd. diff --git a/lib/Qpsmtpd.pm b/lib/Qpsmtpd.pm index 9ef1056..2e8c675 100644 --- a/lib/Qpsmtpd.pm +++ b/lib/Qpsmtpd.pm @@ -148,14 +148,17 @@ sub config { # first try the cache # XXX - is this always the right thing to do? what if a config hook # can return different values on subsequent calls? - if ($_config_cache->{$c}) { + my $is_address = (ref $type and $type->can('address')); + if ($_config_cache->{$c} and ! $is_address) { $self->log(LOGDEBUG, "config($c) returning (@{$_config_cache->{$c}}) from cache"); return wantarray ? @{$_config_cache->{$c}} : $_config_cache->{$c}->[0]; } # then run the hooks - my ($rc, @config) = $self->run_hooks_no_respond("config", $c); + my @args = $is_address ? ('user_config',$type,$c) : ('config',$c); + my ($rc, @config) = $self->run_hooks_no_respond(@args); + return wantarray ? @config : $config[0] if $is_address; $self->log(LOGDEBUG, "config($c): hook returned ($rc, @config) "); if ($rc == OK) { $self->log(LOGDEBUG, diff --git a/lib/Qpsmtpd/Address.pm b/lib/Qpsmtpd/Address.pm index a0f6b50..5e25813 100644 --- a/lib/Qpsmtpd/Address.pm +++ b/lib/Qpsmtpd/Address.pm @@ -338,6 +338,19 @@ sub notes { return $self->{_notes}->{$key} = shift; } +=head2 config($value) + +Looks up a configuration directive based on this recipient, using any plugins that utilize +hook_rcpt_config + +=cut + +sub config { + my ($self,$key) = @_; + my $qp = $self->notes('qp_obj') or return; + return $qp->config($key,$self); +} + sub _addr_cmp { require UNIVERSAL; my ($left, $right, $swap) = @_; diff --git a/lib/Qpsmtpd/Plugin.pm b/lib/Qpsmtpd/Plugin.pm index 5dde02c..7f1cc80 100644 --- a/lib/Qpsmtpd/Plugin.pm +++ b/lib/Qpsmtpd/Plugin.pm @@ -9,7 +9,7 @@ use Qpsmtpd::Constants; # more or less in the order they will fire our @hooks = qw( - logging config post-fork pre-connection connect ehlo_parse ehlo + logging config user_config post-fork pre-connection connect ehlo_parse ehlo helo_parse helo auth_parse auth auth-plain auth-login auth-cram-md5 rcpt_parse rcpt_pre rcpt mail_parse mail mail_pre data data_headers_end data_post queue_pre queue queue_post vrfy noop diff --git a/lib/Qpsmtpd/SMTP.pm b/lib/Qpsmtpd/SMTP.pm index c6db8a5..a53abec 100644 --- a/lib/Qpsmtpd/SMTP.pm +++ b/lib/Qpsmtpd/SMTP.pm @@ -396,6 +396,7 @@ sub mail_pre_respond { } return $self->respond(501, "could not parse your mail from command") unless $from; + $from->notes('qp_obj',$self); $self->run_hooks("mail", $from, %$param); } @@ -485,6 +486,7 @@ sub rcpt_pre_respond { return $self->respond(501, "could not parse recipient") if (!$rcpt or ($rcpt->format eq '<>')); + $rcpt->notes('qp_obj',$self); $self->run_hooks("rcpt", $rcpt, %$param); } From 3379248c45793613121f0c203975ca3ede966aba Mon Sep 17 00:00:00 2001 From: Jared Johnson Date: Tue, 9 Sep 2014 18:09:31 -0500 Subject: [PATCH 02/19] Add user_config example plugin Add a plugin to read qpsmptd-style configuration files from users' home directories. Little to no testing yet. --- plugins/user_config | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) create mode 100644 plugins/user_config diff --git a/plugins/user_config b/plugins/user_config new file mode 100644 index 0000000..aa7e259 --- /dev/null +++ b/plugins/user_config @@ -0,0 +1,17 @@ +#!/perl (Editor hint) +use strict; +use warnings; + +sub hook_user_config { + my ($self,$txn,$user,$conf) = @_; + my $username = $user->host or return DECLINED; + my $filename = "/home/$username/.qpsmtpd/$conf"; + return DECLINED unless -f $filename; + my $fh; + unless (open $fh,$filename) { + $self->log(LOGNOTICE,"Couldn't open $filename:$!"); + return DECLINED; + } + map {chomp} (my @return = (<$fh>)); + return OK,@return; +} From 8d032d8b50e69fd0e90197c4dd53404c580bb8b3 Mon Sep 17 00:00:00 2001 From: Jared Johnson Date: Thu, 11 Sep 2014 10:13:32 -0500 Subject: [PATCH 03/19] Follow upstream convention in shebang Our fork uses '#!/perl (Editor hint)' but upstream normally uses '#!perl'. Conforming to upstream. FWIW, the Kate editor recognizes the former as perl for the purpose of syntax highlighting but does not recognize the latter. But the one guy I know who uses Kate didn't take the opportunity to object :) --- plugins/user_config | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/user_config b/plugins/user_config index aa7e259..092d01d 100644 --- a/plugins/user_config +++ b/plugins/user_config @@ -1,4 +1,4 @@ -#!/perl (Editor hint) +#!perl use strict; use warnings; From eb482aad0a8b1fd63bc0632cde5428dcc9a8d919 Mon Sep 17 00:00:00 2001 From: Jared Johnson Date: Fri, 12 Sep 2014 02:42:08 -0500 Subject: [PATCH 04/19] Tests for Qpsmtpd::Address::config() Tests for the new Qpsmtpd::Address::config() which should call hook_user_config plugins --- t/qpsmtpd-address.t | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/t/qpsmtpd-address.t b/t/qpsmtpd-address.t index 56c9ecf..7f0f0e1 100644 --- a/t/qpsmtpd-address.t +++ b/t/qpsmtpd-address.t @@ -6,8 +6,24 @@ use Test::More; use lib 'lib'; -BEGIN { - use_ok('Qpsmtpd::Address'); +BEGIN { use_ok('Qpsmtpd::Constants'); } +use_ok('Qpsmtpd::Address'); +use lib 't'; +use_ok('Test::Qpsmtpd'); + +__config(); + +sub __config { + ok( my ($qp,$cxn) = Test::Qpsmtpd->new_conn(), "get new connection" ); + ok( $qp->command('HELO test') ); + ok( $qp->command('MAIL FROM:') ); + my $sender = $qp->transaction->sender; + $qp->hooks->{user_config} = []; + is( $sender->config('test config'), undef, 'no user_config plugins exist' ); + $qp->hooks->{user_config} = [{ name => 'test hook', code => sub { return DECLINED } }]; + is( $sender->config('test config'), undef, 'no user_config plugins return OK' ); + $qp->hooks->{user_config} = [{ name => 'test hook', code => sub { return OK, 'test data' } }]; + is( $sender->config('test config'), 'test data', 'user_config plugins return a value' ); } __new(); From 50cc469881230c76b43ab21d9580a9b1999b122b Mon Sep 17 00:00:00 2001 From: Jared Johnson Date: Fri, 12 Sep 2014 03:16:45 -0500 Subject: [PATCH 05/19] Add docs and flexible path to user_config plugin I needed to make the path modifyable for testing anyway, might as well make it actually usable. Not yet tested. --- plugins/user_config | 37 +++++++++++++++++++++++++++++++++++-- 1 file changed, 35 insertions(+), 2 deletions(-) diff --git a/plugins/user_config b/plugins/user_config index 092d01d..2ce405b 100644 --- a/plugins/user_config +++ b/plugins/user_config @@ -2,10 +2,43 @@ use strict; use warnings; +=head1 NAME + +user_config - basic plugin for storing per-user configuration directives + +=head1 SYNOPSIS + +# in config/plugins + +user_config [B] + +=over 4 + +=item B + +Pattern to use when searching for user config directory +Substitute %u for username, %h for host, or %a for full addressn. +Default: I + +=head1 DESCRIPTION + +This plugin implements very basic support for storing user configuration +in separate directories similar to the global qpsmtpd config directory. + +=cut + +sub init { + my ( $self, $qp, $pattern ) = @_; + $self->{pattern} = $pattern || '/home/%u/.qpsmtpd'; +} + sub hook_user_config { my ($self,$txn,$user,$conf) = @_; - my $username = $user->host or return DECLINED; - my $filename = "/home/$username/.qpsmtpd/$conf"; + my $path = $self->{pattern} or return DECLINED; + $path =~ s/%u/$user->user/g; + $path =~ s/%h/$user->host/g; + $path =~ s/%a/$user->address/g; + my $filename = "$path/$conf"; return DECLINED unless -f $filename; my $fh; unless (open $fh,$filename) { From 5b8138971a1b8ba628078b85821e9683c6b77c2e Mon Sep 17 00:00:00 2001 From: Jared Johnson Date: Fri, 12 Sep 2014 05:13:49 -0500 Subject: [PATCH 06/19] Don't use config cache for hook_config plugins Conflig plugins can do their own caching: there's no telling what might change their return values over the life of the config cache. --- lib/Qpsmtpd.pm | 28 +++------------------------- 1 file changed, 3 insertions(+), 25 deletions(-) diff --git a/lib/Qpsmtpd.pm b/lib/Qpsmtpd.pm index 2e8c675..2a46346 100644 --- a/lib/Qpsmtpd.pm +++ b/lib/Qpsmtpd.pm @@ -145,46 +145,24 @@ sub config { $self->log(LOGDEBUG, "in config($c)"); - # first try the cache - # XXX - is this always the right thing to do? what if a config hook - # can return different values on subsequent calls? my $is_address = (ref $type and $type->can('address')); - if ($_config_cache->{$c} and ! $is_address) { - $self->log(LOGDEBUG, - "config($c) returning (@{$_config_cache->{$c}}) from cache"); - return wantarray ? @{$_config_cache->{$c}} : $_config_cache->{$c}->[0]; - } - - # then run the hooks my @args = $is_address ? ('user_config',$type,$c) : ('config',$c); my ($rc, @config) = $self->run_hooks_no_respond(@args); return wantarray ? @config : $config[0] if $is_address; $self->log(LOGDEBUG, "config($c): hook returned ($rc, @config) "); if ($rc == OK) { - $self->log(LOGDEBUG, -"setting _config_cache for $c to [@config] from hooks and returning it" - ); - $_config_cache->{$c} = \@config; - return wantarray ? @{$_config_cache->{$c}} : $_config_cache->{$c}->[0]; + return wantarray ? @config : $config[0]; } # and then get_qmail_config @config = $self->get_qmail_config($c, $type); if (@config) { - $self->log(LOGDEBUG, -"setting _config_cache for $c to [@config] from get_qmail_config and returning it" - ); - $_config_cache->{$c} = \@config; - return wantarray ? @{$_config_cache->{$c}} : $_config_cache->{$c}->[0]; + return wantarray ? @config : $config[0]; } # finally we use the default if there is any: if (exists($defaults{$c})) { - $self->log(LOGDEBUG, -"setting _config_cache for $c to @{[$defaults{$c}]} from defaults and returning it" - ); - $_config_cache->{$c} = [$defaults{$c}]; - return wantarray ? @{$_config_cache->{$c}} : $_config_cache->{$c}->[0]; + return wantarray ? @config : $config[0]; } return; } From 18bfc45d0b6cd544352b42e1c21d957fa2aa3ce0 Mon Sep 17 00:00:00 2001 From: Jared Johnson Date: Fri, 12 Sep 2014 12:53:26 -0500 Subject: [PATCH 07/19] Fall back correctly between config methods hook_user_config no falls back to global hook_config followed by file-based config followed by %defaults --- lib/Qpsmtpd.pm | 26 +++++++++++++------------- t/qpsmtpd-address.t | 3 ++- 2 files changed, 15 insertions(+), 14 deletions(-) diff --git a/lib/Qpsmtpd.pm b/lib/Qpsmtpd.pm index 2a46346..4c19ae8 100644 --- a/lib/Qpsmtpd.pm +++ b/lib/Qpsmtpd.pm @@ -145,25 +145,25 @@ sub config { $self->log(LOGDEBUG, "in config($c)"); - my $is_address = (ref $type and $type->can('address')); - my @args = $is_address ? ('user_config',$type,$c) : ('config',$c); - my ($rc, @config) = $self->run_hooks_no_respond(@args); - return wantarray ? @config : $config[0] if $is_address; + # first run the hooks + my ($rc, @config); + ($rc, @config) = $self->run_hooks_no_respond('user_config',$type,$c) + if ref $type and $type->can('address'); + return wantarray ? @config : $config[0] + if defined $rc and $rc == OK; + ($rc, @config) = $self->run_hooks_no_respond('config',$c); $self->log(LOGDEBUG, "config($c): hook returned ($rc, @config) "); - if ($rc == OK) { - return wantarray ? @config : $config[0]; - } + return wantarray ? @config : $config[0] + if defined $rc and $rc == OK; # and then get_qmail_config @config = $self->get_qmail_config($c, $type); - if (@config) { - return wantarray ? @config : $config[0]; - } + return wantarray ? @config : $config[0] + if @config; # finally we use the default if there is any: - if (exists($defaults{$c})) { - return wantarray ? @config : $config[0]; - } + return wantarray ? ($defaults{$c}) : $defaults{$c} + if exists $defaults{$c}; return; } diff --git a/t/qpsmtpd-address.t b/t/qpsmtpd-address.t index 7f0f0e1..6344cf3 100644 --- a/t/qpsmtpd-address.t +++ b/t/qpsmtpd-address.t @@ -18,7 +18,8 @@ sub __config { ok( $qp->command('HELO test') ); ok( $qp->command('MAIL FROM:') ); my $sender = $qp->transaction->sender; - $qp->hooks->{user_config} = []; + $qp->hooks->{user_config} = undef; + is( $qp->config('size_threshold'), 10000, 'use global config when user_config is absent' ); is( $sender->config('test config'), undef, 'no user_config plugins exist' ); $qp->hooks->{user_config} = [{ name => 'test hook', code => sub { return DECLINED } }]; is( $sender->config('test config'), undef, 'no user_config plugins return OK' ); From 41a71f5d79836ea45cfd3db54b5461e5bad21d40 Mon Sep 17 00:00:00 2001 From: Jared Johnson Date: Fri, 12 Sep 2014 13:09:20 -0500 Subject: [PATCH 08/19] Move test sub definition to the bottom --- t/qpsmtpd-address.t | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/t/qpsmtpd-address.t b/t/qpsmtpd-address.t index 6344cf3..d971204 100644 --- a/t/qpsmtpd-address.t +++ b/t/qpsmtpd-address.t @@ -13,20 +13,6 @@ use_ok('Test::Qpsmtpd'); __config(); -sub __config { - ok( my ($qp,$cxn) = Test::Qpsmtpd->new_conn(), "get new connection" ); - ok( $qp->command('HELO test') ); - ok( $qp->command('MAIL FROM:') ); - my $sender = $qp->transaction->sender; - $qp->hooks->{user_config} = undef; - is( $qp->config('size_threshold'), 10000, 'use global config when user_config is absent' ); - is( $sender->config('test config'), undef, 'no user_config plugins exist' ); - $qp->hooks->{user_config} = [{ name => 'test hook', code => sub { return DECLINED } }]; - is( $sender->config('test config'), undef, 'no user_config plugins return OK' ); - $qp->hooks->{user_config} = [{ name => 'test hook', code => sub { return OK, 'test data' } }]; - is( $sender->config('test config'), 'test data', 'user_config plugins return a value' ); -} - __new(); __parse(); @@ -135,3 +121,17 @@ sub __parse { is($ao && $ao->address, $as, "address $as"); ok($ao eq $as, "overloaded 'cmp' operator"); }; + +sub __config { + ok( my ($qp,$cxn) = Test::Qpsmtpd->new_conn(), "get new connection" ); + ok( $qp->command('HELO test') ); + ok( $qp->command('MAIL FROM:') ); + my $sender = $qp->transaction->sender; + $qp->hooks->{user_config} = undef; + is( $qp->config('size_threshold'), 10000, 'use global config when user_config is absent' ); + is( $sender->config('test config'), undef, 'no user_config plugins exist' ); + $qp->hooks->{user_config} = [{ name => 'test hook', code => sub { return DECLINED } }]; + is( $sender->config('test config'), undef, 'no user_config plugins return OK' ); + $qp->hooks->{user_config} = [{ name => 'test hook', code => sub { return OK, 'test data' } }]; + is( $sender->config('test config'), 'test data', 'user_config plugins return a value' ); +} From fb8f5820559977668c68af800a3c31a56e71ce19 Mon Sep 17 00:00:00 2001 From: Jared Johnson Date: Sat, 13 Sep 2014 22:04:07 -0500 Subject: [PATCH 09/19] Use a loop to make test data clearer --- t/qpsmtpd-address.t | 45 ++++++++++++++++++++++++++++++++++++++------- 1 file changed, 38 insertions(+), 7 deletions(-) diff --git a/t/qpsmtpd-address.t b/t/qpsmtpd-address.t index d971204..97804c8 100644 --- a/t/qpsmtpd-address.t +++ b/t/qpsmtpd-address.t @@ -127,11 +127,42 @@ sub __config { ok( $qp->command('HELO test') ); ok( $qp->command('MAIL FROM:') ); my $sender = $qp->transaction->sender; - $qp->hooks->{user_config} = undef; - is( $qp->config('size_threshold'), 10000, 'use global config when user_config is absent' ); - is( $sender->config('test config'), undef, 'no user_config plugins exist' ); - $qp->hooks->{user_config} = [{ name => 'test hook', code => sub { return DECLINED } }]; - is( $sender->config('test config'), undef, 'no user_config plugins return OK' ); - $qp->hooks->{user_config} = [{ name => 'test hook', code => sub { return OK, 'test data' } }]; - is( $sender->config('test config'), 'test data', 'user_config plugins return a value' ); + my @test_data = ( + { + pref => 'size_threshold', + result => [], + expected => 10000, + descr => 'fall back to global config when user_config is absent', + }, + { + pref => 'test_config', + result => [], + expected => undef, + descr => 'return nothing when no user_config plugins exist', + }, + { + pref => 'test_config', + result => [DECLINED], + expected => undef, + descr => 'return nothing when user_config plugins return DECLINED', + }, + { + pref => 'test_config', + result => [OK,'test value'], + expected => 'test value', + descr => 'return results when user_config plugin returns a value', + }, + ); + for (@test_data) { + $qp->hooks->{user_config} + = @{ $_->{result} } + ? [{ name => 'test hook', code => sub { return @{ $_->{result} }} }] + : undef; + is( $sender->config($_->{pref}), $_->{expected}, $_->{descr} ); + } +} + +sub fake_hook { + my ( $r ) = @_; + return @$r ? [{ name => 'test hook', code => sub { return @{ $_->{result} }} }] : undef; } From cda40f970be8f9aba87831ff68b475de31f959d0 Mon Sep 17 00:00:00 2001 From: Jared Johnson Date: Sat, 13 Sep 2014 22:34:52 -0500 Subject: [PATCH 10/19] Remove an unintentionally commited subroutine --- t/qpsmtpd-address.t | 5 ----- 1 file changed, 5 deletions(-) diff --git a/t/qpsmtpd-address.t b/t/qpsmtpd-address.t index 97804c8..5d53aeb 100644 --- a/t/qpsmtpd-address.t +++ b/t/qpsmtpd-address.t @@ -161,8 +161,3 @@ sub __config { is( $sender->config($_->{pref}), $_->{expected}, $_->{descr} ); } } - -sub fake_hook { - my ( $r ) = @_; - return @$r ? [{ name => 'test hook', code => sub { return @{ $_->{result} }} }] : undef; -} From 23ce6002cf0008d250539b45a8d604f1431b6085 Mon Sep 17 00:00:00 2001 From: Jared Johnson Date: Mon, 15 Sep 2014 09:24:13 -0500 Subject: [PATCH 11/19] Qpsmtpd::config() tests --- t/qpsmtpd.t | 114 ++++++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 107 insertions(+), 7 deletions(-) diff --git a/t/qpsmtpd.t b/t/qpsmtpd.t index f02ce6c..ed854e3 100644 --- a/t/qpsmtpd.t +++ b/t/qpsmtpd.t @@ -6,8 +6,13 @@ use Data::Dumper; use Test::More; use lib 'lib'; # test lib/Qpsmtpd (vs site_perl) -BEGIN { use_ok('Qpsmtpd'); } -BEGIN { use_ok('Qpsmtpd::Constants'); } +BEGIN { + use_ok('Qpsmtpd'); + use_ok('Qpsmtpd::Constants'); +} + +use lib 't'; +use_ok('Test::Qpsmtpd'); my $qp = bless {}, 'Qpsmtpd'; @@ -23,11 +28,6 @@ __load_logging(); done_testing(); -sub __config { - my @r = $qp->config('badhelo'); - ok( $r[0], "config, badhelo, @r"); -}; - sub __get_qmail_config { ok( !$qp->get_qmail_config('me'), "get_qmail_config, me"); @@ -83,3 +83,103 @@ sub __authenticated { $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 From de742dc95e6a69bd45de44dbc428db4181a01ea1 Mon Sep 17 00:00:00 2001 From: Jared Johnson Date: Mon, 15 Sep 2014 10:40:06 -0500 Subject: [PATCH 12/19] Add tests for user_config plugin --- t/plugin_tests/user_config | 50 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 50 insertions(+) create mode 100644 t/plugin_tests/user_config diff --git a/t/plugin_tests/user_config b/t/plugin_tests/user_config new file mode 100644 index 0000000..48d2547 --- /dev/null +++ b/t/plugin_tests/user_config @@ -0,0 +1,50 @@ +#!perl -w + +use strict; +use warnings; +use File::Path; +use Qpsmtpd::Constants; + +BEGIN { # need this to happen before anything else + my $cwd = `pwd`; + chomp($cwd); + open my $spooldir, '>', "./config.sample/spool_dir"; + print $spooldir "$cwd/t/tmp"; + close $spooldir; +} + +sub register_tests { + my ($self) = @_; + $self->register_test('test_hook_user_config', 1); +} + +sub test_hook_user_config { + my ( $self ) = @_; + my $dirname = $self->qp->temp_dir; + $self->{pattern} = $dirname . '/%u_%h_%a'; + $dirname .= '/testuser_testhost_testaddress'; + -d $dirname + or mkdir($dirname, 0700) + or die "Could not create $dirname: $!"; + open my $fh, '>', "$dirname/testfield"; + print $fh "testdata"; + close $fh; + my $a = FakeAddress->new( user => 'testuser', host => 'testhost', address => 'testaddress' ); + my ( $r, $value ) = $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); +} + +package FakeAddress; + +sub new { + shift; + return bless {@_}; +} +sub address { return shift->{address} } +sub user { return shift->{user} } +sub host { return shift->{host} } From 4b7af20f49204102187437abfeb4b1916ee2397b Mon Sep 17 00:00:00 2001 From: Jared Johnson Date: Mon, 15 Sep 2014 10:40:46 -0500 Subject: [PATCH 13/19] Fix pattern substitution in user_config plugin --- plugins/user_config | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/plugins/user_config b/plugins/user_config index 2ce405b..1315265 100644 --- a/plugins/user_config +++ b/plugins/user_config @@ -33,11 +33,12 @@ sub init { } sub hook_user_config { - my ($self,$txn,$user,$conf) = @_; + my ($self,$txn,$addr,$conf) = @_; my $path = $self->{pattern} or return DECLINED; - $path =~ s/%u/$user->user/g; - $path =~ s/%h/$user->host/g; - $path =~ s/%a/$user->address/g; + my ( $user, $host, $address ) = ( $addr->user, $addr->host, $addr->address ); + $path =~ s/%u/$user/g; + $path =~ s/%h/$host/g; + $path =~ s/%a/$address/g; my $filename = "$path/$conf"; return DECLINED unless -f $filename; my $fh; From f05254315402cdc1fd0dfe60f435fd9d6261c35a Mon Sep 17 00:00:00 2001 From: Jared Johnson Date: Mon, 15 Sep 2014 10:51:39 -0500 Subject: [PATCH 14/19] Correct number of user_config tests --- t/plugin_tests/user_config | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/t/plugin_tests/user_config b/t/plugin_tests/user_config index 48d2547..0a0af7a 100644 --- a/t/plugin_tests/user_config +++ b/t/plugin_tests/user_config @@ -15,7 +15,7 @@ BEGIN { # need this to happen before anything else sub register_tests { my ($self) = @_; - $self->register_test('test_hook_user_config', 1); + $self->register_test('test_hook_user_config', 4); } sub test_hook_user_config { From 2caa191334bddf85840588e6f19ee9ee659a6356 Mon Sep 17 00:00:00 2001 From: Jared Johnson Date: Mon, 15 Sep 2014 11:03:52 -0500 Subject: [PATCH 15/19] Avoid warnings on undef hook_config returns values --- lib/Qpsmtpd.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lib/Qpsmtpd.pm b/lib/Qpsmtpd.pm index 4c19ae8..00f9450 100644 --- a/lib/Qpsmtpd.pm +++ b/lib/Qpsmtpd.pm @@ -152,7 +152,8 @@ sub config { return wantarray ? @config : $config[0] if defined $rc and $rc == OK; ($rc, @config) = $self->run_hooks_no_respond('config',$c); - $self->log(LOGDEBUG, "config($c): hook returned ($rc, @config) "); + $self->log(LOGDEBUG, "config($c): hook returned (" + . join( ',', map { defined $_ ? $_ : 'undef' } ($rc,@config) ) . ")"); return wantarray ? @config : $config[0] if defined $rc and $rc == OK; From 6ed109914cfd6e0fb5e9add0bbce7d4ac3ab3e64 Mon Sep 17 00:00:00 2001 From: Jonathan Hall Date: Mon, 15 Sep 2014 12:51:08 -0500 Subject: [PATCH 16/19] POD updates, corrections, and clarifications. --- docs/hooks.pod | 20 ++++++++++---------- lib/Qpsmtpd/Address.pm | 2 +- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/docs/hooks.pod b/docs/hooks.pod index 3c7b6f6..36ec59c 100644 --- a/docs/hooks.pod +++ b/docs/hooks.pod @@ -712,20 +712,20 @@ Allowed return codes are plugin didn't find the requested value -=item OK +=item OK, @values requested values as C<@list>, example: - return (OK, @{$config{$value}}) - if exists $config{$value}; + return (OK, @{$config{$key}}) + if exists $config{$key}; return (DECLINED); =back Arguments: - my ($self,$transaction,$value) = @_; - # $value: the requested config item(s) + my ($self,$transaction,$key) = @_; + # $key: the requested config item(s) B C<$transaction> may be C, depending when / where this hook is called. It's probably best not to try acessing it. @@ -744,20 +744,20 @@ Allowed return codes are plugin didn't find the requested value -=item OK +=item OK, @values requested values as C<@list>, example: - return (OK, @{$config{$value}}) - if exists $config{$value}; + return (OK, @{$config{$key}}) + if exists $config{$key}; return (DECLINED); =back Arguments: - my ($self,$transaction,$user,$value) = @_; - # $value: the requested config item(s) + my ($self,$transaction,$user,$key) = @_; + # $key: the requested config item(s) Example plugin is F from the qpsmtpd distribution. diff --git a/lib/Qpsmtpd/Address.pm b/lib/Qpsmtpd/Address.pm index 5e25813..50aa6e2 100644 --- a/lib/Qpsmtpd/Address.pm +++ b/lib/Qpsmtpd/Address.pm @@ -341,7 +341,7 @@ sub notes { =head2 config($value) Looks up a configuration directive based on this recipient, using any plugins that utilize -hook_rcpt_config +hook_user_config =cut From 1253e73a4d0e76ff7dacf2c2f377a8928b67b142 Mon Sep 17 00:00:00 2001 From: Jonathan Hall Date: Mon, 15 Sep 2014 13:31:03 -0500 Subject: [PATCH 17/19] Another minor POD update. --- docs/hooks.pod | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/docs/hooks.pod b/docs/hooks.pod index 36ec59c..37e3625 100644 --- a/docs/hooks.pod +++ b/docs/hooks.pod @@ -724,8 +724,8 @@ requested values as C<@list>, example: Arguments: - my ($self,$transaction,$key) = @_; - # $key: the requested config item(s) + my ($self,$transaction,@keys) = @_; + # @keys: the requested config item(s) B C<$transaction> may be C, depending when / where this hook is called. It's probably best not to try acessing it. @@ -756,8 +756,8 @@ requested values as C<@list>, example: Arguments: - my ($self,$transaction,$user,$key) = @_; - # $key: the requested config item(s) + my ($self,$transaction,$user,@keys) = @_; + # @keys: the requested config item(s) Example plugin is F from the qpsmtpd distribution. From e9c56dc2689999ec593884326c72f20a9a6075a6 Mon Sep 17 00:00:00 2001 From: Jared Johnson Date: Mon, 15 Sep 2014 15:14:32 -0500 Subject: [PATCH 18/19] Avoid passing Qpsmtpd object refs around Use an instantiator in Qpsmtpd.pm for creating Qpsmtpd::Address objects instead --- lib/Qpsmtpd.pm | 7 +++++++ lib/Qpsmtpd/Address.pm | 7 ++++++- lib/Qpsmtpd/SMTP.pm | 9 +++------ 3 files changed, 16 insertions(+), 7 deletions(-) diff --git a/lib/Qpsmtpd.pm b/lib/Qpsmtpd.pm index 00f9450..f73bac4 100644 --- a/lib/Qpsmtpd.pm +++ b/lib/Qpsmtpd.pm @@ -648,6 +648,13 @@ sub auth_mechanism { return (defined $self->{_auth_mechanism} ? $self->{_auth_mechanism} : ""); } +sub address { + my $self = shift; + my $addr = Qpsmtpd::Address->new(@_); + $addr->{qp} = $self; + return $addr; +} + 1; __END__ diff --git a/lib/Qpsmtpd/Address.pm b/lib/Qpsmtpd/Address.pm index 50aa6e2..fc0c810 100644 --- a/lib/Qpsmtpd/Address.pm +++ b/lib/Qpsmtpd/Address.pm @@ -345,9 +345,14 @@ hook_user_config =cut +sub qp { + my ($self) = @_; + return $self->{qp}; +} + sub config { my ($self,$key) = @_; - my $qp = $self->notes('qp_obj') or return; + my $qp = $self->qp or return; return $qp->config($key,$self); } diff --git a/lib/Qpsmtpd/SMTP.pm b/lib/Qpsmtpd/SMTP.pm index a53abec..1582e82 100644 --- a/lib/Qpsmtpd/SMTP.pm +++ b/lib/Qpsmtpd/SMTP.pm @@ -15,7 +15,6 @@ use Qpsmtpd::Transaction; use Qpsmtpd::Plugin; use Qpsmtpd::Constants; use Qpsmtpd::Auth; -use Qpsmtpd::Address (); use Qpsmtpd::Command; my %auth_mechanisms = (); @@ -389,14 +388,13 @@ sub mail_pre_respond { unless $from =~ /^<.*>$/; if ($from eq "<>" or $from =~ m/\[undefined\]/ or $from eq "<#@[]>") { - $from = Qpsmtpd::Address->new("<>"); + $from = $self->address("<>"); } else { - $from = (Qpsmtpd::Address->parse($from))[0]; + $from = $self->address($from); } return $self->respond(501, "could not parse your mail from command") unless $from; - $from->notes('qp_obj',$self); $self->run_hooks("mail", $from, %$param); } @@ -481,12 +479,11 @@ sub rcpt_pre_respond { return $self->respond(501, "could not parse recipient") unless $rcpt =~ /^<.*>$/; - $rcpt = (Qpsmtpd::Address->parse($rcpt))[0]; + $rcpt = $self->address($rcpt); return $self->respond(501, "could not parse recipient") if (!$rcpt or ($rcpt->format eq '<>')); - $rcpt->notes('qp_obj',$self); $self->run_hooks("rcpt", $rcpt, %$param); } From c6da8610dc61306b797f4d831975bf1c6fb7c04d Mon Sep 17 00:00:00 2001 From: Jared Johnson Date: Mon, 15 Sep 2014 15:34:58 -0500 Subject: [PATCH 19/19] Fix crasher Add missing 'use' and use get/set method for cleaner storage of QP object --- lib/Qpsmtpd.pm | 3 ++- lib/Qpsmtpd/Address.pm | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/lib/Qpsmtpd.pm b/lib/Qpsmtpd.pm index f73bac4..4b9ce65 100644 --- a/lib/Qpsmtpd.pm +++ b/lib/Qpsmtpd.pm @@ -5,6 +5,7 @@ use vars qw($TraceLevel $Spool_dir $Size_threshold); use Sys::Hostname; use Qpsmtpd::Constants; +use Qpsmtpd::Address; our $VERSION = "0.94"; @@ -651,7 +652,7 @@ sub auth_mechanism { sub address { my $self = shift; my $addr = Qpsmtpd::Address->new(@_); - $addr->{qp} = $self; + $addr->qp($self); return $addr; } diff --git a/lib/Qpsmtpd/Address.pm b/lib/Qpsmtpd/Address.pm index fc0c810..35ac4f6 100644 --- a/lib/Qpsmtpd/Address.pm +++ b/lib/Qpsmtpd/Address.pm @@ -346,7 +346,8 @@ hook_user_config =cut sub qp { - my ($self) = @_; + my $self = shift; + $self->{qp} = $_[0] if @_; return $self->{qp}; }