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