Merge pull request #31 from libwww-perl/ipv6

Use IO::Socket::IP for IPv6 support.

Author: karenetheridge

Changes

@@ -6,6 +6,8 @@ Revision history for HTTP-Daemon
   - Tidied Daemon.pm
   - Turned on EOL and tab tests
   - Removed obvious indirect object syntax in test suite
+  - Added IPv6 support. (GH#24) Thanks, @ppisar and @intrigeri
+  - Added IO::Socket::IP as a prerequisite rather than IO::Socket::INET
 
 6.04      2019-04-02 13:09:45Z
   - Remove circular dependency on LWP::RobotUA introduced in 6.02 (GH#29)

lib/HTTP/Daemon.pm

@@ -7,8 +7,12 @@ use warnings;
 
 our $VERSION = '6.05';
 
-use IO::Socket qw(AF_INET INADDR_ANY INADDR_LOOPBACK inet_ntoa);
-our @ISA = qw(IO::Socket::INET);
+use Socket qw(
+    AF_INET AF_INET6 INADDR_ANY IN6ADDR_ANY INADDR_LOOPBACK IN6ADDR_LOOPBACK
+    inet_ntop sockaddr_family
+);
+use IO::Socket::IP;
+our @ISA = qw(IO::Socket::IP);
 
 our $PROTO = "HTTP/1.1";
 
@@ -38,15 +42,31 @@ sub url {
     my $self = shift;
     my $url  = $self->_default_scheme . "://";
     my $addr = $self->sockaddr;
-    if (!$addr || $addr eq INADDR_ANY) {
+    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_ntoa($addr);
+        $url .= inet_ntop(AF_INET, $addr);
+    }
+    elsif ($addr eq IN6ADDR_LOOPBACK) {
+        $url .= '[' . inet_ntop(AF_INET6, $addr) . ']';
     }
     else {
-        $url .= gethostbyaddr($addr, AF_INET) || inet_ntoa($addr);
+        my $host = $self->sockhostname;
+        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 $port = $self->sockport;
     $url .= ":$port" if $port != $self->_default_port;
@@ -72,8 +92,8 @@ package    # hide from PAUSE
 use strict;
 use warnings;
 
-use IO::Socket ();
-our @ISA = qw(IO::Socket::INET);
+use IO::Socket::IP ();
+our @ISA = qw(IO::Socket::IP);
 our $DEBUG;
 *DEBUG = \$HTTP::Daemon::DEBUG;
 
@@ -613,12 +633,12 @@ __END__
 
 Instances of the C<HTTP::Daemon> class are HTTP/1.1 servers that
 listen on a socket for incoming requests. The C<HTTP::Daemon> is a
-subclass of C<IO::Socket::INET>, so you can perform socket operations
+subclass of C<IO::Socket::IP>, so you can perform socket operations
 directly on it too.
 
 The accept() method will return when a connection from a client is
 available.  The returned value will be an C<HTTP::Daemon::ClientConn>
-object which is another C<IO::Socket::INET> subclass.  Calling the
+object which is another C<IO::Socket::IP> subclass.  Calling the
 get_request() method on this object will read data from the client and
 return an C<HTTP::Request> object.  The ClientConn object also provide
 methods to send back various responses.
@@ -629,7 +649,7 @@ desirable.  Also note that the user is responsible for generating
 responses that conform to the HTTP/1.1 protocol.
 
 The following methods of C<HTTP::Daemon> are new (or enhanced) relative
-to the C<IO::Socket::INET> base class:
+to the C<IO::Socket::IP> base class:
 
 =over 4
 
@@ -638,7 +658,7 @@ to the C<IO::Socket::INET> base class:
 =item $d = HTTP::Daemon->new( %opts )
 
 The constructor method takes the same arguments as the
-C<IO::Socket::INET> constructor, but unlike its base class it can also
+C<IO::Socket::IP> constructor, but unlike its base class it can also
 be called without any arguments.  The daemon will then set up a listen
 queue of 5 connections and allocate some random port number.
 
@@ -650,7 +670,7 @@ HTTP port will be constructed like this:
            LocalPort => 80,
        );
 
-See L<IO::Socket::INET> for a description of other arguments that can
+See L<IO::Socket::IP> for a description of other arguments that can
 be used configure the daemon during construction.
 
 =item $c = $d->accept
@@ -667,7 +687,7 @@ class a subclass of C<HTTP::Daemon::ClientConn>.
 
 The accept method will return C<undef> if timeouts have been enabled
 and no connection is made within the given time.  The timeout() method
-is described in L<IO::Socket>.
+is described in L<IO::Socket::IP>.
 
 In list context both the client object and the peer address will be
 returned; see the description of the accept method L<IO::Socket> for
@@ -689,7 +709,7 @@ replaced with the version number of this module.
 
 =back
 
-The C<HTTP::Daemon::ClientConn> is a C<IO::Socket::INET>
+The C<HTTP::Daemon::ClientConn> is a C<IO::Socket::IP>
 subclass. Instances of this class are returned by the accept() method
 of C<HTTP::Daemon>.  The following methods are provided:
 
@@ -863,6 +883,6 @@ Return a reference to the corresponding C<HTTP::Daemon> object.
 
 RFC 2616
 
-L<IO::Socket::INET>, L<IO::Socket>
+L<IO::Socket::IP>, L<IO::Socket>
 
 =cut

t/chunked.t

@@ -101,20 +101,32 @@ my $can_fork
 my $tests = @TESTS;
 my $tport = 8334;
 
-my $tsock = IO::Socket::INET->new(
-    LocalAddr => '0.0.0.0',
-    LocalPort => $tport,
-    Listen    => 1,
-    ReuseAddr => 1
+my @addresses = (
+    {server => '::',      client => '::1'},
+    {server => '0.0.0.0', client => '127.0.0.1'}
 );
+my $family;
+for my $id (0 .. $#addresses) {
+    my $tsock = IO::Socket::IP->new(
+        LocalAddr => $addresses[$id]->{server},
+        LocalPort => $tport,
+        Listen    => 1,
+        ReuseAddr => 1
+    );
+    if ($tsock) {
+        close $tsock;
+        $family = $id;
+        last;
+    }
+}
+
 if (!$can_fork) {
     plan skip_all => "This system cannot fork";
 }
-elsif (!$tsock) {
-    plan skip_all => "Cannot listen on 0.0.0.0:$tport";
+elsif (!defined $family) {
+    plan skip_all => "Cannot listen on unspecifed address and port $tport";
 }
 else {
-    close $tsock;
     plan tests => $tests;
 }
 
@@ -139,11 +151,11 @@ if ($pid = fork) {
             open my $fh, "| socket localhost $tport" or die;
             print $fh $test;
         }
-        use IO::Socket::INET;
-        my $sock
-            = IO::Socket::INET->new(PeerAddr => "127.0.0.1",
-            PeerPort => $tport,)
-            or die;
+        use IO::Socket::IP;
+        my $sock = IO::Socket::IP->new(
+            PeerAddr => $addresses[$family]->{client},
+            PeerPort => $tport,
+        ) or die;
         if (0) {
             for my $pos (0 .. length($raw) - 1) {
                 print $sock substr($raw, $pos, 1);
@@ -164,7 +176,7 @@ if ($pid = fork) {
 else {
     die "cannot fork: $!" unless defined $pid;
     my $d = HTTP::Daemon->new(
-        LocalAddr => '0.0.0.0',
+        LocalAddr => $addresses[$family]->{server},
         LocalPort => $tport,
         ReuseAddr => 1,
     ) or die;

t/local/http.t

@@ -12,7 +12,7 @@ unless (-f "CAN_TALK_TO_OURSELF") {
 
 $| = 1;    # autoflush
 
-require IO::Socket;   # make sure this work before we try to make a HTTP::Daemon
+require IO::Socket::IP;   # make sure this work before we try to make a HTTP::Daemon
 
 # First we make ourself a daemon in another process
 my $D = shift || '';

t/robot/ua-get.t

@@ -11,7 +11,7 @@ unless (-f "CAN_TALK_TO_OURSELF") {
 }
 
 $| = 1;               # autoflush
-require IO::Socket;   # make sure this work before we try to make a HTTP::Daemon
+require IO::Socket::IP;   # make sure this work before we try to make a HTTP::Daemon
 
 # First we make ourself a daemon in another process
 my $D = shift || '';

t/robot/ua.t

@@ -11,7 +11,7 @@ unless (-f "CAN_TALK_TO_OURSELF") {
 }
 
 $| = 1;               # autoflush
-require IO::Socket;   # make sure this work before we try to make a HTTP::Daemon
+require IO::Socket::IP;   # make sure this work before we try to make a HTTP::Daemon
 
 # First we make ourself a daemon in another process
 my $D = shift || '';