diff options
author | James E Keenan <jkeenan@cpan.org> | 2016-12-17 17:43:00 -0500 |
---|---|---|
committer | James E Keenan <jkeenan@cpan.org> | 2016-12-17 18:15:21 -0500 |
commit | 3e7b45e4a2b8308f16a5ca9443c3f6b8caafe0a6 (patch) | |
tree | 5c831b4f8b995907c7526485663e76e20e1eb1dd /cpan/Socket | |
parent | ff10d69bdea75948c1004e91f4f8117b6c6449bc (diff) | |
download | perl-3e7b45e4a2b8308f16a5ca9443c3f6b8caafe0a6.tar.gz |
Update Socket to CPAN version 2.024.
'porting/customized.t --regen' for Socket.pm and .xs
perldelta entry for Socket 2.020 to 2.024 upgrade.
Diffstat (limited to 'cpan/Socket')
-rw-r--r-- | cpan/Socket/Makefile.PL | 61 | ||||
-rw-r--r-- | cpan/Socket/Socket.pm | 48 | ||||
-rw-r--r-- | cpan/Socket/Socket.xs | 110 | ||||
-rw-r--r-- | cpan/Socket/t/getaddrinfo.t | 30 | ||||
-rw-r--r-- | cpan/Socket/t/sockaddr.t | 44 |
5 files changed, 219 insertions, 74 deletions
diff --git a/cpan/Socket/Makefile.PL b/cpan/Socket/Makefile.PL index 3bad65516d..7a6aa7186b 100644 --- a/cpan/Socket/Makefile.PL +++ b/cpan/Socket/Makefile.PL @@ -14,7 +14,7 @@ sub check_for { my %args = @_; return if $ENV{PERL_CORE}; - return if defined $Config{$args{confkey}}; + return if defined $args{confkey} and defined $Config{$args{confkey}}; require ExtUtils::CBuilder; $cb ||= ExtUtils::CBuilder->new( quiet => 1 ); @@ -77,12 +77,13 @@ sub check_for_func } my %defines = ( - # -Dfoo func() $Config{key} - HAS_GETADDRINFO => [ "getaddrinfo", "d_getaddrinfo" ], - HAS_GETNAMEINFO => [ "getnameinfo", "d_getnameinfo" ], - HAS_INET_ATON => [ "inet_aton", "d_inetaton" ], - HAS_INETNTOP => [ "inet_ntop", "d_inetntop" ], - HAS_INETPTON => [ "inet_pton", "d_inetpton" ], + # -Dfoo func() $Config{key} + HAS_GETADDRINFO => [ "getaddrinfo", "d_getaddrinfo" ], + HAS_GETNAMEINFO => [ "getnameinfo", "d_getnameinfo" ], + HAS_GAI_STRERROR => [ "gai_strerror" ], + HAS_INET_ATON => [ "inet_aton", "d_inetaton" ], + HAS_INETNTOP => [ "inet_ntop", "d_inetntop" ], + HAS_INETPTON => [ "inet_pton", "d_inetpton" ], ); foreach my $define ( sort keys %defines ) { @@ -177,20 +178,25 @@ my @names = ( IOV_MAX - IP_ADD_MEMBERSHIP IP_ADD_SOURCE_MEMBERSHIP IP_DROP_MEMBERSHIP - IP_DROP_SOURCE_MEMBERSHIP IP_HDRINCL IP_MULTICAST_IF IP_MULTICAST_LOOP - IP_MULTICAST_TTL IP_OPTIONS IP_RECVOPTS IP_RECVRETOPTS IP_RETOPTS IP_TOS - IP_TTL + IP_ADD_MEMBERSHIP IP_ADD_SOURCE_MEMBERSHIP IP_BIND_ADDRESS_NO_PORT + IP_DROP_MEMBERSHIP IP_DROP_SOURCE_MEMBERSHIP IP_FREEBIND IP_HDRINCL + IP_MULTICAST_ALL IP_MULTICAST_IF IP_MULTICAST_LOOP IP_MULTICAST_TTL + IP_MTU IP_MTU_DISCOVER IP_NODEFRAG IP_OPTIONS IP_RECVERR IP_RECVOPTS + IP_RECVRETOPTS IP_RETOPTS IP_TOS IP_TRANSPARENT IP_TTL + + IP_PMTUDISC_DO IP_PMTUDISC_DONT IP_PMTUDISC_PROBE IP_PMTUDISC_WANT IPTOS_LOWDELAY IPTOS_THROUGHPUT IPTOS_RELIABILITY IPTOS_MINCOST - IPV6_ADD_MEMBERSHIP IPV6_DROP_MEMBERSHIP IPV6_JOIN_GROUP + IPV6_ADDRFROM IPV6_ADD_MEMBERSHIP IPV6_DROP_MEMBERSHIP IPV6_JOIN_GROUP IPV6_LEAVE_GROUP IPV6_MTU IPV6_MTU_DISCOVER IPV6_MULTICAST_HOPS - IPV6_MULTICAST_IF IPV6_MULTICAST_LOOP IPV6_UNICAST_HOPS IPV6_V6ONLY + IPV6_MULTICAST_IF IPV6_MULTICAST_LOOP IPV6_RECVERR IPV6_ROUTER_ALERT + IPV6_UNICAST_HOPS IPV6_V6ONLY MSG_BCAST MSG_BTAG MSG_CTLFLAGS MSG_CTLIGNORE MSG_DONTWAIT MSG_EOF - MSG_EOR MSG_ERRQUEUE MSG_ETAG MSG_FIN MSG_MAXIOVLEN MSG_MCAST - MSG_NOSIGNAL MSG_RST MSG_SYN MSG_TRUNC MSG_URG MSG_WAITALL MSG_WIRE + MSG_EOR MSG_ERRQUEUE MSG_ETAG MSG_FASTOPEN MSG_FIN MSG_MAXIOVLEN + MSG_MCAST MSG_NOSIGNAL MSG_RST MSG_SYN MSG_TRUNC MSG_URG MSG_WAITALL + MSG_WIRE NI_DGRAM NI_IDN NI_IDN_ALLOW_UNASSIGNED NI_IDN_USE_STD3_ASCII_RULES NI_NAMEREQD NI_NOFQDN NI_NUMERICHOST NI_NUMERICSERV @@ -213,18 +219,19 @@ my @names = ( SO_ACCEPTCONN SO_ATTACH_FILTER SO_BACKLOG SO_BINDTODEVICE SO_BROADCAST SO_BSDCOMPAT SO_BUSY_POLL SO_CHAMELEON SO_DEBUG SO_DETACH_FILTER SO_DGRAM_ERRIND SO_DOMAIN SO_DONTLINGER SO_DONTROUTE SO_ERROR SO_FAMILY - SO_KEEPALIVE SO_LINGER SO_MARK SO_OOBINLINE SO_PASSCRED SO_PASSIFNAME - SO_PEEK_OFF SO_PEERCRED SO_PRIORITY 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_TIMESTAMP SO_TYPE SO_USELOOPBACK SO_XOPEN SO_XSE - - TCP_CONGESTION TCP_CONNECTIONTIMEOUT TCP_CORK TCP_DEFER_ACCEPT TCP_INFO - TCP_INIT_CWND TCP_KEEPALIVE TCP_KEEPCNT TCP_KEEPIDLE TCP_KEEPINTVL - TCP_LINGER2 TCP_MAXRT TCP_MAXSEG TCP_MD5SIG TCP_NODELAY TCP_NOOPT - TCP_NOPUSH TCP_QUICKACK TCP_SACK_ENABLE TCP_STDURG TCP_SYNCNT - TCP_WINDOW_CLAMP + SO_KEEPALIVE SO_LINGER SO_LOCK_FILTER SO_MARK SO_OOBINLINE SO_PASSCRED + SO_PASSIFNAME SO_PEEK_OFF SO_PEERCRED SO_PRIORITY SO_PROTOCOL + SO_PROTOTYPE SO_RCVBUF SO_RCVBUFFORCE SO_RCVLOWAT SO_RCVTIMEO + SO_REUSEADDR SO_REUSEPORT SO_RXQ_OVFL SO_SECURITY_AUTHENTICATION + SO_SECURITY_ENCRYPTION_NETWORK SO_SECURITY_ENCRYPTION_TRANSPORT + SO_SNDBUF SO_SNDBUFFORCE SO_SNDLOWAT SO_SNDTIMEO SO_STATE SO_TIMESTAMP + SO_TYPE SO_USELOOPBACK SO_XOPEN SO_XSE + + TCP_CONGESTION TCP_CONNECTIONTIMEOUT TCP_CORK TCP_DEFER_ACCEPT + TCP_FASTOPEN TCP_INFO TCP_INIT_CWND TCP_KEEPALIVE TCP_KEEPCNT + TCP_KEEPIDLE TCP_KEEPINTVL TCP_LINGER2 TCP_MAXRT TCP_MAXSEG + TCP_MD5SIG TCP_NODELAY TCP_NOOPT TCP_NOPUSH TCP_QUICKACK + TCP_SACK_ENABLE TCP_STDURG TCP_SYNCNT TCP_WINDOW_CLAMP UIO_MAXIOV ), diff --git a/cpan/Socket/Socket.pm b/cpan/Socket/Socket.pm index 5b187facf2..64e18ad25e 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.020_03'; # patched in perl5.git +our $VERSION = '2.024'; =head1 NAME @@ -108,6 +108,10 @@ C<SOL_SOCKET> level. Socket option name constants for IPv4 socket options at the C<IPPROTO_IP> level. +=head2 IP_PMTUDISC_WANT, IP_PMTUDISC_DONT, ... + +Socket option value contants for C<IP_MTU_DISCOVER> socket option. + =head2 IPTOS_LOWDELAY, IPTOS_THROUGHPUT, IPTOS_RELIABILITY, ... Socket option value constants for C<IP_TOS> socket option. @@ -180,6 +184,9 @@ arguments packed in and C<AF_INET> filled in. For Internet domain sockets, this structure is normally what you need for the arguments in bind(), connect(), and send(). +An undefined $port argument is taken as zero; an undefined $ip_address is +considered a fatal error. + =head2 ($port, $ip_address) = unpack_sockaddr_in $sockaddr Takes a C<sockaddr_in> structure (as returned by pack_sockaddr_in(), @@ -209,6 +216,9 @@ inet_pton()), optionally a scope ID number, and optionally a flow label number. Returns the C<sockaddr_in6> structure with those arguments packed in and C<AF_INET6> filled in. IPv6 equivalent of pack_sockaddr_in(). +An undefined $port argument is taken as zero; an undefined $ip6_address is +considered a fatal error. + =head2 ($port, $ip6_address, $scope_id, $flowinfo) = unpack_sockaddr_in6 $sockaddr Takes a C<sockaddr_in6> structure. Returns a list of four elements: the port @@ -384,7 +394,7 @@ Restrict to only generating addresses for this protocol The return value will be a list; the first value being an error indication, followed by a list of address structures (if no error occurred). -The error value will be a dualvar; comparable to the C<EI_*> error constants, +The error value will be a dualvar; comparable to the C<EAI_*> error constants, or printable as a human-readable error message string. If no error occurred it will be zero numerically and an empty string. @@ -452,7 +462,7 @@ constants, or defaults to 0 if unspecified. The return value will be a list; the first value being an error condition, followed by the hostname and service name. -The error value will be a dualvar; comparable to the C<EI_*> error constants, +The error value will be a dualvar; comparable to the C<EAI_*> error constants, or printable as a human-readable error message string. The host and service names will be plain strings. @@ -722,11 +732,11 @@ our @EXPORT = qw( SO_SECURITY_ENCRYPTION_TRANSPORT SO_SNDBUF SO_SNDLOWAT SO_SNDTIMEO SO_STATE SO_TYPE SO_USELOOPBACK SO_XOPEN SO_XSE - IP_OPTIONS IP_HDRINCL IP_TOS IP_TTL IP_RECVOPTS IP_RECVRETOPTS - IP_RETOPTS + IP_HDRINCL IP_OPTIONS IP_RECVOPTS IP_RECVRETOPTS IP_RETOPTS IP_TOS + IP_TTL MSG_BCAST MSG_BTAG MSG_CTLFLAGS MSG_CTLIGNORE MSG_CTRUNC MSG_DONTROUTE - MSG_DONTWAIT MSG_EOF MSG_EOR MSG_ERRQUEUE MSG_ETAG MSG_FIN + MSG_DONTWAIT MSG_EOF MSG_EOR MSG_ERRQUEUE MSG_ETAG MSG_FASTOPEN MSG_FIN MSG_MAXIOVLEN MSG_MCAST MSG_NOSIGNAL MSG_OOB MSG_PEEK MSG_PROXY MSG_RST MSG_SYN MSG_TRUNC MSG_URG MSG_WAITALL MSG_WIRE @@ -756,27 +766,33 @@ our @EXPORT_OK = qw( SOCK_NONBLOCK SOCK_CLOEXEC - IP_ADD_MEMBERSHIP IP_ADD_SOURCE_MEMBERSHIP IP_DROP_MEMBERSHIP - IP_DROP_SOURCE_MEMBERSHIP IP_MULTICAST_IF IP_MULTICAST_LOOP - IP_MULTICAST_TTL + IP_ADD_MEMBERSHIP IP_ADD_SOURCE_MEMBERSHIP IP_BIND_ADDRESS_NO_PORT + IP_DROP_MEMBERSHIP IP_DROP_SOURCE_MEMBERSHIP IP_FREEBIND + IP_MULTICAST_ALL IP_MULTICAST_IF IP_MULTICAST_LOOP IP_MULTICAST_TTL + IP_MTU IP_MTU_DISCOVER IP_NODEFRAG IP_RECVERR IP_TRANSPARENT IPPROTO_IP IPPROTO_IPV6 IPPROTO_RAW IPPROTO_ICMP IPPROTO_IGMP IPPROTO_TCP IPPROTO_UDP IPPROTO_GRE IPPROTO_ESP IPPROTO_AH IPPROTO_SCTP + IP_PMTUDISC_DO IP_PMTUDISC_DONT IP_PMTUDISC_PROBE IP_PMTUDISC_WANT + IPTOS_LOWDELAY IPTOS_THROUGHPUT IPTOS_RELIABILITY IPTOS_MINCOST - TCP_CONGESTION TCP_CONNECTIONTIMEOUT TCP_CORK TCP_DEFER_ACCEPT TCP_INFO - TCP_INIT_CWND TCP_KEEPALIVE TCP_KEEPCNT TCP_KEEPIDLE TCP_KEEPINTVL - TCP_LINGER2 TCP_MAXRT TCP_MAXSEG TCP_MD5SIG TCP_NODELAY TCP_NOOPT - TCP_NOPUSH TCP_QUICKACK TCP_SACK_ENABLE TCP_STDURG TCP_SYNCNT - TCP_WINDOW_CLAMP + TCP_CONGESTION TCP_CONNECTIONTIMEOUT TCP_CORK TCP_DEFER_ACCEPT + TCP_FASTOPEN TCP_INFO TCP_INIT_CWND TCP_KEEPALIVE TCP_KEEPCNT + TCP_KEEPIDLE TCP_KEEPINTVL TCP_LINGER2 TCP_MAXRT TCP_MAXSEG + TCP_MD5SIG TCP_NODELAY TCP_NOOPT TCP_NOPUSH TCP_QUICKACK + TCP_SACK_ENABLE TCP_STDURG TCP_SYNCNT TCP_WINDOW_CLAMP IN6ADDR_ANY IN6ADDR_LOOPBACK - IPV6_ADD_MEMBERSHIP IPV6_DROP_MEMBERSHIP IPV6_JOIN_GROUP + IPV6_ADDRFROM IPV6_ADD_MEMBERSHIP IPV6_DROP_MEMBERSHIP IPV6_JOIN_GROUP IPV6_LEAVE_GROUP IPV6_MTU IPV6_MTU_DISCOVER IPV6_MULTICAST_HOPS - IPV6_MULTICAST_IF IPV6_MULTICAST_LOOP IPV6_UNICAST_HOPS IPV6_V6ONLY + IPV6_MULTICAST_IF IPV6_MULTICAST_LOOP IPV6_RECVERR IPV6_ROUTER_ALERT + IPV6_UNICAST_HOPS IPV6_V6ONLY + + SO_LOCK_FILTER SO_RCVBUFFORCE SO_SNDBUFFORCE pack_ip_mreq unpack_ip_mreq pack_ip_mreq_source unpack_ip_mreq_source diff --git a/cpan/Socket/Socket.xs b/cpan/Socket/Socket.xs index 3b1d70eaf4..e44a3966af 100644 --- a/cpan/Socket/Socket.xs +++ b/cpan/Socket/Socket.xs @@ -473,6 +473,65 @@ not_here(const char *s) #include "const-c.inc" +#if defined(HAS_GETADDRINFO) && !defined(HAS_GAI_STRERROR) +static const char *gai_strerror(int err) +{ + switch (err) + { +#ifdef EAI_ADDRFAMILY + case EAI_ADDRFAMILY: + return "Address family for hostname is not supported."; +#endif +#ifdef EAI_AGAIN + case EAI_AGAIN: + return "The name could not be resolved at this time."; +#endif +#ifdef EAI_BADFLAGS + case EAI_BADFLAGS: + return "The flags parameter has an invalid value."; +#endif +#ifdef EAI_FAIL + case EAI_FAIL: + return "A non-recoverable error occurred while resolving the name."; +#endif +#ifdef EAI_FAMILY + case EAI_FAMILY: + return "The address family was not recognized or length is invalid."; +#endif +#ifdef EAI_MEMORY + case EAI_MEMORY: + return "A memory allocation failure occurred."; +#endif +#ifdef EAI_NODATA + case EAI_NODATA: + return "No address is associated with the hostname."; +#endif +#ifdef EAI_NONAME + case EAI_NONAME: + return "The name does not resolve for the supplied parameters."; +#endif +#ifdef EAI_OVERFLOW + case EAI_OVERFLOW: + return "An argument buffer overflowed."; +#endif +#ifdef EAI_SERVICE + case EAI_SERVICE: + return "The service parameter was not recognized for the specified socket type."; +#endif +#ifdef EAI_SOCKTYPE + case EAI_SOCKTYPE: + return "The specified socket type was not recognized."; +#endif +#ifdef EAI_SYSTEM + case EAI_SYSTEM: + return "A system error occurred - see errno."; +#endif + default: + return "Unknown error in getaddrinfo()."; + } +} +#endif + #ifdef HAS_GETADDRINFO static SV *err_to_SV(pTHX_ int err) { @@ -693,13 +752,13 @@ inet_aton(host) ST(0) = sv_2mortal(newSVpvn((char *)&ip_address, sizeof(ip_address))); XSRETURN(1); } - +#ifdef HAS_GETHOSTBYNAME phe = gethostbyname(host); if (phe && phe->h_addrtype == AF_INET && phe->h_length == 4) { ST(0) = sv_2mortal(newSVpvn((char *)phe->h_addr, phe->h_length)); XSRETURN(1); } - +#endif XSRETURN_UNDEF; } @@ -758,11 +817,17 @@ pack_sockaddr_un(pathname) char * pathname_pv; int addr_len; + if (!SvOK(pathname)) + croak("Undefined path for %s", "Socket::pack_sockaddr_un"); + Zero(&sun_ad, sizeof(sun_ad), char); sun_ad.sun_family = AF_UNIX; pathname_pv = SvPV(pathname,len); - if (len > sizeof(sun_ad.sun_path)) + if (len > sizeof(sun_ad.sun_path)) { + warn("Path length (%d) is longer than maximum supported length" + " (%d) and will be truncated", len, sizeof(sun_ad.sun_path)); len = sizeof(sun_ad.sun_path); + } # ifdef OS2 /* Name should start with \socket\ and contain backslashes! */ { int off; @@ -818,8 +883,11 @@ unpack_sockaddr_un(sun_sv) #ifdef I_SYS_UN struct sockaddr_un addr; STRLEN sockaddrlen; - char * sun_ad = SvPVbyte(sun_sv,sockaddrlen); - int addr_len; + char * sun_ad; + int addr_len = 0; + if (!SvOK(sun_sv)) + croak("Undefined address for %s", "Socket::unpack_sockaddr_un"); + sun_ad = SvPVbyte(sun_sv,sockaddrlen); # if defined(__linux__) || defined(HAS_SOCKADDR_SA_LEN) /* On Linux or *BSD sockaddrlen on sockets returned by accept, recvfrom, getpeername and getsockname is not equal to sizeof(addr). */ @@ -861,8 +929,8 @@ unpack_sockaddr_un(sun_sv) # else const int maxlen = (int)sizeof(addr.sun_path); # endif - for (addr_len = 0; addr_len < maxlen - && addr.sun_path[addr_len]; addr_len++); + while (addr_len < maxlen && addr.sun_path[addr_len]) + addr_len++; } ST(0) = sv_2mortal(newSVpvn(addr.sun_path, addr_len)); @@ -872,15 +940,20 @@ unpack_sockaddr_un(sun_sv) } void -pack_sockaddr_in(port, ip_address_sv) - unsigned short port +pack_sockaddr_in(port_sv, ip_address_sv) + SV * port_sv SV * ip_address_sv CODE: { struct sockaddr_in sin; struct in_addr addr; STRLEN addrlen; + unsigned short port = 0; char * ip_address; + if (SvOK(port_sv)) + port = SvUV(port_sv); + if (!SvOK(ip_address_sv)) + croak("Undefined address for %s", "Socket::pack_sockaddr_in"); if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1)) croak("Wide character in %s", "Socket::pack_sockaddr_in"); ip_address = SvPVbyte(ip_address_sv, addrlen); @@ -912,7 +985,10 @@ unpack_sockaddr_in(sin_sv) STRLEN sockaddrlen; struct sockaddr_in addr; SV *ip_address_sv; - char * sin = SvPVbyte(sin_sv,sockaddrlen); + char * sin; + if (!SvOK(sin_sv)) + croak("Undefined address for %s", "Socket::unpack_sockaddr_in"); + sin = SvPVbyte(sin_sv,sockaddrlen); if (sockaddrlen != sizeof(addr)) { croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf, "Socket::unpack_sockaddr_in", (UV)sockaddrlen, (UV)sizeof(addr)); @@ -935,17 +1011,22 @@ unpack_sockaddr_in(sin_sv) } void -pack_sockaddr_in6(port, sin6_addr, scope_id=0, flowinfo=0) - unsigned short port +pack_sockaddr_in6(port_sv, sin6_addr, scope_id=0, flowinfo=0) + SV * port_sv SV * sin6_addr unsigned long scope_id unsigned long flowinfo CODE: { #ifdef HAS_SOCKADDR_IN6 + unsigned short port = 0; struct sockaddr_in6 sin6; char * addrbytes; STRLEN addrlen; + if (SvOK(port_sv)) + port = SvUV(port_sv); + if (!SvOK(sin6_addr)) + croak("Undefined address for %s", "Socket::pack_sockaddr_in6"); if (DO_UTF8(sin6_addr) && !sv_utf8_downgrade(sin6_addr, 1)) croak("Wide character in %s", "Socket::pack_sockaddr_in6"); addrbytes = SvPVbyte(sin6_addr, addrlen); @@ -983,8 +1064,11 @@ unpack_sockaddr_in6(sin6_sv) #ifdef HAS_SOCKADDR_IN6 STRLEN addrlen; struct sockaddr_in6 sin6; - char * addrbytes = SvPVbyte(sin6_sv, addrlen); + char * addrbytes; SV *ip_address_sv; + if (!SvOK(sin6_sv)) + croak("Undefined address for %s", "Socket::unpack_sockaddr_in6"); + addrbytes = SvPVbyte(sin6_sv, addrlen); if (addrlen != sizeof(sin6)) croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf, "Socket::unpack_sockaddr_in6", (UV)addrlen, (UV)sizeof(sin6)); diff --git a/cpan/Socket/t/getaddrinfo.t b/cpan/Socket/t/getaddrinfo.t index 6f8a324dfb..b33a3e7c6e 100644 --- a/cpan/Socket/t/getaddrinfo.t +++ b/cpan/Socket/t/getaddrinfo.t @@ -22,8 +22,8 @@ ok( defined $res[0]->{addr}, '$res[0] addr is defined' ); if (length $res[0]->{addr}) { is_deeply( [ unpack_sockaddr_in $res[0]->{addr} ], - [ 80, inet_aton( "127.0.0.1" ) ], - '$res[0] addr is {"127.0.0.1", 80}' ); + [ 80, inet_aton( "127.0.0.1" ) ], + '$res[0] addr is {"127.0.0.1", 80}' ); } else { fail( '$res[0] addr is empty: check $socksizetype' ); } @@ -50,8 +50,8 @@ cmp_ok( $err, "==", 0, '$err == 0 for host=127.0.0.1/service=undef' ); cmp_ok( $err, "==", 0, '$err == 0 for host=$1' ); ok( scalar @res > 0, '@res has results' ); is( (unpack_sockaddr_in $res[0]->{addr})[1], - inet_aton( "127.0.0.1" ), - '$res[0] addr is {"127.0.0.1", ??}' ); + inet_aton( "127.0.0.1" ), + '$res[0] addr is {"127.0.0.1", ??}' ); } ( $err, @res ) = getaddrinfo( "", "80", { family => AF_INET, socktype => SOCK_STREAM, protocol => IPPROTO_TCP } ); @@ -90,13 +90,13 @@ SKIP: { # Some OSes return $err == 0 but no results ( $err, @res ) = getaddrinfo( $missinghost, "ftp", { socktype => SOCK_STREAM } ); ok( $err != 0 || ( $err == 0 && @res == 0 ), - '$err != 0 or @res == 0 for host=TbK4jM2M0OS.lm57DWIyu4i/service=ftp/socktype=SOCK_STREAM' ); + '$err != 0 or @res == 0 for host=TbK4jM2M0OS.lm57DWIyu4i/service=ftp/socktype=SOCK_STREAM' ); if( @res ) { - # Diagnostic that might help - while( my $r = shift @res ) { - diag( "family=$r->{family} socktype=$r->{socktype} protocol=$r->{protocol} addr=[" . length( $r->{addr} ) . " bytes]" ); - diag( " addr=" . join( ", ", map { sprintf '0x%02x', ord $_ } split m//, $r->{addr} ) ); - } + # Diagnostic that might help + while( my $r = shift @res ) { + diag( "family=$r->{family} socktype=$r->{socktype} protocol=$r->{protocol} addr=[" . length( $r->{addr} ) . " bytes]" ); + diag( " addr=" . join( ", ", map { sprintf '0x%02x', ord $_ } split m//, $r->{addr} ) ); + } } } @@ -112,11 +112,11 @@ AI_NUMERICHOST: { # for enabled services but that's kind of yuck, too. my @port = (80, 7, 22, 25, 88, 123, 110, 389, 443, 445, 873, 2049, 3306); foreach my $port ( @port ) { - ( $err, @res ) = getaddrinfo( "127.0.0.1", $port, { flags => AI_NUMERICHOST, socktype => SOCK_STREAM } ); - if( $err == 0 ) { - ok( $err == 0, "\$err == 0 for 127.0.0.1/$port/flags=AI_NUMERICHOST" ); - last AI_NUMERICHOST; - } + ( $err, @res ) = getaddrinfo( "127.0.0.1", $port, { flags => AI_NUMERICHOST, socktype => SOCK_STREAM } ); + if( $err == 0 ) { + ok( $err == 0, "\$err == 0 for 127.0.0.1/$port/flags=AI_NUMERICHOST" ); + last AI_NUMERICHOST; + } } fail( "$err for 127.0.0.1/$port[-1]/flags=AI_NUMERICHOST (failed for ports @port)" ); } diff --git a/cpan/Socket/t/sockaddr.t b/cpan/Socket/t/sockaddr.t index 1ae24a0bba..7492eb3dc1 100644 --- a/cpan/Socket/t/sockaddr.t +++ b/cpan/Socket/t/sockaddr.t @@ -7,10 +7,11 @@ use Socket qw( AF_INET inet_ntoa inet_aton inet_ntop inet_pton pack_sockaddr_in unpack_sockaddr_in sockaddr_in + pack_sockaddr_un unpack_sockaddr_un sockaddr_family sockaddr_un ); -use Test::More tests => 33; +use Test::More tests => 46; # inet_aton, inet_ntoa { @@ -80,6 +81,18 @@ SKIP: { is(sockaddr_family(scalar sockaddr_in(200,v10.30.50.70)), AF_INET, 'sockaddr_in in scalar context packs'); + + my $warnings = 0; + local $SIG{__WARN__} = sub { $warnings++ }; + ok( !eval { pack_sockaddr_in 0, undef; 1 }, + 'pack_sockaddr_in undef addr is fatal' ); + ok( !eval { unpack_sockaddr_in undef; 1 }, + 'unpack_sockaddr_in undef is fatal' ); + + ok( eval { pack_sockaddr_in undef, "\0\0\0\0"; 1 }, + 'pack_sockaddr_in undef port is allowed' ); + + is( $warnings, 0, 'undefined values produced no warnings' ); } # pack_sockaddr_in6, unpack_sockaddr_in6 @@ -104,12 +117,24 @@ SKIP: { is(sockaddr_family(scalar Socket::sockaddr_in6(0x1357, "02468ace13579bdf")), $AF_INET6, 'sockaddr_in6 in scalar context packs' ); + + my $warnings = 0; + local $SIG{__WARN__} = sub { $warnings++ }; + ok( !eval { Socket::pack_sockaddr_in6( 0, undef ); 1 }, + 'pack_sockaddr_in6 undef addr is fatal' ); + ok( !eval { Socket::unpack_sockaddr_in6( undef ); 1 }, + 'unpack_sockaddr_in6 undef is fatal' ); + + ok( eval { Socket::pack_sockaddr_in6( undef, "\0"x16 ); 1 }, + 'pack_sockaddr_in6 undef port is allowed' ); + + is( $warnings, 0, 'undefined values produced no warnings' ); } -# sockaddr_un +# sockaddr_un on abstract paths SKIP: { # see if we can handle abstract sockets - skip "Abstract AF_UNIX paths unsupported", 2 unless $^O eq "linux"; + skip "Abstract AF_UNIX paths unsupported", 7 unless $^O eq "linux"; my $test_abstract_socket = chr(0) . '/org/perl/hello'. chr(0) . 'world'; my $addr = sockaddr_un ($test_abstract_socket); @@ -118,6 +143,19 @@ SKIP: { # see if we calculate the address structure length correctly is(length ($test_abstract_socket) + 2, length $addr, 'sockaddr_un abstract address length'); + + my $warnings = 0; + local $SIG{__WARN__} = sub { $warnings++ }; + ok( !eval { pack_sockaddr_un( undef ); 1 }, + 'pack_sockaddr_un undef path is fatal' ); + ok( !eval { unpack_sockaddr_un( undef ); 1 }, + 'unpack_sockaddr_un undef is fatal' ); + + is( $warnings, 0, 'undefined values produced no warnings' ); + + ok( eval { pack_sockaddr_un( "x" x 0x10000 ); 1 }, + 'pack_sockaddr_un(very long path) succeeds' ) or diag( "Died: $@" ); + is( $warnings, 1, 'pack_sockaddr_in(very long path) warns' ); } # warnings |