diff --git a/docs/advanced.pod b/docs/advanced.pod index fffb412..ed3ce5e 100644 --- a/docs/advanced.pod +++ b/docs/advanced.pod @@ -65,14 +65,17 @@ should be configured to run I, like B. my ($self, $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 = ($self->connection->notes('count_relay_attempts') || 0) + 1; $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, "Too many relaying attempts"); } diff --git a/docs/hooks.pod b/docs/hooks.pod index 3a236cf..aae4048 100644 --- a/docs/hooks.pod +++ b/docs/hooks.pod @@ -712,8 +712,9 @@ plugin didn't find the requested value requested values as C<@list>, example: - return OK, @{$config{$key}} - if exists $config{$key}; + if (exists $config{$key}) { + return OK, @{$config{$key}} + }; return DECLINED; =back @@ -744,8 +745,9 @@ plugin didn't find the requested value requested values as C<@list>, example: - return OK, @{$config{$key}} - if exists $config{$key}; + if (exists $config{$key}) { + return OK, @{$config{$key}} + }; return DECLINED; =back diff --git a/lib/Qpsmtpd/Address.pm b/lib/Qpsmtpd/Address.pm index fc81a01..469a23e 100644 --- a/lib/Qpsmtpd/Address.pm +++ b/lib/Qpsmtpd/Address.pm @@ -1,4 +1,3 @@ -#!/usr/bin/perl -w package Qpsmtpd::Address; use strict; @@ -22,13 +21,6 @@ for easy testing of values. =head1 METHODS -=cut - -use overload ( - '""' => \&format, - 'cmp' => \&_addr_cmp, - ); - =head2 new() Can be called two ways: @@ -56,14 +48,19 @@ test for equality (like in badmailfrom). =cut +use overload ( + '""' => \&format, + 'cmp' => \&_addr_cmp, + ); + sub new { my ($class, $user, $host) = @_; my $self = {}; if ($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; ($user, $host) = $address =~ m/(.*)(?:\@(.*))/; } @@ -193,54 +190,44 @@ sub canonify { my ($dummy, $path) = @_; # strip delimiters - return undef unless ($path =~ /^<(.*)>$/); + return if $path !~ /^<(.*)>$/; $path = $1; - my $domain = - $domain_expr - ? $domain_expr - : "$subdomain_expr(?:\.$subdomain_expr)*"; + my $domain = $domain_expr || "$subdomain_expr(?:\.$subdomain_expr)*"; - # it is possible for $address_literal_expr to be empty, if a site - # doesn't want to allow them - $domain = "(?:$address_literal_expr|$domain)" - if !$domain_expr and $address_literal_expr; + # $address_literal_expr may be empty, if a site doesn't allow them + if (!$domain_expr && $address_literal_expr) { + $domain = "(?:$address_literal_expr|$domain)"; + }; # strip source route $path =~ s/^\@$domain(?:,\@$domain)*://; # empty path is ok - return "" if $path eq ""; + return '' if $path eq ''; # bare postmaster is permissible, perl RFC-2821 (4.5.1) if ( $path =~ m/^postmaster$/i ) { - return "postmaster", undef; + return 'postmaster'; } my ($localpart, $domainpart) = ($path =~ /^(.*)\@($domain)$/); - return undef if !defined $localpart; + return if !defined $localpart; if ($localpart =~ /^$atom_expr(\.$atom_expr)*/) { - - # simple case, we are done - return $localpart, $domainpart; + return $localpart, $domainpart; # simple case, we are done } + if ($localpart =~ /^"(($qtext_expr|\\$text_expr)*)"$/) { $localpart = $1; $localpart =~ s/\\($text_expr)/$1/g; return $localpart, $domainpart; } - return undef; + return; } -=head2 parse() - -Retained as a compatibility method, it is completely equivalent -to new() called with a single parameter. - -=cut - -sub parse { # retain for compatibility only +sub parse { +# Retained for compatibility return shift->new(shift); } @@ -283,7 +270,7 @@ stringification operator, so the following are equivalent: sub format { my ($self) = @_; 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) { return qq(<"$user") diff --git a/t/qpsmtpd-address.t b/t/qpsmtpd-address.t index 2a1ec0b..8db4a14 100644 --- a/t/qpsmtpd-address.t +++ b/t/qpsmtpd-address.t @@ -2,18 +2,22 @@ use strict; use warnings; +use Data::Dumper; use Test::More; +use lib 't'; use lib 'lib'; -BEGIN { use_ok('Qpsmtpd::Constants'); } -use_ok('Qpsmtpd::Address'); -use lib 't'; -use_ok('Test::Qpsmtpd'); - -__config(); +BEGIN { + use_ok('Qpsmtpd::Address'); + use_ok('Qpsmtpd::Constants'); + use_ok('Test::Qpsmtpd'); +} __new(); +done_testing() and exit; + +__config(); __parse(); done_testing(); @@ -49,6 +53,22 @@ sub __new { $as = ''; $ao = Qpsmtpd::Address->new($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(''); + is('', $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 {