t/lib/io_multihomed.t

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