Upgrade Socket to 2.000
authorAbigail <abigail@abigail.be>
Wed, 14 Mar 2012 00:31:45 +0000 (01:31 +0100)
committerAbigail <abigail@abigail.be>
Wed, 14 Mar 2012 01:40:05 +0000 (02:40 +0100)
MANIFEST
Porting/Maintainers.pl
cpan/Socket/Makefile.PL
cpan/Socket/Socket.pm
cpan/Socket/Socket.xs
cpan/Socket/t/Socket.t

index 86480b1..125d0bd 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2223,6 +2223,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
 cpan/Socket/t/socketpair.t             See if socketpair works
 cpan/Socket/t/Socket.t                 See if Socket works
 cpan/Socket/typemap
index 17c578e..f0fbb37 100755 (executable)
@@ -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',
     },
index ed6c210..9a8f65d 100644 (file)
@@ -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
index c6420e1..3b8ea73 100644 (file)
@@ -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
index 665553c..3999c4b 100644 (file)
@@ -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");
index b1c6748..a73f6d4 100644 (file)
@@ -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');
-}