1 From 067faffb8e596a53c9ac2ed7e571472f7a163681 Mon Sep 17 00:00:00 2001
2 From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
3 Date: Mon, 16 Jan 2017 16:13:08 +0100
4 Subject: [PATCH] Add IPv6 support
5 MIME-Version: 1.0
6 Content-Type: text/plain; charset=UTF-8
7 Content-Transfer-Encoding: 8bit
8
9 This patch ports the code from IO::Socket::INET to IO::Socket::IP in
10 order to support IPv6.
11
12 CPAN RT #91699, #71395.
13
14 Signed-off-by: Petr Písař <ppisar@redhat.com>
15 ---
16 Makefile.PL | 1 +
17 README | 24 ++++++++++++------------
18 lib/HTTP/Daemon.pm | 43 ++++++++++++++++++++++++++++---------------
19 t/chunked.t | 34 +++++++++++++++++++++++-----------
20 4 files changed, 64 insertions(+), 38 deletions(-)
21
22 diff --git a/Makefile.PL b/Makefile.PL
23 index 09c7e86..85d5712 100644
24 --- a/Makefile.PL
25 +++ b/Makefile.PL
26 @@ -14,6 +14,7 @@ WriteMakefile(
27 PREREQ_PM => {
28 'Sys::Hostname' => 0,
29 'IO::Socket' => 0,
30 + 'IO::Socket::IP' => 0,
31 'HTTP::Request' => 6,
32 'HTTP::Response' => 6,
33 'HTTP::Status' => 6,
34 diff --git a/README b/README
35 index be5a20a..ddb3b6e 100644
36 --- a/README
37 +++ b/README
38 @@ -24,12 +24,12 @@ SYNOPSIS
39 DESCRIPTION
40 Instances of the `HTTP::Daemon' class are HTTP/1.1 servers that listen
41 on a socket for incoming requests. The `HTTP::Daemon' is a subclass of
42 - `IO::Socket::INET', so you can perform socket operations directly on it
43 + `IO::Socket::IP', so you can perform socket operations directly on it
44 too.
45
46 The accept() method will return when a connection from a client is
47 available. The returned value will be an `HTTP::Daemon::ClientConn'
48 - object which is another `IO::Socket::INET' subclass. Calling the
49 + object which is another `IO::Socket::IP' subclass. Calling the
50 get_request() method on this object will read data from the client and
51 return an `HTTP::Request' object. The ClientConn object also provide
52 methods to send back various responses.
53 @@ -40,13 +40,13 @@ DESCRIPTION
54 responses that conform to the HTTP/1.1 protocol.
55
56 The following methods of `HTTP::Daemon' are new (or enhanced) relative
57 - to the `IO::Socket::INET' base class:
58 + to the `IO::Socket::IP' base class:
59
60 $d = HTTP::Daemon->new
61 $d = HTTP::Daemon->new( %opts )
62 The constructor method takes the same arguments as the
63 - `IO::Socket::INET' constructor, but unlike its base class it can
64 - also be called without any arguments. The daemon will then set up a
65 + `IO::Socket::IP' constructor, but unlike its base class it can also
66 + be called without any arguments. The daemon will then set up a
67 listen queue of 5 connections and allocate some random port number.
68
69 A server that wants to bind to some specific address on the standard
70 @@ -57,8 +57,8 @@ DESCRIPTION
71 LocalPort => 80,
72 );
73
74 - See IO::Socket::INET for a description of other arguments that can
75 - be used configure the daemon during construction.
76 + See IO::Socket::IP for a description of other arguments that can be
77 + used configure the daemon during construction.
78
79 $c = $d->accept
80 $c = $d->accept( $pkg )
81 @@ -71,7 +71,7 @@ DESCRIPTION
82
83 The accept method will return `undef' if timeouts have been enabled
84 and no connection is made within the given time. The timeout()
85 - method is described in IO::Socket.
86 + method is described in IO::Socket::IP.
87
88 In list context both the client object and the peer address will be
89 returned; see the description of the accept method IO::Socket for
90 @@ -89,9 +89,9 @@ DESCRIPTION
91 The default is the string "libwww-perl-daemon/#.##" where "#.##" is
92 replaced with the version number of this module.
93
94 - The `HTTP::Daemon::ClientConn' is a `IO::Socket::INET' subclass.
95 - Instances of this class are returned by the accept() method of
96 - `HTTP::Daemon'. The following methods are provided:
97 + The `HTTP::Daemon::ClientConn' is a `IO::Socket::IP' subclass. Instances
98 + of this class are returned by the accept() method of `HTTP::Daemon'. The
99 + following methods are provided:
100
101 $c->get_request
102 $c->get_request( $headers_only )
103 @@ -227,7 +227,7 @@ DESCRIPTION
104 SEE ALSO
105 RFC 2616
106
107 - IO::Socket::INET, IO::Socket
108 + IO::Socket::IP, IO::Socket
109
110 COPYRIGHT
111 Copyright 1996-2003, Gisle Aas
112 diff --git a/lib/HTTP/Daemon.pm b/lib/HTTP/Daemon.pm
113 index 27a7bf4..0e22b77 100644
114 --- a/lib/HTTP/Daemon.pm
115 +++ b/lib/HTTP/Daemon.pm
116 @@ -5,8 +5,10 @@ use vars qw($VERSION @ISA $PROTO $DEBUG);
117
118 $VERSION = "6.01";
119
120 -use IO::Socket qw(AF_INET INADDR_ANY INADDR_LOOPBACK inet_ntoa);
121 -@ISA=qw(IO::Socket::INET);
122 +use Socket qw(AF_INET AF_INET6 INADDR_ANY IN6ADDR_ANY
123 + INADDR_LOOPBACK IN6ADDR_LOOPBACK inet_ntop sockaddr_family);
124 +use IO::Socket::IP;
125 +@ISA=qw(IO::Socket::IP);
126
127 $PROTO = "HTTP/1.1";
128
129 @@ -40,15 +42,26 @@ sub url
130 my $self = shift;
131 my $url = $self->_default_scheme . "://";
132 my $addr = $self->sockaddr;
133 - if (!$addr || $addr eq INADDR_ANY) {
134 + if (!$addr || $addr eq INADDR_ANY || $addr eq IN6ADDR_ANY) {
135 require Sys::Hostname;
136 $url .= lc Sys::Hostname::hostname();
137 }
138 elsif ($addr eq INADDR_LOOPBACK) {
139 - $url .= inet_ntoa($addr);
140 + $url .= inet_ntop(AF_INET, $addr);
141 + }
142 + elsif ($addr eq IN6ADDR_LOOPBACK) {
143 + $url .= '[' . inet_ntop(AF_INET6, $addr) . ']';
144 }
145 else {
146 - $url .= gethostbyaddr($addr, AF_INET) || inet_ntoa($addr);
147 + my $host = $addr->sockhostname;
148 + if (!defined $host) {
149 + if (sockaddr_family($addr) eq AF_INET6) {
150 + $host = '[' . inet_ntop(AF_INET6, $addr) . ']';
151 + } else {
152 + $host = inet_ntop(AF_INET6, $addr);
153 + }
154 + }
155 + $url .= $host;
156 }
157 my $port = $self->sockport;
158 $url .= ":$port" if $port != $self->_default_port;
159 @@ -77,8 +90,8 @@ sub product_tokens
160 package HTTP::Daemon::ClientConn;
161
162 use vars qw(@ISA $DEBUG);
163 -use IO::Socket ();
164 -@ISA=qw(IO::Socket::INET);
165 +use IO::Socket::IP ();
166 +@ISA=qw(IO::Socket::IP);
167 *DEBUG = \$HTTP::Daemon::DEBUG;
168
169 use HTTP::Request ();
170 @@ -645,12 +658,12 @@ HTTP::Daemon - a simple http server class
171
172 Instances of the C<HTTP::Daemon> class are HTTP/1.1 servers that
173 listen on a socket for incoming requests. The C<HTTP::Daemon> is a
174 -subclass of C<IO::Socket::INET>, so you can perform socket operations
175 +subclass of C<IO::Socket::IP>, so you can perform socket operations
176 directly on it too.
177
178 The accept() method will return when a connection from a client is
179 available. The returned value will be an C<HTTP::Daemon::ClientConn>
180 -object which is another C<IO::Socket::INET> subclass. Calling the
181 +object which is another C<IO::Socket::IP> subclass. Calling the
182 get_request() method on this object will read data from the client and
183 return an C<HTTP::Request> object. The ClientConn object also provide
184 methods to send back various responses.
185 @@ -661,7 +674,7 @@ desirable. Also note that the user is responsible for generating
186 responses that conform to the HTTP/1.1 protocol.
187
188 The following methods of C<HTTP::Daemon> are new (or enhanced) relative
189 -to the C<IO::Socket::INET> base class:
190 +to the C<IO::Socket::IP> base class:
191
192 =over 4
193
194 @@ -670,7 +683,7 @@ to the C<IO::Socket::INET> base class:
195 =item $d = HTTP::Daemon->new( %opts )
196
197 The constructor method takes the same arguments as the
198 -C<IO::Socket::INET> constructor, but unlike its base class it can also
199 +C<IO::Socket::IP> constructor, but unlike its base class it can also
200 be called without any arguments. The daemon will then set up a listen
201 queue of 5 connections and allocate some random port number.
202
203 @@ -682,7 +695,7 @@ HTTP port will be constructed like this:
204 LocalPort => 80,
205 );
206
207 -See L<IO::Socket::INET> for a description of other arguments that can
208 +See L<IO::Socket::IP> for a description of other arguments that can
209 be used configure the daemon during construction.
210
211 =item $c = $d->accept
212 @@ -699,7 +712,7 @@ class a subclass of C<HTTP::Daemon::ClientConn>.
213
214 The accept method will return C<undef> if timeouts have been enabled
215 and no connection is made within the given time. The timeout() method
216 -is described in L<IO::Socket>.
217 +is described in L<IO::Socket::IP>.
218
219 In list context both the client object and the peer address will be
220 returned; see the description of the accept method L<IO::Socket> for
221 @@ -721,7 +734,7 @@ replaced with the version number of this module.
222
223 =back
224
225 -The C<HTTP::Daemon::ClientConn> is a C<IO::Socket::INET>
226 +The C<HTTP::Daemon::ClientConn> is a C<IO::Socket::IP>
227 subclass. Instances of this class are returned by the accept() method
228 of C<HTTP::Daemon>. The following methods are provided:
229
230 @@ -895,7 +908,7 @@ Return a reference to the corresponding C<HTTP::Daemon> object.
231
232 RFC 2616
233
234 -L<IO::Socket::INET>, L<IO::Socket>
235 +L<IO::Socket::IP>, L<IO::Socket>
236
237 =head1 COPYRIGHT
238
239 diff --git a/t/chunked.t b/t/chunked.t
240 index e11799f..c274b11 100644
241 --- a/t/chunked.t
242 +++ b/t/chunked.t
243 @@ -95,18 +95,30 @@ my $can_fork = $Config{d_fork} ||
244 my $tests = @TESTS;
245 my $tport = 8333;
246
247 -my $tsock = IO::Socket::INET->new(LocalAddr => '0.0.0.0',
248 - LocalPort => $tport,
249 - Listen => 1,
250 - ReuseAddr => 1);
251 +my @addresses = (
252 + { server => '::', client => '::1' },
253 + { server => '0.0.0.0', client => '127.0.0.1' }
254 +);
255 +my $family;
256 +for my $id (0..$#addresses) {
257 + my $tsock = IO::Socket::IP->new(LocalAddr => $addresses[$id]->{server},
258 + LocalPort => $tport,
259 + Listen => 1,
260 + ReuseAddr => 1);
261 + if ($tsock) {
262 + close $tsock;
263 + $family = $id;
264 + last;
265 + }
266 +}
267 +
268 if (!$can_fork) {
269 plan skip_all => "This system cannot fork";
270 }
271 -elsif (!$tsock) {
272 - plan skip_all => "Cannot listen on 0.0.0.0:$tport";
273 +elsif (!defined $family) {
274 + plan skip_all => "Cannot listen on unspecifed address and port $tport";
275 }
276 else {
277 - close $tsock;
278 plan tests => $tests;
279 }
280
281 @@ -132,9 +144,9 @@ if ($pid = fork) {
282 open my $fh, "| socket localhost $tport" or die;
283 print $fh $test;
284 }
285 - use IO::Socket::INET;
286 - my $sock = IO::Socket::INET->new(
287 - PeerAddr => "127.0.0.1",
288 + use IO::Socket::IP;
289 + my $sock = IO::Socket::IP->new(
290 + PeerAddr => $addresses[$family]->{client},
291 PeerPort => $tport,
292 ) or die;
293 if (0) {
294 @@ -158,7 +170,7 @@ if ($pid = fork) {
295 } else {
296 die "cannot fork: $!" unless defined $pid;
297 my $d = HTTP::Daemon->new(
298 - LocalAddr => '0.0.0.0',
299 + LocalAddr => $addresses[$family]->{server},
300 LocalPort => $tport,
301 ReuseAddr => 1,
302 ) or die;
303 --
304 2.7.4
|
