1This patch file has been copied off the Debian. Their Net::Server package 2can be found at http://packages.qa.debian.org/libn/libnet-server-perl.html 3 4diff -ur lib.orig/Net/Server/Proto/SSLEAY.pm lib/Net/Server/Proto/SSLEAY.pm 5--- lib.orig/Net/Server/Proto/SSLEAY.pm 2010-07-09 18:44:48.000000000 +0200 6+++ lib/Net/Server/Proto/SSLEAY.pm 2011-04-06 16:32:19.835579843 +0200 7@@ -23,7 +23,7 @@ 8 9 use strict; 10 use vars qw($VERSION $AUTOLOAD @ISA); 11-use IO::Socket::INET; 12+use IO::Socket::INET6; 13 use Fcntl (); 14 use Errno (); 15 use Socket (); 16@@ -38,7 +38,7 @@ 17 } 18 19 $VERSION = $Net::Server::VERSION; # done until separated 20-@ISA = qw(IO::Socket::INET); 21+@ISA = qw(IO::Socket::INET6); 22 23 sub object { 24 my $type = shift; 25@@ -48,9 +48,12 @@ 26 my $prop = $server->{'server'}; 27 my $host; 28 29- if ($port =~ m/^([\w\.\-\*\/]+):(\w+)$/) { # allow for things like "domain.com:80" 30+ if ($port =~ m/^([\w\.\-\*\/]+):(\w+)$/) { # allow for things like "domain.com:80" (IPv4) 31 ($host, $port) = ($1, $2); 32 } 33+ elsif( $port =~ m/^\[([\:\w\.\-\*\/]+)\]:(\w+)$/ ){ # allow for things like "[::1]:80" (IPv6) 34+ ($host,$port) = ($1,$2); 35+ } 36 elsif ($port =~ /^(\w+)$/) { # allow for things like "80" 37 ($host, $port) = ($default_host, $1); 38 } 39diff -ur lib.orig/Net/Server/Proto/SSL.pm lib/Net/Server/Proto/SSL.pm 40--- lib.orig/Net/Server/Proto/SSL.pm 2010-05-05 05:13:03.000000000 +0200 41+++ lib/Net/Server/Proto/SSL.pm 2011-04-05 14:39:39.788076698 +0200 42@@ -39,10 +39,14 @@ 43 my $prop = $server->{server}; 44 my $host; 45 46- ### allow for things like "domain.com:80" 47+ ### allow for things like "domain.com:80" (IPv4) 48 if( $port =~ m/^([\w\.\-\*\/]+):(\w+)$/ ){ 49 ($host,$port) = ($1,$2); 50 51+ ### allow for things like "[::1]:80" (IPv6) 52+ }elsif( $port =~ m/^\[([\:\w\.\-\*\/]+)\]:(\w+)$/ ){ 53+ ($host,$port) = ($1,$2); 54+ 55 ### allow for things like "80" 56 }elsif( $port =~ /^(\w+)$/ ){ 57 ($host,$port) = ($default_host,$1); 58diff -ur lib.orig/Net/Server/Proto/TCP.pm lib/Net/Server/Proto/TCP.pm 59--- lib.orig/Net/Server/Proto/TCP.pm 2010-05-05 06:41:08.000000000 +0200 60+++ lib/Net/Server/Proto/TCP.pm 2011-04-05 14:29:26.123577536 +0200 61@@ -23,10 +23,10 @@ 62 63 use strict; 64 use vars qw($VERSION $AUTOLOAD @ISA); 65-use IO::Socket (); 66+use IO::Socket::INET6 (); 67 68 $VERSION = $Net::Server::VERSION; # done until separated 69-@ISA = qw(IO::Socket::INET); 70+@ISA = qw(IO::Socket::INET6); 71 72 sub object { 73 my $type = shift; 74@@ -35,10 +35,14 @@ 75 my ($default_host,$port,$server) = @_; 76 my $host; 77 78- ### allow for things like "domain.com:80" 79+ ### allow for things like "domain.com:80" (IPv4) 80 if( $port =~ m/^([\w\.\-\*\/]+):(\w+)$/ ){ 81 ($host,$port) = ($1,$2); 82 83+ ### allow for things like "[::1]:80" (IPv6) 84+ }elsif( $port =~ m/^\[([\:\w\.\-\*\/]+)\]:(\w+)$/ ){ 85+ ($host,$port) = ($1,$2); 86+ 87 ### allow for things like "80" 88 }elsif( $port =~ /^(\w+)$/ ){ 89 ($host,$port) = ($default_host,$1); 90diff -ur lib.orig/Net/Server.pm lib/Net/Server.pm 91--- lib.orig/Net/Server.pm 2010-07-09 16:55:31.000000000 +0200 92+++ lib/Net/Server.pm 2011-04-06 16:33:57.739576765 +0200 93@@ -25,7 +25,8 @@ 94 95 use strict; 96 use vars qw($VERSION); 97-use Socket qw(inet_aton inet_ntoa AF_INET AF_UNIX SOCK_DGRAM SOCK_STREAM); 98+use Socket qw(unpack_sockaddr_in sockaddr_family AF_INET AF_INET6 AF_UNIX SOCK_DGRAM SOCK_STREAM); 99+use Socket6 qw(inet_ntop inet_pton unpack_sockaddr_in6); 100 use IO::Socket (); 101 use IO::Select (); 102 use POSIX (); 103@@ -356,7 +357,7 @@ 104 push @{ $prop->{host} }, (($prop->{host}->[-1]) x (@{ $prop->{port} } - @{ $prop->{host}})); # augment hosts with as many as port 105 foreach my $host (@{ $prop->{host} }) { 106 $host = '*' if ! defined $host || ! length $host;; 107- $host = ($host =~ /^([\w\.\-\*\/]+)$/) ? $1 : $self->fatal("Unsecure host \"$host\""); 108+ $host = ($host =~ /^([\[\]\:\w\.\-\*\/]+)$/) ? $1 : $self->fatal("Unsecure host \"$host\""); 109 } 110 111 $prop->{proto} = [] if ! defined $prop->{proto}; 112@@ -757,12 +758,14 @@ 113 ### read information about this connection 114 my $sockname = getsockname( $sock ); 115 if( $sockname ){ 116+ $prop->{sockfamily} = sockaddr_family( $sockname ); 117 ($prop->{sockport}, $prop->{sockaddr}) 118- = Socket::unpack_sockaddr_in( $sockname ); 119- $prop->{sockaddr} = inet_ntoa( $prop->{sockaddr} ); 120+ = ($prop->{sockfamily} == AF_INET6) ? unpack_sockaddr_in6( $sockname ) : unpack_sockaddr_in( $sockname ); 121+ $prop->{sockaddr} = inet_ntop( $prop->{sockfamily}, $prop->{sockaddr} ); 122 123 }else{ 124 ### does this only happen from command line? 125+ $prop->{sockfamily} = AF_INET; 126 $prop->{sockaddr} = $ENV{'REMOTE_HOST'} || '0.0.0.0'; 127 $prop->{sockhost} = 'inet.test'; 128 $prop->{sockport} = 0; 129@@ -773,17 +776,17 @@ 130 if( $prop->{udp_true} ){ 131 $proto_type = 'UDP'; 132 ($prop->{peerport} ,$prop->{peeraddr}) 133- = Socket::sockaddr_in( $prop->{udp_peer} ); 134+ = ($prop->{sockfamily} == AF_INET6) ? unpack_sockaddr_in6( $prop->{udp_peer} ) : unpack_sockaddr_in( $prop->{udp_peer} ); 135 }elsif( $prop->{peername} = getpeername( $sock ) ){ 136 ($prop->{peerport}, $prop->{peeraddr}) 137- = Socket::unpack_sockaddr_in( $prop->{peername} ); 138+ = ($prop->{sockfamily} == AF_INET6) ? unpack_sockaddr_in6( $prop->{peername} ) : unpack_sockaddr_in( $prop->{peername} ); 139 } 140 141 if( $prop->{peername} || $prop->{udp_true} ){ 142- $prop->{peeraddr} = inet_ntoa( $prop->{peeraddr} ); 143+ $prop->{peeraddr} = inet_ntop( $prop->{sockfamily}, $prop->{peeraddr} ); 144 145 if( defined $prop->{reverse_lookups} ){ 146- $prop->{peerhost} = gethostbyaddr( inet_aton($prop->{peeraddr}), AF_INET ); 147+ $prop->{peerhost} = gethostbyaddr( inet_pton($prop->{sockfamily}, $prop->{peeraddr}), $prop->{sockfamily} ); 148 } 149 $prop->{peerhost} = '' unless defined $prop->{peerhost}; 150 151@@ -803,7 +806,6 @@ 152 ### user customizable hook 153 sub post_accept_hook {} 154 155- 156 ### perform basic allow/deny service 157 sub allow_deny { 158 my $self = shift; 159@@ -1145,7 +1147,7 @@ 160 or $self->fatal("Can't dup socket [$!]"); 161 162 ### hold on to the socket copy until exec 163- $prop->{_HUP}->[$i] = IO::Socket::INET->new; 164+ $prop->{_HUP}->[$i] = IO::Socket::INET6->new(); 165 $prop->{_HUP}->[$i]->fdopen($fd, 'w') 166 or $self->fatal("Can't open to file descriptor [$!]"); 167 168diff -ur lib.orig/Net/Server.pm lib/Net/Server.pm 169--- lib.orig/Net/Server.pm 2011-04-07 11:44:54.973953140 +0200 170+++ lib/Net/Server.pm 2011-04-07 14:11:28.637453856 +0200 171@@ -824,25 +824,29 @@ 172 && $#{ $prop->{cidr_allow} } == -1 173 && $#{ $prop->{cidr_deny} } == -1; 174 175+ ### work around Net::CIDR::cidrlookup() croaking, 176+ ### if first parameter is an IPv4 address in IPv6 notation. 177+ my $peeraddr = ($prop->{peeraddr} =~ /^\s*::ffff:([0-9.]+\s*)$/) ? $1 : $prop->{peeraddr}; 178+ 179 ### if the addr or host matches a deny, reject it immediately 180 foreach ( @{ $prop->{deny} } ){ 181 return 0 if $prop->{peerhost} =~ /^$_$/ && defined($prop->{reverse_lookups}); 182- return 0 if $prop->{peeraddr} =~ /^$_$/; 183+ return 0 if $peeraddr =~ /^$_$/; 184 } 185 if ($#{ $prop->{cidr_deny} } != -1) { 186 require Net::CIDR; 187- return 0 if Net::CIDR::cidrlookup($prop->{peeraddr}, @{ $prop->{cidr_deny} }); 188+ return 0 if Net::CIDR::cidrlookup($peeraddr, @{ $prop->{cidr_deny} }); 189 } 190 191 192 ### if the addr or host isn't blocked yet, allow it if it is allowed 193 foreach ( @{ $prop->{allow} } ){ 194 return 1 if $prop->{peerhost} =~ /^$_$/ && defined($prop->{reverse_lookups}); 195- return 1 if $prop->{peeraddr} =~ /^$_$/; 196+ return 1 if $peeraddr =~ /^$_$/; 197 } 198 if ($#{ $prop->{cidr_allow} } != -1) { 199 require Net::CIDR; 200- return 1 if Net::CIDR::cidrlookup($prop->{peeraddr}, @{ $prop->{cidr_allow} }); 201+ return 1 if Net::CIDR::cidrlookup($peeraddr, @{ $prop->{cidr_allow} }); 202 } 203 204 return 0; 205 206