Bug#659075: [rt.cpan.org #61577] more robust patch to fix un-propagated cached details for IO::Socket objects

[Daniel Kahn Gillmor]

Hi perl porters--

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 has been forwarded to CPAN's #61577 [0] and debian's
#659075 [1], and should address these issues no matter why the cached
details happen to be missing.

I'd be happy to improve the patch somehow if you have any suggestions
(you'll note that there's a FIXME in there because of SO_DOMAIN's
general non-portability -- i'm not sure how you'd generally want to
approach that sort of thing generally within perl, so i've gone for the
narrowly-targeted fix instead of something more intrusive).

I'm not subscribed to perl5-porters, so please CC me with any replies.

Thanks for maintaining Perl!

        --dkg

[0] https://rt.cpan.org/Ticket/Display.html?id=61577
[1] http://bugs.debian.org/659075

--- a/dist/IO/lib/IO/Socket.pm	2012-02-07 21:12:42.000000000 -0500
+++ b/dist/IO/lib/IO/Socket.pm	2012-02-09 00:54:14.000000000 -0500
@@ -336,18 +336,34 @@
 sub sockdomain {
     @_ == 1 or croak 'usage: $sock->sockdomain()';
     my $sock = shift;
+# FIXME: SO_DOMAIN should probably ultimately be included in Socket.pm
+# and the associated XS, but it isn't necessarily portable.  see:
+# https://mail.gnome.org/archives/commits-list/2011-September/msg00944.html
+    my $so_domain = 39; 
+    if (!defined(${*$sock}{'io_socket_domain'})) {
+	my $addr = $sock->getsockname();
+	if (defined($addr)) {
+	    ${*$sock}{'io_socket_domain'} = sockaddr_family($addr);
+	} else {
+	    ${*$sock}{'io_socket_domain'} = $sock->sockopt($so_domain)
+	}
+    }
     ${*$sock}{'io_socket_domain'};
 }
 
 sub socktype {
     @_ == 1 or croak 'usage: $sock->socktype()';
     my $sock = shift;
+    ${*$sock}{'io_socket_type'} = $sock->sockopt(SO_TYPE)
+	unless defined(${*$sock}{'io_socket_type'});
     ${*$sock}{'io_socket_type'}
 }
 
 sub protocol {
     @_ == 1 or croak 'usage: $sock->protocol()';
     my($sock) = @_;
+    ${*$sock}{'io_socket_proto'} = $sock->sockopt(SO_PROTOCOL)
+	unless defined(${*$sock}{'io_socket_proto'});
     ${*$sock}{'io_socket_proto'};
 }