This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
dist/IO: Always bind to localhost in tests.
[perl5.git] / dist / IO / t / io_multihomed.t
CommitLineData
cf7fe8a2
GS
1#!./perl
2
3BEGIN {
2adbc9b6 4 require($ENV{PERL_CORE} ? '../../t/test.pl' : './t/test.pl');
cf7fe8a2 5
ed272d6f 6 use Config;
ec64f737
SH
7 my $can_fork = $Config{d_fork} ||
8 (($^O eq 'MSWin32' || $^O eq 'NetWare') and
9 $Config{useithreads} and
10 $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/
11 );
90b9a713
GB
12 my $reason;
13 if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bSocket\b/) {
14 $reason = 'Socket extension unavailable';
15 }
16 elsif ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bIO\b/) {
17 $reason = 'IO extension unavailable';
18 }
ec64f737
SH
19 elsif (!$can_fork) {
20 $reason = 'no fork';
90b9a713 21 }
ed272d6f 22 skip_all($reason) if $reason;
cf7fe8a2
GS
23}
24
25$| = 1;
26
27print "1..8\n";
ed272d6f 28watchdog(15);
cf7fe8a2
GS
29
30package Multi;
31require IO::Socket::INET;
32@ISA=qw(IO::Socket::INET);
33
34use Socket qw(inet_aton inet_ntoa unpack_sockaddr_in);
35
36sub _get_addr
37{
38 my($sock,$addr_str, $multi) = @_;
39 #print "_get_addr($sock, $addr_str, $multi)\n";
40
41 print "not " unless $multi;
42 print "ok 2\n";
43
44 (
45 # private IP-addresses which I hope does not work anywhere :-)
46 inet_aton("10.250.230.10"),
47 inet_aton("10.250.230.12"),
48 inet_aton("127.0.0.1") # loopback
49 )
50}
51
52sub connect
53{
54 my $self = shift;
55 if (@_ == 1) {
56 my($port, $addr) = unpack_sockaddr_in($_[0]);
57 $addr = inet_ntoa($addr);
58 #print "connect($self, $port, $addr)\n";
362d283a
GB
59 if($addr eq "10.250.230.10") {
60 print "ok 3\n";
61 return 0;
62 }
63 if($addr eq "10.250.230.12") {
64 print "ok 4\n";
65 return 0;
66 }
cf7fe8a2
GS
67 }
68 $self->SUPER::connect(@_);
69}
70
71
72
73package main;
74
75use IO::Socket;
76
04093f69
AP
77$listen = IO::Socket::INET->new(LocalAddr => 'localhost',
78 Listen => 2,
cf7fe8a2
GS
79 Proto => 'tcp',
80 Timeout => 5,
81 ) or die "$!";
82
83print "ok 1\n";
84
85$port = $listen->sockport;
86
87if($pid = fork()) {
88
89 $sock = $listen->accept() or die "$!";
90 print "ok 5\n";
91
92 print $sock->getline();
93 print $sock "ok 7\n";
94
95 waitpid($pid,0);
96
97 $sock->close;
98
99 print "ok 8\n";
100
101} elsif(defined $pid) {
102
103 $sock = Multi->new(PeerPort => $port,
104 Proto => 'tcp',
105 PeerAddr => 'localhost',
106 MultiHomed => 1,
107 Timeout => 1,
108 ) or die "$!";
109
110 print $sock "ok 6\n";
111 sleep(1); # race condition
112 print $sock->getline();
113
114 $sock->close;
115
116 exit;
117} else {
118 die;
119}