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