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