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/lib/Qpsmtpd/Command.pm b/lib/Qpsmtpd/Command.pm index 7787f2d..b1b5961 100644 --- a/lib/Qpsmtpd/Command.pm +++ b/lib/Qpsmtpd/Command.pm @@ -33,14 +33,17 @@ Inside a plugin sub hook_unrecognized_command_parse { my ($self, $transaction, $cmd) = @_; - return OK, \&bdat_parser if $cmd eq 'bdat'; + if ($cmd eq 'bdat') { + return OK, \&bdat_parser; + }; } sub bdat_parser { my ($self,$cmd,$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; } @@ -72,9 +75,7 @@ sub parse { return DENY, $line; } ## my @log = @ret; - ## for (@log) { - ## $_ ||= ""; - ## } + ## for (@log) { $_ ||= ""; } ## $self->log(LOGDEBUG, "parse($cmd) => [".join("], [", @log)."]"); return @ret; } @@ -94,14 +95,18 @@ sub parse { sub parse_rcpt { my ($self, $cmd, $line) = @_; - return DENY, "Syntax error in command" if $line !~ s/^to:\s*//i; - return &_get_mail_params($cmd, $line); + if ($line !~ s/^to:\s*//i) { + return DENY, "Syntax error in command"; + }; + return _get_mail_params($cmd, $line); } sub parse_mail { my ($self, $cmd, $line) = @_; - return DENY, "Syntax error in command" if $line !~ s/^from:\s*//i; - return &_get_mail_params($cmd, $line); + if ($line !~ s/^from:\s*//i) { + return DENY, "Syntax error in command"; + }; + return _get_mail_params($cmd, $line); } ### RFC 1869: ## 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 # 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; } $line = shift @params; - if ($cmd eq "mail") { - return OK, "<>" if !$line; # 'MAIL FROM:' --> 'MAIL FROM:<>' - return DENY, "Syntax error in parameters" if $line =~ /\@.*\s/; # parameter syntax error - } - else { - if ($line =~ /\@/) { - return DENY, "Syntax error in parameters" if $line =~ /\@.*\s/; - } - else { - # XXX: what about 'abuse' in Qpsmtpd::Address? - return DENY, "Syntax error in parameters" if $line =~ /\s/; - return DENY, "Syntax error in address" if $line !~ /^(postmaster|abuse)$/i; + if ($cmd eq 'mail') { + return OK, '<>' if !$line; # 'MAIL FROM:' --> 'MAIL FROM:<>' + if ($line =~ /\@.*\s/) { + return DENY, "Syntax error in parameters"; } + return OK, $line, @params; } - ## 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.">"; } + + if ($line =~ /\@/) { + return DENY, "Syntax error in parameters" if $line =~ /\@.*\s/; + return OK, $line, @params; + } + + return DENY, "Syntax error in parameters" if $line =~ /\s/; + return DENY, "Syntax error in address" if $line !~ /^(postmaster|abuse)$/i; return OK, $line, @params; } diff --git a/plugins/parse_addr_withhelo b/plugins/parse_addr_withhelo index cde2277..43bdc80 100644 --- a/plugins/parse_addr_withhelo +++ b/plugins/parse_addr_withhelo @@ -38,33 +38,34 @@ sub _parse { my ($self, $cmd, $line) = @_; $self->log(LOGDEBUG, "_parse() cmd=[$cmd], line=[$line]"); 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' return DENY, "Syntax error in command" if $line !~ s/^to:\s*//i; } if ($line =~ s/^(<.*>)\s*//) { - my $addr = $1; - return DENY, "No parameters allowed in " . uc($cmd) - if $line =~ /^\S/; - return OK, $addr, (); + return DENY, "No parameters allowed in " . uc($cmd) if $line =~ /^\S/; + return OK, $1; # $1 is captured address } ## now, no <> are given $line =~ s/\s*$//; if ($line =~ /\@/) { - return DENY, "No parameters allowed in " . uc($cmd) - if $line =~ /\@\S+\s+\S/; - return OK, $line, (); + if ($line =~ /\@\S+\s+\S/) { + return DENY, "No parameters allowed in " . uc($cmd); + }; + return OK, $line; } - if ($cmd eq "mail") { - return OK, "<>" if !$line; # 'MAIL FROM:' -> 'MAIL FROM:<>' + if ($cmd eq 'mail') { + return OK, '<>' if !$line; # 'MAIL FROM:' -> 'MAIL FROM:<>' 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"; + }; } diff --git a/plugins/queue/qmail-queue b/plugins/queue/qmail-queue index 9323e70..53b428f 100644 --- a/plugins/queue/qmail-queue +++ b/plugins/queue/qmail-queue @@ -21,7 +21,7 @@ If set the environment variable QMAILQUEUE overrides this setting. =cut use strict; -use warnings; +#use warnings; use Qpsmtpd::Constants; use POSIX (); @@ -31,8 +31,7 @@ sub register { if (@args > 0) { $self->{_queue_exec} = $args[0]; - $self->log(LOGWARN, "WARNING: Ignoring additional arguments.") - if @args > 1; + $self->log(LOGWARN, "Ignoring additional arguments.") if @args > 1; } $self->{_queue_exec} ||= ($ENV{QMAIL} || '/var/qmail') . "/bin/qmail-queue"; @@ -49,8 +48,7 @@ sub hook_queue { local $SIG{PIPE} = sub { die 'SIGPIPE' }; my $child = fork(); - - !defined $child and die "Could not fork"; + die "Could not fork" if !defined $child; if ($child) { @@ -87,44 +85,40 @@ sub hook_queue { $msg_id = "<$msg_id>" unless $msg_id =~ /^<.*>$/; # surround in <>'s return OK, "Queued! " . time . " qp $child $msg_id"; } - elsif (defined $child) { - # Child - close MESSAGE_WRITER or exit 1; - close ENVELOPE_WRITER or exit 2; + return if !defined $child; - # Untaint $self->{_queue_exec} - my $queue_exec = $self->{_queue_exec}; - if ($queue_exec =~ /^(\/[\/\-\_\.a-z0-9A-Z]*)$/) { - $queue_exec = $1; - } - else { - $self->log(LOGERROR, -"FATAL ERROR: Unexpected characters in qmail-queue plugin argument" - ); + # Child + close MESSAGE_WRITER or exit 1; + close ENVELOPE_WRITER or exit 2; - # 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 - open(SAVE_STDIN, "<&STDIN"); - open(SAVE_STDOUT, ">&STDOUT"); - - POSIX::dup2(fileno(MESSAGE_READER), 0) - or die "Unable to dup MESSAGE_READER: $!"; - POSIX::dup2(fileno(ENVELOPE_READER), 1) - or die "Unable to dup ENVELOPE_READER: $!"; - - my $ppid = getppid(); - $self->log(LOGNOTICE, "(for $ppid) Queuing to $queue_exec"); - - my $rc = exec $queue_exec; - - # close the pipe - close(MESSAGE_READER); - close(MESSAGE_WRITER); - - exit 6; # we'll only get here if the exec fails + # Untaint $self->{_queue_exec} + my $queue_exec = $self->{_queue_exec}; + if ($queue_exec =~ /^(\/[\/\-\_\.a-z0-9A-Z]*)$/) { + $queue_exec = $1; } + else { + $self->log(LOGERROR, "FATAL: Unexpected characters in plugin argument"); + exit 3; # exiting the forked child process. + } + + # save the original STDIN and STDOUT in case exec() fails below + open(SAVE_STDIN, "<&STDIN"); + open(SAVE_STDOUT, ">&STDOUT"); + + POSIX::dup2(fileno(MESSAGE_READER), 0) + or die "Unable to dup MESSAGE_READER: $!"; + POSIX::dup2(fileno(ENVELOPE_READER), 1) + or die "Unable to dup ENVELOPE_READER: $!"; + + my $ppid = getppid(); + $self->log(LOGNOTICE, "(for $ppid) Queuing to $queue_exec"); + + my $rc = exec $queue_exec; + + # close the pipe + close(MESSAGE_READER); + close(MESSAGE_WRITER); + + exit 6; # we'll only get here if the exec fails } diff --git a/plugins/quit_fortune b/plugins/quit_fortune index 6a3a77c..87ad6f0 100644 --- a/plugins/quit_fortune +++ b/plugins/quit_fortune @@ -1,16 +1,26 @@ #!perl -w +use strict; -sub hook_quit { - my $qp = shift->qp; +use Qpsmtpd::Constants; - # if she talks EHLO she is probably too sophisticated to enjoy the - # fun, so skip it. - return DECLINED if ($qp->connection->hello || '') eq "ehlo"; +sub register { + my $self = shift; + $self->{_fortune} = '/usr/games/fortune'; + return if ! $self->{_fortune}; - my $fortune = '/usr/games/fortune'; - return DECLINED if !-e $fortune; + # if fortune not installed, don't register hook + $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; $qp->respond(221, $qp->config('me') . " closing connection.", @fortune); return DONE; diff --git a/plugins/rcpt_map b/plugins/rcpt_map index 025654f..fcf8391 100644 --- a/plugins/rcpt_map +++ b/plugins/rcpt_map @@ -1,4 +1,5 @@ #!perl -w +use strict; =head1 NAME @@ -92,13 +93,12 @@ our %map; sub register { my ($self, $qp, %args) = @_; foreach my $arg (qw(domain file default)) { - next unless exists $args{$arg}; - if ($arg eq "default") { + next if !exists $args{$arg}; + if ($arg eq 'default') { my ($code, $msg) = split /=/, $args{$arg}; - $code = Qpsmtpd::Constants::return_code($code); - die "Not a valid constant for 'default' arg" - unless defined $code; + $code = Qpsmtpd::Constants::return_code($code) + or die "Not a valid constant for 'default' arg"; $msg or $msg = "No such user."; $msg =~ s/_/ /g; @@ -110,21 +110,15 @@ sub register { } } - $self->{_default} - or $self->{_default} = [DENY, "No such user."]; - - $self->{_file} - or die "No map file given..."; - - $self->{_domain} - or die "No domain name given..."; + $self->{_default} ||= [DENY, 'No such user.']; + $self->{_file} or die "No map file given..."; + $self->{_domain} or die "No domain name given..."; $self->{_domain} = lc $self->{_domain}; $self->log(LOGDEBUG, "Using map " . $self->{_file} . " for domain " . $self->{_domain}); %map = $self->read_map(1); - die "Empty map file " . $self->{_file} - unless keys %map; + die "Empty map file " . $self->{_file} unless keys %map; } sub hook_pre_connection { @@ -132,8 +126,7 @@ sub hook_pre_connection { my ($time) = (stat($self->{_file}))[9] || 0; if ($time > $self->{_time}) { my %temp = $self->read_map(); - keys %temp - or return DECLINED; + return DECLINED if !keys %temp; %map = %temp; } return DECLINED; @@ -142,13 +135,15 @@ sub hook_pre_connection { sub read_map { my $self = shift; my %hash = (); - open F, $self->{_file} - or do { $_[0] ? die "ERROR opening: $!" : return (); }; + open my $F, '<', $self->{_file} or do { + die "ERROR opening: $!" if $_[0]; + return; + }; - ($self->{_time}) = (stat(F))[9] || 0; + ($self->{_time}) = (stat($F))[9] || 0; my $line = 0; - while () { + while (<$F>) { ++$line; s/^\s*//; next if /^#/; @@ -156,34 +151,32 @@ sub read_map { my ($addr, $code, $msg) = split / /, $_, 3; next unless $addr; - unless ($code) { + if (!$code) { $self->log(LOGERROR, "No constant in line $line in " . $self->{_file}); next; } - $code = Qpsmtpd::Constants::return_code($code); - unless (defined $code) { + + $code = Qpsmtpd::Constants::return_code($code) or do { $self->log(LOGERROR, "Not a valid constant in line $line in " . $self->{_file}); next; - } + }; $msg or $msg = "No such user."; $hash{$addr} = [$code, $msg]; } + close $F; return %hash; } sub hook_rcpt { my ($self, $transaction, $recipient) = @_; - return DECLINED - unless $recipient->host && $recipient->user; - return DECLINED - unless lc($recipient->host) eq $self->{_domain}; + return DECLINED unless $recipient->host && $recipient->user; + return DECLINED if lc($recipient->host) ne $self->{_domain}; 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}}; } diff --git a/plugins/stunnel b/plugins/stunnel index c596e89..3bdf24c 100644 --- a/plugins/stunnel +++ b/plugins/stunnel @@ -26,58 +26,48 @@ use strict; use warnings; use Qpsmtpd::Constants; -my $proxy_enabled; -sub init { - my ($self, $qp, %args) = @_; +sub register { + my ($self, $qp, %args) = @_; - return if ( uc $args{proxy} ne 'ON' ); + return if uc $args{proxy} ne 'ON'; - $self->log(LOGINFO, "proxy protocol enabled"); - $proxy_enabled = 1; + $self->log(LOGINFO, "proxy protocol enabled"); + + $self->register_hook('unrecognized_command', 'stunnel'); } -sub hook_unrecognized_command { - my ($self, $transaction, $cmd, @args) = @_; +sub stunnel { + my ($self, $transaction, $cmd, @args) = @_; - 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->notes('proxy') ); + return OK if uc $cmd ne 'PROXY'; + return DENY_DISCONNECT if $self->connection->remote_ip() ne '127.0.0.1'; + return DENY_DISCONNECT if $self->connection->notes('proxy'); - # TCP4 192.168.41.227 10.27.11.106 50060 465 - if ( $args[0] =~ m/^(.*?) (.*?) (.*?) (.*?) (.*?)$/ ) { - my $protocol = $1; - my $remote_ip = $2; - my $local_ip = $3; - my $remote_port = $4; - my $local_port = $5; - $self->connection->remote_ip( $remote_ip ); - $self->connection->remote_port( $remote_port ); - $self->connection->remote_info( "[$remote_ip]"); + # TCP4 192.168.41.227 10.27.11.106 50060 465 + if ($args[0] !~ m/^(.*?) (.*?) (.*?) (.*?) (.*?)$/) { + return DENY_DISCONNECT; + } - $self->connection->notes('proxy', 'YES'); - $self->connection->notes('protocol', $protocol); - $self->connection->notes('remote_ip', $remote_ip); - $self->connection->notes('remote_port', $remote_port); - $self->connection->notes('local_ip', $local_ip); - $self->connection->notes('local_port', $local_port); - $self->log(LOGINFO, "stunnel : $remote_ip:$remote_port"); + $self->connection->remote_ip($2); + $self->connection->remote_port($4); + $self->connection->remote_info("[$2]"); - # DNS reverse - my $res = Net::DNS::Resolver->new( dnsrch => 0 ); - $res->tcp_timeout(3); - $res->udp_timeout(3); - my $query = $res->query( $remote_ip, 'PTR' ); - if ($query) { - foreach my $rr ($query->answer) { - next if $rr->type ne 'PTR'; - $self->connection->remote_host( $rr->ptrdname ); - } + $self->connection->notes('proxy', 'YES'); + $self->connection->notes('protocol', $1); + $self->connection->notes('remote_ip', $2); + $self->connection->notes('local_ip', $3); + $self->connection->notes('remote_port', $4); + $self->connection->notes('local_port', $5); + $self->log(LOGINFO, "stunnel : $2:$4"); + + # DNS reverse + my $res = $self->init_resolver(); + if (my $query = $res->query($self->connection->remote_ip, 'PTR')) { + foreach my $rr ($query->answer) { + next if $rr->type ne 'PTR'; + $self->connection->remote_host($rr->ptrdname); } - } - else { - return DENY_DISCONNECT; - } - return DONE; + } + return DONE; } diff --git a/t/auth.t b/t/auth.t index 2d2876e..31a4907 100644 --- a/t/auth.t +++ b/t/auth.t @@ -2,18 +2,16 @@ use strict; use warnings; -use lib 't'; -use lib 'lib'; - use Data::Dumper; use Digest::HMAC_MD5 qw(hmac_md5_hex); use English qw/ -no_match_vars /; use File::Path; - -use Qpsmtpd::Constants; use Scalar::Util qw( openhandle ); use Test::More qw(no_plan); +use lib 't'; +use lib 'lib'; +use Qpsmtpd::Constants; use_ok('Test::Qpsmtpd'); use_ok('Qpsmtpd::Auth'); @@ -22,10 +20,6 @@ my ($smtpd, $conn) = Test::Qpsmtpd->new_conn(); ok($smtpd, "get new connection ($smtpd)"); 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 $user = 'good@example.com'; my $pass = 'good_pass'; 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 {