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

Merge pull request #122 from msimerson/return_cleanups

Browse Source 
Return cleanups
This commit is contained in:
flimzy 2014-09-18 05:52:14 -05:00
commit 5c9e7631ed
11 changed files with 220 additions and 221 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
docs/advanced.pod
View File

@ -65,14 +65,17 @@ should be configured to run I<last>, like B<rcpt_ok>.
my ($self, $transaction, $recipient) = @_; my ($self, $transaction, $recipient) = @_;
my ($rc, @msg) = $self->SUPER::hook_rcpt($transaction, $recipient); my ($rc, @msg) = $self->SUPER::hook_rcpt($transaction, $recipient);
return $rc, @msg unless (($rc == DENY) and $self->{_count_relay_max}) {
unless (($rc == DENY) and $self->{_count_relay_max}); return $rc, @msg;
};
my $count = my $count =
($self->connection->notes('count_relay_attempts') || 0) + 1; ($self->connection->notes('count_relay_attempts') || 0) + 1;
$self->connection->notes('count_relay_attempts', $count); $self->connection->notes('count_relay_attempts', $count);
return $rc, @msg unless ($count > $self->{_count_relay_max}); unless ($count > $self->{_count_relay_max}) {
return $rc, @msg;
};
return Qpsmtpd::DSN->relaying_denied(DENY_DISCONNECT, return Qpsmtpd::DSN->relaying_denied(DENY_DISCONNECT,
"Too many relaying attempts"); "Too many relaying attempts");
} }

6
docs/hooks.pod
View File

@ -712,8 +712,9 @@ plugin didn't find the requested value
requested values as C<@list>, example: requested values as C<@list>, example:
if (exists $config{$key}) {
return OK, @{$config{$key}} return OK, @{$config{$key}}
if exists $config{$key}; };
return DECLINED; return DECLINED;
=back =back
@ -744,8 +745,9 @@ plugin didn't find the requested value
requested values as C<@list>, example: requested values as C<@list>, example:
if (exists $config{$key}) {
return OK, @{$config{$key}} return OK, @{$config{$key}}
if exists $config{$key}; };
return DECLINED; return DECLINED;
=back =back

57
lib/Qpsmtpd/Address.pm
View File

@ -1,4 +1,3 @@
#!/usr/bin/perl -w
package Qpsmtpd::Address; package Qpsmtpd::Address;
use strict; use strict;
@ -22,13 +21,6 @@ for easy testing of values.
=head1 METHODS =head1 METHODS
=cut
use overload (
'""' => \&format,
'cmp' => \&_addr_cmp,
);
=head2 new() =head2 new()
Can be called two ways: Can be called two ways:
@ -56,14 +48,19 @@ test for equality (like in badmailfrom).
=cut =cut
use overload (
'""' => \&format,
'cmp' => \&_addr_cmp,
);
sub new { sub new {
my ($class, $user, $host) = @_; my ($class, $user, $host) = @_;
my $self = {}; my $self = {};
if ($user =~ /^<(.*)>$/) { if ($user =~ /^<(.*)>$/) {
($user, $host) = $class->canonify($user); ($user, $host) = $class->canonify($user);
return undef unless defined $user; return if !defined $user;
} }
elsif (not defined $host) { elsif (!defined $host) {
my $address = $user; my $address = $user;
($user, $host) = $address =~ m/(.*)(?:\@(.*))/; ($user, $host) = $address =~ m/(.*)(?:\@(.*))/;
} }
@ -193,54 +190,44 @@ sub canonify {
my ($dummy, $path) = @_; my ($dummy, $path) = @_;
# strip delimiters # strip delimiters
return undef unless ($path =~ /^<(.*)>$/); return if $path !~ /^<(.*)>$/;
$path = $1; $path = $1;
my $domain = my $domain = $domain_expr || "$subdomain_expr(?:\.$subdomain_expr)*";
$domain_expr
? $domain_expr
: "$subdomain_expr(?:\.$subdomain_expr)*";
# it is possible for $address_literal_expr to be empty, if a site # $address_literal_expr may be empty, if a site doesn't allow them
# doesn't want to allow them if (!$domain_expr && $address_literal_expr) {
$domain = "(?:$address_literal_expr|$domain)" $domain = "(?:$address_literal_expr|$domain)";
if !$domain_expr and $address_literal_expr; };
# strip source route # strip source route
$path =~ s/^\@$domain(?:,\@$domain)*://; $path =~ s/^\@$domain(?:,\@$domain)*://;
# empty path is ok # empty path is ok
return "" if $path eq ""; return '' if $path eq '';
# bare postmaster is permissible, perl RFC-2821 (4.5.1) # bare postmaster is permissible, perl RFC-2821 (4.5.1)
if ( $path =~ m/^postmaster$/i ) { if ( $path =~ m/^postmaster$/i ) {
return "postmaster", undef; return 'postmaster';
} }
my ($localpart, $domainpart) = ($path =~ /^(.*)\@($domain)$/); my ($localpart, $domainpart) = ($path =~ /^(.*)\@($domain)$/);
return undef if !defined $localpart; return if !defined $localpart;
if ($localpart =~ /^$atom_expr(\.$atom_expr)*/) { if ($localpart =~ /^$atom_expr(\.$atom_expr)*/) {
return $localpart, $domainpart; # simple case, we are done
# simple case, we are done
return $localpart, $domainpart;
} }
if ($localpart =~ /^"(($qtext_expr|\\$text_expr)*)"$/) { if ($localpart =~ /^"(($qtext_expr|\\$text_expr)*)"$/) {
$localpart = $1; $localpart = $1;
$localpart =~ s/\\($text_expr)/$1/g; $localpart =~ s/\\($text_expr)/$1/g;
return $localpart, $domainpart; return $localpart, $domainpart;
} }
return undef; return;
} }
=head2 parse() sub parse {
# Retained for compatibility
Retained as a compatibility method, it is completely equivalent
to new() called with a single parameter.
=cut
sub parse { # retain for compatibility only
return shift->new(shift); return shift->new(shift);
} }
@ -283,7 +270,7 @@ stringification operator, so the following are equivalent:
sub format { sub format {
my ($self) = @_; my ($self) = @_;
my $qchar = '[^a-zA-Z0-9!#\$\%\&\x27\*\+\x2D\/=\?\^_`{\|}~.]'; my $qchar = '[^a-zA-Z0-9!#\$\%\&\x27\*\+\x2D\/=\?\^_`{\|}~.]';
return '<>' unless defined $self->{_user}; return '<>' if !defined $self->{_user};
if ((my $user = $self->{_user}) =~ s/($qchar)/\\$1/g) { if ((my $user = $self->{_user}) =~ s/($qchar)/\\$1/g) {
return return
qq(<"$user") qq(<"$user")

49
lib/Qpsmtpd/Command.pm
View File

@ -33,14 +33,17 @@ Inside a plugin
sub hook_unrecognized_command_parse { sub hook_unrecognized_command_parse {
my ($self, $transaction, $cmd) = @_; my ($self, $transaction, $cmd) = @_;
return OK, \&bdat_parser if $cmd eq 'bdat'; if ($cmd eq 'bdat') {
return OK, \&bdat_parser;
};
} }
sub bdat_parser { sub bdat_parser {
my ($self,$cmd,$line) = @_; my ($self,$cmd,$line) = @_;
# .. do something with $line... # .. do something with $line...
return DENY, "Invalid arguments" if ($some_reason_why_there_is_a_syntax_error) {
if $some_reason_why_there_is_a_syntax_error; return DENY, "Invalid arguments";
};
return OK, @args; return OK, @args;
} }
@ -72,9 +75,7 @@ sub parse {
return DENY, $line; return DENY, $line;
} }
## my @log = @ret; ## my @log = @ret;
## for (@log) { ## for (@log) { $_ ||= ""; }
## $_ ||= "";
## }
## $self->log(LOGDEBUG, "parse($cmd) => [".join("], [", @log)."]"); ## $self->log(LOGDEBUG, "parse($cmd) => [".join("], [", @log)."]");
return @ret; return @ret;
} }
@ -94,14 +95,18 @@ sub parse {
sub parse_rcpt { sub parse_rcpt {
my ($self, $cmd, $line) = @_; my ($self, $cmd, $line) = @_;
return DENY, "Syntax error in command" if $line !~ s/^to:\s*//i; if ($line !~ s/^to:\s*//i) {
return &_get_mail_params($cmd, $line); return DENY, "Syntax error in command";
};
return _get_mail_params($cmd, $line);
} }
sub parse_mail { sub parse_mail {
my ($self, $cmd, $line) = @_; my ($self, $cmd, $line) = @_;
return DENY, "Syntax error in command" if $line !~ s/^from:\s*//i; if ($line !~ s/^from:\s*//i) {
return &_get_mail_params($cmd, $line); return DENY, "Syntax error in command";
};
return _get_mail_params($cmd, $line);
} }
### RFC 1869: ### RFC 1869:
## 6. MAIL FROM and RCPT TO Parameters ## 6. MAIL FROM and RCPT TO Parameters
@ -141,28 +146,28 @@ sub _get_mail_params {
# parameter syntax error, i.e. not all of the arguments were # parameter syntax error, i.e. not all of the arguments were
# stripped by the while() loop: # stripped by the while() loop:
return DENY, "Syntax error in parameters" if $line =~ /\@.*\s/; if ($line =~ /\@.*\s/) {
return DENY, "Syntax error in parameters";
};
return OK, $line, @params; return OK, $line, @params;
} }
$line = shift @params; $line = shift @params;
if ($cmd eq "mail") { if ($cmd eq 'mail') {
return OK, "<>" if !$line; # 'MAIL FROM:' --> 'MAIL FROM:<>' return OK, '<>' if !$line; # 'MAIL FROM:' --> 'MAIL FROM:<>'
return DENY, "Syntax error in parameters" if $line =~ /\@.*\s/; # parameter syntax error if ($line =~ /\@.*\s/) {
return DENY, "Syntax error in parameters";
} }
else { return OK, $line, @params;
}
if ($line =~ /\@/) { if ($line =~ /\@/) {
return DENY, "Syntax error in parameters" if $line =~ /\@.*\s/; return DENY, "Syntax error in parameters" if $line =~ /\@.*\s/;
return OK, $line, @params;
} }
else {
# XXX: what about 'abuse' in Qpsmtpd::Address?
return DENY, "Syntax error in parameters" if $line =~ /\s/; return DENY, "Syntax error in parameters" if $line =~ /\s/;
return DENY, "Syntax error in address" if $line !~ /^(postmaster|abuse)$/i; return DENY, "Syntax error in address" if $line !~ /^(postmaster|abuse)$/i;
}
}
## XXX: No: let this do a plugin, so it's not up to us to decide
## if we require <> around an address :-)
## unless ($line =~ /^<.*>$/) { $line = "<".$line.">"; }
return OK, $line, @params; return OK, $line, @params;
} }

29
plugins/parse_addr_withhelo
View File

@ -38,33 +38,34 @@ sub _parse {
my ($self, $cmd, $line) = @_; my ($self, $cmd, $line) = @_;
$self->log(LOGDEBUG, "_parse() cmd=[$cmd], line=[$line]"); $self->log(LOGDEBUG, "_parse() cmd=[$cmd], line=[$line]");
if ($cmd eq 'mail') { if ($cmd eq 'mail') {
return DENY, "Syntax error in command" if $line !~ s/^from:\s*//i; if ($line !~ s/^from:\s*//i) {
return DENY, "Syntax error in command";
};
} }
else { # cmd eq 'rcpt' else { # cmd eq 'rcpt'
return DENY, "Syntax error in command" if $line !~ s/^to:\s*//i; return DENY, "Syntax error in command" if $line !~ s/^to:\s*//i;
} }
if ($line =~ s/^(<.*>)\s*//) { if ($line =~ s/^(<.*>)\s*//) {
my $addr = $1; return DENY, "No parameters allowed in " . uc($cmd) if $line =~ /^\S/;
return DENY, "No parameters allowed in " . uc($cmd) return OK, $1; # $1 is captured address
if $line =~ /^\S/;
return OK, $addr, ();
} }
## now, no <> are given ## now, no <> are given
$line =~ s/\s*$//; $line =~ s/\s*$//;
if ($line =~ /\@/) { if ($line =~ /\@/) {
return DENY, "No parameters allowed in " . uc($cmd) if ($line =~ /\@\S+\s+\S/) {
if $line =~ /\@\S+\s+\S/; return DENY, "No parameters allowed in " . uc($cmd);
return OK, $line, (); };
return OK, $line;
} }
if ($cmd eq "mail") { if ($cmd eq 'mail') {
return OK, "<>" if !$line; # 'MAIL FROM:' -> 'MAIL FROM:<>' return OK, '<>' if !$line; # 'MAIL FROM:' -> 'MAIL FROM:<>'
return DENY, "Could not parse your MAIL FROM command"; return DENY, "Could not parse your MAIL FROM command";
} }
else {
return DENY, "Could not parse your RCPT TO command" if ($line !~ /^(postmaster|abuse)$/i) {
if $line !~ /^(postmaster|abuse)$/i; return DENY, "Could not parse your RCPT TO command";
} };
} }

20
plugins/queue/qmail-queue
View File

@ -21,7 +21,7 @@ If set the environment variable QMAILQUEUE overrides this setting.
=cut =cut
use strict; use strict;
use warnings; #use warnings;
use Qpsmtpd::Constants; use Qpsmtpd::Constants;
use POSIX (); use POSIX ();
@ -31,8 +31,7 @@ sub register {
if (@args > 0) { if (@args > 0) {
$self->{_queue_exec} = $args[0]; $self->{_queue_exec} = $args[0];
$self->log(LOGWARN, "WARNING: Ignoring additional arguments.") $self->log(LOGWARN, "Ignoring additional arguments.") if @args > 1;
if @args > 1;
} }
$self->{_queue_exec} ||= ($ENV{QMAIL} || '/var/qmail') . "/bin/qmail-queue"; $self->{_queue_exec} ||= ($ENV{QMAIL} || '/var/qmail') . "/bin/qmail-queue";
@ -49,8 +48,7 @@ sub hook_queue {
local $SIG{PIPE} = sub { die 'SIGPIPE' }; local $SIG{PIPE} = sub { die 'SIGPIPE' };
my $child = fork(); my $child = fork();
die "Could not fork" if !defined $child;
!defined $child and die "Could not fork";
if ($child) { if ($child) {
@ -87,7 +85,8 @@ sub hook_queue {
$msg_id = "<$msg_id>" unless $msg_id =~ /^<.*>$/; # surround in <>'s $msg_id = "<$msg_id>" unless $msg_id =~ /^<.*>$/; # surround in <>'s
return OK, "Queued! " . time . " qp $child $msg_id"; return OK, "Queued! " . time . " qp $child $msg_id";
} }
elsif (defined $child) {
return if !defined $child;
# Child # Child
close MESSAGE_WRITER or exit 1; close MESSAGE_WRITER or exit 1;
@ -99,12 +98,8 @@ sub hook_queue {
$queue_exec = $1; $queue_exec = $1;
} }
else { else {
$self->log(LOGERROR, $self->log(LOGERROR, "FATAL: Unexpected characters in plugin argument");
"FATAL ERROR: Unexpected characters in qmail-queue plugin argument" exit 3; # exiting the forked child process.
);
# This exit is ok as we're exiting a forked child process.
exit 3;
} }
# save the original STDIN and STDOUT in case exec() fails below # save the original STDIN and STDOUT in case exec() fails below
@ -126,5 +121,4 @@ sub hook_queue {
close(MESSAGE_WRITER); close(MESSAGE_WRITER);
exit 6; # we'll only get here if the exec fails exit 6; # we'll only get here if the exec fails
}
} }

26
plugins/quit_fortune
View File

@ -1,16 +1,26 @@
#!perl -w #!perl -w
use strict;
sub hook_quit { use Qpsmtpd::Constants;
my $qp = shift->qp;
# if she talks EHLO she is probably too sophisticated to enjoy the sub register {
# fun, so skip it. my $self = shift;
return DECLINED if ($qp->connection->hello || '') eq "ehlo"; $self->{_fortune} = '/usr/games/fortune';
return if ! $self->{_fortune};
my $fortune = '/usr/games/fortune'; # if fortune not installed, don't register hook
return DECLINED if !-e $fortune; $self->register_hook('quit', 'fortune');
}
my @fortune = `$fortune -s`; sub fortune {
my $self = shift;
my $qp = $self->qp;
# if she talks EHLO she is probably too sophisticated to enjoy the fun
return DECLINED if !$qp->connection->hello;
return DECLINED if $qp->connection->hello eq 'ehlo';
my @fortune = `$self->{_fortune} -s`;
@fortune = map { chop; s/^/ \/ /; $_ } @fortune; @fortune = map { chop; s/^/ \/ /; $_ } @fortune;
$qp->respond(221, $qp->config('me') . " closing connection.", @fortune); $qp->respond(221, $qp->config('me') . " closing connection.", @fortune);
return DONE; return DONE;

55
plugins/rcpt_map
View File

@ -1,4 +1,5 @@
#!perl -w #!perl -w
use strict;
=head1 NAME =head1 NAME
@ -92,13 +93,12 @@ our %map;
sub register { sub register {
my ($self, $qp, %args) = @_; my ($self, $qp, %args) = @_;
foreach my $arg (qw(domain file default)) { foreach my $arg (qw(domain file default)) {
next unless exists $args{$arg}; next if !exists $args{$arg};
if ($arg eq "default") { if ($arg eq 'default') {
my ($code, $msg) = split /=/, $args{$arg}; my ($code, $msg) = split /=/, $args{$arg};
$code = Qpsmtpd::Constants::return_code($code); $code = Qpsmtpd::Constants::return_code($code)
die "Not a valid constant for 'default' arg" or die "Not a valid constant for 'default' arg";
unless defined $code;
$msg or $msg = "No such user."; $msg or $msg = "No such user.";
$msg =~ s/_/ /g; $msg =~ s/_/ /g;
@ -110,21 +110,15 @@ sub register {
} }
} }
$self->{_default} $self->{_default} ||= [DENY, 'No such user.'];
or $self->{_default} = [DENY, "No such user."]; $self->{_file} or die "No map file given...";
$self->{_domain} or die "No domain name given...";
$self->{_file}
or die "No map file given...";
$self->{_domain}
or die "No domain name given...";
$self->{_domain} = lc $self->{_domain}; $self->{_domain} = lc $self->{_domain};
$self->log(LOGDEBUG, $self->log(LOGDEBUG,
"Using map " . $self->{_file} . " for domain " . $self->{_domain}); "Using map " . $self->{_file} . " for domain " . $self->{_domain});
%map = $self->read_map(1); %map = $self->read_map(1);
die "Empty map file " . $self->{_file} die "Empty map file " . $self->{_file} unless keys %map;
unless keys %map;
} }
sub hook_pre_connection { sub hook_pre_connection {
@ -132,8 +126,7 @@ sub hook_pre_connection {
my ($time) = (stat($self->{_file}))[9] || 0; my ($time) = (stat($self->{_file}))[9] || 0;
if ($time > $self->{_time}) { if ($time > $self->{_time}) {
my %temp = $self->read_map(); my %temp = $self->read_map();
keys %temp return DECLINED if !keys %temp;
or return DECLINED;
%map = %temp; %map = %temp;
} }
return DECLINED; return DECLINED;
@ -142,13 +135,15 @@ sub hook_pre_connection {
sub read_map { sub read_map {
my $self = shift; my $self = shift;
my %hash = (); my %hash = ();
open F, $self->{_file} open my $F, '<', $self->{_file} or do {
or do { $_[0] ? die "ERROR opening: $!" : return (); }; die "ERROR opening: $!" if $_[0];
return;
};
($self->{_time}) = (stat(F))[9] || 0; ($self->{_time}) = (stat($F))[9] || 0;
my $line = 0; my $line = 0;
while (<F>) { while (<$F>) {
++$line; ++$line;
s/^\s*//; s/^\s*//;
next if /^#/; next if /^#/;
@ -156,34 +151,32 @@ sub read_map {
my ($addr, $code, $msg) = split / /, $_, 3; my ($addr, $code, $msg) = split / /, $_, 3;
next unless $addr; next unless $addr;
unless ($code) { if (!$code) {
$self->log(LOGERROR, $self->log(LOGERROR,
"No constant in line $line in " . $self->{_file}); "No constant in line $line in " . $self->{_file});
next; next;
} }
$code = Qpsmtpd::Constants::return_code($code);
unless (defined $code) { $code = Qpsmtpd::Constants::return_code($code) or do {
$self->log(LOGERROR, $self->log(LOGERROR,
"Not a valid constant in line $line in " . $self->{_file}); "Not a valid constant in line $line in " . $self->{_file});
next; next;
} };
$msg or $msg = "No such user."; $msg or $msg = "No such user.";
$hash{$addr} = [$code, $msg]; $hash{$addr} = [$code, $msg];
} }
close $F;
return %hash; return %hash;
} }
sub hook_rcpt { sub hook_rcpt {
my ($self, $transaction, $recipient) = @_; my ($self, $transaction, $recipient) = @_;
return DECLINED
unless $recipient->host && $recipient->user;
return DECLINED return DECLINED unless $recipient->host && $recipient->user;
unless lc($recipient->host) eq $self->{_domain}; return DECLINED if lc($recipient->host) ne $self->{_domain};
my $rcpt = lc $recipient->user . '@' . lc $recipient->host; my $rcpt = lc $recipient->user . '@' . lc $recipient->host;
return @{$self->{_default}}
unless exists $map{$rcpt};
return @{$self->{_default}} if ! exists $map{$rcpt};
return @{$map{$rcpt}}; return @{$map{$rcpt}};
} }

58
plugins/stunnel
View File

@ -26,58 +26,48 @@ use strict;
use warnings; use warnings;
use Qpsmtpd::Constants; use Qpsmtpd::Constants;
my $proxy_enabled; sub register {
sub init {
my ($self, $qp, %args) = @_; my ($self, $qp, %args) = @_;
return if ( uc $args{proxy} ne 'ON' ); return if uc $args{proxy} ne 'ON';
$self->log(LOGINFO, "proxy protocol enabled"); $self->log(LOGINFO, "proxy protocol enabled");
$proxy_enabled = 1;
$self->register_hook('unrecognized_command', 'stunnel');
} }
sub hook_unrecognized_command { sub stunnel {
my ($self, $transaction, $cmd, @args) = @_; my ($self, $transaction, $cmd, @args) = @_;
return OK if ( uc $cmd ne 'PROXY' ); return OK if uc $cmd ne 'PROXY';
return OK if ( !defined $proxy_enabled ); return DENY_DISCONNECT if $self->connection->remote_ip() ne '127.0.0.1';
return DENY_DISCONNECT if ( $self->connection->remote_ip() ne '127.0.0.1' ); return DENY_DISCONNECT if $self->connection->notes('proxy');
return DENY_DISCONNECT if ( $self->connection->notes('proxy') );
# TCP4 192.168.41.227 10.27.11.106 50060 465 # TCP4 192.168.41.227 10.27.11.106 50060 465
if ( $args[0] =~ m/^(.*?) (.*?) (.*?) (.*?) (.*?)$/ ) { if ($args[0] !~ m/^(.*?) (.*?) (.*?) (.*?) (.*?)$/) {
my $protocol = $1; return DENY_DISCONNECT;
my $remote_ip = $2; }
my $local_ip = $3;
my $remote_port = $4; $self->connection->remote_ip($2);
my $local_port = $5; $self->connection->remote_port($4);
$self->connection->remote_ip( $remote_ip ); $self->connection->remote_info("[$2]");
$self->connection->remote_port( $remote_port );
$self->connection->remote_info( "[$remote_ip]");
$self->connection->notes('proxy', 'YES'); $self->connection->notes('proxy', 'YES');
$self->connection->notes('protocol', $protocol); $self->connection->notes('protocol', $1);
$self->connection->notes('remote_ip', $remote_ip); $self->connection->notes('remote_ip', $2);
$self->connection->notes('remote_port', $remote_port); $self->connection->notes('local_ip', $3);
$self->connection->notes('local_ip', $local_ip); $self->connection->notes('remote_port', $4);
$self->connection->notes('local_port', $local_port); $self->connection->notes('local_port', $5);
$self->log(LOGINFO, "stunnel : $remote_ip:$remote_port"); $self->log(LOGINFO, "stunnel : $2:$4");
# DNS reverse # DNS reverse
my $res = Net::DNS::Resolver->new( dnsrch => 0 ); my $res = $self->init_resolver();
$res->tcp_timeout(3); if (my $query = $res->query($self->connection->remote_ip, 'PTR')) {
$res->udp_timeout(3);
my $query = $res->query( $remote_ip, 'PTR' );
if ($query) {
foreach my $rr ($query->answer) { foreach my $rr ($query->answer) {
next if $rr->type ne 'PTR'; next if $rr->type ne 'PTR';
$self->connection->remote_host( $rr->ptrdname ); $self->connection->remote_host($rr->ptrdname);
} }
} }
}
else {
return DENY_DISCONNECT;
}
return DONE; return DONE;
} }

12
t/auth.t
View File

@ -2,18 +2,16 @@
use strict; use strict;
use warnings; use warnings;
use lib 't';
use lib 'lib';
use Data::Dumper; use Data::Dumper;
use Digest::HMAC_MD5 qw(hmac_md5_hex); use Digest::HMAC_MD5 qw(hmac_md5_hex);
use English qw/ -no_match_vars /; use English qw/ -no_match_vars /;
use File::Path; use File::Path;
use Qpsmtpd::Constants;
use Scalar::Util qw( openhandle ); use Scalar::Util qw( openhandle );
use Test::More qw(no_plan); use Test::More qw(no_plan);
use lib 't';
use lib 'lib';
use Qpsmtpd::Constants;
use_ok('Test::Qpsmtpd'); use_ok('Test::Qpsmtpd');
use_ok('Qpsmtpd::Auth'); use_ok('Qpsmtpd::Auth');
@ -22,10 +20,6 @@ my ($smtpd, $conn) = Test::Qpsmtpd->new_conn();
ok($smtpd, "get new connection ($smtpd)"); ok($smtpd, "get new connection ($smtpd)");
isa_ok($conn, 'Qpsmtpd::Connection', "get new connection"); isa_ok($conn, 'Qpsmtpd::Connection', "get new connection");
#warn Dumper($smtpd) and exit;
#my $hooks = $smtpd->hooks;
#warn Dumper($hooks) and exit;
my $r; my $r;
my $user = 'good@example.com'; my $user = 'good@example.com';
my $pass = 'good_pass'; my $pass = 'good_pass';

32
t/qpsmtpd-address.t
View File

@ -2,18 +2,22 @@
use strict; use strict;
use warnings; use warnings;
use Data::Dumper;
use Test::More; use Test::More;
use lib 't';
use lib 'lib'; use lib 'lib';
BEGIN { use_ok('Qpsmtpd::Constants'); } BEGIN {
use_ok('Qpsmtpd::Address'); use_ok('Qpsmtpd::Address');
use lib 't'; use_ok('Qpsmtpd::Constants');
use_ok('Test::Qpsmtpd'); use_ok('Test::Qpsmtpd');
}
__config();
__new(); __new();
done_testing() and exit;
__config();
__parse(); __parse();
done_testing(); done_testing();
@ -49,6 +53,22 @@ sub __new {
$as = '<user@example.com#>'; $as = '<user@example.com#>';
$ao = Qpsmtpd::Address->new($as); $ao = Qpsmtpd::Address->new($as);
is($ao, undef, "illegal $as"); is($ao, undef, "illegal $as");
is_deeply($ao, undef, "illegal $as, deeply");
$ao = Qpsmtpd::Address->new(undef);
is('<>', $ao, "new, user=undef, format");
is_deeply(bless({_user => undef, _host=>undef}, 'Qpsmtpd::Address'), $ao, "new, user=undef, deeply");
$ao = Qpsmtpd::Address->new('<matt@test.com>');
is('<matt@test.com>', $ao, 'new, user=matt@test.com, format');
is_deeply(bless( { '_host' => 'test.com', '_user' => 'matt' }, 'Qpsmtpd::Address' ),
$ao,
'new, user=matt@test.com, deeply');
$ao = Qpsmtpd::Address->new('postmaster');
is('<>', $ao, "new, user=postmaster, format");
is_deeply(bless({_user => undef, _host=>undef}, 'Qpsmtpd::Address'), $ao, "new, user=postmaster, deeply");
} }
sub __parse { sub __parse {