diff --git a/MANIFEST b/MANIFEST index 5cbad48..9a7c847 100644 --- a/MANIFEST +++ b/MANIFEST @@ -39,7 +39,9 @@ lib/Danga/TimeoutSocket.pm lib/Qpsmtpd.pm lib/Qpsmtpd/Address.pm lib/Qpsmtpd/Auth.pm +lib/Qpsmtpd/Base.pm lib/Qpsmtpd/Command.pm +lib/Qpsmtpd/Config.pm lib/Qpsmtpd/ConfigServer.pm lib/Qpsmtpd/Connection.pm lib/Qpsmtpd/Constants.pm @@ -55,7 +57,6 @@ lib/Qpsmtpd/SMTP/Prefork.pm lib/Qpsmtpd/TcpServer.pm lib/Qpsmtpd/TcpServer/Prefork.pm lib/Qpsmtpd/Transaction.pm -lib/Qpsmtpd/Utils.pm LICENSE log/log2sql log/log2sql.sql @@ -166,7 +167,6 @@ run.tcpserver STATUS t/addresses.t t/auth.t -t/config.t t/config/badhelo t/config/badrcptto t/config/dnsbl_allow @@ -178,6 +178,8 @@ t/config/plugins t/config/public_suffix_list t/config/rcpthosts t/config/relayclients +t/config/size_threshold +t/config/test_config_file t/helo.t t/misc.t t/plugin_tests.t @@ -209,11 +211,11 @@ t/plugin_tests/spamassassin t/plugin_tests/user_config t/plugin_tests/virus/clamdscan t/qpsmtpd-address.t +t/qpsmtpd-base.t +t/qpsmtpd-config.t t/qpsmtpd-smtp.t -t/qpsmtpd-utils.t t/qpsmtpd.t t/rset.t -t/tempstuff.t t/Test/Qpsmtpd.pm t/Test/Qpsmtpd/Plugin.pm UPGRADING.pod diff --git a/Makefile.PL b/Makefile.PL index 7a3298e..7d455d3 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -7,18 +7,19 @@ WriteMakefile( NAME => 'qpsmtpd', VERSION_FROM => 'lib/Qpsmtpd.pm', PREREQ_PM => { - 'Data::Dumper' => 0, - 'Date::Parse' => 0, - 'File::Temp' => 0, - 'Mail::Header' => 0, - 'MIME::Base64' => 0, - 'Net::DNS' => 0.39, - 'Net::IP' => 0, - 'Time::HiRes' => 0, + 'CDB_File' => 0, + 'Data::Dumper' => 0, + 'Date::Parse' => 0, + 'File::Temp' => 0, + 'Mail::Header' => 0, + 'MIME::Base64' => 0, + 'Net::DNS' => 0.39, + 'Net::IP' => 0, + 'Time::HiRes' => 0, 'IO::Socket::SSL' => 0, # Dev/Test modules - 'Test::More' => 0, - 'Test::Output' => 0, + 'Test::More' => 0, + 'Test::Output' => 0, # modules for specific features 'Mail::DKIM' => 0, 'File::Tail' => 0, # log/summarize, log/watch diff --git a/lib/Qpsmtpd.pm b/lib/Qpsmtpd.pm index fa52a58..50a17e6 100644 --- a/lib/Qpsmtpd.pm +++ b/lib/Qpsmtpd.pm @@ -2,13 +2,15 @@ package Qpsmtpd; use strict; #use warnings; -use vars qw($TraceLevel $Spool_dir $Size_threshold); - -use Sys::Hostname; -use Qpsmtpd::Constants; -use Qpsmtpd::Address; our $VERSION = "0.95"; +use vars qw($TraceLevel $Spool_dir $Size_threshold); + +use lib 'lib'; +use base 'Qpsmtpd::Base'; +use Qpsmtpd::Address; +use Qpsmtpd::Config; +use Qpsmtpd::Constants; my $git; @@ -19,12 +21,6 @@ if (-e ".git") { } our $hooks = {}; -my %defaults = ( - me => hostname, - timeout => 1200, - ); -my $_config_cache = {}; -our %config_dir_memo; our $LOGGING_LOADED = 0; @@ -34,13 +30,12 @@ sub _restart { if ($args{restart}) { # reset all global vars to defaults - $self->clear_config_cache; - $hooks = {}; - $LOGGING_LOADED = 0; - %config_dir_memo = (); - $TraceLevel = LOGWARN; - $Spool_dir = undef; - $Size_threshold = undef; + $self->conf->clear_cache(); + $hooks = {}; + $LOGGING_LOADED = 0; + $TraceLevel = LOGWARN; + $Spool_dir = undef; + $Size_threshold = undef; } } @@ -58,11 +53,11 @@ sub load_logging { my $configdir = $self->config_dir("logging"); my $configfile = "$configdir/logging"; - my @loggers = $self->_config_from_file($configfile, 'logging'); + my @loggers = $self->conf->from_file($configfile, 'logging'); $configdir = $self->config_dir('plugin_dirs'); $configfile = "$configdir/plugin_dirs"; - my @plugin_dirs = $self->_config_from_file($configfile, 'plugin_dirs'); + my @plugin_dirs = $self->conf->from_file($configfile, 'plugin_dirs'); unless (@plugin_dirs) { my ($name) = ($0 =~ m!(.*?)/([^/]+)$!); @plugin_dirs = ("$name/plugins"); @@ -79,7 +74,7 @@ sub load_logging { $configdir = $self->config_dir("loglevel"); $configfile = "$configdir/loglevel"; - $TraceLevel = $self->_config_from_file($configfile, 'loglevel'); + $TraceLevel = $self->conf->from_file($configfile, 'loglevel'); unless (defined($TraceLevel) and $TraceLevel =~ /^\d+$/) { $TraceLevel = LOGWARN; # Default if no loglevel file found. @@ -92,7 +87,7 @@ sub load_logging { sub trace_level { return $TraceLevel; } -sub init_logger { # needed for compatibility purposes +sub init_logger { # needed for compatibility shift->trace_level(); } @@ -104,23 +99,17 @@ sub log { sub varlog { my ($self, $trace) = (shift, shift); my ($hook, $plugin, @log); - if ($#_ == 0) { # log itself - (@log) = @_; - } - elsif ($#_ == 1) { # plus the hook - ($hook, @log) = @_; - } - else { # called from plugin - ($hook, $plugin, @log) = @_; - } + if ($#_ == 0) { (@log) = @_; } # log itself + elsif ($#_ == 1) { ($hook, @log) = @_; } # plus the hook + else { ($hook, $plugin, @log) = @_; } # from a plugin - $self->load_logging; # in case we don't have this loaded yet + $self->load_logging; my ($rc) = $self->run_hooks_no_respond("logging", $trace, $hook, $plugin, @log) or return; - return if $rc == DECLINED || $rc == OK; # plugin success + return if $rc == DECLINED || $rc == OK; # plugin success return if $trace > $TraceLevel; # no logging plugins registered, fall back to STDERR @@ -133,64 +122,22 @@ sub varlog { warn join(' ', $$ . $prefix, @log), "\n"; } -sub clear_config_cache { - $_config_cache = {}; +sub conf { + my $self = shift; + if (!$self->{_config}) { + $self->{_config} = Qpsmtpd::Config->new(); + } + return $self->{_config}; } -# -# method to get the configuration. It just calls get_qmail_config by -# default, but it could be overwritten to look configuration up in a -# database or whatever. -# sub config { - my ($self, $c, $type) = @_; - - $self->log(LOGDEBUG, "in config($c)"); - - # first run the user_config hooks - my ($rc, @config); - if (ref $type && $type->can('address')) { - ($rc, @config) = $self->run_hooks_no_respond('user_config', $type, $c); - if (defined $rc && $rc == OK) { - return wantarray ? @config : $config[0]; - }; - }; - - # 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); - return wantarray ? @config : $config[0] if @config; - - # then the default, if any - if (exists $defaults{$c}) { - return wantarray ? ($defaults{$c}) : $defaults{$c}; - }; - return; + my $self = shift; + return $self->conf->config($self, @_); } sub config_dir { - my ($self, $config) = @_; - if (exists $config_dir_memo{$config}) { - return $config_dir_memo{$config}; - } - my $configdir = ($ENV{QMAIL} || '/var/qmail') . '/control'; - my ($path) = ($ENV{PROCESS} ? $ENV{PROCESS} : $0) =~ m!(.*?)/([^/]+)$!; - $configdir = "$path/config" if -e "$path/config/$config"; - if (exists $ENV{QPSMTPD_CONFIG}) { - $ENV{QPSMTPD_CONFIG} =~ /^(.*)$/; # detaint - $configdir = $1 if -e "$1/$config"; - } - return $config_dir_memo{$config} = $configdir; + my $self = shift; + return $self->conf->config_dir(@_); } sub plugin_dirs { @@ -204,143 +151,6 @@ sub plugin_dirs { return @plugin_dirs; } -sub get_qmail_config { - 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_config_map($config, $configfile); - } - - return $self->_config_from_file($configfile, $config); -} - -sub get_qmail_config_map { - my ($self, $config, $configfile) = @_; - - unless (-e $configfile . ".cdb") { - $_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: $@" - ); - return +{}; - } - - my %h; - unless (tie(%h, 'CDB_File', "$configfile.cdb")) { - $self->log(LOGERROR, "tie of $configfile.cdb failed: $!"); - return +{}; - } - - # We explicitly don't cache cdb entries. The assumption is that - # 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. - return \%h; -} - -sub _config_from_file { - my ($self, $configfile, $config, $visited) = @_; - unless (-e $configfile) { - $_config_cache->{$config} ||= []; - return; - } - - $visited ||= []; - push @$visited, $configfile; - - open my $CF, '<', $configfile or do { - warn "$$ could not open configfile $configfile: $!"; - return; - }; - my @config = <$CF>; - chomp @config; - @config = grep { length($_) and $_ !~ m/^\s*#/ and $_ =~ m/\S/ } - map { s/^\s+//; s/\s+$//; $_; } # trim leading/trailing whitespace - @config; - close $CF; - - my $pos = 0; - while ($pos < @config) { - - # recursively pursue an $include reference, if found. An inclusion which - # begins with a leading slash is interpreted as a path to a file and will - # supercede the usual config path resolution. Otherwise, the normal - # config_dir() lookup is employed (the location in which the inclusion - # appeared receives no special precedence; possibly it should, but it'd - # be complicated beyond justifiability for so simple a config system. - if ($config[$pos] =~ /^\s*\$include\s+(\S+)\s*$/) { - my ($includedir, $inclusion) = ('', $1); - - splice @config, $pos, 1; # remove the $include line - if ($inclusion !~ /^\//) { - $includedir = $self->config_dir($inclusion); - $inclusion = "$includedir/$inclusion"; - } - - if (grep($_ eq $inclusion, @{$visited})) { - $self->log(LOGERROR, - "Circular \$include reference in config $config:"); - $self->log(LOGERROR, "From $visited->[0]:"); - $self->log(LOGERROR, " includes $_") - for (@{$visited}[1 .. $#{$visited}], $inclusion); - return wantarray ? () : undef; - } - push @{$visited}, $inclusion; - - for my $inc ($self->expand_inclusion_($inclusion, $configfile)) { - my @insertion = - $self->_config_from_file($inc, $config, $visited); - splice @config, $pos, 0, @insertion; # insert the inclusion - $pos += @insertion; - } - } - else { - $pos++; - } - } - - $_config_cache->{$config} = \@config; - - return wantarray ? @config : $config[0]; -} - -sub expand_inclusion_ { - my $self = shift; - my $inclusion = shift; - my $context = shift; - my @includes; - - if (-d $inclusion) { - $self->log(LOGDEBUG, "inclusion of directory $inclusion from $context"); - - if (opendir(INCD, $inclusion)) { - @includes = map { "$inclusion/$_" } - (grep { -f "$inclusion/$_" and !/^\./ } sort readdir INCD); - closedir INCD; - } - else { - $self->log(LOGERROR, - "Couldn't open directory $inclusion," - . " referenced from $context ($!)" - ); - } - } - else { - $self->log(LOGDEBUG, "inclusion of file $inclusion from $context"); - @includes = ($inclusion); - } - return @includes; -} - sub load_plugins { my $self = shift; @@ -393,18 +203,20 @@ sub _load_plugin { # don't reload plugins if they are already loaded if (!defined &{"${package}::plugin_name"}) { - PLUGIN_DIR: for my $dir (@plugin_dirs) { + for my $dir (@plugin_dirs) { next if !-e "$dir/$plugin"; Qpsmtpd::Plugin->compile($plugin_name, $package, - "$dir/$plugin", $self->{_test_mode}, $plugin); + "$dir/$plugin", $self->{_test_mode}, + $plugin); if ($safe_line !~ /logging/) { $self->log(LOGDEBUG, "Loading $safe_line from $dir/$plugin"); - }; - last PLUGIN_DIR; + } + last; + } + if (!defined &{"${package}::plugin_name"}) { + die "Plugin $plugin_name not found in our plugin dirs (", + join(', ', @plugin_dirs), ")"; } - if (! defined &{"${package}::plugin_name"}) { - die "Plugin $plugin_name not found in our plugin dirs (", join(', ', @plugin_dirs), ")"; - }; } my $plug = $package->new(); @@ -423,11 +235,12 @@ sub _load_package_plugin { qq[require $package;\n] . qq[sub ${plugin}::plugin_name { '$plugin' }]; $eval =~ m/(.*)/s; $eval = $1; - eval $eval; + eval $eval; ## no critic (Eval) die "Failed loading $package - eval $@" if $@; + if ($plugin_line !~ /logging/) { $self->log(LOGDEBUG, "Loading $package ($plugin_line)"); - }; + } my $plug = $package->new(); $plug->_register($self, @$args); @@ -454,9 +267,10 @@ sub run_hooks_no_respond { my @r; for my $code (@{$hooks->{$hook}}) { eval { (@r) = $code->{code}->($self, $self->transaction, @_); }; - $@ - and warn("FATAL PLUGIN ERROR [" . $code->{name} . "]: ", $@) - and next; + if ($@) { + warn("FATAL PLUGIN ERROR [" . $code->{name} . "]: ", $@); + next; + } if ($r[0] == YIELD) { die "YIELD not valid from $hook hook"; } @@ -474,7 +288,6 @@ sub pause_read { die "Continuations only work in qpsmtpd-async" } sub run_continuation { my $self = shift; - #my $t1 = $SAMPLER->("run_hooks", undef, 1); die "No continuation in progress" unless $self->{_continuation}; $self->continue_read(); my $todo = $self->{_continuation}; @@ -486,16 +299,14 @@ sub run_continuation { while (@$todo) { my $code = shift @$todo; - #my $t2 = $SAMPLER->($hook . "_" . $code->{name}, undef, 1); - #warn("Got sampler called: ${hook}_$code->{name}\n"); $self->varlog(LOGDEBUG, $hook, $code->{name}); my $tran = $self->transaction; eval { (@r) = $code->{code}->($self, $tran, @$args); }; - $@ - and - $self->log(LOGCRIT, "FATAL PLUGIN ERROR [" . $code->{name} . "]: ", - $@) - and next; + if ($@) { + $self->log(LOGCRIT, "FATAL PLUGIN ERROR [" . $code->{name} . "]: ", + $@); + next; + } !defined $r[0] and $self->log(LOGERROR, @@ -565,7 +376,6 @@ sub run_continuation { sub hook_responder { my ($self, $hook, $msg, $args) = @_; - #my $t1 = $SAMPLER->("hook_responder", undef, 1); my $code = shift @$msg; my $responder = $hook . '_respond'; @@ -576,40 +386,40 @@ sub hook_responder { } sub _register_hook { - my $self = shift; - my ($hook, $code, $unshift) = @_; + my ($self, $hook, $code, $unshift) = @_; if ($unshift) { unshift @{$hooks->{$hook}}, $code; + return; } - else { - push @{$hooks->{$hook}}, $code; - } + + push @{$hooks->{$hook}}, $code; } sub spool_dir { my $self = shift; - unless ($Spool_dir) { # first time through - $self->log(LOGDEBUG, "Initializing spool_dir"); - $Spool_dir = $self->config('spool_dir') - || Qpsmtpd::Utils->tildeexp('~/tmp/'); + return $Spool_dir if $Spool_dir; # already set - $Spool_dir .= "/" unless ($Spool_dir =~ m!/$!); + $self->log(LOGDEBUG, "Initializing spool_dir"); + $Spool_dir = $self->config('spool_dir') || $self->tildeexp('~/tmp/'); - $Spool_dir =~ /^(.+)$/ or die "spool_dir not configured properly"; - $Spool_dir = $1; # cleanse the taint - my $Spool_perms = $self->config('spool_perms') || '0700'; + $Spool_dir .= "/" if $Spool_dir !~ m!/$!; - if (!-d $Spool_dir) { # create it if it doesn't exist - mkdir($Spool_dir, oct($Spool_perms)) - or die "Could not create spool_dir $Spool_dir: $!"; - } + $Spool_dir =~ /^(.+)$/ or die "spool_dir not configured properly"; + $Spool_dir = $1; # cleanse the taint - # Make sure the spool dir has appropriate rights + my $Spool_perms = $self->config('spool_perms') || '0700'; + + if (!-d $Spool_dir) { # create if it doesn't exist + mkdir($Spool_dir, oct($Spool_perms)) + or die "Could not create spool_dir $Spool_dir: $!"; + } + + # Make sure the spool dir has appropriate rights + if (((stat $Spool_dir)[2] & oct('07777')) != oct($Spool_perms)) { $self->log(LOGWARN, - "Permissions on spool_dir $Spool_dir are not $Spool_perms") - unless ((stat $Spool_dir)[2] & 07777) == oct($Spool_perms); + "Permissions on spool_dir $Spool_dir are not $Spool_perms"); } return $Spool_dir; @@ -627,21 +437,22 @@ sub temp_file { } sub temp_dir { - my $self = shift; - my $mask = shift || 0700; + my ($self, $mask) = @_; + $mask ||= '0700'; my $dirname = $self->temp_file(); - -d $dirname - or mkdir($dirname, $mask) - or die "Could not create temporary directory $dirname: $!"; + if (!-d $dirname) { + mkdir($dirname, $mask) + or die "Could not create temporary directory $dirname: $!"; + } return $dirname; } sub size_threshold { my $self = shift; - unless (defined $Size_threshold) { - $Size_threshold = $self->config('size_threshold') || 0; - $self->log(LOGDEBUG, "size_threshold set to $Size_threshold"); - } + return $Size_threshold if defined $Size_threshold; + + $Size_threshold = $self->config('size_threshold') || 0; + $self->log(LOGDEBUG, "size_threshold set to $Size_threshold"); return $Size_threshold; } diff --git a/lib/Qpsmtpd/Utils.pm b/lib/Qpsmtpd/Base.pm similarity index 74% rename from lib/Qpsmtpd/Utils.pm rename to lib/Qpsmtpd/Base.pm index 2aa3c0b..b07835b 100644 --- a/lib/Qpsmtpd/Utils.pm +++ b/lib/Qpsmtpd/Base.pm @@ -1,15 +1,18 @@ -package Qpsmtpd::Utils; +package Qpsmtpd::Base; use strict; use Net::IP; +sub new { + return bless {}, shift; +}; + sub tildeexp { my ($self, $path) = @_; - $path =~ s{^~([^/]*)} { - $1 - ? (getpwnam($1))[7] - : ( $ENV{HOME} || $ENV{LOGDIR} || (getpwuid($>))[7]) - }ex; + $path =~ s{^~([^/]*)} { + $1 ? (getpwnam($1))[7] + : ( $ENV{HOME} || $ENV{LOGDIR} || (getpwuid($>))[7]) + }ex; return $path; } diff --git a/lib/Qpsmtpd/Config.pm b/lib/Qpsmtpd/Config.pm new file mode 100644 index 0000000..e2eb25e --- /dev/null +++ b/lib/Qpsmtpd/Config.pm @@ -0,0 +1,227 @@ +package Qpsmtpd::Config; +use strict; +use warnings; + +use Sys::Hostname; + +use lib 'lib'; +use parent 'Qpsmtpd::Base'; +use Qpsmtpd::Constants; + +our %config_cache = (); +our %dir_memo; +our %defaults = ( + me => hostname, + timeout => 1200, + ); + +sub log { + my ($self, $trace, @log) = @_; + + # logging methods attempt to read config files, this log() prevents that + # until after logging has fully loaded + return if $trace > LOGWARN; + no warnings 'once'; + if ($Qpsmtpd::LOGGING_LOADED) { + return Qpsmtpd->log($trace, @log); + } + warn join(' ', $$, @log) . "\n"; +} + +sub config { + my ($self, $qp, $c, $type) = @_; + + $qp->log(LOGDEBUG, "in config($c)"); + + # first run the user_config hooks + my ($rc, @config); + if (ref $type && $type->can('address')) { + ($rc, @config) = $qp->run_hooks_no_respond('user_config', $type, $c); + if (defined $rc && $rc == OK) { + return wantarray ? @config : $config[0]; + } + } + + # then run the config hooks + ($rc, @config) = $qp->run_hooks_no_respond('config', $c); + $qp->log(LOGDEBUG, + "config($c): hook returned (" + . join(',', map { defined $_ ? $_ : 'undef' } ($rc, @config)) + . ")" + ); + if (defined $rc && $rc == OK) { + return wantarray ? @config : $config[0]; + } + + # then qmail + @config = $self->get_qmail($c, $type); + return wantarray ? @config : $config[0] if @config; + + # then the default, which may be undefined + return $self->default($c); +} + +sub config_dir { + my ($self, $config) = @_; + if (exists $dir_memo{$config}) { + return $dir_memo{$config}; + } + my $configdir = ($ENV{QMAIL} || '/var/qmail') . '/control'; + my ($path) = ($ENV{PROCESS} ? $ENV{PROCESS} : $0) =~ m!(.*?)/([^/]+)$!; + $configdir = "$path/config" if -e "$path/config/$config"; + if (exists $ENV{QPSMTPD_CONFIG}) { + $ENV{QPSMTPD_CONFIG} =~ /^(.*)$/; # detaint + $configdir = $1 if -e "$1/$config"; + } + return $dir_memo{$config} = $configdir; +} + +sub clear_cache { + %config_cache = (); + %dir_memo = (); +} + +sub default { + my ($self, $def) = @_; + return if !exists $defaults{$def}; + return wantarray ? ($defaults{$def}) : $defaults{$def}; +} + +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->from_file($configfile, $config); +} + +sub get_qmail_map { + my ($self, $config, $configfile) = @_; + + if (!-e $configfile . ".cdb") { + $self->log(LOGERROR, "File $configfile.cdb 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: $@" + ); + return +{}; + } + + my %h; + unless (tie(%h, 'CDB_File', "$configfile.cdb")) { + $self->log(LOGERROR, "tie of $configfile.cdb failed: $!"); + return +{}; + } + + # We explicitly don't cache cdb entries. The assumption is that + # 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. + return \%h; +} + +sub from_file { + my ($self, $configfile, $config, $visited) = @_; + if (!-e $configfile) { + $config_cache{$config} ||= []; + return; + } + + $visited ||= []; + push @$visited, $configfile; + + open my $CF, '<', $configfile or do { + warn "$$ could not open configfile $configfile: $!"; + return; + }; + my @config = <$CF>; + close $CF; + + chomp @config; + @config = grep { length($_) and $_ !~ m/^\s*#/ and $_ =~ m/\S/ } @config; + for (@config) { s/^\s+//; s/\s+$//; } # trim leading/trailing whitespace + + my $pos = 0; + while ($pos < @config) { + + # recursively pursue an $include reference, if found. An inclusion which + # begins with a leading slash is interpreted as a path to a file and will + # supercede the usual config path resolution. Otherwise, the normal + # config_dir() lookup is employed (the location in which the inclusion + # appeared receives no special precedence; possibly it should, but it'd + # be complicated beyond justifiability for so simple a config system. + if ($config[$pos] =~ /^\s*\$include\s+(\S+)\s*$/) { + my ($includedir, $inclusion) = ('', $1); + + splice @config, $pos, 1; # remove the $include line + if ($inclusion !~ /^\//) { + $includedir = $self->config_dir($inclusion); + $inclusion = "$includedir/$inclusion"; + } + + if (grep($_ eq $inclusion, @{$visited})) { + $self->log(LOGERROR, + "Circular \$include reference in config $config:"); + $self->log(LOGERROR, "From $visited->[0]:"); + $self->log(LOGERROR, " includes $_") + for (@{$visited}[1 .. $#{$visited}], $inclusion); + return wantarray ? () : undef; + } + push @{$visited}, $inclusion; + + for my $inc ($self->expand_inclusion($inclusion, $configfile)) { + my @insertion = $self->from_file($inc, $config, $visited); + splice @config, $pos, 0, @insertion; # insert the inclusion + $pos += @insertion; + } + } + else { + $pos++; + } + } + + $config_cache{$config} = \@config; + + return wantarray ? @config : $config[0]; +} + +sub expand_inclusion { + my $self = shift; + my $inclusion = shift; + my $context = shift; + my @includes; + + if (-d $inclusion) { + $self->log(LOGDEBUG, "inclusion of directory $inclusion from $context"); + + if (opendir(INCD, $inclusion)) { + @includes = map { "$inclusion/$_" } + (grep { -f "$inclusion/$_" and !/^\./ } sort readdir INCD); + closedir INCD; + } + else { + $self->log(LOGERROR, + "Couldn't open directory $inclusion," + . " referenced from $context ($!)" + ); + } + } + else { + $self->log(LOGDEBUG, "inclusion of file $inclusion from $context"); + @includes = ($inclusion); + } + return @includes; +} + +1; diff --git a/lib/Qpsmtpd/Plugin.pm b/lib/Qpsmtpd/Plugin.pm index 7f1cc80..7a76ccb 100644 --- a/lib/Qpsmtpd/Plugin.pm +++ b/lib/Qpsmtpd/Plugin.pm @@ -1,5 +1,4 @@ package Qpsmtpd::Plugin; - use strict; use warnings; diff --git a/lib/Qpsmtpd/SMTP.pm b/lib/Qpsmtpd/SMTP.pm index 31e6021..529927b 100644 --- a/lib/Qpsmtpd/SMTP.pm +++ b/lib/Qpsmtpd/SMTP.pm @@ -142,9 +142,9 @@ sub reset_transaction { sub connection { my $self = shift; - @_ and $self->{_connection} = shift; - return $self->{_connection} - || ($self->{_connection} = Qpsmtpd::Connection->new()); + if (@_) { $self->{_connection} = shift; } + return $self->{_connection} if $self->{_connection}; + return $self->{_connection} = Qpsmtpd::Connection->new(); } sub helo { diff --git a/lib/Qpsmtpd/Transaction.pm b/lib/Qpsmtpd/Transaction.pm index 294fcd0..65307c4 100644 --- a/lib/Qpsmtpd/Transaction.pm +++ b/lib/Qpsmtpd/Transaction.pm @@ -4,7 +4,7 @@ use Qpsmtpd; use strict; use warnings; -use Qpsmtpd::Utils; +use Qpsmtpd::Base; use Qpsmtpd::Constants; use IO::File qw(O_RDWR O_CREAT); diff --git a/plugins/badmailfromto b/plugins/badmailfromto index efe46c4..c97a321 100644 --- a/plugins/badmailfromto +++ b/plugins/badmailfromto @@ -30,8 +30,9 @@ sub hook_mail { my $from = lc($sender->user) . '@' . $host; for my $bad (@badmailfromto) { + next if !$bad; $bad =~ s/^\s*(\S+).*/$1/; - next unless $bad; + next if !$bad; $bad = lc $bad; if ($bad !~ m/\@/) { $self->log(LOGWARN, 'bad config, no @ sign in ' . $bad); diff --git a/plugins/fcrdns b/plugins/fcrdns index e9f224a..26af74e 100644 --- a/plugins/fcrdns +++ b/plugins/fcrdns @@ -166,7 +166,7 @@ sub connect_handler { sub is_valid_localhost { my ($self) = @_; - if (Qpsmtpd::Utils->is_localhost($self->qp->connection->remote_ip)) { + if (Qpsmtpd::Base->is_localhost($self->qp->connection->remote_ip)) { $self->adjust_karma(1); $self->log(LOGDEBUG, "pass, is localhost"); return 1; diff --git a/plugins/greylisting b/plugins/greylisting index 166130e..c854d56 100644 --- a/plugins/greylisting +++ b/plugins/greylisting @@ -157,24 +157,26 @@ Adjust the quantity of logging for this plugin. See docs/logging.pod Written by Gavin Carr . -nfslock feature by JT Moree - 2007-01-22 +2007-01-22 - nfslock feature by JT Moree -p0f feature by Matt Simerson - 2010-05-03 +2010-05-03 - p0f feature by Matt Simerson -geoip, loglevel, reject added. Refactored into subs - Matt Simerson - 2012-05 +2012-05 - geoip, loglevel, reject added. Refactored into subs by Matt Simerson =cut use strict; use warnings; + +use Net::IP; + use Qpsmtpd::Constants; -my $VERSION = '0.11'; +my $VERSION = '0.12'; BEGIN { @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File) } use AnyDBM_File; use Fcntl qw(:DEFAULT :flock LOCK_EX LOCK_NB); -use Net::IP; my $DENYMSG = "This mail is temporarily denied"; my ($QPHOME) = ($0 =~ m!(.*?)/([^/]+)$!); @@ -197,9 +199,10 @@ my %DEFAULTS = ( sub register { my ($self, $qp, %arg) = @_; + my $c = $self->qp->config('denysoft_greylist'); my $config = { %DEFAULTS, - map { split /\s+/, $_, 2 } $self->qp->config('denysoft_greylist'), + ($c ? map { split /\s+/, $_, 2 } $c : ()), %arg }; if (my @bad = grep { !exists $PERMITTED_ARGS{$_} } sort keys %$config) { @@ -265,9 +268,8 @@ sub hook_data { return DECLINED unless $transaction->notes('greylist'); # Decline if ALL recipients are whitelisted - if (($transaction->notes('whitelistrcpt') || 0) == - scalar($transaction->recipients)) - { + my $recips = scalar $transaction->recipients || 0; + if (($transaction->notes('whitelistrcpt') || 0) == $recips) { $self->log(LOGWARN, "skip: all recipients whitelisted"); return DECLINED; } @@ -370,7 +372,7 @@ sub get_db_key { sub get_db_tie { my ($self, $db, $lock) = @_; - tie(my %db, 'AnyDBM_File', $db, O_CREAT | O_RDWR, 0600) or do { + tie(my %db, 'AnyDBM_File', $db, O_CREAT | O_RDWR, oct('0600')) or do { $self->log(LOGCRIT, "tie to database $db failed: $!"); close $lock; return; @@ -419,7 +421,7 @@ sub get_db_lock { return $self->get_db_lock_nfs($db) if $self->{_args}{nfslock}; # Check denysoft db - open(my $lock, ">$db.lock") or do { + open(my $lock, '>', "$db.lock") or do { $self->log(LOGCRIT, "opening lockfile failed: $!"); return; }; @@ -450,7 +452,7 @@ sub get_db_lock_nfs { return; }; - open(my $lock, "+<$db.lock") or do { + open(my $lock, '+<', "$db.lock") or do { $self->log(LOGCRIT, "opening nfs lockfile failed: $!"); return; }; diff --git a/plugins/helo b/plugins/helo index 92ac3eb..49088bb 100644 --- a/plugins/helo +++ b/plugins/helo @@ -229,8 +229,8 @@ use warnings; use Net::IP; +use Qpsmtpd::Base; use Qpsmtpd::Constants; -use Qpsmtpd::Utils; sub register { my ($self, $qp) = (shift, shift); @@ -342,7 +342,7 @@ sub is_regex_match { sub invalid_localhost { my ($self, $host) = @_; - if (Qpsmtpd::Utils->is_localhost($self->qp->connection->remote_ip)) { + if (Qpsmtpd::Base->is_localhost($self->qp->connection->remote_ip)) { $self->log(LOGDEBUG, "pass, is localhost"); return; } @@ -357,7 +357,7 @@ sub invalid_localhost { sub is_plain_ip { my ($self, $host) = @_; - return if !Qpsmtpd::Utils->is_valid_ip($host); + return if !Qpsmtpd::Base->is_valid_ip($host); $self->log(LOGDEBUG, "fail, plain IP"); return ("Plain IP is invalid HELO hostname (RFC 2821)", "plain IP"); @@ -369,7 +369,7 @@ sub is_address_literal { my ($ip) = $host =~ /^\[(.*)\]/; # strip off any brackets return if !$ip; # no brackets, not a literal - return if !Qpsmtpd::Utils->is_valid_ip($ip); + return if !Qpsmtpd::Base->is_valid_ip($ip); $self->log(LOGDEBUG, "fail, bracketed IP"); return ("RFC 2821 allows an address literal, but we do not", @@ -378,7 +378,7 @@ sub is_address_literal { sub is_forged_literal { my ($self, $host) = @_; - return if !Qpsmtpd::Utils->is_valid_ip($host); + return if !Qpsmtpd::Base->is_valid_ip($host); # should we add exceptions for reserved internal IP space? (192.168,10., etc) $host = substr $host, 1, -1; diff --git a/plugins/virus/clamdscan b/plugins/virus/clamdscan index a12d6b7..5a990e7 100644 --- a/plugins/virus/clamdscan +++ b/plugins/virus/clamdscan @@ -129,17 +129,16 @@ sub register { $self->log(LOGERROR, "Bad parameters for the clamdscan plugin") if @_ % 2; $self->{'_args'} = {@_}; - eval 'use ClamAV::Client'; + eval 'use ClamAV::Client'; ## no critic (Stringy) if ($@) { - warn "unable to load ClamAV::Client\n"; $self->log(LOGERROR, "unable to load ClamAV::Client"); return; } - # Set some sensible defaults - $self->{'_args'}{'deny_viruses'} ||= 'yes'; - $self->{'_args'}{'max_size'} ||= 1024; - $self->{'_args'}{'scan_all'} ||= 1; + # Set sensible defaults + $self->{_args}{deny_viruses} ||= 'yes'; + $self->{_args}{max_size} ||= 1024; + $self->{_args}{scan_all} ||= 1; for my $setting ('deny_viruses', 'defer_on_error') { next unless $self->{'_args'}{$setting}; if (lc $self->{'_args'}{$setting} eq 'no') { @@ -241,9 +240,11 @@ sub get_filename { } if (!-f $filename) { - $self->log(LOGERROR, "spool file missing! Attempting to respool"); - $transaction->body_spool; - $filename = $transaction->body_filename; + if ($transaction->data_size) { + $self->log(LOGERROR, "spool file missing! Attempting to respool"); + $transaction->body_spool; + $filename = $transaction->body_filename; + }; if (!-f $filename) { $self->log(LOGERROR, "skip: failed spool to $filename! Giving up"); return; @@ -264,14 +265,14 @@ sub set_permission { my $dir_mode = (stat($self->spool_dir()))[2]; $self->log(LOGDEBUG, "spool dir mode: $dir_mode"); - if ($dir_mode & 0010 || $dir_mode & 0001) { + if ($dir_mode & oct('0010') || $dir_mode & oct('0001')) { # match the spool file mode with the mode of the directory -- add # the read bit for group, world, or both, depending on what the # spool dir had, and strip all other bits, especially the sticky bit my $fmode = - ($dir_mode & 0044) | ($dir_mode & 0010 ? 0040 : 0) | - ($dir_mode & 0001 ? 0004 : 0); + ($dir_mode & oct('0044')) | ($dir_mode & oct('0010') ? oct('0040') : 0) | + ($dir_mode & oct('0001') ? oct('0004') : 0); unless (chmod $fmode, $filename) { $self->log(LOGERROR, "chmod: $filename: $!"); diff --git a/qpsmtpd-async b/qpsmtpd-async index e4f9bf9..223f226 100755 --- a/qpsmtpd-async +++ b/qpsmtpd-async @@ -396,7 +396,7 @@ sub cmd_hup { # clear cache print "Clearing cache\n"; - Qpsmtpd::clear_config_cache(); + Qpsmtpd::Config::clear_cache(); # should also reload modules... but can't do that yet. } diff --git a/t/Test/Qpsmtpd.pm b/t/Test/Qpsmtpd.pm index 0499ac5..b039100 100644 --- a/t/Test/Qpsmtpd.pm +++ b/t/Test/Qpsmtpd.pm @@ -1,10 +1,13 @@ package Test::Qpsmtpd; use strict; + +use Carp qw(croak); +use Test::More; + use lib 't'; use lib 'lib'; -use Carp qw(croak); -use base qw(Qpsmtpd::SMTP); -use Test::More; +use parent 'Qpsmtpd::SMTP'; + use Qpsmtpd::Constants; use Test::Qpsmtpd::Plugin; @@ -78,7 +81,7 @@ sub input { sub config_dir { return './t/config' if $ENV{QPSMTPD_DEVELOPER}; - './config.sample'; + return './config.sample'; } sub plugin_dirs { diff --git a/t/Test/Qpsmtpd/Plugin.pm b/t/Test/Qpsmtpd/Plugin.pm index 2733f50..9fd2d2b 100644 --- a/t/Test/Qpsmtpd/Plugin.pm +++ b/t/Test/Qpsmtpd/Plugin.pm @@ -1,4 +1,5 @@ package Test::Qpsmtpd::Plugin; +use strict; 1; # Additional plugin methods used during testing diff --git a/t/config.t b/t/config.t deleted file mode 100644 index 06f5ce0..0000000 --- a/t/config.t +++ /dev/null @@ -1,37 +0,0 @@ -#!/usr/bin/perl -w -use Test::More qw(no_plan); -use File::Path; -use strict; -use lib 't'; -use_ok('Test::Qpsmtpd'); - -my @mes; - -BEGIN { # need this to happen before anything else - my $cwd = `pwd`; - chomp($cwd); - @mes = qw{ ./config.sample/me ./t/config/me }; - foreach my $f (@mes) { - open my $me_config, '>', $f; - print $me_config "some.host.example.org"; - close $me_config; - } -} - -ok(my ($smtpd, $conn) = Test::Qpsmtpd->new_conn(), "get new connection"); - -is($smtpd->config('me'), 'some.host.example.org', 'config("me")'); - -# test for ignoring leading/trailing whitespace (relayclients has a -# line with both) -my $relayclients = join ",", sort $smtpd->config('relayclients'); -is( - $relayclients, -'127.0.0.1,192.0.,2001:0DB8,2001:0DB8:0000:0000:0000:0000:0000:0001,2001:DB8::1,2001:DB8::1/32', - 'config("relayclients") are trimmed' - ); - -foreach my $f (@mes) { - unlink $f if -f $f; -} - diff --git a/t/config/plugins b/t/config/plugins index 7e7ce5b..48903ea 100644 --- a/t/config/plugins +++ b/t/config/plugins @@ -46,10 +46,10 @@ helo sender_permitted_from greylisting p0f genre,windows -auth/auth_checkpassword checkpw /usr/local/vpopmail/bin/vchkpw true /usr/bin/true -auth/auth_vpopmail +#auth/auth_checkpassword checkpw /usr/local/vpopmail/bin/vchkpw true /usr/bin/true +#auth/auth_vpopmail auth/auth_vpopmaild -auth/auth_vpopmail_sql +#auth/auth_vpopmail_sql auth/auth_flat_file auth/authdeny @@ -57,7 +57,7 @@ auth/authdeny rcpt_ok headers days 5 reject_type temp require From,Date -domainkeys +#domainkeys dkim dmarc diff --git a/t/config/size_threshold b/t/config/size_threshold new file mode 100644 index 0000000..a6a1fb4 --- /dev/null +++ b/t/config/size_threshold @@ -0,0 +1,3 @@ +# Messages below the size below will be stored in memory and not spooled. +# Without this file, the default is 0 bytes, i.e. all messages will be spooled. +10000 diff --git a/t/config/test_config_file b/t/config/test_config_file new file mode 100644 index 0000000..2ebad4f --- /dev/null +++ b/t/config/test_config_file @@ -0,0 +1,4 @@ +# a comment line that should get stripped + # another comment line that should get stripped + + 1st line with content diff --git a/t/config/users.cdb b/t/config/users.cdb new file mode 100644 index 0000000..507dbf9 Binary files /dev/null and b/t/config/users.cdb differ diff --git a/t/plugin_tests/virus/clamdscan b/t/plugin_tests/virus/clamdscan index bab847b..8deb1a3 100644 --- a/t/plugin_tests/virus/clamdscan +++ b/t/plugin_tests/virus/clamdscan @@ -8,7 +8,7 @@ use Qpsmtpd::Constants; sub register_tests { my $self = shift; - eval 'use ClamAV::Client'; + eval 'use ClamAV::Client'; ## no critic (Stringy) if ( ! $@ ) { $self->register_test('test_register', 3); $self->register_test('test_get_clamd', 1); @@ -42,6 +42,9 @@ sub test_err_and_return { sub test_get_filename { my $self = shift; + my $tran = $self->qp->transaction(); + $tran->{_body_array} = ['line','two']; + my $filename = $self->get_filename(); ok( $filename, "get_filename ($filename)" ); } diff --git a/t/qpsmtpd-utils.t b/t/qpsmtpd-base.t similarity index 58% rename from t/qpsmtpd-utils.t rename to t/qpsmtpd-base.t index 920c271..1845ee5 100644 --- a/t/qpsmtpd-utils.t +++ b/t/qpsmtpd-base.t @@ -4,11 +4,14 @@ use warnings; use Test::More; -use lib 'lib'; # test lib/Qpsmtpd/Utils (vs site_perl) +use lib 'lib'; # test lib/Qpsmtpd/Base (vs site_perl) -BEGIN { use_ok('Qpsmtpd::Utils'); } +BEGIN { + use_ok('Qpsmtpd::Base'); + use_ok('Qpsmtpd::Constants'); +} -my $utils = bless {}, 'Qpsmtpd::Utils'; +my $base = Qpsmtpd::Base->new(); __tildeexp(); __is_localhost(); @@ -19,30 +22,30 @@ done_testing(); sub __is_valid_ip { my @good = qw/ 1.2.3.4 1.0.0.0 254.254.254.254 2001:db8:ffff:ffff:ffff:ffff:ffff:ffff /; foreach my $ip ( @good ) { - ok( $utils->is_valid_ip($ip), "is_valid_ip: $ip"); + ok( $base->is_valid_ip($ip), "is_valid_ip: $ip"); } my @bad = qw/ 1.2.3.256 256.1.1.1 2001:db8:ffff:ffff:ffff:ffff:ffff:fffj /; foreach my $ip ( @bad ) { - ok( !$utils->is_valid_ip($ip), "is_valid_ip, neg: $ip"); + ok( !$base->is_valid_ip($ip), "is_valid_ip, neg: $ip"); } }; sub __is_localhost { for my $local_ip (qw/ 127.0.0.1 ::1 2607:f060:b008:feed::127.0.0.1 127.0.0.2 /) { - ok( $utils->is_localhost($local_ip), "is_localhost, $local_ip"); + ok( $base->is_localhost($local_ip), "is_localhost, $local_ip"); } for my $rem_ip (qw/ 128.0.0.1 ::2 2607:f060:b008:feed::128.0.0.1 /) { - ok( !$utils->is_localhost($rem_ip), "!is_localhost, $rem_ip"); + ok( !$base->is_localhost($rem_ip), "!is_localhost, $rem_ip"); } }; sub __tildeexp { - my $path = $utils->tildeexp('~root/foo.txt'); + my $path = $base->tildeexp('~root/foo.txt'); ok( $path, "tildeexp, $path"); - $path = $utils->tildeexp('no/tilde/in/path'); + $path = $base->tildeexp('no/tilde/in/path'); cmp_ok( $path, 'eq', 'no/tilde/in/path', 'tildeexp, no expansion'); }; diff --git a/t/qpsmtpd-config.t b/t/qpsmtpd-config.t new file mode 100644 index 0000000..b580251 --- /dev/null +++ b/t/qpsmtpd-config.t @@ -0,0 +1,127 @@ +use strict; +use warnings; + +use Data::Dumper; +use File::Path; +use Test::More; +use Sys::Hostname; + +use lib 'lib'; # test lib/Qpsmtpd (vs site_perl) +use lib 't'; + +my @mes; + +BEGIN { + use_ok('Qpsmtpd::Config'); # call classes directly + use_ok('Qpsmtpd::Constants'); + + use_ok('Test::Qpsmtpd'); # call via a connection object + + @mes = qw{ ./config.sample/me ./t/config/me }; + foreach my $f (@mes) { + open my $me_config, '>', $f; + print $me_config "host.example.org"; + close $me_config; + } +} + +my $config = Qpsmtpd::Config->new(); + +isa_ok($config, 'Qpsmtpd::Config'); + +__log(); +__config_dir(); +__clear_cache(); +__default(); +__from_file(); +__get_qmail(); +__get_qmail_map(); +__expand_inclusion(); +__config_via_smtpd(); + +foreach my $f (@mes) { unlink $f; } + +done_testing(); + +sub __log { + my $warned = ''; + local $SIG{__WARN__} = sub { + if ($_[0] eq "$$ test log message\n") { + $warned = join ' ', @_; + } + else { + warn @_; + } + }; + ok($config->log(LOGWARN, "test log message"), 'log'); + is($warned, "$$ test log message\n", 'LOGWARN emitted correct warning'); +} + +sub __config_dir { + my $dir = $config->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 __clear_cache { + $Qpsmtpd::Config::config_cache{foo} = 2; + $Qpsmtpd::Config::dir_memo{dir1} = 'some/path'; + + $config->clear_cache(); + ok(! $Qpsmtpd::Config::config_cache{foo}, "clear_cache, config_cache") + or diag Data::Dumper::Dumper($Qpsmtpd::Config::config_cache{foo}); + ok(! $Qpsmtpd::Config::dir_memo{dir1}, "clear_cache, dir_memo") +}; + +sub __default { + is($config->default('me'), hostname, "default, my hostname"); + is($config->default('timeout'), 1200, "default timeout is 1200"); + + is($config->default('undefined-test'), undef, "default, undefined"); + + $Qpsmtpd::Config::defaults{'zero-test'} = 0; + is($config->default('zero-test'), 0, "default, zero"); +} + +sub __get_qmail { + is($config->get_qmail('me'), 'host.example.org', 'get_qmail("me")'); + ok(!$config->get_qmail('not-me'), 'get_qmail("not-me")'); +} + +sub __get_qmail_map { + eval "require CDB_File"; ## no critic (StringyEval) + if (!$@) { + my $r = $config->get_qmail_map('users', 't/config/users'); + ok(keys %$r, 'get_qmail_map("users.cdb")'); + ok($r->{'!example.com-'}, "get_qmail_map, known entry"); + }; +} + +sub __from_file { + my $test_file = 't/config/test_config_file'; + my @r = $config->from_file($test_file, 'test_config_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"); +} + +sub __expand_inclusion { + # TODO +} + +sub __config_via_smtpd { + ok(my ($smtpd, $conn) = Test::Qpsmtpd->new_conn(), "get new connection"); + + is($smtpd->config('me'), 'host.example.org', 'config("me")'); + +# test for ignoring leading/trailing whitespace (relayclients has a +# line with both) + my $relayclients = join ',', sort $smtpd->config('relayclients'); + is($relayclients, + '127.0.0.1,192.0.,2001:0DB8,2001:0DB8:0000:0000:0000:0000:0000:0001,2001:DB8::1,2001:DB8::1/32', + 'config("relayclients") are trimmed' + ); +}; diff --git a/t/qpsmtpd.t b/t/qpsmtpd.t index 65e2203..f4183b4 100644 --- a/t/qpsmtpd.t +++ b/t/qpsmtpd.t @@ -2,45 +2,44 @@ 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'); } -use lib 't'; -use_ok('Test::Qpsmtpd'); - my $qp = bless {}, 'Qpsmtpd'; ok($qp->version(), "version, " . $qp->version()); is_deeply(Qpsmtpd::hooks(), {}, 'hooks, empty'); +ok(my ($smtpd, $conn) = Test::Qpsmtpd->new_conn(), "get new connection"); +ok(Qpsmtpd::hooks(), "hooks, populated"); + +__temp_file(); +__temp_dir(); +__size_threshold(); __authenticated(); -__config_dir(); -__get_qmail_config(); -__config(); +__auth_user(); +__auth_mechanism(); +__spool_dir(); + __log(); __load_logging(); +__config_dir(); +__config(); + 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 { @@ -55,15 +54,6 @@ sub __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"); @@ -75,20 +65,101 @@ sub __load_logging { $Qpsmtpd::hooks->{logging} = undef; # restore } -sub __authenticated { +sub __spool_dir { + my $dir = $qp->spool_dir(); + ok($dir, "spool_dir is at $dir"); - ok(!$qp->authenticated(), "authenticated, undef"); + 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, true"); + ok($qp->authenticated(), "authenticated is true"); $qp->{_auth} = 0; - ok(!$qp->authenticated(), "authenticated, false"); + 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"); + + #warn Data::Dumper::Dumper($Qpsmtpd::config_dir_memo{logging}); + $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 = ( @@ -187,11 +258,15 @@ sub __config { } } +1; + package FakeAddress; sub new { - shift; - return bless {@_}; + my $class = shift; + return bless {@_}, $class; } sub address { } # pass the can('address') conditional + +1; diff --git a/t/tempstuff.t b/t/tempstuff.t deleted file mode 100644 index fdcef05..0000000 --- a/t/tempstuff.t +++ /dev/null @@ -1,27 +0,0 @@ -#!/usr/bin/perl -w -use Test::More qw(no_plan); -use File::Path; -use strict; -use lib 't'; -use_ok('Test::Qpsmtpd'); - -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; -} - -ok(my ($smtpd, $conn) = Test::Qpsmtpd->new_conn(), "get new connection"); - -my ($spool_dir, $tempfile, $tempdir) = - ($smtpd->spool_dir, $smtpd->temp_file(), $smtpd->temp_dir()); - -ok($spool_dir =~ m!t/tmp/$!, "Located the spool directory"); -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);