Update Socket to CPAN version 2.000smoke-me/socket

  [DELTA]

  2012/03/10
  2.000   CHANGES:
         * Apply (modified) patch from rurban to fix memory overflow bug with
           sockaddr_un() - RT75623
         * Increase to three-digit version suffix in new major version

  2012/02/21
  1.99    CHANGES:
         * Better implementation of inet_pton() that sets correct size (RT 75074)
         * Added SO_DOMAIN
         * More robust unit tests of address-mangling functions

8 files changed, 185 insertions, 108 deletions

diff --git a/MANIFEST b/MANIFEST
index 92efe61391..3e0de0e317 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2217,6 +2217,7 @@ cpan/Socket/Socket.xs			Socket extension external subroutines
 cpan/Socket/t/getaddrinfo.t		See if Socket::getaddrinfo works
 cpan/Socket/t/getnameinfo.t		See if Socket::getnameinfo works
 cpan/Socket/t/ipv6_mreq.t		See if (un)pack_ipv6_mreq work
+cpan/Socket/t/sockaddr.t		See if socketaddr works
 cpan/Socket/t/socketpair.t		See if socketpair works
 cpan/Socket/t/Socket.t			See if Socket works
 cpan/Socket/typemap
diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index 444967732b..ca97539b03 100755
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -1621,7 +1621,7 @@ use File::Glob qw(:case);
 
     'Socket' => {
         'MAINTAINER'   => 'pevans',
-        'DISTRIBUTION' => 'PEVANS/Socket-1.98.tar.gz',
+        'DISTRIBUTION' => 'PEVANS/Socket-2.000.tar.gz',
         'FILES'        => q[cpan/Socket],
         'UPSTREAM'     => 'cpan',
     },
diff --git a/cpan/Socket/Makefile.PL b/cpan/Socket/Makefile.PL
index ed6c210cb9..9a8f65d274 100644
--- a/cpan/Socket/Makefile.PL
+++ b/cpan/Socket/Makefile.PL
@@ -92,7 +92,7 @@ check_for(
 );
 
 check_for(
-    confkey => "d_sockaddr_in6", # invented - check with core later
+    confkey => "d_sockaddr_in6",
     define  => "HAS_SOCKADDR_IN6",
     main    => "struct sockaddr_in6 sin6; sin6.sin6_family = AF_INET6;"
 );
@@ -104,7 +104,7 @@ check_for(
 );
 
 check_for(
-    confkey => "d_ipv6_mreq", # invented - check with core later
+    confkey => "d_ipv6_mreq",
     define  => "HAS_IPV6_MREQ",
     main    => "struct ipv6_mreq mreq; mreq.ipv6mr_interface = 0;"
 );
@@ -116,17 +116,20 @@ my %makefile_args;
 $makefile_args{INSTALLDIRS} = "perl" if $] < 5.012;
 
 WriteMakefile(
-    NAME	 => 'Socket',
-    VERSION_FROM => 'Socket.pm',
+    NAME	  => 'Socket',
+    VERSION_FROM  => 'Socket.pm',
+    # ABSTRACT_FROM gets confused by C<Socket>
+    ABSTRACT      => 'networking constants and support functions',
    ($Config{libs} =~ /(-lsocks\S*)/ ? (LIBS => [ "$1" ] ) : ()),
-    XSPROTOARG   => '-noprototypes', 		# XXX remove later?
-    realclean => {FILES=> 'const-c.inc const-xs.inc'},
-    DEFINE       => join( " ", map { "-D$_" } @DEFINES ),
+    XSPROTOARG    => '-noprototypes', 		# XXX remove later?
+    realclean     => {FILES=> 'const-c.inc const-xs.inc'},
+    DEFINE        => join( " ", map { "-D$_" } @DEFINES ),
     CONFIGURE_REQUIRES => {
 	'ExtUtils::CBuilder' => 0,
 	'ExtUtils::Constant' => '0.23',
     },
     MIN_PERL_VERSION => '5.006001',
+    LICENSE       => 'perl',
     %makefile_args,
 );
 my @names = (
@@ -175,10 +178,10 @@ my @names = (
 	SOMAXCONN
 
 	SO_ACCEPTCONN SO_ATTACH_FILTER SO_BACKLOG SO_BROADCAST SO_CHAMELEON
-	SO_DEBUG SO_DETACH_FILTER SO_DGRAM_ERRIND SO_DONTLINGER SO_DONTROUTE
-	SO_ERROR SO_FAMILY SO_KEEPALIVE SO_LINGER SO_OOBINLINE SO_PASSCRED
-	SO_PASSIFNAME SO_PEERCRED SO_PROTOCOL SO_PROTOTYPE SO_RCVBUF
-	SO_RCVLOWAT SO_RCVTIMEO SO_REUSEADDR SO_REUSEPORT
+	SO_DEBUG SO_DETACH_FILTER SO_DGRAM_ERRIND SO_DOMAIN SO_DONTLINGER
+	SO_DONTROUTE SO_ERROR SO_FAMILY SO_KEEPALIVE SO_LINGER SO_OOBINLINE
+	SO_PASSCRED SO_PASSIFNAME SO_PEERCRED SO_PROTOCOL SO_PROTOTYPE
+	SO_RCVBUF SO_RCVLOWAT SO_RCVTIMEO SO_REUSEADDR SO_REUSEPORT
 	SO_SECURITY_AUTHENTICATION SO_SECURITY_ENCRYPTION_NETWORK
 	SO_SECURITY_ENCRYPTION_TRANSPORT SO_SNDBUF SO_SNDLOWAT SO_SNDTIMEO
 	SO_STATE SO_TYPE SO_USELOOPBACK SO_XOPEN SO_XSE
diff --git a/cpan/Socket/Socket.pm b/cpan/Socket/Socket.pm
index c6420e1904..3b8ea73eed 100644
--- a/cpan/Socket/Socket.pm
+++ b/cpan/Socket/Socket.pm
@@ -3,7 +3,7 @@ package Socket;
 use strict;
 { use 5.006001; }
 
-our $VERSION = '1.98';
+our $VERSION = '2.000';
 
 =head1 NAME
 
@@ -74,7 +74,7 @@ provided will depend on the OS and headers found at compile-time.
 =head2 PF_INET, PF_INET6, PF_UNIX, ...
 
 Protocol family constants to use as the first argument to socket() or the
-value of the C<SO_FAMILY> socket option.
+value of the C<SO_DOMAIN> or C<SO_FAMILY> socket option.
 
 =head2 AF_INET, AF_INET6, AF_UNIX, ...
 
@@ -675,10 +675,10 @@ our @EXPORT = qw(
 	SOL_SOCKET
 
 	SO_ACCEPTCONN SO_ATTACH_FILTER SO_BACKLOG SO_BROADCAST SO_CHAMELEON
-	SO_DEBUG SO_DETACH_FILTER SO_DGRAM_ERRIND SO_DONTLINGER SO_DONTROUTE
-	SO_ERROR SO_FAMILY SO_KEEPALIVE SO_LINGER SO_OOBINLINE SO_PASSCRED
-	SO_PASSIFNAME SO_PEERCRED SO_PROTOCOL SO_PROTOTYPE SO_RCVBUF
-	SO_RCVLOWAT SO_RCVTIMEO SO_REUSEADDR SO_REUSEPORT
+	SO_DEBUG SO_DETACH_FILTER SO_DGRAM_ERRIND SO_DOMAIN SO_DONTLINGER
+	SO_DONTROUTE SO_ERROR SO_FAMILY SO_KEEPALIVE SO_LINGER SO_OOBINLINE
+	SO_PASSCRED SO_PASSIFNAME SO_PEERCRED SO_PROTOCOL SO_PROTOTYPE
+	SO_RCVBUF SO_RCVLOWAT SO_RCVTIMEO SO_REUSEADDR SO_REUSEPORT
 	SO_SECURITY_AUTHENTICATION SO_SECURITY_ENCRYPTION_NETWORK
 	SO_SECURITY_ENCRYPTION_TRANSPORT SO_SNDBUF SO_SNDLOWAT SO_SNDTIMEO
 	SO_STATE SO_TYPE SO_USELOOPBACK SO_XOPEN SO_XSE
diff --git a/cpan/Socket/Socket.xs b/cpan/Socket/Socket.xs
index 665553c94e..3999c4b7ce 100644
--- a/cpan/Socket/Socket.xs
+++ b/cpan/Socket/Socket.xs
@@ -707,15 +707,21 @@ unpack_sockaddr_un(sun_sv)
 	STRLEN sockaddrlen;
 	char * sun_ad = SvPVbyte(sun_sv,sockaddrlen);
 	int addr_len;
-#   ifndef __linux__
+#   ifdef __linux__
 	/* On Linux sockaddrlen on sockets returned by accept, recvfrom,
 	   getpeername and getsockname is not equal to sizeof(addr). */
+	if (sockaddrlen < sizeof(addr)) {
+	  Copy(sun_ad, &addr, sockaddrlen, char);
+	  Zero(&addr+sockaddrlen, sizeof(addr)-sockaddrlen, char);
+	} else {
+	  Copy(sun_ad, &addr, sizeof(addr), char);
+	}
+#   else
 	if (sockaddrlen != sizeof(addr))
 		croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
 		      "Socket::unpack_sockaddr_un", (UV)sockaddrlen, (UV)sizeof(addr));
-#   endif
-
 	Copy(sun_ad, &addr, sizeof(addr), char);
+#   endif
 
 	if (addr.sun_family != AF_UNIX)
 		croak("Bad address family for %s, got %d, should be %d",
@@ -879,7 +885,12 @@ inet_ntop(af, ip_address_sv)
 	struct in_addr addr;
 	char str[INET_ADDRSTRLEN];
 #endif
-	char *ip_address = SvPV(ip_address_sv, addrlen);
+	char *ip_address;
+
+	if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
+		croak("Wide character in %s", "Socket::inet_ntop");
+
+	ip_address = SvPV(ip_address_sv, addrlen);
 
 	struct_size = sizeof(addr);
 
@@ -912,17 +923,23 @@ inet_pton(af, host)
 	CODE:
 #ifdef HAS_INETPTON
 	int ok;
+	int addrlen = 0;
 #ifdef AF_INET6
 	struct in6_addr ip_address;
 #else
 	struct in_addr ip_address;
 #endif
 
-	if (af != AF_INET
+	switch(af) {
+	  case AF_INET:
+	    addrlen = 4;
+	    break;
 #ifdef AF_INET6
-	    && af != AF_INET6
+	  case AF_INET6:
+	    addrlen = 16;
+	    break;
 #endif
-	   ) {
+	  default:
 		croak("Bad address family for %s, got %d, should be"
 #ifdef AF_INET6
 		      " either AF_INET or AF_INET6",
@@ -935,7 +952,7 @@ inet_pton(af, host)
 
 	ST(0) = sv_newmortal();
 	if (ok) {
-		sv_setpvn( ST(0), (char *)&ip_address, sizeof(ip_address) );
+		sv_setpvn( ST(0), (char *)&ip_address, addrlen);
 	}
 #else
 	ST(0) = (SV*)not_here("inet_pton");
diff --git a/cpan/Socket/t/Socket.t b/cpan/Socket/t/Socket.t
index b1c6748009..a73f6d4da5 100644
--- a/cpan/Socket/t/Socket.t
+++ b/cpan/Socket/t/Socket.t
@@ -11,7 +11,7 @@ BEGIN {
 }
 	
 use Socket qw(:all);
-use Test::More tests => 26;
+use Test::More tests => 6;
 
 $has_echo = $^O ne 'MSWin32';
 $alarmed = 0;
@@ -100,84 +100,3 @@ SKIP: {
 	ok(($read == 0 || $buff eq "olleh"), "PF_INET echo INADDR_LOOPBACK reply");
     }
 }
-
-# warnings
-{
-    my $w = 0;
-    local $SIG{__WARN__} = sub {
-	++ $w if $_[0] =~ /^6-ARG sockaddr_in call is deprecated/ ;
-    };
-
-    no warnings 'Socket';
-    sockaddr_in(1,2,3,4,5,6) ;
-    is($w, 0, "sockaddr_in deprecated form doesn't warn without lexical warnings");
-
-    use warnings 'Socket';
-    sockaddr_in(1,2,3,4,5,6) ;
-    is($w, 1, "sockaddr_in deprecated form warns with lexical warnings");
-}
-
-# Test that whatever we give into pack/unpack_sockaddr retains
-# the value thru the entire chain.
-is(inet_ntoa((unpack_sockaddr_in(pack_sockaddr_in(100,inet_aton("10.250.230.10"))))[1]), '10.250.230.10',
-   'inet_aton->pack_sockaddr_in->unpack_sockaddr_in->inet_ntoa roundtrip');
-
-is(inet_ntoa(inet_aton("10.20.30.40")), "10.20.30.40", 'inet_aton->inet_ntoa roundtrip');
-is(inet_ntoa(v10.20.30.40), "10.20.30.40", 'inet_ntoa from v-string');
-
-{
-    my ($port,$addr) = unpack_sockaddr_in(pack_sockaddr_in(100,v10.10.10.10));
-    is($port, 100, 'pack_sockaddr_in->unpack_sockaddr_in port');
-    is(inet_ntoa($addr), "10.10.10.10", 'pack_sockaddr_in->unpack_sockaddr_in addr');
-}
-
-{
-    local $@;
-    eval { inet_ntoa(v10.20.30.400) };
-    like($@, qr/^Wide character in Socket::inet_ntoa at/, 'inet_ntoa warns about wide characters');
-}
-
-is(sockaddr_family(pack_sockaddr_in(100,inet_aton("10.250.230.10"))), AF_INET, 'pack_sockaddr_in->sockaddr_family');
-
-{
-    local $@;
-    eval { sockaddr_family("") };
-    like($@, qr/^Bad arg length for Socket::sockaddr_family, length is 0, should be at least \d+/, 'sockaddr_family warns about argument length');
-}
-
-SKIP: {
-    # see if we can handle abstract sockets
-    skip "Abstract AF_UNIX paths unsupported", 2 unless $^O eq "linux";
-
-    my $test_abstract_socket = chr(0) . '/org/perl/hello'. chr(0) . 'world';
-    my $addr = sockaddr_un ($test_abstract_socket);
-    my ($path) = sockaddr_un ($addr);
-    is($path, $test_abstract_socket, 'sockaddr_un can handle abstract AF_UNIX paths');
-
-    # see if we calculate the address structure length correctly
-    is(length ($test_abstract_socket) + 2, length $addr, 'sockaddr_un abstract address length');
-}
-
-SKIP: {
-    skip "No inet_ntop", 3 unless defined eval { inet_pton(AF_INET, "10.20.30.40") };
-
-    is(inet_ntop(AF_INET, inet_pton(AF_INET, "10.20.30.40")), "10.20.30.40", 'inet_pton->inet_ntop AF_INET roundtrip');
-    is(inet_ntop(AF_INET, inet_aton("10.20.30.40")), "10.20.30.40", 'inet_aton->inet_ntop AF_INET roundtrip');
-
-    SKIP: {
-	skip "No AF_INET6", 1 unless defined eval { AF_INET6() };
-	is(lc inet_ntop(AF_INET6, inet_pton(AF_INET6, "2001:503:BA3E::2:30")), "2001:503:ba3e::2:30", 'inet_pton->inet_ntop AF_INET6 roundtrip');
-    }
-}
-
-SKIP: {
-    skip "No AF_INET6", 5 unless defined eval { AF_INET6() };
-    skip "Cannot pack_sockaddr_in6()", 5 unless my $sin6 = eval { pack_sockaddr_in6(0x1234, "0123456789abcdef", 0, 89) };
-
-    is(sockaddr_family($sin6), AF_INET6, 'sockaddr_family of pack_sockaddr_in6');
-
-    is((unpack_sockaddr_in6($sin6))[0], 0x1234,             'pack_sockaddr_in6->unpack_sockaddr_in6 port');
-    is((unpack_sockaddr_in6($sin6))[1], "0123456789abcdef", 'pack_sockaddr_in6->unpack_sockaddr_in6 addr');
-    is((unpack_sockaddr_in6($sin6))[2], 0,                  'pack_sockaddr_in6->unpack_sockaddr_in6 scope_id');
-    is((unpack_sockaddr_in6($sin6))[3], 89,                 'pack_sockaddr_in6->unpack_sockaddr_in6 flowinfo');
-}
diff --git a/cpan/Socket/t/sockaddr.t b/cpan/Socket/t/sockaddr.t
new file mode 100644
index 0000000000..63cce24309
--- /dev/null
+++ b/cpan/Socket/t/sockaddr.t
@@ -0,0 +1,133 @@
+#!./perl
+
+use strict;
+use warnings;
+
+use Socket qw(
+    AF_INET
+    inet_ntoa inet_aton inet_ntop inet_pton
+    pack_sockaddr_in unpack_sockaddr_in sockaddr_in
+    sockaddr_family
+    sockaddr_un
+);
+use Test::More tests => 31;
+
+# inet_aton, inet_ntoa
+{
+    is(join(".", unpack("C*",inet_aton("10.20.30.40"))), "10.20.30.40", 'inet_aton returns packed bytes');
+
+    is(inet_ntoa(v10.20.30.40), "10.20.30.40", 'inet_ntoa from v-string');
+
+    is(inet_ntoa(inet_aton("10.20.30.40")), "10.20.30.40", 'inet_aton->inet_ntoa roundtrip');
+
+    local $@;
+    eval { inet_ntoa(v10.20.30.400) };
+    like($@, qr/^Wide character in Socket::inet_ntoa at/, 'inet_ntoa warns about wide characters');
+}
+
+# inet_ntop, inet_pton
+SKIP: {
+    skip "No inet_ntop", 5 unless defined eval { inet_pton(AF_INET, "10.20.30.40") };
+
+    is(join(".", unpack("C*",inet_pton(AF_INET, "10.20.30.40"))), "10.20.30.40", 'inet_pton AF_INET returns packed bytes');
+
+    is(inet_ntop(AF_INET, v10.20.30.40), "10.20.30.40", 'inet_ntop AF_INET from v-string');
+
+    is(inet_ntop(AF_INET, inet_pton(AF_INET, "10.20.30.40")), "10.20.30.40", 'inet_pton->inet_ntop AF_INET roundtrip');
+    is(inet_ntop(AF_INET, inet_aton("10.20.30.40")), "10.20.30.40", 'inet_aton->inet_ntop AF_INET roundtrip');
+
+    local $@;
+    eval { inet_ntop(AF_INET, v10.20.30.400) };
+    like($@, qr/^Wide character in Socket::inet_ntop at/, 'inet_ntop warns about wide characters');
+}
+
+SKIP: {
+    skip "No AF_INET6", 3 unless my $AF_INET6 = eval { Socket::AF_INET6() };
+    skip "No inet_ntop", 3 unless defined eval { inet_pton($AF_INET6, "2460::1") };
+
+    is(uc unpack("H*",inet_pton($AF_INET6, "2001:503:BA3E::2:30")), "20010503BA3E00000000000000020030",
+        'inet_pton AF_INET6 returns packed bytes');
+
+    is(uc inet_ntop($AF_INET6, "\x20\x01\x05\x03\xBA\x3E\x00\x00\x00\x00\x00\x00\x00\x02\x00\x30"), "2001:503:BA3E::2:30",
+        'inet_ntop AF_INET6 from octet string');
+
+    is(lc inet_ntop($AF_INET6, inet_pton($AF_INET6, "2001:503:BA3E::2:30")), "2001:503:ba3e::2:30",
+        'inet_pton->inet_ntop AF_INET6 roundtrip');
+}
+
+# sockaddr_family
+{
+    local $@;
+    eval { sockaddr_family("") };
+    like($@, qr/^Bad arg length for Socket::sockaddr_family, length is 0, should be at least \d+/, 'sockaddr_family warns about argument length');
+}
+
+# pack_sockaddr_in, unpack_sockaddr_in
+# sockaddr_in
+{
+    my $sin = pack_sockaddr_in 100, inet_aton("10.20.30.40");
+    ok(defined $sin, 'pack_sockaddr_in defined');
+
+    is(sockaddr_family($sin), AF_INET, 'sockaddr_family of pack_sockaddr_in' );
+
+    is(          (unpack_sockaddr_in($sin))[0] , 100,           'pack_sockaddr_in->unpack_sockaddr_in port');
+    is(inet_ntoa((unpack_sockaddr_in($sin))[1]), "10.20.30.40", 'pack_sockaddr_in->unpack_sockaddr_in addr');
+
+    is_deeply( [ sockaddr_in($sin) ], [ unpack_sockaddr_in($sin) ],
+        'sockaddr_in in list context unpacks' );
+
+    is(sockaddr_family(scalar sockaddr_in(200,v10.30.50.70)), AF_INET,
+        'sockaddr_in in scalar context packs');
+}
+
+# pack_sockaddr_in6, unpack_sockaddr_in6
+# sockaddr_in6
+SKIP: {
+    skip "No AF_INET6", 8 unless my $AF_INET6 = eval { Socket::AF_INET6() };
+    skip "Cannot pack_sockaddr_in6()", 8 unless my $sin6 = eval { Socket::pack_sockaddr_in6(0x1234, "0123456789abcdef", 0, 89) };
+
+    ok(defined $sin6, 'pack_sockaddr_in6 defined');
+
+    is(sockaddr_family($sin6), $AF_INET6, 'sockaddr_family of pack_sockaddr_in6');
+
+    is((Socket::unpack_sockaddr_in6($sin6))[0], 0x1234,             'pack_sockaddr_in6->unpack_sockaddr_in6 port');
+    is((Socket::unpack_sockaddr_in6($sin6))[1], "0123456789abcdef", 'pack_sockaddr_in6->unpack_sockaddr_in6 addr');
+    is((Socket::unpack_sockaddr_in6($sin6))[2], 0,                  'pack_sockaddr_in6->unpack_sockaddr_in6 scope_id');
+    is((Socket::unpack_sockaddr_in6($sin6))[3], 89,                 'pack_sockaddr_in6->unpack_sockaddr_in6 flowinfo');
+
+    is_deeply( [ Socket::sockaddr_in6($sin6) ], [ Socket::unpack_sockaddr_in6($sin6) ],
+        'sockaddr_in6 in list context unpacks' );
+
+    is(sockaddr_family(scalar Socket::sockaddr_in6(0x1357, "02468ace13579bdf")), $AF_INET6,
+        'sockaddr_in6 in scalar context packs' );
+}
+
+# sockaddr_un
+SKIP: {
+    # see if we can handle abstract sockets
+    skip "Abstract AF_UNIX paths unsupported", 2 unless $^O eq "linux";
+
+    my $test_abstract_socket = chr(0) . '/org/perl/hello'. chr(0) . 'world';
+    my $addr = sockaddr_un ($test_abstract_socket);
+    my ($path) = sockaddr_un ($addr);
+    is($path, $test_abstract_socket, 'sockaddr_un can handle abstract AF_UNIX paths');
+
+    # see if we calculate the address structure length correctly
+    is(length ($test_abstract_socket) + 2, length $addr, 'sockaddr_un abstract address length');
+}
+
+# warnings
+{
+    my $w = 0;
+    local $SIG{__WARN__} = sub {
+	++ $w if $_[0] =~ /^6-ARG sockaddr_in call is deprecated/ ;
+    };
+
+    no warnings 'Socket';
+    sockaddr_in(1,2,3,4,5,6) ;
+    is($w, 0, "sockaddr_in deprecated form doesn't warn without lexical warnings");
+
+    use warnings 'Socket';
+    sockaddr_in(1,2,3,4,5,6) ;
+    is($w, 1, "sockaddr_in deprecated form warns with lexical warnings");
+}
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index dbdd49206e..0f6fd8549e 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -99,6 +99,10 @@ XXX
 
 L<XXX> has been upgraded from version 0.69 to version 0.70.
 
+=item *
+
+L<Socket> has been upgraded from version 1.98 to version 2.000.
+
 =back
 
 =head2 Removed Modules and Pragmata