xref: /openbsd/gnu/usr.bin/perl/dist/IO/t/io_multihomed.t (revision cecf84d4) 
1#!./perl
2
3BEGIN {
4    require($ENV{PERL_CORE} ? '../../t/test.pl' : './t/test.pl');
5
6    use Config;
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		    );
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    }
19    elsif (!$can_fork) {
20        $reason = 'no fork';
21    }
22    skip_all($reason) if $reason;
23}
24
25$| = 1;
26
27print "1..8\n";
28watchdog(15);
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";
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	}
67    }
68    $self->SUPER::connect(@_);
69}
70
71
72
73package main;
74
75use IO::Socket;
76
77$listen = IO::Socket::INET->new(LocalAddr => 'localhost',
78				Listen => 2,
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}
120