Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

206 lines (179 sloc) 7.843 kb
This patch file has been copied off the Debian. Their Net::Server package
can be found at http://packages.qa.debian.org/libn/libnet-server-perl.html
diff -ur lib.orig/Net/Server/Proto/SSLEAY.pm lib/Net/Server/Proto/SSLEAY.pm
--- lib.orig/Net/Server/Proto/SSLEAY.pm 2010-07-09 18:44:48.000000000 +0200
+++ lib/Net/Server/Proto/SSLEAY.pm 2011-04-06 16:32:19.835579843 +0200
@@ -23,7 +23,7 @@
use strict;
use vars qw($VERSION $AUTOLOAD @ISA);
-use IO::Socket::INET;
+use IO::Socket::INET6;
use Fcntl ();
use Errno ();
use Socket ();
@@ -38,7 +38,7 @@
}
$VERSION = $Net::Server::VERSION; # done until separated
-@ISA = qw(IO::Socket::INET);
+@ISA = qw(IO::Socket::INET6);
sub object {
my $type = shift;
@@ -48,9 +48,12 @@
my $prop = $server->{'server'};
my $host;
- if ($port =~ m/^([\w\.\-\*\/]+):(\w+)$/) { # allow for things like "domain.com:80"
+ if ($port =~ m/^([\w\.\-\*\/]+):(\w+)$/) { # allow for things like "domain.com:80" (IPv4)
($host, $port) = ($1, $2);
}
+ elsif( $port =~ m/^\[([\:\w\.\-\*\/]+)\]:(\w+)$/ ){ # allow for things like "[::1]:80" (IPv6)
+ ($host,$port) = ($1,$2);
+ }
elsif ($port =~ /^(\w+)$/) { # allow for things like "80"
($host, $port) = ($default_host, $1);
}
diff -ur lib.orig/Net/Server/Proto/SSL.pm lib/Net/Server/Proto/SSL.pm
--- lib.orig/Net/Server/Proto/SSL.pm 2010-05-05 05:13:03.000000000 +0200
+++ lib/Net/Server/Proto/SSL.pm 2011-04-05 14:39:39.788076698 +0200
@@ -39,10 +39,14 @@
my $prop = $server->{server};
my $host;
- ### allow for things like "domain.com:80"
+ ### allow for things like "domain.com:80" (IPv4)
if( $port =~ m/^([\w\.\-\*\/]+):(\w+)$/ ){
($host,$port) = ($1,$2);
+ ### allow for things like "[::1]:80" (IPv6)
+ }elsif( $port =~ m/^\[([\:\w\.\-\*\/]+)\]:(\w+)$/ ){
+ ($host,$port) = ($1,$2);
+
### allow for things like "80"
}elsif( $port =~ /^(\w+)$/ ){
($host,$port) = ($default_host,$1);
diff -ur lib.orig/Net/Server/Proto/TCP.pm lib/Net/Server/Proto/TCP.pm
--- lib.orig/Net/Server/Proto/TCP.pm 2010-05-05 06:41:08.000000000 +0200
+++ lib/Net/Server/Proto/TCP.pm 2011-04-05 14:29:26.123577536 +0200
@@ -23,10 +23,10 @@
use strict;
use vars qw($VERSION $AUTOLOAD @ISA);
-use IO::Socket ();
+use IO::Socket::INET6 ();
$VERSION = $Net::Server::VERSION; # done until separated
-@ISA = qw(IO::Socket::INET);
+@ISA = qw(IO::Socket::INET6);
sub object {
my $type = shift;
@@ -35,10 +35,14 @@
my ($default_host,$port,$server) = @_;
my $host;
- ### allow for things like "domain.com:80"
+ ### allow for things like "domain.com:80" (IPv4)
if( $port =~ m/^([\w\.\-\*\/]+):(\w+)$/ ){
($host,$port) = ($1,$2);
+ ### allow for things like "[::1]:80" (IPv6)
+ }elsif( $port =~ m/^\[([\:\w\.\-\*\/]+)\]:(\w+)$/ ){
+ ($host,$port) = ($1,$2);
+
### allow for things like "80"
}elsif( $port =~ /^(\w+)$/ ){
($host,$port) = ($default_host,$1);
diff -ur lib.orig/Net/Server.pm lib/Net/Server.pm
--- lib.orig/Net/Server.pm 2010-07-09 16:55:31.000000000 +0200
+++ lib/Net/Server.pm 2011-04-06 16:33:57.739576765 +0200
@@ -25,7 +25,8 @@
use strict;
use vars qw($VERSION);
-use Socket qw(inet_aton inet_ntoa AF_INET AF_UNIX SOCK_DGRAM SOCK_STREAM);
+use Socket qw(unpack_sockaddr_in sockaddr_family AF_INET AF_INET6 AF_UNIX SOCK_DGRAM SOCK_STREAM);
+use Socket6 qw(inet_ntop inet_pton unpack_sockaddr_in6);
use IO::Socket ();
use IO::Select ();
use POSIX ();
@@ -356,7 +357,7 @@
push @{ $prop->{host} }, (($prop->{host}->[-1]) x (@{ $prop->{port} } - @{ $prop->{host}})); # augment hosts with as many as port
foreach my $host (@{ $prop->{host} }) {
$host = '*' if ! defined $host || ! length $host;;
- $host = ($host =~ /^([\w\.\-\*\/]+)$/) ? $1 : $self->fatal("Unsecure host \"$host\"");
+ $host = ($host =~ /^([\[\]\:\w\.\-\*\/]+)$/) ? $1 : $self->fatal("Unsecure host \"$host\"");
}
$prop->{proto} = [] if ! defined $prop->{proto};
@@ -757,12 +758,14 @@
### read information about this connection
my $sockname = getsockname( $sock );
if( $sockname ){
+ $prop->{sockfamily} = sockaddr_family( $sockname );
($prop->{sockport}, $prop->{sockaddr})
- = Socket::unpack_sockaddr_in( $sockname );
- $prop->{sockaddr} = inet_ntoa( $prop->{sockaddr} );
+ = ($prop->{sockfamily} == AF_INET6) ? unpack_sockaddr_in6( $sockname ) : unpack_sockaddr_in( $sockname );
+ $prop->{sockaddr} = inet_ntop( $prop->{sockfamily}, $prop->{sockaddr} );
}else{
### does this only happen from command line?
+ $prop->{sockfamily} = AF_INET;
$prop->{sockaddr} = $ENV{'REMOTE_HOST'} || '0.0.0.0';
$prop->{sockhost} = 'inet.test';
$prop->{sockport} = 0;
@@ -773,17 +776,17 @@
if( $prop->{udp_true} ){
$proto_type = 'UDP';
($prop->{peerport} ,$prop->{peeraddr})
- = Socket::sockaddr_in( $prop->{udp_peer} );
+ = ($prop->{sockfamily} == AF_INET6) ? unpack_sockaddr_in6( $prop->{udp_peer} ) : unpack_sockaddr_in( $prop->{udp_peer} );
}elsif( $prop->{peername} = getpeername( $sock ) ){
($prop->{peerport}, $prop->{peeraddr})
- = Socket::unpack_sockaddr_in( $prop->{peername} );
+ = ($prop->{sockfamily} == AF_INET6) ? unpack_sockaddr_in6( $prop->{peername} ) : unpack_sockaddr_in( $prop->{peername} );
}
if( $prop->{peername} || $prop->{udp_true} ){
- $prop->{peeraddr} = inet_ntoa( $prop->{peeraddr} );
+ $prop->{peeraddr} = inet_ntop( $prop->{sockfamily}, $prop->{peeraddr} );
if( defined $prop->{reverse_lookups} ){
- $prop->{peerhost} = gethostbyaddr( inet_aton($prop->{peeraddr}), AF_INET );
+ $prop->{peerhost} = gethostbyaddr( inet_pton($prop->{sockfamily}, $prop->{peeraddr}), $prop->{sockfamily} );
}
$prop->{peerhost} = '' unless defined $prop->{peerhost};
@@ -803,7 +806,6 @@
### user customizable hook
sub post_accept_hook {}
-
### perform basic allow/deny service
sub allow_deny {
my $self = shift;
@@ -1145,7 +1147,7 @@
or $self->fatal("Can't dup socket [$!]");
### hold on to the socket copy until exec
- $prop->{_HUP}->[$i] = IO::Socket::INET->new;
+ $prop->{_HUP}->[$i] = IO::Socket::INET6->new();
$prop->{_HUP}->[$i]->fdopen($fd, 'w')
or $self->fatal("Can't open to file descriptor [$!]");
diff -ur lib.orig/Net/Server.pm lib/Net/Server.pm
--- lib.orig/Net/Server.pm 2011-04-07 11:44:54.973953140 +0200
+++ lib/Net/Server.pm 2011-04-07 14:11:28.637453856 +0200
@@ -824,25 +824,29 @@
&& $#{ $prop->{cidr_allow} } == -1
&& $#{ $prop->{cidr_deny} } == -1;
+ ### work around Net::CIDR::cidrlookup() croaking,
+ ### if first parameter is an IPv4 address in IPv6 notation.
+ my $peeraddr = ($prop->{peeraddr} =~ /^\s*::ffff:([0-9.]+\s*)$/) ? $1 : $prop->{peeraddr};
+
### if the addr or host matches a deny, reject it immediately
foreach ( @{ $prop->{deny} } ){
return 0 if $prop->{peerhost} =~ /^$_$/ && defined($prop->{reverse_lookups});
- return 0 if $prop->{peeraddr} =~ /^$_$/;
+ return 0 if $peeraddr =~ /^$_$/;
}
if ($#{ $prop->{cidr_deny} } != -1) {
require Net::CIDR;
- return 0 if Net::CIDR::cidrlookup($prop->{peeraddr}, @{ $prop->{cidr_deny} });
+ return 0 if Net::CIDR::cidrlookup($peeraddr, @{ $prop->{cidr_deny} });
}
### if the addr or host isn't blocked yet, allow it if it is allowed
foreach ( @{ $prop->{allow} } ){
return 1 if $prop->{peerhost} =~ /^$_$/ && defined($prop->{reverse_lookups});
- return 1 if $prop->{peeraddr} =~ /^$_$/;
+ return 1 if $peeraddr =~ /^$_$/;
}
if ($#{ $prop->{cidr_allow} } != -1) {
require Net::CIDR;
- return 1 if Net::CIDR::cidrlookup($prop->{peeraddr}, @{ $prop->{cidr_allow} });
+ return 1 if Net::CIDR::cidrlookup($peeraddr, @{ $prop->{cidr_allow} });
}
return 0;
Jump to Line
Something went wrong with that request. Please try again.