This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
don't attempt connect() to bogus IP addresses
[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         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 }