Bug#596176: [rt.cpan.org #61200] IPv6 support for HTTP::Server::Simple
Attached is a a patch for HTTP::Server::Simple that i believe implements
proper IPv6 support without adding any non-core dependencies. It keeps
the same interface changes as the original patch by Mats (optional
$family argument to new(), new family() method on the object, all
defaulting to AF_INET).
The patch also modifies the test suite to perform IPv4 and IPv6 tests.
I've tested it and it works against perl 5.14 (i think that's Socket
1.94), but it fails against perl 5.10 (Socket 1.82, afaict). I can't
find the full history of Socket to figure out where the relevant symbols
(Socket::IN6ADDR_ANY and Socket::getaddrinfo) were added.
Maybe you want to also make the use Socket; line have a version number
if you know the correct cutoff.
Please let me know if you have any trouble or concerns with it, or if
you need me to modify it some way to consider accepting it.
Regards,
--dkg
diff --git a/lib/HTTP/Server/Simple.pm b/lib/HTTP/Server/Simple.pm
index 50479ae..5905d55 100755
--- a/lib/HTTP/Server/Simple.pm
+++ b/lib/HTTP/Server/Simple.pm
@@ -124,15 +124,17 @@ could kill the server.
=head1 METHODS
-=head2 HTTP::Server::Simple-new($port)
+=head2 HTTP::Server::Simple-new($port, $family)
API call to start a new server. Does not actually start listening
-until you call C-Egtrun(). If omitted, C$port defaults to 8080.
+until you call C-Egtrun(). If omitted, C$port defaults to 8080,
+and C$family defaults to LSocket::AF_INET.
+The alternative domain is LSocket::AF_INET6.
=cut
sub new {
-my ( $proto, $port ) = @_;
+my ( $proto, $port, $family ) = @_;
my $class = ref($proto) || $proto;
if ( $class eq __PACKAGE__ ) {
@@ -143,6 +145,7 @@ sub new {
my $self = {};
bless( $self, $class );
$self-port( $port || '8080' );
+$self-family( $family || AF_INET );
return $self;
}
@@ -151,7 +154,7 @@ sub new {
=head2 lookup_localhost
Looks up the local host's IP address, and returns it. For most hosts,
-this is C127.0.0.1.
+this is C127.0.0.1, or possibly C::1.
=cut
@@ -159,9 +162,14 @@ sub lookup_localhost {
my $self = shift;
my $local_sockaddr = getsockname( $self-stdio_handle );
-my ( undef, $localiaddr ) = sockaddr_in($local_sockaddr);
-$self-host( gethostbyaddr( $localiaddr, AF_INET ) || localhost);
-$self-{'local_addr'} = inet_ntoa($localiaddr) || 127.0.0.1;
+my $local_family = sockaddr_family($local_sockaddr);
+my ( undef, $localiaddr ) =
+($local_family == AF_INET6) ? sockaddr_in6($local_sockaddr)
+: sockaddr_in($local_sockaddr);
+
+$self-host( gethostbyaddr( $localiaddr, $local_family ) || localhost);
+$self-{'local_addr'} = Socket::inet_ntop($local_family, $localiaddr)
+|| (($local_family == AF_INET6) ? ::1 : 127.0.0.1);
}
@@ -180,6 +188,31 @@ sub port {
}
+=head2 family [NUMBER]
+
+Takes an optional address family for this server to use. Valid values
+are Socket::AF_INET and Socket::AF_INET6. All other values are silently
+changed into Socket::AF_INET for backwards compatibility with previous
+versions of the module.
+
+Returns the address family of the present listening socket. (Defaults to
+Socket::AF_INET.)
+
+=cut
+
+sub family {
+my $self = shift;
+if (@_) {
+if ($_[0] == AF_INET || $_[0] == AF_INET6) {
+$self-{'family'} = shift;
+} else {
+$self-{'family'} = AF_INET;
+}
+}
+return ( $self-{'family'} );
+
+}
+
=head2 host [address]
Takes an optional host address for this server to bind to.
@@ -359,8 +392,15 @@ sub _process_request {
# ( http://dev.catalyst.perl.org/changeset/5195, 5221 )
my $remote_sockaddr = getpeername( $self-stdio_handle );
-my ( $iport, $iaddr ) = $remote_sockaddr ? sockaddr_in($remote_sockaddr) : (undef,undef);
-my $peeraddr = $iaddr ? ( inet_ntoa($iaddr) || 127.0.0.1 ) : '127.0.0.1';
+my $family = sockaddr_family($remote_sockaddr);
+
+my ( $iport, $iaddr ) = $remote_sockaddr
+? ( ($family == AF_INET6) ? sockaddr_in6($remote_sockaddr)
+ : sockaddr_in($remote_sockaddr) )
+: (undef,undef);
+
+my $loopback = ($family == AF_INET6) ? ::1 : 127.0.0.1;
+my $peeraddr = $iaddr ? ( Socket::inet_ntop($family, $iaddr) || $loopback ) : $loopback;
my ( $method, $request_uri, $proto ) = $self-parse_request;
@@ -650,18 +690,34 @@ sub setup_listener {
my $self = shift;
my $tcp = getprotobyname('tcp');
-socket( HTTPDaemon, PF_INET, SOCK_STREAM, $tcp ) or croak socket: $!;
+my $sockaddr;
+socket( HTTPDaemon, $self-{'family'}, SOCK_STREAM, $tcp )
+or croak socket: $!;
setsockopt( HTTPDaemon, SOL_SOCKET, SO_REUSEADDR, pack( l, 1 ) )
or warn setsockopt: $!;
-bind(
Bug#596176: [rt.cpan.org #61200] IPv6 support for HTTP::Server::Simple
On Mon, 28 Nov 2011 02:06:58 -0500, Daniel Kahn Gillmor wrote: I can confirm that this patch provides a baseline of IPv6 support for HTTP::Server::Simple. Please adopt it, or provide an alternate IPv6 implementation for this package. I haven't tested it yet, but the patch looks good IMO, and having IPv6 support for HTTP::Server::Simple would indeed be nice. Cheers, gregor -- .''`. Homepage: http://info.comodo.priv.at/ - OpenPGP key ID: 0x8649AA06 : :' : Debian GNU/Linux user, admin, developer - http://www.debian.org/ `. `' Member of VIBE!AT SPI, fellow of Free Software Foundation Europe `-NP: The Doors: Soul Kitchen signature.asc Description: Digital signature
Bug#596176: [rt.cpan.org #61200] IPv6 support for HTTP::Server::Simple
The original IPv6 patch for HTTP::Server::Simple proposed by Mats [0]
produces the following warnings:
Subroutine HTTP::Server::Simple::pack_sockaddr_in6 redefined at
/usr/share/perl/5.14/Exporter.pm line 67.
at /usr/share/perl5/HTTP/Server/Simple.pm line 7
Subroutine HTTP::Server::Simple::unpack_sockaddr_in6 redefined at
/usr/share/perl/5.14/Exporter.pm line 67.
at /usr/share/perl5/HTTP/Server/Simple.pm line 7
Subroutine HTTP::Server::Simple::sockaddr_in6 redefined at
/usr/share/perl/5.14/Exporter.pm line 67.
at /usr/share/perl5/HTTP/Server/Simple.pm line 7
The attached patch avoids those warnings while still enabling IPv6
support.
I can confirm that this patch provides a baseline of IPv6 support for
HTTP::Server::Simple. Please adopt it, or provide an alternate IPv6
implementation for this package.
Thanks for maintaining HTTP::Server::Simple!
--dkg
[0] http://bugs.debian.org/596176#10
Description: Upgrade the module to accept IPv6.
The contructor and the listener methods are extended to allow
a domain parameter. A new method, family(), mediates in deciding
between AF_INET and AF_INET6.
.
The request processing method detects the correct domain for an
incoming socket.
Author: Mats Erik Andersson deb...@gisladisker.se
Forwarded: no
Last-Update: 2010-10-28
Bug-Debian: http://bugs.debian.org/cgi-bin/bugreport-cgi?bug=596176
--- libhttp-server-simple-perl-0.43.debian/lib/HTTP/Server/Simple.pm
+++ libhttp-server-simple-perl-0.43/lib/HTTP/Server/Simple.pm
@@ -4,6 +4,7 @@
package HTTP::Server::Simple;
use FileHandle;
use Socket;
+use Socket6 qw(in6addr_any);
use Carp;
use IO::Select;
@@ -125,15 +126,17 @@
=head1 METHODS
-=head2 HTTP::Server::Simple-new($port)
+=head2 HTTP::Server::Simple-new($port, $family)
API call to start a new server. Does not actually start listening
-until you call C-Egtrun(). If omitted, C$port defaults to 8080.
+until you call C-Egtrun(). If omitted, C$port defaults to 8080,
+and C$family defaults to LSocket::AF_INET.
+The alternative domain is LSocket::AF_INET6.
=cut
sub new {
-my ( $proto, $port ) = @_;
+my ( $proto, $port, $family ) = @_;
my $class = ref($proto) || $proto;
if ( $class eq __PACKAGE__ ) {
@@ -144,6 +147,7 @@ sub new {
my $self = {};
bless( $self, $class );
$self-port( $port || '8080' );
+$self-family( $family || AF_INET );
return $self;
}
@@ -152,7 +156,7 @@
=head2 lookup_localhost
Looks up the local host's IP address, and returns it. For most hosts,
-this is C127.0.0.1.
+this is C127.0.0.1, or possibly C::1.
=cut
@@ -160,9 +164,14 @@ sub lookup_localhost {
my $self = shift;
my $local_sockaddr = getsockname( $self-stdio_handle );
-my ( undef, $localiaddr ) = sockaddr_in($local_sockaddr);
-$self-host( gethostbyaddr( $localiaddr, AF_INET ) || localhost);
-$self-{'local_addr'} = inet_ntoa($localiaddr) || 127.0.0.1;
+my $local_family = sockaddr_family($local_sockaddr);
+my ( undef, $localiaddr ) =
+($local_family == AF_INET6) ? sockaddr_in6($local_sockaddr)
+: sockaddr_in($local_sockaddr);
+
+$self-host( gethostbyaddr( $localiaddr, $local_family ) || localhost);
+$self-{'local_addr'} = Socket::inet_ntop($local_family, $localiaddr)
+|| (($local_family == AF_INET6) ? ::1 : 127.0.0.1);
}
@@ -181,6 +190,31 @@
}
+=head2 family [NUMBER]
+
+Takes an optional address family for this server to use. Valid values
+are Socket::AF_INET and Socket::AF_INET6. All other values are silently
+changed into Socket::AF_INET for backwards compatibility with previous
+versions of the module.
+
+Returns the address family of the present listening socket. (Defaults to
+Socket::AF_INET.)
+
+=cut
+
+sub family {
+my $self = shift;
+if (@_) {
+if ($_[0] == AF_INET || $_[0] == AF_INET6) {
+$self-{'family'} = shift;
+} else {
+$self-{'family'} = AF_INET;
+}
+}
+return ( $self-{'family'} );
+
+}
+
=head2 host [address]
Takes an optional host address for this server to bind to.
@@ -384,8 +418,15 @@ sub _process_request {
# ( http://dev.catalyst.perl.org/changeset/5195, 5221 )
my $remote_sockaddr = getpeername( $self-stdio_handle );
-my ( $iport, $iaddr ) = $remote_sockaddr ? sockaddr_in($remote_sockaddr) : (undef,undef);
-my $peeraddr = $iaddr ? ( inet_ntoa($iaddr) || 127.0.0.1 ) : '127.0.0.1';
+my $family = sockaddr_family($remote_sockaddr);
+
+my ( $iport, $iaddr ) = $remote_sockaddr
+? ( ($family == AF_INET6) ? sockaddr_in6($remote_sockaddr)
+ : sockaddr_in($remote_sockaddr) )
+: (undef,undef);
+
+my $loopback = ($family == AF_INET6) ? ::1 : 127.0.0.1;
+my $peeraddr = $iaddr ? ( Socket::inet_ntop($family,
