Merge pull request #40 from libwww-perl/skaji/url

prefer ip address for host in $d->url

Author: oalders

lib/HTTP/Daemon.pm

@@ -7,10 +7,7 @@ use warnings;
 
 our $VERSION = '6.07';
 
-use Socket qw(
-    AF_INET AF_INET6 INADDR_ANY IN6ADDR_ANY INADDR_LOOPBACK IN6ADDR_LOOPBACK
-    inet_ntop sockaddr_family
-);
+use Socket ();
 use IO::Socket::IP;
 our @ISA = qw(IO::Socket::IP);
 
@@ -48,48 +45,13 @@ sub accept {
 
 sub url {
     my $self = shift;
-    my $url  = $self->_default_scheme . "://";
-    my $addr = $self->sockaddr;
-    if (!$addr || $addr eq INADDR_ANY || $addr eq IN6ADDR_ANY) {
-        require Sys::Hostname;
-        $url .= lc Sys::Hostname::hostname();
-    }
-    elsif ($addr eq INADDR_LOOPBACK) {
-        $url .= inet_ntop(AF_INET, $addr);
-    }
-    elsif ($addr eq IN6ADDR_LOOPBACK) {
-        $url .= '[' . inet_ntop(AF_INET6, $addr) . ']';
-    }
-    else {
-        my $host = $self->sockhostname;
-
-        # sockhostname() seems to return a stringified IP address if not
-        # resolvable. Then quote it for a port separator and an IPv6 zone
-        # separator. But be paranoid for a case when it already contains
-        # a bracket.
-        if (defined $host and $host =~ /:/) {
-            if ($host =~ /[\[\]]/) {
-                $host = undef;
-            }
-            else {
-                $host =~ s/%/%25/g;
-                $host = '[' . $host . ']';
-            }
-        }
-        if (!defined $host) {
-            my $family = sockaddr_family($self->sockname);
-            if ($family && $family == AF_INET6) {
-                $host = '[' . inet_ntop(AF_INET6, $addr) . ']';
-            }
-            elsif ($family && $family == AF_INET) {
-                $host = inet_ntop(AF_INET, $addr);
-            }
-            else {
-                die "Unknown family";
-            }
-        }
-        $url .= $host;
-    }
+
+    my $host = $self->sockhost;
+    $host = "127.0.0.1" if $host eq "0.0.0.0";
+    $host = "::1"       if $host eq "::";
+    $host = "[$host]"   if $self->sockdomain == Socket::AF_INET6;
+
+    my $url = $self->_default_scheme . "://" . $host;
     my $port = $self->sockport;
     $url .= ":$port" if $port != $self->_default_port;
     $url .= "/";

t/url.t

@@ -0,0 +1,62 @@
+use strict;
+use warnings;
+
+use Test::More 0.98;
+
+use Config;
+use HTTP::Daemon;
+use HTTP::Response;
+use HTTP::Tiny;
+
+my $can_fork
+    = $Config{d_fork}
+    || (($^O eq 'MSWin32' || $^O eq 'NetWare')
+    and $Config{useithreads}
+    and $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/);
+
+plan skip_all => "This system cannot fork" if !$can_fork;
+
+my $d = HTTP::Daemon->new or die "HTTP::Daemon->new: $!";
+
+my $url = $d->url;
+note "url: $url";
+
+my $pid = fork;
+die "fork: $!" if !defined $pid;
+
+if ($pid == 0) {
+    my $http = HTTP::Tiny->new(
+        timeout => 3,
+        proxy => undef,
+        http_proxy => undef,
+        https_proxy => undef,
+    );
+    my $res;
+    eval {
+        local $SIG{ALRM} = sub { die "alarm\n" };
+        alarm 4;
+        $res = $http->get($url);
+    };
+    my $err = $@;
+    alarm 0;
+    exit if $res && $res->{success};
+    if ($err) {
+        diag $err;
+    }
+    if ($res) {
+        diag "$res->{status} $res->{reason}";
+        diag $res->{content} if $res->{status} == 599;
+    }
+    exit 1;
+}
+
+my $c = $d->accept or die "accept: $!";
+my $req = $c->get_request;
+$c->send_response(HTTP::Response->new(200));
+$c->close;
+$d->close;
+
+wait;
+is $?, 0;
+
+done_testing;