more tests for Qpsmtpd.pm

lib/Qpsmtpd.pm

@@ -221,34 +221,40 @@ sub get_qmail_config {
 
     # CDB config support really should be moved to a plugin
     if ($type and $type eq "map") {
-        unless (-e $configfile . ".cdb") {
+        return $self->get_qmail_config_map($config, $configfile);
-            $_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;
-    }
 
     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) {
@@ -257,10 +263,12 @@ sub _config_from_file {
     }
 
     $visited ||= [];
-    push @{$visited}, $configfile;
+    push @$visited, $configfile;
 
-    open my $CF, '<', $configfile
+    open my $CF, '<', $configfile or do {
-      or warn "$$ could not open configfile $configfile: $!" and return;
+        warn "$$ could not open configfile $configfile: $!";
+        return;
+    };
     my @config = <$CF>;
     chomp @config;
     @config = grep { length($_) and $_ !~ m/^\s*#/ and $_ =~ m/\S/ }

t/qpsmtpd-address.t

@@ -1,108 +1,120 @@
 #!/usr/bin/perl
 use strict;
-$^W = 1;
+use warnings;
 
-use Test::More qw/no_plan/;
+use Test::More;
+
+use lib 'lib';
 
 BEGIN {
     use_ok('Qpsmtpd::Address');
 }
 
-my $as;
+__new();
-my $ao;
+__parse();
 
-$as = '<>';
+done_testing();
-$ao = Qpsmtpd::Address->parse($as);
-ok($ao, "parse $as");
-is($ao->format, $as, "format $as");
 
-$as = '<postmaster>';
+sub __new {
-$ao = Qpsmtpd::Address->parse($as);
+    my ($as, $ao);
-ok($ao, "parse $as");
-is($ao->format, $as, "format $as");
 
-$as = '<foo@example.com>';
+    my @unsorted_list = map { Qpsmtpd::Address->new($_) } qw(
-$ao = Qpsmtpd::Address->parse($as);
+    "musa_ibrah@caramail.comandrea.luger"@wifo.ac.at
-ok($ao, "parse $as");
+    foo@example.com
-is($ao->format, $as, "format $as");
+    ask@perl.org
+    foo@foo.x.example.com
+    jpeacock@cpan.org
+    test@example.com
+    );
 
-is($ao->user, 'foo',         'user');
+# NOTE that this is sorted by _host_ not by _domain_
-is($ao->host, 'example.com', 'host');
+    my @sorted_list = map { Qpsmtpd::Address->new($_) } qw(
+    jpeacock@cpan.org
+    foo@example.com
+    test@example.com
+    foo@foo.x.example.com
+    ask@perl.org
+    "musa_ibrah@caramail.comandrea.luger"@wifo.ac.at
+    );
+
+    my @test_list = sort @unsorted_list;
+
+    is_deeply(\@test_list, \@sorted_list, "sort via overloaded 'cmp' operator");
+
+# RT#38746 - non-RFC compliant address should return undef
+
+    $as = '<user@example.com#>';
+    $ao = Qpsmtpd::Address->new($as);
+    is($ao, undef, "illegal $as");
+}
+
+sub __parse {
+    my ($as, $ao);
+
+    $as = '<>';
+    $ao = Qpsmtpd::Address->parse($as);
+    ok($ao, "parse $as");
+    is($ao->format, $as, "format $as");
+
+    $as = '<postmaster>';
+    $ao = Qpsmtpd::Address->parse($as);
+    ok($ao, "parse $as");
+    is($ao->format, $as, "format $as");
+
+    $as = '<foo@example.com>';
+    $ao = Qpsmtpd::Address->parse($as);
+    ok($ao, "parse $as");
+    is($ao->format, $as, "format $as");
+
+    is($ao->user, 'foo',         'user');
+    is($ao->host, 'example.com', 'host');
 
 # the \ before the @ in the local part is not required, but
 # allowed. For simplicity we add a backslash before all characters
 # which are not allowed in a dot-string.
-$as = '<"musa_ibrah@caramail.comandrea.luger"@wifo.ac.at>';
+    $as = '<"musa_ibrah@caramail.comandrea.luger"@wifo.ac.at>';
-$ao = Qpsmtpd::Address->parse($as);
+    $ao = Qpsmtpd::Address->parse($as);
-ok($ao, "parse $as");
+    ok($ao, "parse $as");
-is($ao->format, '<"musa_ibrah\@caramail.comandrea.luger"@wifo.ac.at>',
+    is($ao->format, '<"musa_ibrah\@caramail.comandrea.luger"@wifo.ac.at>',
-    "format $as");
+        "format $as");
 
 # email addresses with spaces
-$as = '<foo bar@example.com>';
+    $as = '<foo bar@example.com>';
-$ao = Qpsmtpd::Address->parse($as);
+    $ao = Qpsmtpd::Address->parse($as);
-ok($ao, "parse $as");
+    ok($ao, "parse $as");
-is($ao->format, '<"foo\ bar"@example.com>', "format $as");
+    is($ao->format, '<"foo\ bar"@example.com>', "format $as");
 
-$as = 'foo@example.com';
+    $as = 'foo@example.com';
-$ao = Qpsmtpd::Address->new($as);
+    $ao = Qpsmtpd::Address->new($as);
-ok($ao, "new $as");
+    ok($ao, "new $as");
-is($ao->address, $as, "address $as");
+    is($ao->address, $as, "address $as");
 
-$as = '<foo@example.com>';
+    $as = '<foo@example.com>';
-$ao = Qpsmtpd::Address->new($as);
+    $ao = Qpsmtpd::Address->new($as);
-ok($ao, "new $as");
+    ok($ao, "new $as");
-is($ao->address, 'foo@example.com', "address $as");
+    is($ao->address, 'foo@example.com', "address $as");
 
-$as = '<foo@foo.x.example.com>';
+    $as = '<foo@foo.x.example.com>';
-$ao = Qpsmtpd::Address->new($as);
+    $ao = Qpsmtpd::Address->new($as);
-ok($ao, "new $as");
+    ok($ao, "new $as");
-is($ao->format, $as, "format $as");
+    is($ao->format, $as, "format $as");
 
-$as = 'foo@foo.x.example.com';
+    $as = 'foo@foo.x.example.com';
-ok($ao = Qpsmtpd::Address->parse('<' . $as . '>'), "parse $as");
+    ok($ao = Qpsmtpd::Address->parse('<' . $as . '>'), "parse $as");
-is($ao && $ao->address, $as, "address $as");
+    is($ao && $ao->address, $as, "address $as");
 
 # Not sure why we can change the address like this, but we can so test it ...
-is($ao && $ao->address('test@example.com'),
+    is($ao && $ao->address('test@example.com'),
-    'test@example.com', 'address(test@example.com)');
+        'test@example.com', 'address(test@example.com)');
 
-$as = '<foo@foo.x.example.com>';
+    $as = '<foo@foo.x.example.com>';
-$ao = Qpsmtpd::Address->new($as);
+    $ao = Qpsmtpd::Address->new($as);
-ok($ao, "new $as");
+    ok($ao, "new $as");
-is($ao->format, $as, "format $as");
+    is($ao->format, $as, "format $as");
-is("$ao",       $as, "overloaded stringify $as");
+    is("$ao",       $as, "overloaded stringify $as");
 
-$as = 'foo@foo.x.example.com';
+    $as = 'foo@foo.x.example.com';
-ok($ao = Qpsmtpd::Address->parse("<$as>"), "parse <$as>");
+    ok($ao = Qpsmtpd::Address->parse("<$as>"), "parse <$as>");
-is($ao && $ao->address, $as, "address $as");
+    is($ao && $ao->address, $as, "address $as");
-ok($ao eq $as, "overloaded 'cmp' operator");
+    ok($ao eq $as, "overloaded 'cmp' operator");
-
+};
-my @unsorted_list = map { Qpsmtpd::Address->new($_) } qw(
-  "musa_ibrah@caramail.comandrea.luger"@wifo.ac.at
-  foo@example.com
-  ask@perl.org
-  foo@foo.x.example.com
-  jpeacock@cpan.org
-  test@example.com
-  );
-
-# NOTE that this is sorted by _host_ not by _domain_
-my @sorted_list = map { Qpsmtpd::Address->new($_) } qw(
-  jpeacock@cpan.org
-  foo@example.com
-  test@example.com
-  foo@foo.x.example.com
-  ask@perl.org
-  "musa_ibrah@caramail.comandrea.luger"@wifo.ac.at
-  );
-
-my @test_list = sort @unsorted_list;
-
-is_deeply(\@test_list, \@sorted_list, "sort via overloaded 'cmp' operator");
-
-# RT#38746 - non-RFC compliant address should return undef
-
-$as = '<user@example.com#>';
-$ao = Qpsmtpd::Address->new($as);
-is($ao, undef, "illegal $as");

t/qpsmtpd.t

@@ -9,18 +9,36 @@ use lib 'lib';      # test lib/Qpsmtpd (vs site_perl)
 BEGIN { use_ok('Qpsmtpd'); }
 BEGIN { use_ok('Qpsmtpd::Constants'); }
 
-my $package = 'Qpsmtpd';
+my $qp = bless {}, 'Qpsmtpd';
-my $qp = bless {}, $package;
 
 ok( $qp->version(), "version, " . $qp->version());
 is_deeply( Qpsmtpd::hooks(), {}, 'hooks, empty');
 
+__authenticated();
 __config_dir();
+__get_qmail_config();
+__config();
 __log();
 __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");
+
+    # TODO: add positive tests.
+};
+
+sub __config_from_file {
+    # $configfile, $config, $visited
+
+};
+
 sub __log {
     my $warned = '';
     local $SIG{__WARN__} = sub {
@@ -54,3 +72,14 @@ sub __load_logging {
 
     $Qpsmtpd::hooks->{logging} = undef;  # restore
 }
+
+sub __authenticated {
+
+    ok( ! $qp->authenticated(), "authenticated, undef");
+
+    $qp->{_auth} = 1;
+    ok( $qp->authenticated(), "authenticated, true");
+
+    $qp->{_auth} = 0;
+    ok( !$qp->authenticated(), "authenticated, false");
+};