1b8851fccSafresh1#!perl 2b8851fccSafresh1 3b8851fccSafresh1use 5.008001; 4b8851fccSafresh1 5b8851fccSafresh1use strict; 6b8851fccSafresh1use warnings; 7b8851fccSafresh1 8*eac174f2Safresh1use Test::More; 9*eac174f2Safresh1 10*eac174f2Safresh1BEGIN { 11*eac174f2Safresh1 if (!eval { require Socket }) { 12*eac174f2Safresh1 plan skip_all => "no Socket"; 13*eac174f2Safresh1 } 14*eac174f2Safresh1 elsif (ord('A') == 193 && !eval { require Convert::EBCDIC }) { 15*eac174f2Safresh1 plan skip_all => "EBCDIC but no Convert::EBCDIC"; 16*eac174f2Safresh1 } 17*eac174f2Safresh1} 18*eac174f2Safresh1 19b8851fccSafresh1use Config; 20b8851fccSafresh1use File::Temp 'tempfile'; 21b8851fccSafresh1use Net::SMTP; 22b8851fccSafresh1 23b8851fccSafresh1my $debug = 0; # Net::SMTP->new( Debug => .. ) 24b8851fccSafresh1 25b8851fccSafresh1my $inet6class = Net::SMTP->can_inet6; 26b8851fccSafresh1plan skip_all => "no IPv6 support found in Net::SMTP" if ! $inet6class; 27b8851fccSafresh1 28b8851fccSafresh1plan skip_all => "fork not supported on this platform" 29b8851fccSafresh1 unless $Config::Config{d_fork} || $Config::Config{d_pseudofork} || 30b8851fccSafresh1 (($^O eq 'MSWin32' || $^O eq 'NetWare') and 31b8851fccSafresh1 $Config::Config{useithreads} and 32b8851fccSafresh1 $Config::Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/); 33b8851fccSafresh1 34b8851fccSafresh1my $srv = $inet6class->new( 35b8851fccSafresh1 LocalAddr => '::1', 36b8851fccSafresh1 Listen => 10 37b8851fccSafresh1); 38b8851fccSafresh1plan skip_all => "cannot create listener on ::1: $!" if ! $srv; 39b8851fccSafresh1my $saddr = "[".$srv->sockhost."]".':'.$srv->sockport; 40b8851fccSafresh1note("server on $saddr"); 41b8851fccSafresh1 42b8851fccSafresh1plan tests => 1; 43b8851fccSafresh1 44b8851fccSafresh1defined( my $pid = fork()) or die "fork failed: $!"; 45b8851fccSafresh1exit(smtp_server()) if ! $pid; 46b8851fccSafresh1 47b8851fccSafresh1my $cl = Net::SMTP->new($saddr, Debug => $debug); 48b8851fccSafresh1note("created Net::SMTP object"); 49b8851fccSafresh1if (!$cl) { 50b8851fccSafresh1 fail("IPv6 SMTP connect failed"); 51b8851fccSafresh1} else { 52b8851fccSafresh1 $cl->quit; 53b8851fccSafresh1 pass("IPv6 success"); 54b8851fccSafresh1} 55b8851fccSafresh1wait; 56b8851fccSafresh1 57b8851fccSafresh1sub smtp_server { 58b8851fccSafresh1 my $cl = $srv->accept or die "accept failed: $!"; 59b8851fccSafresh1 print $cl "220 welcome\r\n"; 60b8851fccSafresh1 while (<$cl>) { 61b8851fccSafresh1 my ($cmd,$arg) = m{^(\S+)(?: +(.*))?\r\n} or die $_; 62b8851fccSafresh1 $cmd = uc($cmd); 63b8851fccSafresh1 if ($cmd eq 'QUIT' ) { 64b8851fccSafresh1 print $cl "250 bye\r\n"; 65b8851fccSafresh1 last; 66b8851fccSafresh1 } elsif ( $cmd eq 'HELO' ) { 67b8851fccSafresh1 print $cl "250 localhost\r\n"; 68b8851fccSafresh1 } elsif ( $cmd eq 'EHLO' ) { 69b8851fccSafresh1 print $cl "250-localhost\r\n". 70b8851fccSafresh1 "250 HELP\r\n"; 71b8851fccSafresh1 } else { 72b8851fccSafresh1 diag("received unknown command: $cmd"); 73b8851fccSafresh1 print "500 unknown cmd\r\n"; 74b8851fccSafresh1 } 75b8851fccSafresh1 } 76b8851fccSafresh1 77b8851fccSafresh1 note("SMTP dialog done"); 785759b3d2Safresh1 return 0; 79b8851fccSafresh1} 80