IO/t/io_multihomed.t

#!./perl

BEGIN {
    unless(grep /blib/, @INC) {
    chdir 't' if -d 't';
    @INC = '../lib';
    }
}

use Config;

BEGIN {
    if(-d "lib" && -f "TEST") {
    my $reason;
    if (! $Config{'d_fork'}) {
        $reason = 'no fork';
    }
    elsif ($Config{'extensions'} !~ /\bSocket\b/) {
        $reason = 'Socket extension unavailable';
    }
    elsif ($Config{'extensions'} !~ /\bIO\b/) {
        $reason = 'IO extension unavailable';
    }
    if ($reason) {
        print "1..0 # Skip: $reason\n";
        exit 0;
        }
    }
}

$| = 1;

print "1..8\n";

eval {
    $SIG{ALRM} = sub { die; };
    alarm 60;
};

package Multi;
require IO::Socket::INET;
@ISA=qw(IO::Socket::INET);

use Socket qw(inet_aton inet_ntoa unpack_sockaddr_in);

sub _get_addr
{
    my($sock,$addr_str, $multi) = @_;
    #print "_get_addr($sock, $addr_str, $multi)\n";

    print "not " unless $multi;
    print "ok 2\n";

    (
     # private IP-addresses which I hope does not work anywhere :-)
     inet_aton("10.250.230.10"),
     inet_aton("10.250.230.12"),
     inet_aton("127.0.0.1")        # loopback
    )
}

sub connect
{
    my $self = shift;
    if (@_ == 1) {
    my($port, $addr) = unpack_sockaddr_in($_[0]);
    $addr = inet_ntoa($addr);
    #print "connect($self, $port, $addr)\n";
    if($addr eq "10.250.230.10") {
        print "ok 3\n";
        return 0;
    }
    if($addr eq "10.250.230.12") {
        print "ok 4\n";
        return 0;
    }
    }
    $self->SUPER::connect(@_);
}


package main;

use IO::Socket;

$listen = IO::Socket::INET->new(Listen => 2,
                Proto => 'tcp',
                Timeout => 5,
                   ) or die "$!";

print "ok 1\n";

$port = $listen->sockport;

if($pid = fork()) {

    $sock = $listen->accept() or die "$!";
    print "ok 5\n";

    print $sock->getline();
    print $sock "ok 7\n";

    waitpid($pid,0);

    $sock->close;

    print "ok 8\n";

} elsif(defined $pid) {

    $sock = Multi->new(PeerPort => $port,
               Proto => 'tcp',
               PeerAddr => 'localhost',
               MultiHomed => 1,
               Timeout => 1,
              ) or die "$!";

    print $sock "ok 6\n";
    sleep(1); # race condition
    print $sock->getline();

    $sock->close;

    exit;
} else {
    die;
}