cpan/libnet/t/smtp_ipv6.t

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