package libhttp-server-simple-perl tags 596176 + patch thanks
Hello there, the following patch migrates the module to be supporting IPv6. The changes pass the complete test suite, and pass my manual testing of various IPv6 servers inspired by the original POD documentation. Best regards, Mats Erik Andersson, fil. dr
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 <[email protected]> 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; 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'} = 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 ? ( 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: $!"; }
signature.asc
Description: Digital signature
