Skip to content

Commit 2d396b8

Browse files
committed
Use IO::Socket::IP for IPv6 support.
@ppisar and @intrigeri provided a patch for Debian and Fedora based distributions as lined out in issue #24. That patch was implemented here and has been reviewed by the author of IP::Socket::IP, @leonerd
1 parent 17e677f commit 2d396b8

3 files changed

Lines changed: 59 additions & 29 deletions

File tree

Changes

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,8 @@ Revision history for HTTP-Daemon
66
- Tidied Daemon.pm
77
- Turned on EOL and tab tests
88
- Removed obvious indirect object syntax in test suite
9+
- Added IPv6 support. (GH#24) Thanks, @ppisar and @intrigeri
10+
- Added IO::Socket::IP as a prerequisite rather than IO::Socket::INET
911

1012
6.04 2019-04-02 13:09:45Z
1113
- Remove circular dependency on LWP::RobotUA introduced in 6.02 (GH#29)

lib/HTTP/Daemon.pm

Lines changed: 31 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -7,8 +7,12 @@ use warnings;
77

88
our $VERSION = '6.05';
99

10-
use IO::Socket qw(AF_INET INADDR_ANY INADDR_LOOPBACK inet_ntoa);
11-
our @ISA = qw(IO::Socket::INET);
10+
use Socket qw(
11+
AF_INET AF_INET6 INADDR_ANY IN6ADDR_ANY INADDR_LOOPBACK IN6ADDR_LOOPBACK
12+
inet_ntop sockaddr_family
13+
);
14+
use IO::Socket::IP;
15+
our @ISA = qw(IO::Socket::IP);
1216

1317
our $PROTO = "HTTP/1.1";
1418

@@ -38,15 +42,27 @@ sub url {
3842
my $self = shift;
3943
my $url = $self->_default_scheme . "://";
4044
my $addr = $self->sockaddr;
41-
if (!$addr || $addr eq INADDR_ANY) {
45+
if (!$addr || $addr eq INADDR_ANY || $addr eq IN6ADDR_ANY) {
4246
require Sys::Hostname;
4347
$url .= lc Sys::Hostname::hostname();
4448
}
4549
elsif ($addr eq INADDR_LOOPBACK) {
46-
$url .= inet_ntoa($addr);
50+
$url .= inet_ntop(AF_INET, $addr);
51+
}
52+
elsif ($addr eq IN6ADDR_LOOPBACK) {
53+
$url .= '[' . inet_ntop(AF_INET6, $addr) . ']';
4754
}
4855
else {
49-
$url .= gethostbyaddr($addr, AF_INET) || inet_ntoa($addr);
56+
my $host = $addr->sockhostname;
57+
if (!defined $host) {
58+
if (sockaddr_family($addr) eq AF_INET6) {
59+
$host = '[' . inet_ntop(AF_INET6, $addr) . ']';
60+
}
61+
else {
62+
$host = inet_ntop(AF_INET6, $addr);
63+
}
64+
}
65+
$url .= $host;
5066
}
5167
my $port = $self->sockport;
5268
$url .= ":$port" if $port != $self->_default_port;
@@ -72,8 +88,8 @@ package # hide from PAUSE
7288
use strict;
7389
use warnings;
7490

75-
use IO::Socket ();
76-
our @ISA = qw(IO::Socket::INET);
91+
use IO::Socket::IP ();
92+
our @ISA = qw(IO::Socket::IP);
7793
our $DEBUG;
7894
*DEBUG = \$HTTP::Daemon::DEBUG;
7995

@@ -613,12 +629,12 @@ __END__
613629
614630
Instances of the C<HTTP::Daemon> class are HTTP/1.1 servers that
615631
listen on a socket for incoming requests. The C<HTTP::Daemon> is a
616-
subclass of C<IO::Socket::INET>, so you can perform socket operations
632+
subclass of C<IO::Socket::IP>, so you can perform socket operations
617633
directly on it too.
618634
619635
The accept() method will return when a connection from a client is
620636
available. The returned value will be an C<HTTP::Daemon::ClientConn>
621-
object which is another C<IO::Socket::INET> subclass. Calling the
637+
object which is another C<IO::Socket::IP> subclass. Calling the
622638
get_request() method on this object will read data from the client and
623639
return an C<HTTP::Request> object. The ClientConn object also provide
624640
methods to send back various responses.
@@ -629,7 +645,7 @@ desirable. Also note that the user is responsible for generating
629645
responses that conform to the HTTP/1.1 protocol.
630646
631647
The following methods of C<HTTP::Daemon> are new (or enhanced) relative
632-
to the C<IO::Socket::INET> base class:
648+
to the C<IO::Socket::IP> base class:
633649
634650
=over 4
635651
@@ -638,7 +654,7 @@ to the C<IO::Socket::INET> base class:
638654
=item $d = HTTP::Daemon->new( %opts )
639655
640656
The constructor method takes the same arguments as the
641-
C<IO::Socket::INET> constructor, but unlike its base class it can also
657+
C<IO::Socket::IP> constructor, but unlike its base class it can also
642658
be called without any arguments. The daemon will then set up a listen
643659
queue of 5 connections and allocate some random port number.
644660
@@ -650,7 +666,7 @@ HTTP port will be constructed like this:
650666
LocalPort => 80,
651667
);
652668
653-
See L<IO::Socket::INET> for a description of other arguments that can
669+
See L<IO::Socket::IP> for a description of other arguments that can
654670
be used configure the daemon during construction.
655671
656672
=item $c = $d->accept
@@ -667,7 +683,7 @@ class a subclass of C<HTTP::Daemon::ClientConn>.
667683
668684
The accept method will return C<undef> if timeouts have been enabled
669685
and no connection is made within the given time. The timeout() method
670-
is described in L<IO::Socket>.
686+
is described in L<IO::Socket::IP>.
671687
672688
In list context both the client object and the peer address will be
673689
returned; see the description of the accept method L<IO::Socket> for
@@ -689,7 +705,7 @@ replaced with the version number of this module.
689705
690706
=back
691707
692-
The C<HTTP::Daemon::ClientConn> is a C<IO::Socket::INET>
708+
The C<HTTP::Daemon::ClientConn> is a C<IO::Socket::IP>
693709
subclass. Instances of this class are returned by the accept() method
694710
of C<HTTP::Daemon>. The following methods are provided:
695711
@@ -863,6 +879,6 @@ Return a reference to the corresponding C<HTTP::Daemon> object.
863879
864880
RFC 2616
865881
866-
L<IO::Socket::INET>, L<IO::Socket>
882+
L<IO::Socket::IP>, L<IO::Socket>
867883
868884
=cut

t/chunked.t

Lines changed: 26 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -101,20 +101,32 @@ my $can_fork
101101
my $tests = @TESTS;
102102
my $tport = 8334;
103103

104-
my $tsock = IO::Socket::INET->new(
105-
LocalAddr => '0.0.0.0',
106-
LocalPort => $tport,
107-
Listen => 1,
108-
ReuseAddr => 1
104+
my @addresses = (
105+
{server => '::', client => '::1'},
106+
{server => '0.0.0.0', client => '127.0.0.1'}
109107
);
108+
my $family;
109+
for my $id (0 .. $#addresses) {
110+
my $tsock = IO::Socket::IP->new(
111+
LocalAddr => $addresses[$id]->{server},
112+
LocalPort => $tport,
113+
Listen => 1,
114+
ReuseAddr => 1
115+
);
116+
if ($tsock) {
117+
close $tsock;
118+
$family = $id;
119+
last;
120+
}
121+
}
122+
110123
if (!$can_fork) {
111124
plan skip_all => "This system cannot fork";
112125
}
113-
elsif (!$tsock) {
114-
plan skip_all => "Cannot listen on 0.0.0.0:$tport";
126+
elsif (!defined $family) {
127+
plan skip_all => "Cannot listen on unspecifed address and port $tport";
115128
}
116129
else {
117-
close $tsock;
118130
plan tests => $tests;
119131
}
120132

@@ -139,11 +151,11 @@ if ($pid = fork) {
139151
open my $fh, "| socket localhost $tport" or die;
140152
print $fh $test;
141153
}
142-
use IO::Socket::INET;
143-
my $sock
144-
= IO::Socket::INET->new(PeerAddr => "127.0.0.1",
145-
PeerPort => $tport,)
146-
or die;
154+
use IO::Socket::IP;
155+
my $sock = IO::Socket::IP->new(
156+
PeerAddr => $addresses[$family]->{client},
157+
PeerPort => $tport,
158+
) or die;
147159
if (0) {
148160
for my $pos (0 .. length($raw) - 1) {
149161
print $sock substr($raw, $pos, 1);
@@ -164,7 +176,7 @@ if ($pid = fork) {
164176
else {
165177
die "cannot fork: $!" unless defined $pid;
166178
my $d = HTTP::Daemon->new(
167-
LocalAddr => '0.0.0.0',
179+
LocalAddr => $addresses[$family]->{server},
168180
LocalPort => $tport,
169181
ReuseAddr => 1,
170182
) or die;

0 commit comments

Comments
 (0)