diff options
-rw-r--r-- | Changes | 12 | ||||
-rw-r--r-- | MANIFEST | 6 | ||||
-rw-r--r-- | Makefile.PL | 12 | ||||
-rw-r--r-- | Net/Cmd.pm | 3 | ||||
-rw-r--r-- | Net/POP3.pm | 93 | ||||
-rw-r--r-- | Net/SMTP.pm | 108 | ||||
-rw-r--r-- | t/external/pop3-ssl.t | 54 | ||||
-rw-r--r-- | t/external/smtp-ssl.t | 53 | ||||
-rw-r--r-- | t/pop3_ipv6.t | 57 | ||||
-rw-r--r-- | t/pop3_ssl.t | 122 | ||||
-rw-r--r-- | t/smtp_ipv6.t | 59 | ||||
-rw-r--r-- | t/smtp_ssl.t | 124 |
12 files changed, 687 insertions, 16 deletions
@@ -1,6 +1,16 @@ libnet 1.28 -- TODO - * TODO + * Add support for IPv6 and SSL to Net::SMTP and Net::POP3. These features are + only available if the user has + + a recent IO::Socket::SSL for SSL support + a recent IO::Socket::IP or an older IO::Socket::INET6 for IPv6 support + + If no SSL module is available it will work as before, but attempts to use + the SSL functionality will result in an error message. If no IPv6 modules + are available it will just use IPv4 as before. With IPv6 modules installed + one can of course still access IPv4 hosts. + [Steffen Ullrich; resolves CPAN RT#93823] libnet 1.27 -- Fri May 30 2014 @@ -37,4 +37,10 @@ t/netrc.t t/nntp.t t/require.t t/smtp.t +t/smtp_ssl.t +t/smtp_ipv6.t +t/pop3_ssl.t +t/pop3_ipv6.t t/time.t +t/external/smtp-ssl.t +t/external/pop3-ssl.t diff --git a/Makefile.PL b/Makefile.PL index 80d7b1d..66c3df1 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -42,6 +42,14 @@ MAIN: { my %prereq_pms = (); $prereq_pms{'Convert::EBCDIC'} = '0.06' if $^O eq 'os390'; + my $xt = prompt("Should I do external tests?\n" . + "These tests will fail if there is no internet connection or if a firewall\n" . + "blocks or modifies some traffic.\n" . + "[y/N]", 'n'); + + my $tests = 't/*.t'; + $tests .= ' t/external/*.t' if $xt =~ m/^y/io; + WriteMakefile( NAME => 'Net', DISTNAME => 'libnet', @@ -128,6 +136,10 @@ MAIN: { FILES => $CfgFile }, + test => { + TESTS => $tests + }, + dist => { PREOP => 'find $(DISTVNAME) -type d -print|xargs chmod 0755 && ' . 'find $(DISTVNAME) -type f -print|xargs chmod 0644', @@ -37,7 +37,7 @@ BEGIN { } } -$VERSION = "2.30"; +$VERSION = "2.31"; @ISA = qw(Exporter); @EXPORT = qw(CMD_INFO CMD_OK CMD_MORE CMD_REJECT CMD_ERROR CMD_PENDING); @@ -53,7 +53,6 @@ my %debug = (); my $tr = $^O eq 'os390' ? Convert::EBCDIC->new() : undef; - sub toebcdic { my $cmd = shift; diff --git a/Net/POP3.pm b/Net/POP3.pm index 4b94a11..f51f0cf 100644 --- a/Net/POP3.pm +++ b/Net/POP3.pm @@ -13,9 +13,34 @@ use Net::Cmd; use Carp; use Net::Config; -$VERSION = "2.31"; +$VERSION = "2.32"; @ISA = qw(Net::Cmd IO::Socket::INET); +# Code for detecting if we can use SSL +my $ssl_class = eval { + require IO::Socket::SSL; + # first version with default CA on most platforms + IO::Socket::SSL->VERSION(1.968); +} && 'IO::Socket::SSL'; +my $nossl_warn = !$ssl_class && + 'To use SSL please install IO::Socket::SSL with version>=1.968'; + +# Code for detecting if we can use IPv6 +my $inet6_class = + eval { + require IO::Socket::IP; + IO::Socket::IP->VERSION(0.20); + } && 'IO::Socket::IP' || + eval { + require IO::Socket::INET6; + IO::Socket::INET6->VERSION(2.62); + } && 'IO::Socket::INET6'; + +sub can_ssl { $ssl_class }; +sub can_inet6 { $inet6_class }; + + +@ISA = ( 'Net::Cmd', $inet6_class || 'IO::Socket::INET' ); sub new { @@ -34,6 +59,14 @@ sub new { my $obj; my @localport = exists $arg{ResvPort} ? (LocalPort => $arg{ResvPort}) : (); + if ($arg{SSL}) { + # SSL from start + die $nossl_warn if !$ssl_class; + $arg{Port} ||= 995; + } + + $arg{Timeout} = 120 if ! defined $arg{Timeout}; + my $h; foreach $h (@{$hosts}) { $obj = $type->SUPER::new( @@ -41,9 +74,7 @@ sub new { PeerPort => $arg{Port} || 'pop3(110)', Proto => 'tcp', @localport, - Timeout => defined $arg{Timeout} - ? $arg{Timeout} - : 120 + Timeout => $arg{Timeout}, ) and last; } @@ -51,6 +82,13 @@ sub new { return undef unless defined $obj; + ${*$obj}{'net_pop3_arg'} = \%arg; + if ($arg{SSL}) { + Net::POP3::_SSLified->start_SSL($obj, + SSL_verifycn_name => $host,%arg + ) or return; + } + ${*$obj}{'net_pop3_host'} = $host; $obj->autoflush(1); @@ -93,6 +131,16 @@ sub login { and $me->pass($pass); } +sub starttls { + my $self = shift; + $ssl_class or die $nossl_warn; + $self->_STLS or return; + Net::POP3::_SSLified->start_SSL($self, + %{ ${*$self}{'net_pop3_arg'} }, # (ssl) args given in new + @_ # more (ssl) args + ) or return; + return 1; +} sub apop { @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->apop( USER, PASS )'; @@ -323,6 +371,7 @@ sub _PING { shift->command('PING', $_[0])->response() == CMD_OK } sub _RPOP { shift->command('RPOP', $_[0])->response() == CMD_OK } sub _LAST { shift->command('LAST' )->response() == CMD_OK } sub _CAPA { shift->command('CAPA' )->response() == CMD_OK } +sub _STLS { shift->command("STLS", )->response() == CMD_OK } sub quit { @@ -520,6 +569,24 @@ sub banner { return ${*$this}{'net_pop3_banner'}; } +{ + package Net::POP3::_SSLified; + our @ISA = ( $ssl_class ? ($ssl_class):(), 'Net::POP3' ); + sub starttls { die "POP3 connection is already in SSL mode" } + sub start_SSL { + my ($class,$pop3,%arg) = @_; + delete @arg{ grep { !m{^SSL_} } keys %arg }; + ( $arg{SSL_verifycn_name} ||= $pop3->host ) + =~s{(?<!:):[\w()]+$}{}; # strip port + $arg{SSL_verifycn_scheme} ||= 'pop3'; + my $ok = $class->SUPER::start_SSL($pop3,%arg); + $@ = $ssl_class->errstr if !$ok; + return $ok; + } +} + + + 1; __END__ @@ -535,6 +602,7 @@ Net::POP3 - Post Office Protocol 3 Client class (RFC1939) # Constructors $pop = Net::POP3->new('pop3host'); $pop = Net::POP3->new('pop3host', Timeout => 60); + $pop = Net::POP3->new('pop3host', SSL => 1, Timeout => 60); if ($pop->login($username, $password) > 0) { my $msgnums = $pop->list; # hashref of msgnum => size @@ -580,6 +648,14 @@ the C<PeerAddr> option in L<IO::Socket::INET>, or a reference to an array with hosts to try in turn. The L</host> method will return the value which was used to connect to the host. +B<Port> - port to connect to. +Default - 110 for plain POP3 and 995 for POP3s (direct SSL). + +B<SSL> - If the connection should be done from start with SSL, contrary to later +upgrade with C<starttls>. +You can use SSL arguments as documented in L<IO::Socket::SSL>, but it will +usually use the right arguments already. + B<ResvPort> - If given then the socket for the C<Net::POP3> object will be bound to the local port given using C<bind> when the socket is created. @@ -629,6 +705,12 @@ will give a true value in a boolean context, but zero in a numeric context. If there was an error authenticating the user then I<undef> will be returned. +=item starttls ( SSLARGS ) + +Upgrade existing plain connection to SSL. +You can use SSL arguments as documented in L<IO::Socket::SSL>, but it will +usually use the right arguments already. + =item apop ( [ USER [, PASS ]] ) Authenticate with the server identifying as C<USER> with password C<PASS>. @@ -729,7 +811,8 @@ means that any messages marked to be deleted will not be. =head1 SEE ALSO L<Net::Netrc>, -L<Net::Cmd> +L<Net::Cmd>, +L<IO::Socket::SSL> =head1 AUTHOR diff --git a/Net/SMTP.pm b/Net/SMTP.pm index 3d193a4..819ce8c 100644 --- a/Net/SMTP.pm +++ b/Net/SMTP.pm @@ -16,9 +16,33 @@ use IO::Socket; use Net::Cmd; use Net::Config; -$VERSION = "2.34"; +$VERSION = "2.35"; + +# Code for detecting if we can use SSL +my $ssl_class = eval { + require IO::Socket::SSL; + # first version with default CA on most platforms + IO::Socket::SSL->VERSION(1.968); +} && 'IO::Socket::SSL'; +my $nossl_warn = !$ssl_class && + 'To use SSL please install IO::Socket::SSL with version>=1.968'; + +# Code for detecting if we can use IPv6 +my $inet6_class = + eval { + require IO::Socket::IP; + IO::Socket::IP->VERSION(0.20); + } && 'IO::Socket::IP' || + eval { + require IO::Socket::INET6; + IO::Socket::INET6->VERSION(2.62); + } && 'IO::Socket::INET6'; + +sub can_ssl { $ssl_class }; +sub can_inet6 { $inet6_class }; -@ISA = qw(Net::Cmd IO::Socket::INET); + +@ISA = ( 'Net::Cmd', $inet6_class || 'IO::Socket::INET' ); sub new { @@ -33,9 +57,18 @@ sub new { %arg = @_; $host = delete $arg{Host}; } + + if ($arg{SSL}) { + # SSL from start + die $nossl_warn if !$ssl_class; + $arg{Port} ||= 465; + } + my $hosts = defined $host ? $host : $NetConfig{smtp_hosts}; my $obj; + $arg{Timeout} = 120 if ! defined $arg{Timeout}; + my $h; foreach $h (@{ref($hosts) ? $hosts : [$hosts]}) { $obj = $type->SUPER::new( @@ -44,9 +77,7 @@ sub new { LocalAddr => $arg{LocalAddr}, LocalPort => $arg{LocalPort}, Proto => 'tcp', - Timeout => defined $arg{Timeout} - ? $arg{Timeout} - : 120 + Timeout => $arg{Timeout} ) and last; } @@ -54,6 +85,12 @@ sub new { return undef unless defined $obj; + ${*$obj}{'net_smtp_arg'} = \%arg; + if ($arg{SSL}) { + Net::SMTP::_SSLified->start_SSL($obj,SSL_verifycn_name => $host,%arg) + or return; + } + $obj->autoflush(1); $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef); @@ -189,11 +226,25 @@ sub hello { } return undef unless $ok; + ${*$me}{net_smtp_hello_domain} = $domain; $msg[0] =~ /\A\s*(\S+)/; return ($1 || " "); } +sub starttls { + my $self = shift; + $ssl_class or die $nossl_warn; + $self->_STARTTLS or return; + Net::SMTP::_SSLified->start_SSL($self, + %{ ${*$self}{'net_smtp_arg'} }, # (ssl) args given in new + @_ # more (ssl) args + ) or return; + + # another hello after starttls to read new ESMTP capabilities + return $self->hello(${*$self}{net_smtp_hello_domain}); +} + sub supports { my $self = shift; @@ -531,6 +582,26 @@ sub _BDAT { shift->command("BDAT", @_) } sub _TURN { shift->unsupported(@_); } sub _ETRN { shift->command("ETRN", @_)->response() == CMD_OK } sub _AUTH { shift->command("AUTH", @_)->response() == CMD_OK } +sub _STARTTLS { shift->command("STARTTLS")->response() == CMD_OK } + + +{ + package Net::SMTP::_SSLified; + our @ISA = ( $ssl_class ? ($ssl_class):(), 'Net::SMTP' ); + sub starttls { die "SMTP connection is already in SSL mode" } + sub start_SSL { + my ($class,$smtp,%arg) = @_; + delete @arg{ grep { !m{^SSL_} } keys %arg }; + ( $arg{SSL_verifycn_name} ||= $smtp->host ) + =~s{(?<!:):[\w()]+$}{}; # strip port + $arg{SSL_verifycn_scheme} ||= 'smtp'; + my $ok = $class->SUPER::start_SSL($smtp,%arg); + $@ = $ssl_class->errstr if !$ok; + return $ok; + } +} + + 1; @@ -621,9 +692,15 @@ B<Host> - SMTP host to connect to. It may be a single scalar (hostname[:port]), as defined for the C<PeerAddr> option in L<IO::Socket::INET>, or a reference to an array with hosts to try in turn. The L</host> method will return the value which was used to connect to the host. +Format - C<PeerHost> from L<IO::Socket::INET> new method. -B<Port> - port to connect to. Format - C<PeerHost> from L<IO::Socket::INET> new method. -Default - 25. +B<Port> - port to connect to. +Default - 25 for plain SMTP and 465 for immediate SSL. + +B<SSL> - If the connection should be done from start with SSL, contrary to later +upgrade with C<starttls>. +You can use SSL arguments as documented in L<IO::Socket::SSL>, but it will +usually use the right arguments already. B<LocalAddr> and B<LocalPort> - These parameters are passed directly to IO::Socket to allow binding the socket to a local port. @@ -655,6 +732,14 @@ Example: Debug => 1, ); + # the same with direct SSL + $smtp = Net::SMTP->new('mailhost', + Hello => 'my.mail.domain', + Timeout => 30, + Debug => 1, + SSL => 1, + ); + # Connect to the default server from Net::config $smtp = Net::SMTP->new( Hello => 'my.mail.domain', @@ -702,6 +787,12 @@ to connect to the host. Request a queue run for the DOMAIN given. +=item starttls ( SSLARGS ) + +Upgrade existing plain connection to SSL. +You can use SSL arguments as documented in L<IO::Socket::SSL>, but it will +usually use the right arguments already. + =item auth ( USERNAME, PASSWORD ) Attempt SASL authentication. Requires Authen::SASL module. @@ -868,7 +959,8 @@ accept the address surrounded by angle brackets. =head1 SEE ALSO -L<Net::Cmd> +L<Net::Cmd>, +L<IO::Socket::SSL> =head1 AUTHOR diff --git a/t/external/pop3-ssl.t b/t/external/pop3-ssl.t new file mode 100644 index 0000000..6eec93c --- /dev/null +++ b/t/external/pop3-ssl.t @@ -0,0 +1,54 @@ + +use strict; +use warnings; +use Net::POP3; +use Test::More; + +my $host = 'pop.gmx.net'; +my $debug = 0; + +plan skip_all => "no SSL support" if ! Net::POP3->can_ssl; +{ +no warnings 'once'; +plan skip_all => "no verified SSL connection to $host:995 - $@" if ! eval { + IO::Socket::SSL->new(PeerAddr => "$host:995", Timeout => 10) + || die($IO::Socket::SSL::SSL_ERROR||$!); +}; +} + +plan tests => 2; + +SKIP: { + diag( "connect inet to $host:110" ); + skip "no inet connect to $host:110",1 + if ! IO::Socket::INET->new(PeerAddr => "$host:110", Timeout => 10); + my $pop3 = Net::POP3->new($host, Debug => $debug, Timeout => 10) + or skip "normal POP3 failed: $@",1; + skip "no STARTTLS support",1 if $pop3->message !~/STARTTLS/; + + if (!$pop3->starttls) { + fail("starttls failed: ".$pop3->code." $@") + } else { + # we now should have access to SSL stuff + my $cipher = eval { $pop3->get_cipher }; + if (!$cipher) { + fail("after starttls: not an SSL object"); + } elsif ( $pop3->quit ) { + pass("starttls + quit ok, cipher=$cipher"); + } else { + fail("quit after starttls failed: ".$pop3->code); + } + } +} + + +my $pop3 = Net::POP3->new($host, SSL => 1, Timeout => 10, Debug => $debug); +# we now should have access to SSL stuff +my $cipher = eval { $pop3->get_cipher }; +if (!$cipher) { + fail("after ssl connect: not an SSL object"); +} elsif ( $pop3->quit ) { + pass("ssl connect ok, cipher=$cipher"); +} else { + fail("quit after direct ssl failed: ".$pop3->code); +} diff --git a/t/external/smtp-ssl.t b/t/external/smtp-ssl.t new file mode 100644 index 0000000..1802976 --- /dev/null +++ b/t/external/smtp-ssl.t @@ -0,0 +1,53 @@ + +use strict; +use warnings; +use Net::SMTP; +use Test::More; + +my $host = 'mail.gmx.net'; +my $debug = 0; + +plan skip_all => "no SSL support" if ! Net::SMTP->can_ssl; +{ +no warnings 'once'; +plan skip_all => "no verified SSL connection to $host:465 - $@" if ! eval { + IO::Socket::SSL->new("$host:465") + || die($IO::Socket::SSL::SSL_ERROR||$!); +}; +} + +plan tests => 2; + +SKIP: { + diag( "connect inet to $host:25" ); + skip "no inet connect to $host:25",1 if ! IO::Socket::INET->new("$host:25"); + my $smtp = Net::SMTP->new($host, Debug => $debug) + or skip "normal SMTP failed: $@",1; + skip "no STARTTLS support",1 if $smtp->message !~/STARTTLS/; + + if (!$smtp->starttls) { + fail("starttls failed: ".$smtp->code." $@") + } else { + # we now should have access to SSL stuff + my $cipher = eval { $smtp->get_cipher }; + if (!$cipher) { + fail("after starttls: not an SSL object"); + } elsif ( $smtp->quit ) { + pass("starttls + quit ok, cipher=$cipher"); + } else { + fail("quit after starttls failed: ".$smtp->code); + } + } +} + + +my $smtp = Net::SMTP->new($host, SSL => 1, Debug => $debug); +# we now should have access to SSL stuff +my $cipher = eval { $smtp->get_cipher }; +if (!$cipher) { + fail("after ssl connect: not an SSL object"); +} elsif ( $smtp->quit ) { + pass("ssl connect ok, cipher=$cipher"); +} else { + fail("quit after direct ssl failed: ".$smtp->code); +} diff --git a/t/pop3_ipv6.t b/t/pop3_ipv6.t new file mode 100644 index 0000000..2f073ab --- /dev/null +++ b/t/pop3_ipv6.t @@ -0,0 +1,57 @@ +use strict; +use warnings; +use Test::More; +use File::Temp 'tempfile'; +use Net::POP3; + +my $debug = 0; # Net::POP3->new( Debug => .. ) + +my $inet6class = Net::POP3->can_inet6; +plan skip_all => "no IPv6 support found in Net::POP3" if ! $inet6class; + +plan skip_all => "fork not supported on this platform" + if grep { $^O =~m{$_} } qw(MacOS VOS vmesa riscos amigaos); + +my $srv = $inet6class->new( + LocalAddr => '::1', + Listen => 10 +); +plan skip_all => "cannot create listener on ::1: $!" if ! $srv; +my $saddr = "[".$srv->sockhost."]".':'.$srv->sockport; +diag("server on $saddr"); + +plan tests => 1; + +defined( my $pid = fork()) or die "fork failed: $!"; +exit(pop3_server()) if ! $pid; + +my $cl = Net::POP3->new($saddr, Debug => $debug); +diag("created Net::POP3 object"); +if (!$cl) { + fail("IPv6 POP3 connect failed"); +} else { + $cl->quit; + pass("IPv6 success"); +} +wait; + +sub pop3_server { + my $cl = $srv->accept or die "accept failed: $!"; + print $cl "+OK localhost ready\r\n"; + while (<$cl>) { + my ($cmd,$arg) = m{^(\S+)(?: +(.*))?\r\n} or die $_; + $cmd = uc($cmd); + if ($cmd eq 'QUIT' ) { + print $cl "+OK bye\r\n"; + last; + } elsif ( $cmd eq 'CAPA' ) { + print $cl "+OK\r\n". + ".\r\n"; + } else { + diag("received unknown command: $cmd"); + print "-ERR unknown cmd\r\n"; + } + } + + diag("POP3 dialog done"); +} diff --git a/t/pop3_ssl.t b/t/pop3_ssl.t new file mode 100644 index 0000000..08ef266 --- /dev/null +++ b/t/pop3_ssl.t @@ -0,0 +1,122 @@ +use strict; +use warnings; +use Test::More; +use File::Temp 'tempfile'; +use Net::POP3; + +my $debug = 0; # Net::POP3 Debug => .. + +my $parent = 0; + +plan skip_all => "no SSL support found in Net::POP3" if ! Net::POP3->can_ssl; + +plan skip_all => "fork not supported on this platform" + if grep { $^O =~m{$_} } qw(MacOS VOS vmesa riscos amigaos); + +plan skip_all => "incomplete or to old version of IO::Socket::SSL" if ! eval { + require IO::Socket::SSL + && IO::Socket::SSL->VERSION(1.968) + && require IO::Socket::SSL::Utils + && defined &IO::Socket::SSL::Utils::CERT_create; +}; + +my $srv = IO::Socket::INET->new( + LocalAddr => '127.0.0.1', + Listen => 10 +); +plan skip_all => "cannot create listener on localhost: $!" if ! $srv; +my $saddr = $srv->sockhost.':'.$srv->sockport; + +plan tests => 2; + +my ($ca,$key) = IO::Socket::SSL::Utils::CERT_create( CA => 1 ); +my ($fh,$cafile) = tempfile(); +print $fh IO::Socket::SSL::Utils::PEM_cert2string($ca); +close($fh); + +$parent = $$; +END { unlink($cafile) if $$ == $parent } + +my ($cert) = IO::Socket::SSL::Utils::CERT_create( + subject => { CN => 'pop3.example.com' }, + issuer_cert => $ca, issuer_key => $key, + key => $key +); + +test(1); # direct ssl +test(0); # starttls + + +sub test { + my $ssl = shift; + defined( my $pid = fork()) or die "fork failed: $!"; + exit(pop3_server($ssl)) if ! $pid; + pop3_client($ssl); + wait; +} + + +sub pop3_client { + my $ssl = shift; + my %sslopt = ( + SSL_verifycn_name => 'pop3.example.com', + SSL_ca_file => $cafile + ); + $sslopt{SSL} = 1 if $ssl; + my $cl = Net::POP3->new($saddr, %sslopt, Debug => $debug); + diag("created Net::POP3 object"); + if (!$cl) { + fail( ($ssl ? "SSL ":"" )."POP3 connect failed"); + } elsif ($ssl) { + $cl->quit; + pass("SSL POP3 connect success"); + } elsif ( ! $cl->starttls ) { + no warnings 'once'; + fail("starttls failed: $IO::Socket::SSL::SSL_ERROR"); + } else { + $cl->quit; + pass("starttls success"); + } +} + +sub pop3_server { + my $ssl = shift; + my $cl = $srv->accept or die "accept failed: $!"; + my %sslargs = ( + SSL_server => 1, + SSL_cert => $cert, + SSL_key => $key, + ); + if ( $ssl ) { + if ( ! IO::Socket::SSL->start_SSL($cl, %sslargs)) { + diag("initial ssl handshake with client failed"); + return; + } + } + + print $cl "+OK localhost ready\r\n"; + while (<$cl>) { + my ($cmd,$arg) = m{^(\S+)(?: +(.*))?\r\n} or die $_; + $cmd = uc($cmd); + if ($cmd eq 'QUIT' ) { + print $cl "+OK bye\r\n"; + last; + } elsif ( $cmd eq 'CAPA' ) { + print $cl "+OK\r\n". + ( $ssl ? "" : "STLS\r\n" ). + ".\r\n"; + } elsif ( ! $ssl and $cmd eq 'STLS' ) { + print $cl "+OK starting ssl\r\n"; + if ( ! IO::Socket::SSL->start_SSL($cl, %sslargs)) { + diag("initial ssl handshake with client failed"); + return; + } + $ssl = 1; + } else { + diag("received unknown command: $cmd"); + print "-ERR unknown cmd\r\n"; + } + } + + diag("POP3 dialog done"); +} diff --git a/t/smtp_ipv6.t b/t/smtp_ipv6.t new file mode 100644 index 0000000..6a01520 --- /dev/null +++ b/t/smtp_ipv6.t @@ -0,0 +1,59 @@ +use strict; +use warnings; +use Test::More; +use File::Temp 'tempfile'; +use Net::SMTP; + +my $debug = 0; # Net::SMTP->new( Debug => .. ) + +my $inet6class = Net::SMTP->can_inet6; +plan skip_all => "no IPv6 support found in Net::SMTP" if ! $inet6class; + +plan skip_all => "fork not supported on this platform" + if grep { $^O =~m{$_} } qw(MacOS VOS vmesa riscos amigaos); + +my $srv = $inet6class->new( + LocalAddr => '::1', + Listen => 10 +); +plan skip_all => "cannot create listener on ::1: $!" if ! $srv; +my $saddr = "[".$srv->sockhost."]".':'.$srv->sockport; +diag("server on $saddr"); + +plan tests => 1; + +defined( my $pid = fork()) or die "fork failed: $!"; +exit(smtp_server()) if ! $pid; + +my $cl = Net::SMTP->new($saddr, Debug => $debug); +diag("created Net::SMTP object"); +if (!$cl) { + fail("IPv6 SMTP connect failed"); +} else { + $cl->quit; + pass("IPv6 success"); +} +wait; + +sub smtp_server { + my $cl = $srv->accept or die "accept failed: $!"; + print $cl "220 welcome\r\n"; + while (<$cl>) { + my ($cmd,$arg) = m{^(\S+)(?: +(.*))?\r\n} or die $_; + $cmd = uc($cmd); + if ($cmd eq 'QUIT' ) { + print $cl "250 bye\r\n"; + last; + } elsif ( $cmd eq 'HELO' ) { + print $cl "250 localhost\r\n"; + } elsif ( $cmd eq 'EHLO' ) { + print $cl "250-localhost\r\n". + "250 HELP\r\n"; + } else { + diag("received unknown command: $cmd"); + print "500 unknown cmd\r\n"; + } + } + + diag("SMTP dialog done"); +} diff --git a/t/smtp_ssl.t b/t/smtp_ssl.t new file mode 100644 index 0000000..e7391f3 --- /dev/null +++ b/t/smtp_ssl.t @@ -0,0 +1,124 @@ +use strict; +use warnings; +use Test::More; +use File::Temp 'tempfile'; +use Net::SMTP; + +my $debug = 0; # Net::SMTP Debug => .. + +my $parent = 0; + +plan skip_all => "no SSL support found in Net::SMTP" if ! Net::SMTP->can_ssl; + +plan skip_all => "fork not supported on this platform" + if grep { $^O =~m{$_} } qw(MacOS VOS vmesa riscos amigaos); + +plan skip_all => "incomplete or to old version of IO::Socket::SSL" if ! eval { + require IO::Socket::SSL + && IO::Socket::SSL->VERSION(1.968) + && require IO::Socket::SSL::Utils + && defined &IO::Socket::SSL::Utils::CERT_create; +}; + +my $srv = IO::Socket::INET->new( + LocalAddr => '127.0.0.1', + Listen => 10 +); +plan skip_all => "cannot create listener on localhost: $!" if ! $srv; +my $saddr = $srv->sockhost.':'.$srv->sockport; + +plan tests => 2; + +my ($ca,$key) = IO::Socket::SSL::Utils::CERT_create( CA => 1 ); +my ($fh,$cafile) = tempfile(); +print $fh IO::Socket::SSL::Utils::PEM_cert2string($ca); +close($fh); + +$parent = $$; +END { unlink($cafile) if $$ == $parent } + +my ($cert) = IO::Socket::SSL::Utils::CERT_create( + subject => { CN => 'smtp.example.com' }, + issuer_cert => $ca, issuer_key => $key, + key => $key +); + +test(1); # direct ssl +test(0); # starttls + + +sub test { + my $ssl = shift; + defined( my $pid = fork()) or die "fork failed: $!"; + exit(smtp_server($ssl)) if ! $pid; + smtp_client($ssl); + wait; +} + + +sub smtp_client { + my $ssl = shift; + my %sslopt = ( + SSL_verifycn_name => 'smtp.example.com', + SSL_ca_file => $cafile + ); + $sslopt{SSL} = 1 if $ssl; + my $cl = Net::SMTP->new($saddr, %sslopt, Debug => $debug); + diag("created Net::SMTP object"); + if (!$cl) { + fail( ($ssl ? "SSL ":"" )."SMTP connect failed"); + } elsif ($ssl) { + $cl->quit; + pass("SSL SMTP connect success"); + } elsif ( ! $cl->starttls ) { + no warnings 'once'; + fail("starttls failed: $IO::Socket::SSL::SSL_ERROR"); + } else { + $cl->quit; + pass("starttls success"); + } +} + +sub smtp_server { + my $ssl = shift; + my $cl = $srv->accept or die "accept failed: $!"; + my %sslargs = ( + SSL_server => 1, + SSL_cert => $cert, + SSL_key => $key, + ); + if ( $ssl ) { + if ( ! IO::Socket::SSL->start_SSL($cl, %sslargs)) { + diag("initial ssl handshake with client failed"); + return; + } + } + + print $cl "220 welcome\r\n"; + while (<$cl>) { + my ($cmd,$arg) = m{^(\S+)(?: +(.*))?\r\n} or die $_; + $cmd = uc($cmd); + if ($cmd eq 'QUIT' ) { + print $cl "250 bye\r\n"; + last; + } elsif ( $cmd eq 'HELO' ) { + print $cl "250 localhost\r\n"; + } elsif ( $cmd eq 'EHLO' ) { + print $cl "250-localhost\r\n". + ( $ssl ? "" : "250-STARTTLS\r\n" ). + "250 HELP\r\n"; + } elsif ( ! $ssl and $cmd eq 'STARTTLS' ) { + print $cl "250 starting ssl\r\n"; + if ( ! IO::Socket::SSL->start_SSL($cl, %sslargs)) { + diag("initial ssl handshake with client failed"); + return; + } + $ssl = 1; + } else { + diag("received unknown command: $cmd"); + print "500 unknown cmd\r\n"; + } + } + + diag("SMTP dialog done"); +} |