1
This patch file has been copied off the Debian. Their Net::Server package
2
can be found at http://packages.qa.debian.org/libn/libnet-server-perl.html
4
diff -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
10
use vars qw($VERSION $AUTOLOAD @ISA);
11
-use IO::Socket::INET;
12
+use IO::Socket::INET6;
19
$VERSION = $Net::Server::VERSION; # done until separated
20
-@ISA = qw(IO::Socket::INET);
21
+@ISA = qw(IO::Socket::INET6);
26
my $prop = $server->{'server'};
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);
33
+ elsif( $port =~ m/^\[([\:\w\.\-\*\/]+)\]:(\w+)$/ ){ # allow for things like "[::1]:80" (IPv6)
34
+ ($host,$port) = ($1,$2);
36
elsif ($port =~ /^(\w+)$/) { # allow for things like "80"
37
($host, $port) = ($default_host, $1);
39
diff -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
43
my $prop = $server->{server};
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);
51
+ ### allow for things like "[::1]:80" (IPv6)
52
+ }elsif( $port =~ m/^\[([\:\w\.\-\*\/]+)\]:(\w+)$/ ){
53
+ ($host,$port) = ($1,$2);
55
### allow for things like "80"
56
}elsif( $port =~ /^(\w+)$/ ){
57
($host,$port) = ($default_host,$1);
58
diff -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
64
use vars qw($VERSION $AUTOLOAD @ISA);
66
+use IO::Socket::INET6 ();
68
$VERSION = $Net::Server::VERSION; # done until separated
69
-@ISA = qw(IO::Socket::INET);
70
+@ISA = qw(IO::Socket::INET6);
75
my ($default_host,$port,$server) = @_;
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);
83
+ ### allow for things like "[::1]:80" (IPv6)
84
+ }elsif( $port =~ m/^\[([\:\w\.\-\*\/]+)\]:(\w+)$/ ){
85
+ ($host,$port) = ($1,$2);
87
### allow for things like "80"
88
}elsif( $port =~ /^(\w+)$/ ){
89
($host,$port) = ($default_host,$1);
90
diff -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
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);
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\"");
111
$prop->{proto} = [] if ! defined $prop->{proto};
112
@@ -757,12 +758,14 @@
113
### read information about this connection
114
my $sockname = getsockname( $sock );
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} );
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} ){
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} );
141
if( $prop->{peername} || $prop->{udp_true} ){
142
- $prop->{peeraddr} = inet_ntoa( $prop->{peeraddr} );
143
+ $prop->{peeraddr} = inet_ntop( $prop->{sockfamily}, $prop->{peeraddr} );
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} );
149
$prop->{peerhost} = '' unless defined $prop->{peerhost};
152
### user customizable hook
153
sub post_accept_hook {}
156
### perform basic allow/deny service
159
@@ -1145,7 +1147,7 @@
160
or $self->fatal("Can't dup socket [$!]");
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 [$!]");
168
diff -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;
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};
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 =~ /^$_$/;
185
if ($#{ $prop->{cidr_deny} } != -1) {
187
- return 0 if Net::CIDR::cidrlookup($prop->{peeraddr}, @{ $prop->{cidr_deny} });
188
+ return 0 if Net::CIDR::cidrlookup($peeraddr, @{ $prop->{cidr_deny} });
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 =~ /^$_$/;
198
if ($#{ $prop->{cidr_allow} } != -1) {
200
- return 1 if Net::CIDR::cidrlookup($prop->{peeraddr}, @{ $prop->{cidr_allow} });
201
+ return 1 if Net::CIDR::cidrlookup($peeraddr, @{ $prop->{cidr_allow} });
added
removed
contrib/Net-Server.patch
