t/lib/io_multihomed.t

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