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<-E<gt>run()>. If omitted, C<$port> defaults to 8080. +until you call C<-E<gt>run()>. If omitted, C<$port> defaults to 8080, +and C<$family> defaults to L<Socket::AF_INET>. +The alternative domain is L<Socket::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 C<127.0.0.1>. +this is C<127.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, $iaddr) || $loopback ) : $loopback; my ( $method, $request_uri, $proto ) = $self->parse_request; @@ -685,18 +726,32 @@ 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( HTTPDaemon, - sockaddr_in( - $self->port(), - ( $self->host - ? inet_aton( $self->host ) - : INADDR_ANY - ) - ) - ) + + if ($self->host) { # Explicit listening address + my @res = getaddrinfo($self->host, $self->port, $self->{'family'}, SOCK_STREAM); + while (scalar(@res) >= 5) { + my ($af, undef, undef, $tmp, undef) = splice(@res, 0, 5); + # Be certain on the address family. + # TODO Accept AF_UNSPEC, reject SITE-LOCAL + next unless ($self->{'family'} == $af); + + # Use the first plausible address. + $sockaddr = $tmp; + last; + } + } + else { # Use the wildcard address + $sockaddr = ($self->{'family'} == AF_INET6) + ? sockaddr_in6($self->port(), in6addr_any) + : sockaddr_in($self->port(), INADDR_ANY); + } + + bind( HTTPDaemon, $sockaddr) or croak "bind to @{[$self->host||'*']}:@{[$self->port]}: $!"; listen( HTTPDaemon, SOMAXCONN ) or croak "listen: $!"; }
pgp3yW1OhXBfa.pgp
Description: PGP signature
