byterazor/qpsmtpd
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

more tests for Qpsmtpd.pm

Browse Source
This commit is contained in:
Matt Simerson 2014-09-15 11:53:28 -07:00
parent 43eb6381fe
commit 7396dbbf5f
3 changed files with 160 additions and 111 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
lib/Qpsmtpd.pm
View File

@ -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") {
$_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->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) {
@ -257,10 +263,12 @@ sub _config_from_file {
}
$visited ||= [];
push @{$visited}, $configfile;
push @$visited, $configfile;
open my $CF, '<', $configfile
or warn "$$ could not open configfile $configfile: $!" and return;
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/ }

176
t/qpsmtpd-address.t
View File

@ -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;
my $ao;
__new();
__parse();
$as = '<>';
$ao = Qpsmtpd::Address->parse($as);
ok($ao, "parse $as");
is($ao->format, $as, "format $as");
done_testing();
$as = '<postmaster>';
$ao = Qpsmtpd::Address->parse($as);
ok($ao, "parse $as");
is($ao->format, $as, "format $as");
sub __new {
my ($as, $ao);
$as = '<foo@example.com>';
$ao = Qpsmtpd::Address->parse($as);
ok($ao, "parse $as");
is($ao->format, $as, "format $as");
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
);
is($ao->user, 'foo', 'user');
is($ao->host, 'example.com', 'host');
# 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");
}
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>';
$ao = Qpsmtpd::Address->parse($as);
ok($ao, "parse $as");
is($ao->format, '<"musa_ibrah\@caramail.comandrea.luger"@wifo.ac.at>',
"format $as");
$as = '<"musa_ibrah@caramail.comandrea.luger"@wifo.ac.at>';
$ao = Qpsmtpd::Address->parse($as);
ok($ao, "parse $as");
is($ao->format, '<"musa_ibrah\@caramail.comandrea.luger"@wifo.ac.at>',
"format $as");
# email addresses with spaces
$as = '<foo bar@example.com>';
$ao = Qpsmtpd::Address->parse($as);
ok($ao, "parse $as");
is($ao->format, '<"foo\ bar"@example.com>', "format $as");
$as = '<foo bar@example.com>';
$ao = Qpsmtpd::Address->parse($as);
ok($ao, "parse $as");
is($ao->format, '<"foo\ bar"@example.com>', "format $as");
$as = 'foo@example.com';
$ao = Qpsmtpd::Address->new($as);
ok($ao, "new $as");
is($ao->address, $as, "address $as");
$as = 'foo@example.com';
$ao = Qpsmtpd::Address->new($as);
ok($ao, "new $as");
is($ao->address, $as, "address $as");
$as = '<foo@example.com>';
$ao = Qpsmtpd::Address->new($as);
ok($ao, "new $as");
is($ao->address, 'foo@example.com', "address $as");
$as = '<foo@example.com>';
$ao = Qpsmtpd::Address->new($as);
ok($ao, "new $as");
is($ao->address, 'foo@example.com', "address $as");
$as = '<foo@foo.x.example.com>';
$ao = Qpsmtpd::Address->new($as);
ok($ao, "new $as");
is($ao->format, $as, "format $as");
$as = '<foo@foo.x.example.com>';
$ao = Qpsmtpd::Address->new($as);
ok($ao, "new $as");
is($ao->format, $as, "format $as");
$as = 'foo@foo.x.example.com';
ok($ao = Qpsmtpd::Address->parse('<' . $as . '>'), "parse $as");
is($ao && $ao->address, $as, "address $as");
$as = 'foo@foo.x.example.com';
ok($ao = Qpsmtpd::Address->parse('<' . $as . '>'), "parse $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'),
'test@example.com', 'address(test@example.com)');
is($ao && $ao->address('test@example.com'),
'test@example.com', 'address(test@example.com)');
$as = '<foo@foo.x.example.com>';
$ao = Qpsmtpd::Address->new($as);
ok($ao, "new $as");
is($ao->format, $as, "format $as");
is("$ao", $as, "overloaded stringify $as");
$as = '<foo@foo.x.example.com>';
$ao = Qpsmtpd::Address->new($as);
ok($ao, "new $as");
is($ao->format, $as, "format $as");
is("$ao", $as, "overloaded stringify $as");
$as = 'foo@foo.x.example.com';
ok($ao = Qpsmtpd::Address->parse("<$as>"), "parse <$as>");
is($ao && $ao->address, $as, "address $as");
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");
$as = 'foo@foo.x.example.com';
ok($ao = Qpsmtpd::Address->parse("<$as>"), "parse <$as>");
is($ao && $ao->address, $as, "address $as");
ok($ao eq $as, "overloaded 'cmp' operator");
};

33
t/qpsmtpd.t
View File

@ -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 {}, $package;
my $qp = bless {}, 'Qpsmtpd';
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");
};