1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
|
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;
|
