more tests for Qpsmtpd.pm

lib/Qpsmtpd.pm

@@ -264,12 +264,12 @@ sub _config_from_file {
         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;
 
+    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) {
 
@@ -425,7 +425,7 @@ 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)");
@@ -476,7 +476,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};
@@ -488,8 +487,6 @@ 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); };
@@ -567,7 +564,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';
@@ -578,41 +574,42 @@ sub hook_responder {
 }
 
 sub _register_hook {
-    my $self = shift;
+    my ($self, $hook, $code, $unshift) = @_;
-    my ($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
+    return $Spool_dir if $Spool_dir;    # already set
-        $self->log(LOGDEBUG, "Initializing spool_dir");
-        $Spool_dir = $self->config('spool_dir') || $self->tildeexp('~/tmp/');
 
-        $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 .= "/" if $Spool_dir !~ m!/$!;
-        $Spool_dir = $1;     # cleanse the taint
-        my $Spool_perms = $self->config('spool_perms') || '0700';
 
-        if (!-d $Spool_dir) {    # create it if it doesn't exist
+    $Spool_dir =~ /^(.+)$/ or die "spool_dir not configured properly";
-            mkdir($Spool_dir, oct($Spool_perms))
+    $Spool_dir = $1;     # cleanse the taint
-              or die "Could not create spool_dir $Spool_dir: $!";
-        }
 
-        # Make sure the spool dir has appropriate rights
+    my $Spool_perms = $self->config('spool_perms') || '0700';
-        $self->log(LOGWARN,
+
-                   "Permissions on spool_dir $Spool_dir are not $Spool_perms")
+    if (!-d $Spool_dir) {    # create if it doesn't exist
-          unless ((stat $Spool_dir)[2] & 07777) == oct($Spool_perms);
+        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")
+    };
+
     return $Spool_dir;
 }
 
@@ -629,10 +626,9 @@ sub temp_file {
 
 sub temp_dir {
     my ($self, $mask) = @_;
-    $mask ||= '0700';
     my $dirname = $self->temp_file();
     -d $dirname
-      or mkdir($dirname, $mask)
+      or mkdir($dirname, $mask || '0700')
       or die "Could not create temporary directory $dirname: $!";
     return $dirname;
 }

lib/Qpsmtpd/Plugin.pm

@@ -1,5 +1,4 @@
 package Qpsmtpd::Plugin;
-
 use strict;
 use warnings;
 

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  

t/qpsmtpd.t

@@ -21,16 +21,19 @@ my $qp = bless {}, 'Qpsmtpd';
 ok($qp->version(), "version, " . $qp->version());
 is_deeply(Qpsmtpd::hooks(), {}, 'hooks, empty');
 
+__temp_file();
 __temp_dir();
 __size_threshold();
 __authenticated();
 __auth_user();
 __auth_mechanism();
+__spool_dir();
 
 __log();
 __load_logging();
 
 __config_dir();
+__config_from_file();
 __get_qmail_config();
 __config();
 
@@ -43,10 +46,12 @@ sub __get_qmail_config {
 }
 
 sub __config_from_file {
-
+    my $test_file = 't/config/test_config_file';
-    # $configfile, $config, $visited
+    my @r = $qp->_config_from_file($test_file);
-
+    ok( @r, "_config_from_file, $test_file");
-}
+    cmp_ok('1st line with content', 'eq', $r[0], "_config_from_file string compare");
+    ok( !$r[1], "_config_from_file");
+};
 
 sub __log {
     my $warned = '';
@@ -82,6 +87,68 @@ sub __load_logging {
     $Qpsmtpd::hooks->{logging} = undef;    # restore
 }
 
+sub __spool_dir {
+    my $dir = $qp->spool_dir();
+    ok( $dir, "spool_dir is at $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 {
+    ok( ! $qp->size_threshold(), "size_threshold is undefined")
+        or warn "size_threshold: " . $qp->size_threshold;
+
+    $Qpsmtpd::Size_threshold = 5;
+    cmp_ok( 5, '==', $qp->size_threshold(), "size_threshold equals 5");
+
+    $Qpsmtpd::Size_threshold = undef;
+}
+
+sub __authenticated {
+    ok( ! $qp->authenticated(), "authenticated is undefined");
+
+    $qp->{_auth} = 1;
+    ok($qp->authenticated(), "authenticated is true");
+
+    $qp->{_auth} = 0;
+    ok(! $qp->authenticated(), "authenticated is false");
+}
+
+sub __auth_user {
+    ok( ! $qp->auth_user(), "auth_user is undefined");
+
+    $qp->{_auth_user} = 'matt';
+    cmp_ok('matt', 'eq', $qp->auth_user(), "auth_user set");
+
+    $qp->{_auth_user} = undef;
+}
+
+sub __auth_mechanism {
+    ok( ! $qp->auth_mechanism(), "auth_mechanism is undefined");
+
+    $qp->{_auth_mechanism} = 'MD5';
+    cmp_ok('MD5', 'eq', $qp->auth_mechanism(), "auth_mechanism set");
+
+    $qp->{_auth_mechanism} = undef;
+}
+
 sub __config {
     my @r = $qp->config('badhelo');
     ok($r[0], "config, badhelo, @r");
@@ -183,55 +250,6 @@ sub __config {
     }
 }
 
-sub __temp_dir {
-    my $r = $qp->temp_dir();
-    ok( $r, "temp_dir, $r");
-
-    $r = $qp->temp_dir('0775');
-    ok( $r, "temp_dir with mask, $r");
-
-    if ($r && -d $r) { File::Path::rmtree $r; }
-}
-
-sub __size_threshold {
-    ok( ! $qp->size_threshold(), "size_threshold is undefined")
-        or warn "size_threshold: " . $qp->size_threshold;
-
-    $Qpsmtpd::Size_threshold = 5;
-    cmp_ok( 5, '==', $qp->size_threshold(), "size_threshold equals 5");
-
-    $Qpsmtpd::Size_threshold = undef;
-}
-
-sub __authenticated {
-    ok( ! $qp->authenticated(), "authenticated is undefined");
-
-    $qp->{_auth} = 1;
-    ok($qp->authenticated(), "authenticated is true");
-
-    $qp->{_auth} = 0;
-    ok(! $qp->authenticated(), "authenticated is false");
-}
-
-sub __auth_user {
-    ok( ! $qp->auth_user(), "auth_user is undefined");
-
-    $qp->{_auth_user} = 'matt';
-    cmp_ok('matt', 'eq', $qp->auth_user(), "auth_user set");
-
-    $qp->{_auth_user} = undef;
-}
-
-sub __auth_mechanism {
-    ok( ! $qp->auth_mechanism(), "auth_mechanism is undefined");
-
-    $qp->{_auth_mechanism} = 'MD5';
-    cmp_ok('MD5', 'eq', $qp->auth_mechanism(), "auth_mechanism set");
-
-    $qp->{_auth_mechanism} = undef;
-}
-
-
 package FakeAddress;
 
 sub new {