#!/usr/bin/env perl

use strict;

use warnings;

BEGIN {

    unless(grep /blib/, @INC) {

        chdir 't' if -d 't';

        unshift @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'} !~ /\bSocket6\b/) {

            $reason = 'Socket6 extension unavailable';

        }

        elsif ($Config{'extensions'} !~ /\bIO\b/) {

            $reason = 'IO extension unavailable';

        }

        if ($reason) {

            print "1..0 # SKIP $reason\n";

            exit 0;

        }

    }

    if ($^O eq 'MSWin32') {

        print "1..0 # SKIP accept() fails for IPv6 under MSWin32\n";

        exit 0;

    }

}

# check that localhost resolves to 127.0.0.1 and ::1

# otherwise the test will not work

use Socket (qw(

    AF_INET6 PF_INET6 SOCK_RAW SOCK_STREAM INADDR_ANY SOCK_DGRAM

    AF_INET SO_REUSEADDR SO_REUSEPORT AF_UNSPEC SO_BROADCAST

    sockaddr_in unpack_sockaddr_in

    )

);

# IO::Socket and Socket already import stuff here - possibly AF_INET6

# and PF_INET6 so selectively import things from Socket6.

use Socket6 (

    qw(AI_PASSIVE getaddrinfo

    sockaddr_in6 unpack_sockaddr_in6 pack_sockaddr_in6_all in6addr_any

    inet_ntop

    )

);

{

    my %resolved_addresses;

    my @r = getaddrinfo('localhost',1);

    if (@r < 5) {

        print "1..0 # SKIP getaddrinfo('localhost',1) failed: $r[0]\n";

        exit 0;

    }

    while (@r) {

        my @values = splice(@r,0,5);

        my ($fam,$addr) = @values[0,3];

        $addr =

        (

              ($fam == AF_INET)

            ? ( (unpack_sockaddr_in($addr))[1]  )

            : ( (unpack_sockaddr_in6($addr))[1] )

        );

        $resolved_addresses{inet_ntop($fam,$addr)}++;

    }

    if (! $resolved_addresses{'127.0.0.1'} || ! $resolved_addresses{'::1'}) {

        print "1..0 # SKIP localhost does not resolve to both 127.0.0.1 and ::1\n";

        exit 0;

    }

}

# IO::Socket has an import method that is inherited by IO::Socket::INET6 ,

# and so we should instruct it not to import anything.

use IO::Socket::INET6 ();

$| = 1;

print "1..8\n";

eval {

    $SIG{ALRM} = sub { die; };

    alarm 60;

};

# find out if the host prefers inet or inet6 by offering

# both and checking where it connects

my ($port,@srv);

for my $addr ( '127.0.0.1','::1' ) {

    push @srv,

        IO::Socket::INET6->new(

            Listen => 2,

            LocalAddr => $addr,

            LocalPort => $port,

        ) or die "listen on $addr port $port: $!";

    $port ||= $srv[-1]->sockport;

}

print "ok 1\n";

if (my $pid = fork()) {

    my $vec = '';

    vec($vec,fileno($_),1) = 1 for(@srv);

    select($vec,undef,undef,5) or die $!;

    # connected to first, not second

    my ($first,$second) = vec($vec,fileno($srv[0]),1) ? @srv[0,1]:@srv[1,0];

    my $cl = $first->accept or die $!;

    # listener should not work for next connect

    # so it needs to try second

    close($first);

    # make sure established connection works

    my $fam0 = ( $cl->sockdomain == AF_INET ) ? 'inet':'inet6';

    print {$cl} "ok 2 # $fam0\n";

    print $cl->getline(); # ok 3

    # So we'll be sure ok 3 has already been printed.

    print {$cl} "Move on, will ya!\n";

    close($cl);

    # ... ok 4 comes when client fails to connect to first

    # wait for connect on second and make sure it works

    $vec = '';

    vec($vec,fileno($second),1) = 1;

    if ( select($vec,undef,undef,5)) {

        my $cl2 = $second->accept or die $!;

        my $fam1 = ( $cl2->sockdomain == AF_INET ) ? 'inet':'inet6';

        print {$cl2} "ok 5 # $fam1\n";

        print $cl2->getline(); # ok 6

        close($cl2);

        # should be different families

        print "not " if $fam0 eq $fam1;

        print "ok 7\n";

    }

    waitpid($pid,0);

    print "ok 8\n";

} elsif (defined $pid) {

    close($_) for (@srv);

    # should work because server is listening on inet and inet6

    my $cl = IO::Socket::INET6->new(

        PeerPort => $port,

        PeerAddr => 'localhost',

        Timeout => 5,

    ) or die "$@";

    print $cl->getline(); # ok 2

    print {$cl} "ok 3\n";

    # So we'll be sure ok 3 has already been printed.

    $cl->getline();

    close($cl);

    # this should not work because listener is closed

    if ( $cl = IO::Socket::INET6->new(

            PeerPort => $port,

        PeerAddr => 'localhost',

        Timeout => 5,

    )) {

        print "not ok 4\n";

        exit;

    }

    print "ok 4\n";

    # but same thing with multihoming should work because server

    # is still listening on the other family

    $cl = IO::Socket::INET6->new(

        PeerPort => $port,

        PeerAddr => 'localhost',

        Timeout => 5,

        MultiHomed => 1,

    ) or do {

        print "not ok 5\n";

        exit;

    };

    print $cl->getline(); # ok 5

    print {$cl} "ok 6\n";

    exit;

} else {

    die $!; # fork failed

}