This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
3d7188bf76f1af7ce7357a92c51bc423834c3a76
[perl5.git] / 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{'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         print "ok 3\n" if $addr eq "10.250.230.10";
59         print "ok 4\n" if $addr eq "10.250.230.12";
60     }
61     $self->SUPER::connect(@_);
62 }
63
64
65
66 package main;
67
68 use IO::Socket;
69
70 $listen = IO::Socket::INET->new(Listen => 2,
71                                 Proto => 'tcp',
72                                 Timeout => 5,
73                                ) or die "$!";
74
75 print "ok 1\n";
76
77 $port = $listen->sockport;
78
79 if($pid = fork()) {
80
81     $sock = $listen->accept() or die "$!";
82     print "ok 5\n";
83
84     print $sock->getline();
85     print $sock "ok 7\n";
86
87     waitpid($pid,0);
88
89     $sock->close;
90
91     print "ok 8\n";
92
93 } elsif(defined $pid) {
94
95     $sock = Multi->new(PeerPort => $port,
96                        Proto => 'tcp',
97                        PeerAddr => 'localhost',
98                        MultiHomed => 1,
99                        Timeout => 1,
100                       ) or die "$!";
101
102     print $sock "ok 6\n";
103     sleep(1); # race condition
104     print $sock->getline();
105
106     $sock->close;
107
108     exit;
109 } else {
110     die;
111 }