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