| Subject: | Problem binding to localhost when both IPv6 and IPv4 configured (Windows 7+Strawberry Perl) |
While hunting down a test-suite bug elsewhere, I have found that Strawberry Perl on Windows 7 behaves differently than ActiveState Perl, with this module.
When getting a socket connection to a "localhost" server, which has both IPv4 and IPv6 enabled (at least on Win7), the IPv6 bind fails (because the server is bound to the IPv4 address) but the second iteration of the loop in setup() fails to bind as well. I have noted that getaddrinfo() is returning two records on Strawberry, but only one record under ActiveState. The nested loops in the _io_socket_ip__configure method at lines 525-546 result in @info having two records, the IPv6 record and then the IPv4 record. Then in the setup method, the second iteration of the while-loop fails to bind to the IPv4 address.
The attached sample code exhibits this behavior through the LWP::UaserAgent and HTTP::Daemon classes. HTTP::Daemon doesn't use IO::Socket::IP, and only binds to the IPv4 address for localhost. LWP::UserAgent (or a class that it uses) does use IO::Socket::IP. The script must be run in two separate terminals, one as the server and one as the client.
* Run the server with "perl socket-fail.pl <port>"
* Run the client with "perl socket-fail.pl <port> 1"
Note that this is only exhibiting with Strawberry Perl, and I have only tried it on Windows 7.
Randy
--
Randy J. Ray
rjray@blackperl.com
randy.j.ray@gmail.com
| Subject: | socket-fail.pl |
#!/usr/bin/env perl
use strict;
use warnings;
use LWP::UserAgent;
use HTTP::Daemon;
use HTTP::Request;
use HTTP::Response;
use HTTP::Status;
my ($port, $is_client) = @ARGV;
my $host = 'localhost';
if ($is_client) {
my $UA = LWP::UserAgent->new;
my $req = HTTP::Request->new(HEAD => "http://$host:$port");
print ">>> Sending HEAD request\n";
my $res = $UA->request($req);
print ">>> Headers from HEAD request:\n\t";
printf "%d %s\n\t", $res->code, $res->message;
print $res->headers_as_string("\n\t"), "\n";
sleep 1;
printf ">>> Creating POST request to %s\n", $req->uri;
$req = HTTP::Request->new(POST => "http://$host:$port");
print ">>> Sending POST request\n";
$res = $UA->request($req);
print ">>> Full message from POST request:\n\t";
print $res->as_string("\n\t"), "\n";
} else {
my $server = HTTP::Daemon->new(
ReuseAddr => 1,
LocalHost => $host,
LocalPort => $port,
Listen => 5
);
die "Failed to create server object\n" if (! $server);
$server->timeout(1);
while (1) {
my $conn = $server->accept;
printf "<<< Accept: %s\n", ($conn || '(none)');
next if (! $conn);
my $req;
while ($conn and $req = $conn->get_request('headers only')) {
my $res = HTTP::Response->new;
$res->code(RC_OK);
$res->message('OK');
$res->header(Accept => 'text/xml');
$res->content_type('text/xml');
if ($req->method eq 'HEAD') {
print "<<< Sending HEAD response\n";
$conn->send_response($res);
} elsif ($req->method eq 'POST') {
print "<<< Sending POST response\n";
$res->content('Success');
$conn->send_response($res);
}
}
my $eval_return = eval {
local $SIG{PIPE} = sub { die "<<< server_loop: Caught SIGPIPE\n"; };
$conn->close;
1;
};
if ((! $eval_return) && $@)
{
warn "<<< Cannot close connection: $@\n";
}
undef $conn;
}
}
exit;