Skip Menu |
 

This queue is for tickets about the HTTP-Server-Simple CPAN distribution.

Report information
The Basics
Id: 61200
Status: open
Priority: 0/
Queue: HTTP-Server-Simple

People
Owner: Nobody in particular
Requestors: jeremiah [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Wishlist
Broken in: (no value)
Fixed in: (no value)



Subject: FEATURE REQUEST: Support IP v6
It would be nice is this module supported IP v6
RT-Send-CC: mats.andersson [...] gisladisker.se
Download (untitled) / with headers
text/plain 324b
On Thu Sep 09 07:48:12 2010, jeremiah wrote: Show quoted text
> It would be nice is this module supported IP v6
Hi, Someone's submitted a patch for IPv6 support in the Debian bugtracking system. Can a maintainer take a look at it and see if it's suitable for inclusion? http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=596176 Christine
CC: mats.andersson [...] gisladisker.se, 596176-submitter [...] bugs.debian.org
Subject: [rt.cpan.org #61200] IPv6 support for HTTP::Server::Simple
Date: Mon, 28 Nov 2011 02:06:58 -0500
To: 596176 [...] bugs.debian.org, bug-HTTP-Server-Simple [...] rt.cpan.org
From: Daniel Kahn Gillmor <dkg [...] fifthhorseman.net>
Download (untitled) / with headers
text/plain 918b
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 <debian@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: $!"; }
Download (untitled)
application/pgp-signature 965b

Message body not shown because it is not plain text.

CC: bug-HTTP-Server-Simple [...] rt.cpan.org, mats.andersson [...] gisladisker.se, 596176-submitter [...] bugs.debian.org
Subject: Re: Bug#596176: [rt.cpan.org #61200] IPv6 support for HTTP::Server::Simple
Date: Fri, 2 Dec 2011 01:29:35 +0100
To: Daniel Kahn Gillmor <dkg [...] fifthhorseman.net>, 596176 [...] bugs.debian.org
From: gregor herrmann <gregoa [...] debian.org>
Download (untitled) / with headers
text/plain 657b
On Mon, 28 Nov 2011 02:06:58 -0500, Daniel Kahn Gillmor wrote: Show quoted text
> 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
Download signature.asc
application/pgp-signature 836b

Message body not shown because it is not plain text.

Subject: Re: [rt.cpan.org #61200] IPv6 support for HTTP::Server::Simple
Date: Fri, 23 Dec 2011 08:23:09 -0500
To: bug-HTTP-Server-Simple [...] rt.cpan.org
From: Jesse Vincent <jesse [...] fsck.com>
Download (untitled) / with headers
text/plain 7.6k
Hiya, This has been sitting in my inbox for about a month. I'm sorry for the delay in my reply. The killer for me here is that Socket6 isn't in core. HTTP::Server::Simple has a firm no-non-core-dependencies policy. I believe that it should be possible to use the IPv6 support in modern versions of Socket.pm if it's available rather than depending on an external module. Additionally, I'm leery of adding new functionality without also adding at least basic tests for the new feature. If you can resolve these issues, I'd be thrilled to apply a patch and get an HSS with IPv6 support out. Best, Jesse On Nov 28, 2011, at 2:06 AM, Daniel Kahn Gillmor via RT wrote: Show quoted text
> Queue: HTTP-Server-Simple > Ticket <URL: https://rt.cpan.org/Ticket/Display.html?id=61200 > > > 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 <debian@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: $!"; > } > <Mail Attachment>
Subject: Bug#596176: [rt.cpan.org #61200] IPv6 support for HTTP::Server::Simple
Date: Sat, 24 Mar 2012 02:32:33 -0400
To: 596176 [...] bugs.debian.org, 596176-submitter [...] bugs.debian.org, bug-HTTP-Server-Simple [...] rt.cpan.org, Jesse Vincent <jesse [...] fsck.com>
From: Daniel Kahn Gillmor <dkg [...] fifthhorseman.net>
Download (untitled) / with headers
text/plain 908b
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
Download 61200.patch
text/x-diff 10.1k
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<-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__ ) { @@ -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 C<127.0.0.1>. +this is C<127.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( HTTPDaemon, - sockaddr_in( - $self->port(), - ( $self->host - ? inet_aton( $self->host ) - : INADDR_ANY - ) - ) - ) + + if ($self->host) { # Explicit listening address + my ($err, @res) = Socket::getaddrinfo($self->host, $self->port, { family => $self->{'family'}, socktype => SOCK_STREAM } ); + warn "$err!" + if ($err); + # we're binding only to the first returned address in the requested family. + while ($a = shift(@res)) { + # Be certain on the address family. + # TODO Accept AF_UNSPEC, reject SITE-LOCAL + next unless ($self->{'family'} == $a->{'family'}); + + # Use the first plausible address. + $sockaddr = $a->{'addr'}; + last; + } + } + else { # Use the wildcard address + $sockaddr = ($self->{'family'} == AF_INET6) + ? sockaddr_in6($self->port(), Socket::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: $!"; } diff --git a/t/01live.t b/t/01live.t index 4d0587d..cd58b98 100644 --- a/t/01live.t +++ b/t/01live.t @@ -1,7 +1,7 @@ # -*- perl -*- use Socket; -use Test::More tests => 14; +use Test::More tests => 34; use strict; # This script assumes that `localhost' will resolve to a local IP @@ -31,33 +31,34 @@ my $DEBUG = 1 if @ARGV; my @pids = (); my @classes = (qw(HTTP::Server::Simple SlowServer)); for my $class (@classes) { - run_server_tests($class); + run_server_tests($class, AF_INET); + run_server_tests($class, AF_INET6); $PORT++; # don't reuse the port incase your bogus os doesn't release in time } - -{ - my $s=HTTP::Server::Simple::CGI->new($PORT); +for my $fam ( AF_INET, AF_INET6 ) { + my $s=HTTP::Server::Simple::CGI->new($PORT, $fam); + is($fam, $s->family(), 'family OK'); $s->host("localhost"); my $pid=$s->background(); diag("started server PID='$pid'") if ($ENV{'TEST_VERBOSE'}); like($pid, '/^-?\d+$/', 'pid is numeric'); select(undef,undef,undef,0.2); # wait a sec - my $content=fetch("GET / HTTP/1.1", ""); + my $content=fetch($fam, "GET / HTTP/1.1", ""); like($content, '/Congratulations/', "Returns a page"); eval { - like(fetch("GET a bogus request"), + like(fetch($fam, "GET a bogus request"), '/bad request/i', "knows what a request isn't"); }; fail("got exception in client: $@") if $@; - like(fetch("GET / HTTP/1.1", ""), '/Congratulations/', + like(fetch($fam, "GET / HTTP/1.1", ""), '/Congratulations/', "HTTP/1.1 request"); - like(fetch("GET /"), '/Congratulations/', + like(fetch($fam, "GET /"), '/Congratulations/', "HTTP/0.9 request"); is(kill(9,$pid),1,'Signaled 1 process successfully'); @@ -68,29 +69,43 @@ is( kill( 9, $_ ), 1, "Killed PID: $_" ) for @pids; # this function may look excessive, but hopefully will be very useful # in identifying common problems sub fetch { + my $family = shift; my $hostname = "localhost"; my $port = $PORT; my $message = join "", map { "$_\015\012" } @_; - my $timeout = 5; - my $response; - + my $timeout = 5; + my $response; + my $proto = getprotobyname('tcp') || die "getprotobyname: $!"; + my $socktype = SOCK_STREAM; + eval { local $SIG{ALRM} = sub { die "early exit - SIGALRM caught" }; alarm $timeout*2; #twice longer than timeout used later by select() - - my $iaddr = inet_aton($hostname) || die "inet_aton: $!"; - my $paddr = sockaddr_in($port, $iaddr) || die "sockaddr_in: $!"; - my $proto = getprotobyname('tcp') || die "getprotobyname: $!"; - socket(SOCK, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; + + my $paddr; + my ($err, @res) = Socket::getaddrinfo($hostname, $port, { family => $family, + socktype => $socktype, + protocol => $proto }); + die "getaddrinfo: $err" + if ($err); + while ($a = shift(@res)) { + next unless ($family == $a->{'family'}); + next unless ($proto == $a->{'protocol'}); + next unless ($socktype == $a->{'socktype'}); + + $paddr = $a->{'addr'}; + last + } + socket(SOCK, $family, $socktype, $proto) || die "socket: $!"; connect(SOCK, $paddr) || die "connect: $!"; (send SOCK, $message, 0) || die "send: $!"; - + my $rvec = ''; vec($rvec, fileno(SOCK), 1) = 1; - die "vec(): $!" unless $rvec; + die "vec(): $!" unless $rvec; $response = ''; - for (;;) { + for (;;) { my $r = select($rvec, undef, undef, $timeout); die "select: timeout - no data to read from server" unless ($r > 0); my $l = sysread(SOCK, $response, 1024, length($response)); @@ -100,18 +115,20 @@ sub fetch { $response =~ s/\015\012/\n/g; (close SOCK) || die "close(): $!"; alarm 0; - }; + }; if ($@) { return "[ERROR] $@"; } else { return $response; - } + } } sub run_server_tests { my $class = shift; - my $s = $class->new($PORT); + my $fam = shift; + my $s = $class->new($PORT, $fam); + is($s->family(), $fam, 'constructor set family properly'); is($s->port(),$PORT,"Constructor set port correctly"); my $pid=$s->background(); @@ -119,7 +136,7 @@ sub run_server_tests { like($pid, '/^-?\d+$/', 'pid is numeric'); - my $content=fetch("GET / HTTP/1.1", ""); + my $content=fetch($fam, "GET / HTTP/1.1", ""); like($content, '/Congratulations/', "Returns a page"); push @pids, $pid; diff --git a/t/04cgi.t b/t/04cgi.t index 1b6a5e1..55567d2 100644 --- a/t/04cgi.t +++ b/t/04cgi.t @@ -1,3 +1,5 @@ +# -*- perl -*- + use Test::More; use Socket; use strict;
Download (untitled)
application/pgp-signature 965b

Message body not shown because it is not plain text.

Subject: Re: Bug#596176: [rt.cpan.org #61200] IPv6 support for HTTP::Server::Simple
Date: Sun, 20 May 2012 18:15:15 -0400
To: Daniel Kahn Gillmor via RT <bug-HTTP-Server-Simple [...] rt.cpan.org>
From: Jesse Vincent <jesse [...] fsck.com>
Download (untitled) / with headers
text/plain 11.9k

Message body is not shown because it is too large.



This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.