diff options
author | Daniel Kahn Gillmor <dkg@fifthhorseman.net> | 2012-02-17 14:29:14 -0800 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2012-02-18 11:09:37 -0800 |
commit | 95cb1ee2f640e724647e6c613e5f7155fcb837e5 (patch) | |
tree | b9820f1f5ee15ccb79d7b271cdd10aafed9a065d | |
parent | a0ee90d6275e8e8ed2d2366771ed2111c3dc870d (diff) | |
download | perl-smoke-me/cpan61577.tar.gz |
[rt.cpan.org #61577] sockdomain and socktype undef on newly accepted socketssmoke-me/cpan61577
There appears to be a flaw in IO::Socket where some IO::Socket objects
are unable to properly report their socktype, sockdomain, or protocol
(they return undef, even when the underlying socket is sufficiently
initialized to have these properties).
The attached patch should cover IO::Socket objects created via accept(),
new_from_fd(), new(), and anywhere else whose details haven't been
properly cached.
No new code should be executed on IO::Socket objects whose details are
already cached and present.
-rw-r--r-- | MANIFEST | 3 | ||||
-rw-r--r-- | dist/IO/lib/IO/Socket.pm | 9 | ||||
-rw-r--r-- | dist/IO/t/cachepropagate-tcp.t | 43 | ||||
-rw-r--r-- | dist/IO/t/cachepropagate-udp.t | 27 | ||||
-rw-r--r-- | dist/IO/t/cachepropagate-unix.t | 65 |
5 files changed, 147 insertions, 0 deletions
@@ -3247,6 +3247,9 @@ dist/IO/Makefile.PL IO extension makefile writer dist/IO/poll.c IO poll() emulation using select() dist/IO/poll.h IO poll() emulation using select() dist/IO/README IO extension maintenance notice +dist/IO/t/cachepropagate-tcp.t See if IO::Socket duplication works +dist/IO/t/cachepropagate-udp.t See if IO::Socket duplication works +dist/IO/t/cachepropagate-unix.t See if IO::Socket duplication works dist/IO/t/io_const.t See if constants from IO work dist/IO/t/io_dir.t See if directory-related methods from IO work dist/IO/t/io_dup.t See if dup()-related methods from IO work diff --git a/dist/IO/lib/IO/Socket.pm b/dist/IO/lib/IO/Socket.pm index 529423b5fd..31bf56866d 100644 --- a/dist/IO/lib/IO/Socket.pm +++ b/dist/IO/lib/IO/Socket.pm @@ -349,18 +349,27 @@ sub timeout { sub sockdomain { @_ == 1 or croak 'usage: $sock->sockdomain()'; my $sock = shift; + if (!defined(${*$sock}{'io_socket_domain'})) { + my $addr = $sock->sockname(); + ${*$sock}{'io_socket_domain'} = sockaddr_family($addr) + if (defined($addr)); + } ${*$sock}{'io_socket_domain'}; } sub socktype { @_ == 1 or croak 'usage: $sock->socktype()'; my $sock = shift; + ${*$sock}{'io_socket_type'} = $sock->sockopt(Socket::SO_TYPE) + if (!defined(${*$sock}{'io_socket_type'}) && defined(eval{Socket::SO_TYPE})); ${*$sock}{'io_socket_type'} } sub protocol { @_ == 1 or croak 'usage: $sock->protocol()'; my($sock) = @_; + ${*$sock}{'io_socket_proto'} = $sock->sockopt(Socket::SO_PROTOCOL) + if (!defined(${*$sock}{'io_socket_proto'}) && defined(eval{Socket::SO_PROTOCOL})); ${*$sock}{'io_socket_proto'}; } diff --git a/dist/IO/t/cachepropagate-tcp.t b/dist/IO/t/cachepropagate-tcp.t new file mode 100644 index 0000000000..40f36be274 --- /dev/null +++ b/dist/IO/t/cachepropagate-tcp.t @@ -0,0 +1,43 @@ +#!/usr/bin/perl + +use warnings; +use strict; + +use IO::Socket; +use IO::Socket::INET; +use Test; + +plan tests => 8; + +my $listener = IO::Socket::INET->new(Listen => 1, + LocalAddr => '127.0.0.1', + Proto => 'tcp'); +ok(defined($listener)); + +my $port = $listener->sockport(); + +my $p = $listener->protocol(); +ok(defined($p)); +my $d = $listener->sockdomain(); +ok(defined($d)); +my $s = $listener->socktype(); +ok(defined($s)); + +my $cpid = fork(); +ok(defined($cpid)); +if (0 == $cpid) { + # the child: + sleep(1); + my $connector = IO::Socket::INET->new(PeerAddr => '127.0.0.1', + PeerPort => $port, + Proto => 'tcp'); + exit(0); +}; + +my $new = $listener->accept(); + +ok($new->protocol(), $p); +ok($new->sockdomain(), $d); +ok($new->socktype(), $s); + +wait(); diff --git a/dist/IO/t/cachepropagate-udp.t b/dist/IO/t/cachepropagate-udp.t new file mode 100644 index 0000000000..04462725a0 --- /dev/null +++ b/dist/IO/t/cachepropagate-udp.t @@ -0,0 +1,27 @@ +#!/usr/bin/perl + +use warnings; +use strict; + +use IO::Socket; +use IO::Socket::INET; +use Test; + +plan tests => 7; + +my $listener = IO::Socket::INET->new(LocalAddr => '127.0.0.1', + Proto => 'udp'); +ok(defined($listener)); + +my $p = $listener->protocol(); +ok(defined($p)); +my $d = $listener->sockdomain(); +ok(defined($d)); +my $s = $listener->socktype(); +ok(defined($s)); + +my $new = IO::Socket::INET->new_from_fd($listener->fileno(), 'r+'); + +ok($new->protocol(), $p); +ok($new->sockdomain(), $d); +ok($new->socktype(), $s); diff --git a/dist/IO/t/cachepropagate-unix.t b/dist/IO/t/cachepropagate-unix.t new file mode 100644 index 0000000000..a00897c384 --- /dev/null +++ b/dist/IO/t/cachepropagate-unix.t @@ -0,0 +1,65 @@ +#!/usr/bin/perl + +use warnings; +use strict; + +use IO::Socket; +use IO::Socket::UNIX; +use Test; + +plan tests => 15; + +my $socketpath = './testsock'; + +# start testing stream sockets: + +my $listener = IO::Socket::UNIX->new(Type => SOCK_STREAM, + Listen => 1, + Local => $socketpath); +ok(defined($listener)); + +my $p = $listener->protocol(); +ok(defined($p)); +my $d = $listener->sockdomain(); +ok(defined($d)); +my $s = $listener->socktype(); +ok(defined($s)); + +my $cpid = fork(); +ok(defined($cpid)); +if (0 == $cpid) { + # the child: + sleep(1); + my $connector = IO::Socket::UNIX->new(Peer => $socketpath); + exit(0); +}; + +my $new = $listener->accept(); + +ok($new->protocol(), $p); +ok($new->sockdomain(), $d); +ok($new->socktype(), $s); + +unlink($socketpath); +wait(); + +# now test datagram sockets: + +$listener = IO::Socket::UNIX->new(Type => SOCK_DGRAM, + Local => $socketpath); +ok(defined($listener)); + +$p = $listener->protocol(); +ok(defined($p)); +$d = $listener->sockdomain(); +ok(defined($d)); +$s = $listener->socktype(); +ok(defined($s)); + +$new = IO::Socket::UNIX->new_from_fd($listener->fileno(), 'r+'); + +ok($new->protocol(), $p); +ok($new->sockdomain(), $d); +ok($new->socktype(), $s); + +unlink($socketpath); |