Upgrade Socket to 2.000

4 files changed, 46 insertions, 107 deletions

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');
-}