Commits

committed 453350a

Add the patch from Steffen Ullrich (slightly modified).

• Participants
• Parent commits 23a490d

File modules/IO-Socket-INET6/ChangeLog

`+	* Solved "problems with multihomed and family order"`
`+		- https://rt.cpan.org/Ticket/Display.html?id=57676`
`+		- Thanks to Steffen Ullrich`
`+`
` 2010-03-25 Shlomi Fish <shlomif@iglu.org.il>`
` 	* Fix the inet_pton / inet_ntop import warnings:`
` 		- https://rt.cpan.org/Ticket/Display.html?id=55901`

File modules/IO-Socket-INET6/lib/IO/Socket/INET6.pm

`     }`
` `
`     my @flr;`
`-    for( my \$l=0;\$l<@lres;\$l+=5) {`
`-        my \$fam_listen = \$lres[\$l];`
`-        my \$lsockaddr = \$lres[\$l+3];`
`-        if (@rres) {`
`-            # collect all combinations whith the same family in lres and rres`
`-            for( my \$r=0;\$r<@rres;\$r+=5 ) {`
`-                next if \$rres[0] != \$fam_listen; # must be same family`
`-                push @flr,[ \$fam_listen,\$lsockaddr,\$rres[\$r+3] ];`
`+    if (@rres) {`
`+        # collect all combinations whith the same family in lres and rres`
`+        # the order we search should be defined by the order of @rres, `
`+        # not @lres!`
`+        for( my \$r=0;\$r<@rres;\$r+=5 ) {`
`+            for( my \$l=0;\$l<@lres;\$l+=5) {`
`+                my \$fam_listen = \$lres[\$l];`
`+                next if \$rres[\$r] != \$fam_listen; # must be same family`
`+                push @flr,[ \$fam_listen,\$lres[\$l+3],\$rres[\$r+3] ];`
`             }`
`-        } else {`
`+        }`
`+    } else {`
`+        for( my \$l=0;\$l<@lres;\$l+=5) {`
`+            my \$fam_listen = \$lres[\$l];`
`+            my \$lsockaddr = \$lres[\$l+3];`
`             # collect only the binding side`
`             push @flr,[ \$fam_listen,\$lsockaddr ];`
`         }`

File modules/IO-Socket-INET6/t/io_multihomed6.t

`-#!./perl`
`+#!/usr/bin/env perl`
`+`
`+use strict;`
`+use warnings;`
` `
` BEGIN {`
`     unless(grep /blib/, @INC) {`
`-	chdir 't' if -d 't';`
`-	@INC = '../lib';`
`+        chdir 't' if -d 't';`
`+        unshift @INC,'../lib';`
`     }`
` }`
` `
` `
` 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;`
`+        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";`
`+        print "1..0 # SKIP accept() fails for IPv6 under MSWin32\n";`
`         exit 0;`
`     }`
` }`
` `
`+use IO::Socket::INET6;`
`+`
` \$| = 1;`
`-`
`-print "1..5\n";`
`+print "1..8\n";`
` `
` eval {`
`     \$SIG{ALRM} = sub { die; };`
`     alarm 60;`
` };`
` `
`-# Okey:`
`-# To check the Multihome strategy, let's try the next :`
`-# Open a IPv4 server on a given port.`
`-# then, try a client on unspecified family -AF_UNSPEC-`
`-# The multihomed socket will try then firstly IPv6, fail,`
`-# and then IPv4.`
`-package main;`
`-`
`-use IO::Socket::INET6;`
`-`
`-\$listen = IO::Socket::INET6->new(Listen => 2,`
`-				# 8080 is a commonly used port`
`-                # so we're using a more obscure port`
`-                # instead.`
`-				LocalPort => 28083,`
`-				Family => AF_INET,`
`-				Proto => 'tcp',`
`-				Timeout => 5,`
`-			       ) or die "\$@";`
`+# 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";`
` `
`-\$port = \$listen->sockport;`
`+if (my \$pid = fork()) {`
`+    my \$vec = '';`
`+    vec(\$vec,fileno(\$_),1) = 1 for(@srv);`
`+    select(\$vec,undef,undef,5) or die \$!;`
` `
`-if(\$pid = fork()) {`
`+    # 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 \$!;`
` `
`-    \$sock = \$listen->accept() or die "\$!";`
`-    print "ok 2\n";`
`+    # listener should not work for next connect`
`+    # so it needs to try second`
`+    close(\$first); `
` `
`-    print \$sock->getline();`
`-    print \$sock "ok 4\n";`
`+    # make sure established connection works`
`+    my \$fam0 = ( \$cl->sockdomain == AF_INET ) ? 'inet':'inet6';`
`+    print {\$cl} "ok 2 # \$fam0\n";`
`+    print \$cl->getline(); # ok 3`
`+    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";`
` `
`-    \$sock->close;`
`+} 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 "ok 5\n";`
`+    print \$cl->getline(); # ok 2`
`+    print {\$cl} "ok 3\n";`
`+    close(\$cl);`
` `
`-} elsif(defined \$pid) {`
`+    # 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";`
` `
`-    \$sock = IO::Socket::INET6->new(PeerPort => \$port,`
`-		       Proto => 'tcp',`
`-		       PeerAddr => 'localhost',`
`-		       MultiHomed => 1,`
`-		       Timeout => 1,`
`-		      ) or die "\$@";`
`+    # 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;`
` `
`-    print \$sock "ok 3\n";`
`-    sleep(1); # race condition`
`-    print \$sock->getline();`
`-`
`-    \$sock->close;`
`-`
`-    exit;`
` } else {`
`-    die;`
`+    die \$!; # fork failed`
` }`