Dear all,
the faithful old servant libhttp-server-simple-perl has
a single bug recorded in the BTS:
#596176: Lacking IPv6 support.
Although my main contributions go into IPv6 migration
for C-coded software, I felt compelled to complete a
study on this subject. The changes needed to complete
the migration for this Perl module are simple enough
that I would like to see the experts in the Perl Team
to consider whether upstream should be convinced to
alter the code, or if Debian GNU/Linux could make its
own use of my observations.
Of course, the changes I do suggest could be polished
further by people with more insight that my humble
knowledge in Perl.
Observe that I have coded a new module
HTTP::Server::Simple6
in order to test it alongside the old module, and that
the file path to the updated module is based at
libhttp-server-simple6-perl-0.43
with '6' inserted. The changes to MANIFEST and Makefile.PL
are the expected and elementary ones.
I have successfully tested a few cases with the new module
in a setting where "net.ipv6.bindv6only = 0". By intent,
the modified module falls back to address family AF_INET,
unless told otherwise.
Best regards,
Mats Erik Andersson
----------------------------------------------------------
--- libhttp-server-simple-perl-0.43.orig/lib/HTTP/Server/Simple.pm
+++ libhttp-server-simple6-perl-0.43/lib/HTTP/Server/Simple6.pm
@@ -1,9 +1,10 @@
use strict;
use warnings;
-package HTTP::Server::Simple;
+package HTTP::Server::Simple6;
use FileHandle;
use Socket;
+use Socket6;
use Carp;
use IO::Select;
@@ -133,17 +134,18 @@
=cut
sub new {
- my ( $proto, $port ) = @_;
+ my ( $proto, $port, $family ) = @_;
my $class = ref($proto) || $proto;
if ( $class eq __PACKAGE__ ) {
- require HTTP::Server::Simple::CGI;
- return HTTP::Server::Simple::CGI->new( @_[ 1 .. $#_ ] );
+ require HTTP::Server::Simple6::CGI;
+ return HTTP::Server::Simple6::CGI->new( @_[ 1 .. $#_ ] );
}
my $self = {};
bless( $self, $class );
$self->port( $port || '8080' );
+ $self->family( $family || AF_INET );
return $self;
}
@@ -160,9 +162,12 @@
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 +186,27 @@
}
+=head2 family [NUMBER]
+
+Takes an optional address family for this server to use.
+
+Returns this server's listening family. (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.
@@ -277,9 +303,9 @@
*{"$pkg\::ISA"} = [$server];
# clear the environment before every request
- require HTTP::Server::Simple::CGI;
+ require HTTP::Server::Simple6::CGI;
*{"$pkg\::post_accept"} = sub {
- HTTP::Server::Simple::CGI::Environment->setup_environment;
+ HTTP::Server::Simple6::CGI::Environment->setup_environment;
# $self->SUPER::post_accept uses the wrong super package
$server->can('post_accept')->(@_);
};
@@ -384,8 +410,13 @@
# ( 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,17 +716,26 @@
my $self = shift;
my $tcp = getprotobyname('tcp');
- socket( HTTPDaemon, PF_INET, SOCK_STREAM, $tcp ) or croak "socket: $!";
+ my $family = $self->family();
+ socket( HTTPDaemon, $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
+ ($family == AF_INET6)
+ ? sockaddr_in6(
+ $self->port(),
+ ( $self->host
+ ? inet_pton($family, $self->host)
+ : in6addr_any
+ )
+ )
+ : sockaddr_in(
+ $self->port(),
+ ( $self->host
+ ? inet_pton($family, $self->host)
+ : INADDR_ANY
+ )
)
- )
)
or croak "bind to @{[$self->host||'*']}:@{[$self->port]}: $!";
listen( HTTPDaemon, SOMAXCONN ) or croak "listen: $!";
--- libhttp-server-simple-perl-0.43.orig/lib/HTTP/Server/Simple/CGI.pm
+++ libhttp-server-simple6-perl-0.43/lib/HTTP/Server/Simple6/CGI.pm
@@ -1,12 +1,12 @@
-package HTTP::Server::Simple::CGI;
+package HTTP::Server::Simple6::CGI;
-use base qw(HTTP::Server::Simple HTTP::Server::Simple::CGI::Environment);
+use base qw(HTTP::Server::Simple6 HTTP::Server::Simple6::CGI::Environment);
use strict;
use warnings;
use vars qw($VERSION $default_doc $DEFAULT_CGI_INIT $DEFAULT_CGI_CLASS);
-$VERSION = $HTTP::Server::Simple::VERSION;
+$VERSION = $HTTP::Server::Simple6::VERSION;
$DEFAULT_CGI_CLASS = "CGI";
$DEFAULT_CGI_INIT = sub { require CGI; CGI::initialize_globals()};
--- libhttp-server-simple-perl-0.43.orig/lib/HTTP/Server/Simple/CGI/Environment.pm
+++ libhttp-server-simple6-perl-0.43/lib/HTTP/Server/Simple6/CGI/Environment.pm
@@ -1,12 +1,12 @@
-package HTTP::Server::Simple::CGI::Environment;
+package HTTP::Server::Simple6::CGI::Environment;
use strict;
use warnings;
-use HTTP::Server::Simple;
+use HTTP::Server::Simple6;
use vars qw($VERSION %ENV_MAPPING);
-$VERSION = $HTTP::Server::Simple::VERSION;
+$VERSION = $HTTP::Server::Simple6::VERSION;
my %clean_env = %ENV;
@@ -32,7 +32,7 @@
sub setup_environment {
%ENV = (
%clean_env,
- SERVER_SOFTWARE => "HTTP::Server::Simple/$VERSION",
+ SERVER_SOFTWARE => "HTTP::Server::Simple6/$VERSION",
GATEWAY_INTERFACE => 'CGI/1.1'
);
}
Attachment:
signature.asc
Description: Digital signature