From 3be135d8cfe01725ff3bdfcc1b4a30206a1e0ed2 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Sun, 8 Jul 2012 11:12:51 +1000 Subject: [PATCH] Upgrade Socket to 2.002 --- MANIFEST | 1 + Porting/Maintainers.pl | 2 +- cpan/Socket/Makefile.PL | 26 ++++++++++++---- cpan/Socket/Socket.pm | 38 +++++++++++++++++++---- cpan/Socket/Socket.xs | 81 +++++++++++++++++++++++++++++++++++++++++++------ cpan/Socket/t/ip_mreq.t | 29 ++++++++++++++++++ pod/perldelta.pod | 4 +++ 7 files changed, 158 insertions(+), 23 deletions(-) create mode 100644 cpan/Socket/t/ip_mreq.t diff --git a/MANIFEST b/MANIFEST index 1396660..ff1056a 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2205,6 +2205,7 @@ cpan/Socket/Socket.pm Socket extension Perl module 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/ip_mreq.t See if (un)pack_ip_mreq work 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 diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 4848bae..ca2d4e3 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -1637,7 +1637,7 @@ use File::Glob qw(:case); 'Socket' => { 'MAINTAINER' => 'pevans', - 'DISTRIBUTION' => 'PEVANS/Socket-2.001.tar.gz', + 'DISTRIBUTION' => 'PEVANS/Socket-2.002.tar.gz', 'FILES' => q[cpan/Socket], 'UPSTREAM' => 'cpan', }, diff --git a/cpan/Socket/Makefile.PL b/cpan/Socket/Makefile.PL index 9a8f65d..3be198e 100644 --- a/cpan/Socket/Makefile.PL +++ b/cpan/Socket/Makefile.PL @@ -30,10 +30,15 @@ sub check_for open( my $file_source_fh, ">", $file_source ) or die "Cannot write $file_source - $!"; print $file_source_fh <<"EOF"; #include -#include -#include -#include -#include +#ifdef WIN32 +# include +# include +#else +# include +# include +# include +# include +#endif int main(int argc, char *argv[]) { (void)argc; @@ -103,6 +108,13 @@ check_for( main => "struct sockaddr_in6 sin6; sin6.sin6_scope_id = 0;" ); +# TODO: Needs adding to perl5 core before importing dual-life again +check_for( + confkey => "d_ip_mreq", + define => "HAS_IP_MREQ", + main => "struct ip_mreq mreq; mreq.imr_multiaddr.s_addr = INADDR_ANY;" +); + check_for( confkey => "d_ipv6_mreq", define => "HAS_IPV6_MREQ", @@ -149,8 +161,9 @@ my @names = ( IOV_MAX - IP_OPTIONS IP_HDRINCL IP_TOS IP_TTL IP_RECVOPTS IP_RECVRETOPTS - IP_RETOPTS + IP_ADD_MEMBERSHIP IP_DROP_MEMBERSHIP IP_HDRINCL IP_MULTICAST_IF + IP_MULTICAST_LOOP IP_MULTICAST_TTL IP_OPTIONS IP_RECVOPTS + IP_RECVRETOPTS IP_RETOPTS IP_TOS IP_TTL IPV6_ADD_MEMBERSHIP IPV6_DROP_MEMBERSHIP IPV6_MTU IPV6_MTU_DISCOVER IPV6_MULTICAST_HOPS IPV6_MULTICAST_IF IPV6_MULTICAST_LOOP @@ -172,6 +185,7 @@ my @names = ( SCM_CONNECT SCM_CREDENTIALS SCM_CREDS SCM_TIMESTAMP SOCK_DGRAM SOCK_RAW SOCK_RDM SOCK_SEQPACKET SOCK_STREAM + SOCK_NONBLOCK SOCK_CLOEXEC SOL_SOCKET diff --git a/cpan/Socket/Socket.pm b/cpan/Socket/Socket.pm index e12d851..41f214d 100644 --- a/cpan/Socket/Socket.pm +++ b/cpan/Socket/Socket.pm @@ -3,7 +3,7 @@ package Socket; use strict; { use 5.006001; } -our $VERSION = '2.001'; +our $VERSION = '2.002'; =head1 NAME @@ -87,6 +87,13 @@ functions as sockaddr_family(). Socket type constants to use as the second argument to socket(), or the value of the C socket option. +=head2 SOCK_NONBLOCK. SOCK_CLOEXEC + +Linux-specific shortcuts to specify the C and C flags +during a C call. + + socket( my $sockh, PF_INET, SOCK_DGRAM|SOCK_NONBLOCK, 0 ) + =head2 SOL_SOCKET Socket option level constant for setsockopt() and getsockopt(). @@ -241,13 +248,25 @@ pack_sockaddr_un() or unpack_sockaddr_un() explicitly. These are only supported if your system has EFE. -=head2 $ipv6_mreq = pack_ipv6_mreq $ip6_address, $ifindex +=head2 $ip_mreq = pack_ip_mreq $multiaddr, $interface + +Takes an IPv4 multicast address and optionally an interface address (or +C). Returns the C structure with those arguments packed +in. Suitable for use with the C and C +sockopts. + +=head2 ($multiaddr, $interface) = unpack_ip_mreq $ip_mreq -Takes an IPv6 address and an interface number. Returns the C -structure with those arguments packed in. Suitable for use with the -C and C sockopts. +Takes an C structure. Returns a list of two elements; the IPv4 +multicast address and interface address. -=head2 ($ip6_address, $ifindex) = unpack_ipv6_mreq $ipv6_mreq +=head2 $ipv6_mreq = pack_ipv6_mreq $multiaddr6, $ifindex + +Takes an IPv6 multicast address and an interface number. Returns the +C structure with those arguments packed in. Suitable for use with +the C and C sockopts. + +=head2 ($multiaddr6, $ifindex) = unpack_ipv6_mreq $ipv6_mreq Takes an C structure. Returns a list of two elements; the IPv6 address and an interface number. @@ -715,6 +734,11 @@ our @EXPORT = qw( our @EXPORT_OK = qw( CR LF CRLF $CR $LF $CRLF + SOCK_NONBLOCK SOCK_CLOEXEC + + IP_ADD_MEMBERSHIP IP_DROP_MEMBERSHIP IP_MULTICAST_IF + IP_MULTICAST_LOOP IP_MULTICAST_TTL + IPPROTO_IP IPPROTO_IPV6 IPPROTO_RAW IPPROTO_ICMP IPPROTO_TCP IPPROTO_UDP @@ -729,6 +753,8 @@ our @EXPORT_OK = qw( IPV6_MULTICAST_HOPS IPV6_MULTICAST_IF IPV6_MULTICAST_LOOP IPV6_UNICAST_HOPS IPV6_V6ONLY + pack_ip_mreq unpack_ip_mreq + pack_ipv6_mreq unpack_ipv6_mreq inet_pton inet_ntop diff --git a/cpan/Socket/Socket.xs b/cpan/Socket/Socket.xs index 5ddd0e9..f22c1f3 100644 --- a/cpan/Socket/Socket.xs +++ b/cpan/Socket/Socket.xs @@ -44,6 +44,10 @@ # include #endif +#ifdef WIN32 +# include +#endif + #ifdef NETWARE NETDB_DEFINE_CONTEXT NETINET_DEFINE_CONTEXT @@ -959,27 +963,84 @@ inet_pton(af, host) #endif void -pack_ipv6_mreq(addr, interface) - SV * addr +pack_ip_mreq(multiaddr, interface=&PL_sv_undef) + SV * multiaddr + SV * interface + CODE: + { +#ifdef HAS_IP_MREQ + struct ip_mreq mreq; + char * multiaddrbytes; + char * interfacebytes; + STRLEN len; + if (DO_UTF8(multiaddr) && !sv_utf8_downgrade(multiaddr, 1)) + croak("Wide character in %s", "Socket::pack_ip_mreq"); + multiaddrbytes = SvPVbyte(multiaddr, len); + if (len != sizeof(mreq.imr_multiaddr)) + croak("Bad arg length %s, length is %"UVuf", should be %"UVuf, + "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_multiaddr)); + Zero(&mreq, sizeof(mreq), char); + Copy(multiaddrbytes, &mreq.imr_multiaddr, sizeof(mreq.imr_multiaddr), char); + if(SvOK(interface)) { + if (DO_UTF8(interface) && !sv_utf8_downgrade(interface, 1)) + croak("Wide character in %s", "Socket::pack_ip_mreq"); + interfacebytes = SvPVbyte(interface, len); + if (len != sizeof(mreq.imr_interface)) + croak("Bad arg length %s, length is %"UVuf", should be %"UVuf, + "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_interface)); + Copy(interfacebytes, &mreq.imr_interface, sizeof(mreq.imr_interface), char); + } + else + mreq.imr_interface.s_addr = INADDR_ANY; + ST(0) = sv_2mortal(newSVpvn((char *)&mreq, sizeof(mreq))); +#else + not_here("pack_ip_mreq"); +#endif + } + +void +unpack_ip_mreq(mreq_sv) + SV * mreq_sv + PPCODE: + { +#ifdef HAS_IP_MREQ + struct ip_mreq mreq; + STRLEN mreqlen; + char * mreqbytes = SvPVbyte(mreq_sv, mreqlen); + if (mreqlen != sizeof(mreq)) + croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf, + "Socket::unpack_ip_mreq", (UV)mreqlen, (UV)sizeof(mreq)); + Copy(mreqbytes, &mreq, sizeof(mreq), char); + EXTEND(SP, 2); + mPUSHp((char *)&mreq.imr_multiaddr, sizeof(mreq.imr_multiaddr)); + mPUSHp((char *)&mreq.imr_interface, sizeof(mreq.imr_interface)); +#else + not_here("unpack_ip_mreq"); +#endif + } + +void +pack_ipv6_mreq(multiaddr, interface) + SV * multiaddr unsigned int interface CODE: { #ifdef HAS_IPV6_MREQ struct ipv6_mreq mreq; - char * addrbytes; - STRLEN addrlen; - if (DO_UTF8(addr) && !sv_utf8_downgrade(addr, 1)) + char * multiaddrbytes; + STRLEN len; + if (DO_UTF8(multiaddr) && !sv_utf8_downgrade(multiaddr, 1)) croak("Wide character in %s", "Socket::pack_ipv6_mreq"); - addrbytes = SvPVbyte(addr, addrlen); - if (addrlen != sizeof(mreq.ipv6mr_multiaddr)) + multiaddrbytes = SvPVbyte(multiaddr, len); + if (len != sizeof(mreq.ipv6mr_multiaddr)) croak("Bad arg length %s, length is %"UVuf", should be %"UVuf, - "Socket::pack_ipv6_mreq", (UV)addrlen, (UV)sizeof(mreq.ipv6mr_multiaddr)); + "Socket::pack_ipv6_mreq", (UV)len, (UV)sizeof(mreq.ipv6mr_multiaddr)); Zero(&mreq, sizeof(mreq), char); - Copy(addrbytes, &mreq.ipv6mr_multiaddr, sizeof(mreq.ipv6mr_multiaddr), char); + Copy(multiaddrbytes, &mreq.ipv6mr_multiaddr, sizeof(mreq.ipv6mr_multiaddr), char); mreq.ipv6mr_interface = interface; ST(0) = sv_2mortal(newSVpvn((char *)&mreq, sizeof(mreq))); #else - ST(0) = (SV*)not_here("pack_ipv6_mreq"); + not_here("pack_ipv6_mreq"); #endif } diff --git a/cpan/Socket/t/ip_mreq.t b/cpan/Socket/t/ip_mreq.t new file mode 100644 index 0000000..f08920c --- /dev/null +++ b/cpan/Socket/t/ip_mreq.t @@ -0,0 +1,29 @@ +use strict; +use warnings; +use Test::More; + +use Socket qw( + INADDR_ANY + pack_ip_mreq unpack_ip_mreq +); + +# Check that pack/unpack_ip_mreq either croak with "Not implemented", or +# roundtrip as identity + +my $packed; +eval { + $packed = pack_ip_mreq "\xe0\0\0\1", INADDR_ANY; +}; +if( !defined $packed ) { + plan skip_all => "No pack_ip_mreq" if $@ =~ m/ not implemented /; + die $@; +} + +plan tests => 3; + +my @unpacked = unpack_ip_mreq $packed; + +is( $unpacked[0], "\xe0\0\0\1", 'unpack_ip_mreq multiaddr' ); +is( $unpacked[1], INADDR_ANY, 'unpack_ip_mreq interface' ); + +is( (unpack_ip_mreq pack_ip_mreq "\xe0\0\0\1")[1], INADDR_ANY, 'pack_ip_mreq interface defaults to INADDR_ANY' ); diff --git a/pod/perldelta.pod b/pod/perldelta.pod index c419e29..0b91132 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -138,6 +138,10 @@ Restricted hashes were not always thawed correctly [perl #73972]. Storable would croak when freezing a blessed REF object with a C method [perl #113880]. +=item * + +L has been upgraded from version 2.001 to 2.002. + =back =head2 Removed Modules and Pragmata -- 2.7.4