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