META updates, tidy, PBP tweaks

* update manifest
* perltidy
* replace postfix if/unless with brackets
* reduce useless indention by exiting sooner

MANIFEST

@@ -143,6 +143,7 @@ plugins/stunnel
 plugins/tls
 plugins/tls_cert
 plugins/uribl
+plugins/user_config
 plugins/virus/aveclient
 plugins/virus/bitdefender
 plugins/virus/clamav
@@ -205,6 +206,7 @@ t/plugin_tests/relay
 t/plugin_tests/resolvable_fromhost
 t/plugin_tests/sender_permitted_from
 t/plugin_tests/spamassassin
+t/plugin_tests/user_config
 t/plugin_tests/virus/clamdscan
 t/qpsmtpd-address.t
 t/qpsmtpd-smtp.t

lib/Qpsmtpd.pm

@@ -1,5 +1,6 @@
 package Qpsmtpd;
 use strict;
+
 #use warnings;
 use vars qw($TraceLevel $Spool_dir $Size_threshold);
 
@@ -7,7 +8,7 @@ use Sys::Hostname;
 use Qpsmtpd::Constants;
 use Qpsmtpd::Address;
 
-our $VERSION = "0.94";
+our $VERSION = "0.95";
 
 my $git;
 
@@ -148,24 +149,30 @@ sub config {
 
     # first run the hooks
     my ($rc, @config);
-    ($rc, @config) = $self->run_hooks_no_respond('user_config',$type,$c)
+    if (ref $type && $type->can('address')) {
-        if ref $type and $type->can('address');
+        ($rc, @config) = $self->run_hooks_no_respond('user_config', $type, $c);
-    return wantarray ? @config : $config[0]
+    };
-        if defined $rc and $rc == OK;
+    if (defined $rc && $rc == OK) {
+        return wantarray ? @config : $config[0];
+    };
     ($rc, @config) = $self->run_hooks_no_respond('config', $c);
-    $self->log(LOGDEBUG, "config($c): hook returned ("
+    $self->log(LOGDEBUG,
-        . join( ',', map { defined $_ ? $_ : 'undef' } ($rc,@config) ) . ")");
+                   "config($c): hook returned ("
-    return wantarray ? @config : $config[0]
+                 . join(',', map { defined $_ ? $_ : 'undef' } ($rc, @config))
-        if defined $rc and $rc == OK;
+                 . ")"
+              );
+    if (defined $rc && $rc == OK) {
+        return wantarray ? @config : $config[0];
+    };
 
-    # and then get_qmail_config
+    # then get_qmail_config
     @config = $self->get_qmail_config($c, $type);
-    return wantarray ? @config : $config[0]
+    return wantarray ? @config : $config[0] if @config;
-        if @config;
 
-    # finally we use the default if there is any:
+    # then the default, if any
-    return wantarray ? ($defaults{$c}) : $defaults{$c}
+    if (exists $defaults{$c}) {
-        if exists $defaults{$c};
+        return wantarray ? ($defaults{$c}) : $defaults{$c};
+    };
     return;
 }
 
@@ -205,7 +212,7 @@ sub get_qmail_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);
 }
@@ -236,7 +243,7 @@ sub get_qmail_config_map {
     # 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) = @_;
@@ -363,7 +370,7 @@ sub _load_plugin {
 
     if ($plugin =~ m/::/) {
         return $self->_load_package_plugin($plugin, $safe_line, \@args);
-    };
+    }
 
     # regular plugins/$plugin plugin
     my $plugin_name = $plugin;
@@ -383,19 +390,19 @@ sub _load_plugin {
     my $package = "Qpsmtpd::Plugin::$plugin_name";
 
     # don't reload plugins if they are already loaded
-    unless (defined &{"${package}::plugin_name"}) {
+    if (!defined &{"${package}::plugin_name"}) {
         PLUGIN_DIR: for my $dir (@plugin_dirs) {
-            if (-e "$dir/$plugin") {
+            next if !-e "$dir/$plugin";
             Qpsmtpd::Plugin->compile($plugin_name, $package,
                 "$dir/$plugin", $self->{_test_mode}, $plugin);
-                $self->log(LOGDEBUG, "Loading $safe_line from $dir/$plugin")
+            if ($safe_line !~ /logging/) {
-                    unless $safe_line =~ /logging/;
+                $self->log(LOGDEBUG, "Loading $safe_line from $dir/$plugin");
+            };
             last PLUGIN_DIR;
         }
-        }
+        if (! defined &{"${package}::plugin_name"}) {
-        die "Plugin $plugin_name not found in our plugin dirs (",
+            die "Plugin $plugin_name not found in our plugin dirs (", join(', ', @plugin_dirs), ")";
-            join(", ", @plugin_dirs), ")"
+        };
-            unless defined &{"${package}::plugin_name"};
     }
 
     my $plug = $package->new();
@@ -406,23 +413,25 @@ sub _load_plugin {
 
 sub _load_package_plugin {
     my ($self, $plugin, $plugin_line, $args) = @_;
+
     # "full" package plugin (My::Plugin)
     my $package = $plugin;
     $package =~ s/[^_a-z0-9:]+//gi;
-    my $eval = qq[require $package;\n]
+    my $eval =
-        . qq[sub ${plugin}::plugin_name { '$plugin' }];
+      qq[require $package;\n] . qq[sub ${plugin}::plugin_name { '$plugin' }];
     $eval =~ m/(.*)/s;
     $eval = $1;
     eval $eval;
     die "Failed loading $package - eval $@" if $@;
-    $self->log(LOGDEBUG, "Loading $package ($plugin_line)")
+    if ($plugin_line !~ /logging/) {
-        unless $plugin_line =~ /logging/;
+        $self->log(LOGDEBUG, "Loading $package ($plugin_line)");
+    };
 
     my $plug = $package->new();
     $plug->_register($self, @$args);
 
     return $plug;
-};
+}
 
 sub transaction { return {}; }    # base class implements empty transaction
 

lib/Qpsmtpd/SMTP.pm

@@ -4,6 +4,7 @@ use strict;
 use base 'Qpsmtpd';
 
 use Carp;
+
 #use Data::Dumper;
 use POSIX qw(strftime);
 use Mail::Header;
@@ -31,9 +32,8 @@ sub new {
     my $self = bless({args => \%args}, $class);
 
    # this list of valid commands should probably be a method or a set of methods
-    $self->{_commands} = {
+    $self->{_commands} =
-        map { $_ => '' } qw(ehlo helo rset mail rcpt data help vrfy noop quit)
+      {map { $_ => '' } qw(ehlo helo rset mail rcpt data help vrfy noop quit)};
-    };
 
     $self->SUPER::_restart(%args) if $args{restart}; # calls Qpsmtpd::_restart()
     $self;
@@ -260,11 +260,12 @@ sub ehlo_respond {
         }
 
         # Check if we should only offer AUTH after TLS is completed
-        my $tls_before_auth =
+        my $tls_before_auth = (
-          ($self->config('tls_before_auth')
+                               $self->config('tls_before_auth')
                                ? ($self->config('tls_before_auth'))[0]
                                  && $self->transaction->notes('tls_enabled')
-            : 0);
+                               : 0
+                              );
         if (%auth_mechanisms && !$tls_before_auth) {
             push @capabilities, 'AUTH ' . join(" ", keys(%auth_mechanisms));
             $self->{_commands}->{'auth'} = "";
@@ -789,6 +790,7 @@ sub authentication_results {
     my ($self) = @_;
 
     my @auth_list = $self->config('me');
+
     #   $self->clean_authentication_results();
 
     if (!defined $self->{_auth}) {
@@ -802,17 +804,18 @@ sub authentication_results {
         }
         else {
             push @auth_list, "auth=fail $mechanism $user";
-        };
+        }
-    };
+    }
 
     # RFC 5451: used in AUTH, DKIM, DOMAINKEYS, SENDERID, SPF
     if ($self->connection->notes('authentication_results')) {
         push @auth_list, $self->connection->notes('authentication_results');
-    };
+    }
 
     $self->log(LOGDEBUG, "adding auth results header");
-    $self->transaction->header->add('Authentication-Results', join('; ', @auth_list), 0);
+    $self->transaction->header->add('Authentication-Results',
-};
+                                    join('; ', @auth_list), 0);
+}
 
 sub clean_authentication_results {
     my $self = shift;
@@ -831,11 +834,13 @@ sub clean_authentication_results {
     my @ar_headers = $self->transaction->header->get('Authentication-Results');
     for (my $i = 0 ; $i < scalar @ar_headers ; $i++) {
         $self->transaction->header->delete('Authentication-Results', $i);
-        $self->transaction->header->add('Original-Authentication-Results', $ar_headers[$i]);
+        $self->transaction->header->add('Original-Authentication-Results',
+                                        $ar_headers[$i]);
     }
 
-    $self->log(LOGDEBUG, "Authentication-Results moved to Original-Authentication-Results" );
+    $self->log(LOGDEBUG,
-};
+             "Authentication-Results moved to Original-Authentication-Results");
+}
 
 sub received_line {
     my ($self) = @_;

packaging/rpm/VERSION

@@ -1 +1 @@
-0.94
+0.95

plugins/user_config

@@ -42,10 +42,12 @@ sub hook_user_config {
     my $filename = "$path/$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>));
+    my @return = <$fh>;
+    chomp @return;
     return OK, @return;
 }

t/plugin_tests/user_config

@@ -29,13 +29,21 @@ sub test_hook_user_config {
     open my $fh, '>', "$dirname/testfield";
     print $fh "testdata";
     close $fh;
-    my $a = FakeAddress->new( user => 'testuser', host => 'testhost', address => 'testaddress' );
+    my $a = FakeAddress->new(
-    my ( $r, $value ) = $self->hook_user_config( $self->qp->transaction, $a, 'testfield' );
+                             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' );
+    ($r, $value) =
-    is( $r, DECLINED, 'hook_user_config returned DECLINED when no config file present' );
+      $self->hook_user_config($self->qp->transaction, $a, 'noconfig');
-    is( $value, undef, 'hook_user_config returned no value when no config file present' );
+    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);
 }
 

t/qpsmtpd-address.t

@@ -120,7 +120,7 @@ sub __parse {
     ok($ao = Qpsmtpd::Address->parse("<$as>"), "parse <$as>");
     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");
@@ -154,9 +154,13 @@ sub __config {
             },
     );
     for (@test_data) {
-        $qp->hooks->{user_config}
+        $qp->hooks->{user_config} = @{$_->{result}}
-            = @{ $_->{result} }
+          ? [
-                ? [{ name => 'test hook', code => sub { return @{ $_->{result} }} }]
+            {
+             name => 'test hook',
+             code => sub { return @{$_->{result}} }
+            }
+          ]
           : undef;
         is($sender->config($_->{pref}), $_->{expected}, $_->{descr});
     }

t/qpsmtpd.t

@@ -6,6 +6,7 @@ use Data::Dumper;
 use Test::More;
 
 use lib 'lib';    # test lib/Qpsmtpd (vs site_perl)
+
 BEGIN {
     use_ok('Qpsmtpd');
     use_ok('Qpsmtpd::Constants');
@@ -32,12 +33,13 @@ 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 = '';
@@ -60,7 +62,7 @@ sub __config_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;
@@ -82,7 +84,7 @@ sub __authenticated {
 
     $qp->{_auth} = 0;
     ok(!$qp->authenticated(), "authenticated, false");
-};
+}
 
 sub __config {
     my @r = $qp->config('badhelo');
@@ -165,13 +167,23 @@ sub __config {
     );
     for my $t (@test_data) {
         for my $hook (qw( config user_config )) {
-             $qp->hooks->{$hook}
+            $qp->hooks->{$hook} = @{$t->{hooks}{$hook}}
-                = @{ $t->{hooks}{$hook} }
+              ? [
-                    ? [{ name => 'test hook', code => sub { return @{ $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(
-        is( $qp->config($t->{pref}),    $t->{expected}{global}, "Global config: $t->{descr}");
+            $qp->config($t->{pref}, $a),
+            $t->{expected}{user},
+            "User config: $t->{descr}"
+          );
+        is($qp->config($t->{pref}),
+            $t->{expected}{global},
+            "Global config: $t->{descr}");
     }
 }