dist/IO/t/io_multihomed.t

   1 #!./perl
   2
   3 BEGIN {
   4     require($ENV{PERL_CORE} ? '../../t/test.pl' : './t/test.pl');
   5
   6     use Config;
   7     my $can_fork = $Config{d_fork} ||
   8                     (($^O eq 'MSWin32' || $^O eq 'NetWare') and
   9                      $Config{useithreads} and
  10                      $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/
  11                     );
  12     my $reason;
  13     if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bSocket\b/) {
  14         $reason = 'Socket extension unavailable';
  15     }
  16     elsif ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bIO\b/) {
  17         $reason = 'IO extension unavailable';
  18     }
  19     elsif (!$can_fork) {
  20         $reason = 'no fork';
  21     }
  22     skip_all($reason) if $reason;
  23 }
  24
  25 $| = 1;
  26
  27 print "1..8\n";
  28 watchdog(15);
  29
  30 package Multi;
  31 require IO::Socket::INET;
  32 @ISA=qw(IO::Socket::INET);
  33
  34 use Socket qw(inet_aton inet_ntoa unpack_sockaddr_in);
  35
  36 sub _get_addr
  37 {
  38     my($sock,$addr_str, $multi) = @_;
  39     #print "_get_addr($sock, $addr_str, $multi)\n";
  40
  41     print "not " unless $multi;
  42     print "ok 2\n";
  43
  44     (
  45      # private IP-addresses which I hope does not work anywhere :-)
  46      inet_aton("10.250.230.10"),
  47      inet_aton("10.250.230.12"),
  48      inet_aton("127.0.0.1")        # loopback
  49     )
  50 }
  51
  52 sub connect
  53 {
  54     my $self = shift;
  55     if (@_ == 1) {
  56         my($port, $addr) = unpack_sockaddr_in($_[0]);
  57         $addr = inet_ntoa($addr);
  58         #print "connect($self, $port, $addr)\n";
  59         if($addr eq "10.250.230.10") {
  60             print "ok 3\n";
  61             return 0;
  62         }
  63         if($addr eq "10.250.230.12") {
  64             print "ok 4\n";
  65             return 0;
  66         }
  67     }
  68     $self->SUPER::connect(@_);
  69 }
  70
  71
  72
  73 package main;
  74
  75 use IO::Socket;
  76
  77 $listen = IO::Socket::INET->new(LocalAddr => 'localhost',
  78                                 Listen => 2,
  79                                 Proto => 'tcp',
  80                                 Timeout => 5,
  81                                ) or die "$!";
  82
  83 print "ok 1\n";
  84
  85 $port = $listen->sockport;
  86
  87 if($pid = fork()) {
  88
  89     $sock = $listen->accept() or die "$!";
  90     print "ok 5\n";
  91
  92     print $sock->getline();
  93     print $sock "ok 7\n";
  94
  95     waitpid($pid,0);
  96
  97     $sock->close;
  98
  99     print "ok 8\n";
 100
 101 } elsif(defined $pid) {
 102
 103     $sock = Multi->new(PeerPort => $port,
 104                        Proto => 'tcp',
 105                        PeerAddr => 'localhost',
 106                        MultiHomed => 1,
 107                        Timeout => 1,
 108                       ) or die "$!";
 109
 110     print $sock "ok 6\n";
 111     sleep(1); # race condition
 112     print $sock->getline();
 113
 114     $sock->close;
 115
 116     exit;
 117 } else {
 118     die;
 119 }