776a43
From 067faffb8e596a53c9ac2ed7e571472f7a163681 Mon Sep 17 00:00:00 2001
776a43
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
776a43
Date: Mon, 16 Jan 2017 16:13:08 +0100
776a43
Subject: [PATCH] Add IPv6 support
776a43
MIME-Version: 1.0
776a43
Content-Type: text/plain; charset=UTF-8
776a43
Content-Transfer-Encoding: 8bit
776a43
776a43
This patch ports the code from IO::Socket::INET to IO::Socket::IP in
776a43
order to support IPv6.
776a43
776a43
CPAN RT #91699, #71395.
776a43
776a43
Signed-off-by: Petr Písař <ppisar@redhat.com>
776a43
---
776a43
 Makefile.PL        |  1 +
776a43
 README             | 24 ++++++++++++------------
776a43
 lib/HTTP/Daemon.pm | 43 ++++++++++++++++++++++++++++---------------
776a43
 t/chunked.t        | 34 +++++++++++++++++++++++-----------
776a43
 4 files changed, 64 insertions(+), 38 deletions(-)
776a43
776a43
diff --git a/Makefile.PL b/Makefile.PL
776a43
index 09c7e86..85d5712 100644
776a43
--- a/Makefile.PL
776a43
+++ b/Makefile.PL
776a43
@@ -14,6 +14,7 @@ WriteMakefile(
776a43
     PREREQ_PM => {
776a43
 	'Sys::Hostname' => 0,
776a43
 	'IO::Socket' => 0,
776a43
+	'IO::Socket::IP' => 0,
776a43
 	'HTTP::Request' => 6,
776a43
 	'HTTP::Response' => 6,
776a43
 	'HTTP::Status' => 6,
776a43
diff --git a/README b/README
776a43
index be5a20a..ddb3b6e 100644
776a43
--- a/README
776a43
+++ b/README
776a43
@@ -24,12 +24,12 @@ SYNOPSIS
776a43
 DESCRIPTION
776a43
     Instances of the `HTTP::Daemon' class are HTTP/1.1 servers that listen
776a43
     on a socket for incoming requests. The `HTTP::Daemon' is a subclass of
776a43
-    `IO::Socket::INET', so you can perform socket operations directly on it
776a43
+    `IO::Socket::IP', so you can perform socket operations directly on it
776a43
     too.
776a43
 
776a43
     The accept() method will return when a connection from a client is
776a43
     available. The returned value will be an `HTTP::Daemon::ClientConn'
776a43
-    object which is another `IO::Socket::INET' subclass. Calling the
776a43
+    object which is another `IO::Socket::IP' subclass. Calling the
776a43
     get_request() method on this object will read data from the client and
776a43
     return an `HTTP::Request' object. The ClientConn object also provide
776a43
     methods to send back various responses.
776a43
@@ -40,13 +40,13 @@ DESCRIPTION
776a43
     responses that conform to the HTTP/1.1 protocol.
776a43
 
776a43
     The following methods of `HTTP::Daemon' are new (or enhanced) relative
776a43
-    to the `IO::Socket::INET' base class:
776a43
+    to the `IO::Socket::IP' base class:
776a43
 
776a43
     $d = HTTP::Daemon->new
776a43
     $d = HTTP::Daemon->new( %opts )
776a43
         The constructor method takes the same arguments as the
776a43
-        `IO::Socket::INET' constructor, but unlike its base class it can
776a43
-        also be called without any arguments. The daemon will then set up a
776a43
+        `IO::Socket::IP' constructor, but unlike its base class it can also
776a43
+        be called without any arguments. The daemon will then set up a
776a43
         listen queue of 5 connections and allocate some random port number.
776a43
 
776a43
         A server that wants to bind to some specific address on the standard
776a43
@@ -57,8 +57,8 @@ DESCRIPTION
776a43
                    LocalPort => 80,
776a43
                );
776a43
 
776a43
-        See IO::Socket::INET for a description of other arguments that can
776a43
-        be used configure the daemon during construction.
776a43
+        See IO::Socket::IP for a description of other arguments that can be
776a43
+        used configure the daemon during construction.
776a43
 
776a43
     $c = $d->accept
776a43
     $c = $d->accept( $pkg )
776a43
@@ -71,7 +71,7 @@ DESCRIPTION
776a43
 
776a43
         The accept method will return `undef' if timeouts have been enabled
776a43
         and no connection is made within the given time. The timeout()
776a43
-        method is described in IO::Socket.
776a43
+        method is described in IO::Socket::IP.
776a43
 
776a43
         In list context both the client object and the peer address will be
776a43
         returned; see the description of the accept method IO::Socket for
776a43
@@ -89,9 +89,9 @@ DESCRIPTION
776a43
         The default is the string "libwww-perl-daemon/#.##" where "#.##" is
776a43
         replaced with the version number of this module.
776a43
 
776a43
-    The `HTTP::Daemon::ClientConn' is a `IO::Socket::INET' subclass.
776a43
-    Instances of this class are returned by the accept() method of
776a43
-    `HTTP::Daemon'. The following methods are provided:
776a43
+    The `HTTP::Daemon::ClientConn' is a `IO::Socket::IP' subclass. Instances
776a43
+    of this class are returned by the accept() method of `HTTP::Daemon'. The
776a43
+    following methods are provided:
776a43
 
776a43
     $c->get_request
776a43
     $c->get_request( $headers_only )
776a43
@@ -227,7 +227,7 @@ DESCRIPTION
776a43
 SEE ALSO
776a43
     RFC 2616
776a43
 
776a43
-    IO::Socket::INET, IO::Socket
776a43
+    IO::Socket::IP, IO::Socket
776a43
 
776a43
 COPYRIGHT
776a43
     Copyright 1996-2003, Gisle Aas
776a43
diff --git a/lib/HTTP/Daemon.pm b/lib/HTTP/Daemon.pm
776a43
index 27a7bf4..0e22b77 100644
776a43
--- a/lib/HTTP/Daemon.pm
776a43
+++ b/lib/HTTP/Daemon.pm
776a43
@@ -5,8 +5,10 @@ use vars qw($VERSION @ISA $PROTO $DEBUG);
776a43
 
776a43
 $VERSION = "6.01";
776a43
 
776a43
-use IO::Socket qw(AF_INET INADDR_ANY INADDR_LOOPBACK inet_ntoa);
776a43
-@ISA=qw(IO::Socket::INET);
776a43
+use Socket qw(AF_INET AF_INET6 INADDR_ANY IN6ADDR_ANY
776a43
+	    INADDR_LOOPBACK IN6ADDR_LOOPBACK inet_ntop sockaddr_family);
776a43
+use IO::Socket::IP;
776a43
+@ISA=qw(IO::Socket::IP);
776a43
 
776a43
 $PROTO = "HTTP/1.1";
776a43
 
776a43
@@ -40,15 +42,26 @@ sub url
776a43
     my $self = shift;
776a43
     my $url = $self->_default_scheme . "://";
776a43
     my $addr = $self->sockaddr;
776a43
-    if (!$addr || $addr eq INADDR_ANY) {
776a43
+    if (!$addr || $addr eq INADDR_ANY || $addr eq IN6ADDR_ANY) {
776a43
  	require Sys::Hostname;
776a43
  	$url .= lc Sys::Hostname::hostname();
776a43
     }
776a43
     elsif ($addr eq INADDR_LOOPBACK) {
776a43
-	$url .= inet_ntoa($addr);
776a43
+	$url .= inet_ntop(AF_INET, $addr);
776a43
+    }
776a43
+    elsif ($addr eq IN6ADDR_LOOPBACK) {
776a43
+	$url .= '[' . inet_ntop(AF_INET6, $addr) . ']';
776a43
     }
776a43
     else {
776a43
-	$url .= gethostbyaddr($addr, AF_INET) || inet_ntoa($addr);
776a43
+	my $host = $addr->sockhostname;
776a43
+        if (!defined $host) {
776a43
+	    if (sockaddr_family($addr) eq AF_INET6) {
776a43
+		$host = '[' . inet_ntop(AF_INET6, $addr) . ']';
776a43
+	    } else {
776a43
+		$host = inet_ntop(AF_INET6, $addr);
776a43
+	    }
776a43
+	}
776a43
+	$url .= $host;
776a43
     }
776a43
     my $port = $self->sockport;
776a43
     $url .= ":$port" if $port != $self->_default_port;
776a43
@@ -77,8 +90,8 @@ sub product_tokens
776a43
 package HTTP::Daemon::ClientConn;
776a43
 
776a43
 use vars qw(@ISA $DEBUG);
776a43
-use IO::Socket ();
776a43
-@ISA=qw(IO::Socket::INET);
776a43
+use IO::Socket::IP ();
776a43
+@ISA=qw(IO::Socket::IP);
776a43
 *DEBUG = \$HTTP::Daemon::DEBUG;
776a43
 
776a43
 use HTTP::Request  ();
776a43
@@ -645,12 +658,12 @@ HTTP::Daemon - a simple http server class
776a43
 
776a43
 Instances of the C<HTTP::Daemon> class are HTTP/1.1 servers that
776a43
 listen on a socket for incoming requests. The C<HTTP::Daemon> is a
776a43
-subclass of C<IO::Socket::INET>, so you can perform socket operations
776a43
+subclass of C<IO::Socket::IP>, so you can perform socket operations
776a43
 directly on it too.
776a43
 
776a43
 The accept() method will return when a connection from a client is
776a43
 available.  The returned value will be an C<HTTP::Daemon::ClientConn>
776a43
-object which is another C<IO::Socket::INET> subclass.  Calling the
776a43
+object which is another C<IO::Socket::IP> subclass.  Calling the
776a43
 get_request() method on this object will read data from the client and
776a43
 return an C<HTTP::Request> object.  The ClientConn object also provide
776a43
 methods to send back various responses.
776a43
@@ -661,7 +674,7 @@ desirable.  Also note that the user is responsible for generating
776a43
 responses that conform to the HTTP/1.1 protocol.
776a43
 
776a43
 The following methods of C<HTTP::Daemon> are new (or enhanced) relative
776a43
-to the C<IO::Socket::INET> base class:
776a43
+to the C<IO::Socket::IP> base class:
776a43
 
776a43
 =over 4
776a43
 
776a43
@@ -670,7 +683,7 @@ to the C<IO::Socket::INET> base class:
776a43
 =item $d = HTTP::Daemon->new( %opts )
776a43
 
776a43
 The constructor method takes the same arguments as the
776a43
-C<IO::Socket::INET> constructor, but unlike its base class it can also
776a43
+C<IO::Socket::IP> constructor, but unlike its base class it can also
776a43
 be called without any arguments.  The daemon will then set up a listen
776a43
 queue of 5 connections and allocate some random port number.
776a43
 
776a43
@@ -682,7 +695,7 @@ HTTP port will be constructed like this:
776a43
            LocalPort => 80,
776a43
        );
776a43
 
776a43
-See L<IO::Socket::INET> for a description of other arguments that can
776a43
+See L<IO::Socket::IP> for a description of other arguments that can
776a43
 be used configure the daemon during construction.
776a43
 
776a43
 =item $c = $d->accept
776a43
@@ -699,7 +712,7 @@ class a subclass of C<HTTP::Daemon::ClientConn>.
776a43
 
776a43
 The accept method will return C<undef> if timeouts have been enabled
776a43
 and no connection is made within the given time.  The timeout() method
776a43
-is described in L<IO::Socket>.
776a43
+is described in L<IO::Socket::IP>.
776a43
 
776a43
 In list context both the client object and the peer address will be
776a43
 returned; see the description of the accept method L<IO::Socket> for
776a43
@@ -721,7 +734,7 @@ replaced with the version number of this module.
776a43
 
776a43
 =back
776a43
 
776a43
-The C<HTTP::Daemon::ClientConn> is a C<IO::Socket::INET>
776a43
+The C<HTTP::Daemon::ClientConn> is a C<IO::Socket::IP>
776a43
 subclass. Instances of this class are returned by the accept() method
776a43
 of C<HTTP::Daemon>.  The following methods are provided:
776a43
 
776a43
@@ -895,7 +908,7 @@ Return a reference to the corresponding C<HTTP::Daemon> object.
776a43
 
776a43
 RFC 2616
776a43
 
776a43
-L<IO::Socket::INET>, L<IO::Socket>
776a43
+L<IO::Socket::IP>, L<IO::Socket>
776a43
 
776a43
 =head1 COPYRIGHT
776a43
 
776a43
diff --git a/t/chunked.t b/t/chunked.t
776a43
index e11799f..c274b11 100644
776a43
--- a/t/chunked.t
776a43
+++ b/t/chunked.t
776a43
@@ -95,18 +95,30 @@ my $can_fork = $Config{d_fork} ||
776a43
 my $tests = @TESTS;
776a43
 my $tport = 8333;
776a43
 
776a43
-my $tsock = IO::Socket::INET->new(LocalAddr => '0.0.0.0',
776a43
-                                  LocalPort => $tport,
776a43
-                                  Listen    => 1,
776a43
-                                  ReuseAddr => 1);
776a43
+my @addresses = (
776a43
+    { server => '::', client => '::1' },
776a43
+    { server => '0.0.0.0', client => '127.0.0.1' }
776a43
+);
776a43
+my $family;
776a43
+for my $id (0..$#addresses) {
776a43
+    my $tsock = IO::Socket::IP->new(LocalAddr => $addresses[$id]->{server},
776a43
+                                    LocalPort => $tport,
776a43
+                                    Listen    => 1,
776a43
+                                    ReuseAddr => 1);
776a43
+    if ($tsock) {
776a43
+        close $tsock;
776a43
+        $family = $id;
776a43
+        last;
776a43
+    }
776a43
+}
776a43
+
776a43
 if (!$can_fork) {
776a43
   plan skip_all => "This system cannot fork";
776a43
 }
776a43
-elsif (!$tsock) {
776a43
-  plan skip_all => "Cannot listen on 0.0.0.0:$tport";
776a43
+elsif (!defined $family) {
776a43
+  plan skip_all => "Cannot listen on unspecifed address and port $tport";
776a43
 }
776a43
 else {
776a43
-  close $tsock;
776a43
   plan tests => $tests;
776a43
 }
776a43
 
776a43
@@ -132,9 +144,9 @@ if ($pid = fork) {
776a43
       open my $fh, "| socket localhost $tport" or die;
776a43
       print $fh $test;
776a43
     }
776a43
-    use IO::Socket::INET;
776a43
-    my $sock = IO::Socket::INET->new(
776a43
-                                     PeerAddr => "127.0.0.1",
776a43
+    use IO::Socket::IP;
776a43
+    my $sock = IO::Socket::IP->new(
776a43
+                                     PeerAddr => $addresses[$family]->{client},
776a43
                                      PeerPort => $tport,
776a43
                                     ) or die;
776a43
     if (0) {
776a43
@@ -158,7 +170,7 @@ if ($pid = fork) {
776a43
 } else {
776a43
   die "cannot fork: $!" unless defined $pid;
776a43
   my $d = HTTP::Daemon->new(
776a43
-                            LocalAddr => '0.0.0.0',
776a43
+                            LocalAddr => $addresses[$family]->{server},
776a43
                             LocalPort => $tport,
776a43
                             ReuseAddr => 1,
776a43
                            ) or die;
776a43
-- 
776a43
2.7.4
776a43