ext/IO/t/io_multihomed.t

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