diff options
-rwxr-xr-x | Porting/Maintainers.pl | 2 | ||||
-rw-r--r-- | cpan/Socket/Makefile.PL | 172 | ||||
-rw-r--r-- | cpan/Socket/Socket.pm | 1052 | ||||
-rw-r--r-- | cpan/Socket/Socket.xs | 287 | ||||
-rw-r--r-- | cpan/Socket/t/Socket.t | 12 | ||||
-rw-r--r-- | cpan/Socket/t/getaddrinfo.t | 77 | ||||
-rw-r--r-- | cpan/Socket/t/getnameinfo.t | 15 | ||||
-rw-r--r-- | cpan/Socket/t/ipv6_mreq.t | 8 | ||||
-rw-r--r-- | cpan/Socket/t/socketpair.t | 238 | ||||
-rw-r--r-- | pod/perldelta.pod | 4 | ||||
-rw-r--r-- | t/porting/known_pod_issues.dat | 1 |
11 files changed, 1045 insertions, 823 deletions
diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 007af42a8b..a3a7f8a67b 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -1665,7 +1665,7 @@ use File::Glob qw(:case); 'Socket' => { 'MAINTAINER' => 'pevans', - 'DISTRIBUTION' => 'PEVANS/Socket-1.95.tar.gz', + 'DISTRIBUTION' => 'PEVANS/Socket-1.96.tar.gz', 'FILES' => q[cpan/Socket], 'UPSTREAM' => 'cpan', }, diff --git a/cpan/Socket/Makefile.PL b/cpan/Socket/Makefile.PL index 5518e33f88..bedca394c3 100644 --- a/cpan/Socket/Makefile.PL +++ b/cpan/Socket/Makefile.PL @@ -86,88 +86,100 @@ WriteMakefile( 'ExtUtils::Constant' => '0.23', }, ); -my @names = (qw(AF_802 AF_AAL AF_APPLETALK AF_CCITT AF_CHAOS AF_CTF - AF_DATAKIT AF_DECnet AF_DLI AF_ECMA AF_GOSIP AF_HYLINK - AF_IMPLINK AF_INET AF_INET6 AF_ISO AF_KEY - AF_LAST AF_LAT AF_LINK AF_MAX AF_NBS AF_NIT AF_NS - AF_OSI AF_OSINET AF_PUP AF_ROUTE AF_SNA - AF_UNIX AF_UNSPEC AF_USER AF_WAN AF_X25 - AI_ADDRCONFIG AI_ALL AI_CANONIDN AI_CANONNAME AI_IDN - AI_IDN_ALLOW_UNASSIGNED AI_IDN_USE_STD3_ASCII_RULES - AI_NUMERICHOST AI_NUMERICSERV AI_PASSIVE AI_V4MAPPED - EAI_ADDRFAMILY EAI_AGAIN EAI_BADFLAGS EAI_BADHINTS EAI_FAIL - EAI_FAMILY EAI_NODATA EAI_NONAME EAI_PROTOCOL EAI_SERVICE - EAI_SOCKTYPE EAI_SYSTEM - IOV_MAX IP_OPTIONS IP_HDRINCL IP_TOS IP_TTL IP_RECVOPTS - IP_RECVRETOPTS IP_RETOPTS - IPV6_ADD_MEMBERSHIP IPV6_DROP_MEMBERSHIP IPV6_MTU - IPV6_MTU_DISCOVER IPV6_MULTICAST_HOPS IPV6_MULTICAST_IF - IPV6_MULTICAST_LOOP 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 - NI_DGRAM NI_IDN NI_IDN_ALLOW_UNASSIGNED - NI_IDN_USE_STD3_ASCII_RULES NI_NAMEREQD NI_NOFQDN - NI_NUMERICHOST NI_NUMERICSERV - PF_802 PF_AAL PF_APPLETALK PF_CCITT PF_CHAOS PF_CTF - PF_DATAKIT PF_DECnet PF_DLI PF_ECMA PF_GOSIP PF_HYLINK - PF_IMPLINK PF_INET PF_INET6 PF_ISO PF_KEY - PF_LAST PF_LAT PF_LINK PF_MAX PF_NBS PF_NIT PF_NS - PF_OSI PF_OSINET PF_PUP PF_ROUTE PF_SNA - PF_UNIX PF_UNSPEC PF_USER PF_WAN PF_X25 - SCM_CONNECT SCM_CREDENTIALS SCM_CREDS SCM_TIMESTAMP - SOCK_DGRAM SOCK_RAW SOCK_RDM SOCK_SEQPACKET SOCK_STREAM - SOL_SOCKET 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_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 - TCP_KEEPALIVE TCP_MAXRT TCP_MAXSEG TCP_NODELAY TCP_STDURG - TCP_CORK TCP_KEEPIDLE TCP_KEEPINTVL TCP_KEEPCNT - TCP_SYNCNT TCP_LINGER2 TCP_DEFER_ACCEPT TCP_WINDOW_CLAMP - TCP_INFO TCP_QUICKACK TCP_CONGESTION TCP_MD5SIG - UIO_MAXIOV - ), - {name=>"IPPROTO_IP", type=>"IV", default=>["IV", 0]}, - {name=>"IPPROTO_IPV6", type=>"IV", default=>["IV", 41]}, - {name=>"IPPROTO_RAW", type=>"IV", default=>["IV", 255]}, - {name=>"IPPROTO_ICMP", type=>"IV", default=>["IV", 1]}, - {name=>"IPPROTO_TCP", type=>"IV", default=>["IV", 6]}, - {name=>"IPPROTO_UDP", type=>"IV", default=>["IV", 17]}, - {name=>"SHUT_RD", type=>"IV", default=>["IV", "0"]}, - {name=>"SHUT_WR", type=>"IV", default=>["IV", "1"]}, - {name=>"SHUT_RDWR", type=>"IV", default=>["IV", "2"]}, +my @names = ( + qw( + AF_802 AF_AAL AF_APPLETALK AF_CCITT AF_CHAOS AF_CTF AF_DATAKIT + AF_DECnet AF_DLI AF_ECMA AF_GOSIP AF_HYLINK AF_IMPLINK AF_INET AF_INET6 + AF_ISO AF_KEY AF_LAST AF_LAT AF_LINK AF_MAX AF_NBS AF_NIT AF_NS AF_OSI + AF_OSINET AF_PUP AF_ROUTE AF_SNA AF_UNIX AF_UNSPEC AF_USER AF_WAN + AF_X25 + + AI_ADDRCONFIG AI_ALL AI_CANONIDN AI_CANONNAME AI_IDN + AI_IDN_ALLOW_UNASSIGNED AI_IDN_USE_STD3_ASCII_RULES AI_NUMERICHOST + AI_NUMERICSERV AI_PASSIVE AI_V4MAPPED + + EAI_ADDRFAMILY EAI_AGAIN EAI_BADFLAGS EAI_BADHINTS EAI_FAIL EAI_FAMILY + EAI_NODATA EAI_NONAME EAI_PROTOCOL EAI_SERVICE EAI_SOCKTYPE EAI_SYSTEM + + IOV_MAX + + IP_OPTIONS IP_HDRINCL IP_TOS IP_TTL IP_RECVOPTS IP_RECVRETOPTS + IP_RETOPTS + + IPV6_ADD_MEMBERSHIP IPV6_DROP_MEMBERSHIP IPV6_MTU IPV6_MTU_DISCOVER + IPV6_MULTICAST_HOPS IPV6_MULTICAST_IF IPV6_MULTICAST_LOOP + 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 + + NI_DGRAM NI_IDN NI_IDN_ALLOW_UNASSIGNED NI_IDN_USE_STD3_ASCII_RULES + NI_NAMEREQD NI_NOFQDN NI_NUMERICHOST NI_NUMERICSERV + + PF_802 PF_AAL PF_APPLETALK PF_CCITT PF_CHAOS PF_CTF PF_DATAKIT + PF_DECnet PF_DLI PF_ECMA PF_GOSIP PF_HYLINK PF_IMPLINK PF_INET PF_INET6 + PF_ISO PF_KEY PF_LAST PF_LAT PF_LINK PF_MAX PF_NBS PF_NIT PF_NS PF_OSI + PF_OSINET PF_PUP PF_ROUTE PF_SNA PF_UNIX PF_UNSPEC PF_USER PF_WAN + PF_X25 + + SCM_CONNECT SCM_CREDENTIALS SCM_CREDS SCM_TIMESTAMP + + SOCK_DGRAM SOCK_RAW SOCK_RDM SOCK_SEQPACKET SOCK_STREAM + + SOL_SOCKET + + 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_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 + + TCP_KEEPALIVE TCP_MAXRT TCP_MAXSEG TCP_NODELAY TCP_STDURG TCP_CORK + TCP_KEEPIDLE TCP_KEEPINTVL TCP_KEEPCNT TCP_SYNCNT TCP_LINGER2 + TCP_DEFER_ACCEPT TCP_WINDOW_CLAMP TCP_INFO TCP_QUICKACK TCP_CONGESTION + TCP_MD5SIG + + UIO_MAXIOV + ), + {name=>"IPPROTO_IP", type=>"IV", default=>["IV", 0]}, + {name=>"IPPROTO_IPV6", type=>"IV", default=>["IV", 41]}, + {name=>"IPPROTO_RAW", type=>"IV", default=>["IV", 255]}, + {name=>"IPPROTO_ICMP", type=>"IV", default=>["IV", 1]}, + {name=>"IPPROTO_TCP", type=>"IV", default=>["IV", 6]}, + {name=>"IPPROTO_UDP", type=>"IV", default=>["IV", 17]}, + {name=>"SHUT_RD", type=>"IV", default=>["IV", "0"]}, + {name=>"SHUT_WR", type=>"IV", default=>["IV", "1"]}, + {name=>"SHUT_RDWR", type=>"IV", default=>["IV", "2"]}, ); -push @names, - {name=>$_, type=>"IV", - macro=>["#if defined($_) || defined(HAS_$_) /* might be an enum */\n", - "#endif\n"]} -foreach qw (MSG_CTRUNC MSG_DONTROUTE MSG_OOB MSG_PEEK MSG_PROXY SCM_RIGHTS); - -push @names, -{name => $_, type => "SV", - pre=>"struct in_addr ip_address; ip_address.s_addr = htonl($_);", - value => "newSVpvn_flags((char *)&ip_address,sizeof(ip_address), SVs_TEMP)",} - foreach qw(INADDR_ANY INADDR_LOOPBACK INADDR_NONE INADDR_BROADCAST); - -push @names, -{name => $_, type => "SV", - macro=>["#ifdef ${_}_INIT\n", - "#endif\n"], - pre=>"struct in6_addr ip6_address = ${_}_INIT;", - value => "newSVpvn_flags((char *)&ip6_address,sizeof(ip6_address), SVs_TEMP)",} - foreach qw(IN6ADDR_ANY IN6ADDR_LOOPBACK); +push @names, { + name => $_, + type => "IV", + macro => [ "#if defined($_) || defined(HAS_$_) /* might be an enum */\n", + "#endif\n" ] +} foreach qw (MSG_CTRUNC MSG_DONTROUTE MSG_OOB MSG_PEEK MSG_PROXY SCM_RIGHTS); + +push @names, { + name => $_, + type => "SV", + pre => "struct in_addr ip_address; ip_address.s_addr = htonl($_);", + value => "newSVpvn_flags((char *)&ip_address,sizeof(ip_address), SVs_TEMP)", +} foreach qw(INADDR_ANY INADDR_LOOPBACK INADDR_NONE INADDR_BROADCAST); + +push @names, { + name => $_, + type => "SV", + macro => [ "#ifdef ${_}_INIT\n", + "#endif\n" ], + pre => "struct in6_addr ip6_address = ${_}_INIT;", + value => "newSVpvn_flags((char *)&ip6_address,sizeof(ip6_address), SVs_TEMP)", +} foreach qw(IN6ADDR_ANY IN6ADDR_LOOPBACK); WriteConstants( PROXYSUBS => {autoload => 1}, diff --git a/cpan/Socket/Socket.pm b/cpan/Socket/Socket.pm index 2cf8687c76..25eb5f3e6f 100644 --- a/cpan/Socket/Socket.pm +++ b/cpan/Socket/Socket.pm @@ -2,241 +2,330 @@ package Socket; use strict; -our($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); -$VERSION = "1.95"; +our $VERSION = '1.96'; =head1 NAME -Socket, sockaddr_in, sockaddr_un, inet_aton, inet_ntoa, inet_pton, inet_ntop - load the C socket.h defines and structure manipulators +C<Socket> - networking constants and support functions =head1 SYNOPSIS - use Socket; - - $proto = getprotobyname('udp'); - socket(Socket_Handle, PF_INET, SOCK_DGRAM, $proto); - $iaddr = gethostbyname('hishost.com'); - $port = getservbyname('time', 'udp'); - $sin = sockaddr_in($port, $iaddr); - send(Socket_Handle, 0, 0, $sin); - - $proto = getprotobyname('tcp'); - socket(Socket_Handle, PF_INET, SOCK_STREAM, $proto); - $port = getservbyname('smtp', 'tcp'); - $sin = sockaddr_in($port,inet_aton("127.1")); - $sin = sockaddr_in(7,inet_aton("localhost")); - $sin = sockaddr_in(7,INADDR_LOOPBACK); - connect(Socket_Handle,$sin); - - ($port, $iaddr) = sockaddr_in(getpeername(Socket_Handle)); - $peer_host = gethostbyaddr($iaddr, AF_INET); - $peer_addr = inet_ntoa($iaddr); - - $proto = getprotobyname('tcp'); - socket(Socket_Handle, PF_UNIX, SOCK_STREAM, $proto); - unlink('/var/run/usock'); - $sun = sockaddr_un('/var/run/usock'); - connect(Socket_Handle,$sun); +C<Socket> a low-level module used by, among other things, the L<IO::Socket> +family of modules. The following examples demonstrate some low-level uses but +a practical program would likely use the higher-level API provided by +C<IO::Socket> or similar instead. + + use Socket qw(PF_INET SOCK_STREAM pack_sockaddr_in inet_aton); + + socket(my $socket, PF_INET, SOCK_STREAM, 0) + or die "socket: $!"; + + my $port = getservbyname "echo", "tcp"; + connect($socket, pack_sockaddr_in($port, inet_aton("localhost"))) + or die "connect: $!"; + + print $socket "Hello, world!\n"; + print <$socket>; + +See also the L</EXAMPLES> section. =head1 DESCRIPTION -This module is just a translation of the C F<socket.h> file. -Unlike the old mechanism of requiring a translated F<socket.ph> -file, this uses the B<h2xs> program (see the Perl source distribution) -and your native C compiler. This means that it has a -far more likely chance of getting the numbers right. This includes -all of the commonly used pound-defines like AF_INET, SOCK_STREAM, etc. +This module provides a variety of constants, structure manipulators and other +functions related to socket-based networking. The values and functions +provided are useful when used in conjunction with Perl core functions such as +socket(), setsockopt() and bind(). It also provides several other support +functions, mostly for dealing with conversions of network addresses between +human-readable and native binary forms, and for hostname resolver operations. -Also, some common socket "newline" constants are provided: the -constants C<CR>, C<LF>, and C<CRLF>, as well as C<$CR>, C<$LF>, and -C<$CRLF>, which map to C<\015>, C<\012>, and C<\015\012>. If you do -not want to use the literal characters in your programs, then use -the constants provided here. They are not exported by default, but can -be imported individually, and with the C<:crlf> export tag: +Some constants and functions are exported by default by this module; but for +backward-compatibility any recently-added symbols are not exported by default +and must be requested explicitly. When an import list is provided to the +C<use Socket> line, the default exports are not automatically imported. It is +therefore best practice to always to explicitly list all the symbols required. - use Socket qw(:DEFAULT :crlf); +Also, some common socket "newline" constants are provided: the constants +C<CR>, C<LF>, and C<CRLF>, as well as C<$CR>, C<$LF>, and C<$CRLF>, which map +to C<\015>, C<\012>, and C<\015\012>. If you do not want to use the literal +characters in your programs, then use the constants provided here. They are +not exported by default, but can be imported individually, and with the +C<:crlf> export tag: -In addition, some structure manipulation functions are available: + use Socket qw(:DEFAULT :crlf); -=over 4 + $sock->print("GET / HTTP/1.0$CRLF"); -=item inet_aton HOSTNAME +The entire getaddrinfo() subsystem can be exported using the tag C<:addrinfo>; +this exports the getaddrinfo() and getnameinfo() functions, and all the +C<AI_*>, C<NI_*>, C<NIx_*> and C<EAI_*> constants. -Takes a string giving the name of a host, and translates that to an -opaque string (if programming in C, struct in_addr). Takes arguments -of both the 'rtfm.mit.edu' type and '18.181.0.24'. If the host name -cannot be resolved, returns undef. For multi-homed hosts (hosts with -more than one address), the first address found is returned. +=cut -For portability do not assume that the result of inet_aton() is 32 -bits wide, in other words, that it would contain only the IPv4 address -in network order. +=head1 CONSTANTS -=item inet_ntoa IP_ADDRESS +In each of the following groups, there may be many more constants provided +than just the ones given as examples in the section heading. If the heading +ends C<...> then this means there are likely more; the exact constants +provided will depend on the OS and headers found at compile-time. -Takes a string (an opaque string as returned by inet_aton(), -or a v-string representing the four octets of the IPv4 address in -network order) and translates it into a string of the form 'd.d.d.d' -where the 'd's are numbers less than 256 (the normal human-readable -four dotted number notation for Internet addresses). +=cut -=item INADDR_ANY +=head2 PF_INET, PF_INET6, PF_UNIX, ... -Note: does not return a number, but a packed string. +Protocol family constants to use as the first argument to socket() or the +value of the C<SO_FAMILY> socket option. -Returns the 4-byte wildcard ip address which specifies any -of the hosts ip addresses. (A particular machine can have -more than one ip address, each address corresponding to -a particular network interface. This wildcard address -allows you to bind to all of them simultaneously.) -Normally equivalent to inet_aton('0.0.0.0'). +=head2 AF_INET, AF_INET6, AF_UNIX, ... -=item INADDR_BROADCAST +Address family constants used by the socket address structures, to pass to +such functions as inet_pton() or getaddrinfo(), or are returned by such +functions as sockaddr_family(). -Note: does not return a number, but a packed string. +=head2 SOCK_STREAM, SOCK_DGRAM, SOCK_RAW, ... -Returns the 4-byte 'this-lan' ip broadcast address. -This can be useful for some protocols to solicit information -from all servers on the same LAN cable. -Normally equivalent to inet_aton('255.255.255.255'). +Socket type constants to use as the second argument to socket(), or the value +of the C<SO_TYPE> socket option. -=item INADDR_LOOPBACK +=head2 SOL_SOCKET -Note - does not return a number. +Socket option level constant for setsockopt() and getsockopt(). -Returns the 4-byte loopback address. Normally equivalent -to inet_aton('localhost'). +=head2 SO_ACCEPTCONN, SO_BROADCAST, SO_ERROR, ... -=item INADDR_NONE +Socket option name constants for setsockopt() and getsockopt() at the +C<SOL_SOCKET> level. -Note - does not return a number. +=head2 IP_OPTIONS, IP_TOS, IP_TTL, ... -Returns the 4-byte 'invalid' ip address. Normally equivalent -to inet_aton('255.255.255.255'). +Socket option name constants for IPv4 socket options at the C<IPPROTO_IP> +level. -=item IN6ADDR_ANY +=head2 MSG_BCAST, MSG_OOB, MSG_TRUNC, ... -Returns the 16-byte wildcard IPv6 address. Normally equivalent -to inet_pton(AF_INET6, "::") +Message flag constants for send() and recv(). -=item IN6ADDR_LOOPBACK +=head2 SHUT_RD, SHUT_RDWR, SHUT_WR -Returns the 16-byte loopback IPv6 address. Normally equivalent -to inet_pton(AF_INET6, "::1") +Direction constants for shutdown(). -=item sockaddr_family SOCKADDR +=head2 INADDR_ANY, INADDR_BROADCAST, INADDR_LOOPBACK, INADDR_NONE -Takes a sockaddr structure (as returned by pack_sockaddr_in(), -pack_sockaddr_un() or the perl builtin functions getsockname() and -getpeername()) and returns the address family tag. It will match the -constant AF_INET for a sockaddr_in and AF_UNIX for a sockaddr_un. It -can be used to figure out what unpacker to use for a sockaddr of -unknown type. +Constants giving the special C<AF_INET> addresses for wildcard, broadcast, +local loopback, and invalid addresses. + +Normally equivalent to inet_aton('0.0.0.0'), inet_aton('255.255.255.255'), +inet_aton('localhost') and inet_aton('255.255.255.255') respectively. + +=head2 IPPROTO_IP, IPPROTO_IPV6, IPPROTO_TCP, ... + +IP protocol constants to use as the third argument to socket(), the level +argument to getsockopt() or setsockopt(), or the value of the C<SO_PROTOCOL> +socket option. + +=head2 TCP_CORK, TCP_KEEPALIVE, TCP_NODELAY, ... + +Socket option name constants for TCP socket options at the C<IPPROTO_TCP> +level. + +=head2 IN6ADDR_ANY, IN6ADDR_LOOPBACK + +Constants giving the special C<AF_INET6> addresses for wildcard and local +loopback. + +Normally equivalent to inet_pton(AF_INET6, "::") and +inet_pton(AF_INET6, "::1") respectively. + +=head2 IPV6_ADD_MEMBERSHIP, IPV6_MTU, IPV6_V6ONLY, ... + +Socket option name constants for IPv6 socket options at the C<IPPROTO_IPV6> +level. + +=cut + +# Still undocumented: SCM_*, SOMAXCONN, IOV_MAX, UIO_MAXIOV + +=head1 STRUCTURE MANIPULATORS + +The following functions convert between lists of Perl values and packed binary +strings representing structures. + +=cut -=item sockaddr_in PORT, ADDRESS +=head2 $family = sockaddr_family $sockaddr -=item sockaddr_in SOCKADDR_IN +Takes a packed socket address (as returned by pack_sockaddr_in(), +pack_sockaddr_un() or the perl builtin functions getsockname() and +getpeername()). Returns the address family tag. This will be one of the +C<AF_*> constants, such as C<AF_INET> for a C<sockaddr_in> addresses or +C<AF_UNIX> for a C<sockaddr_un>. It can be used to figure out what unpack to +use for a sockaddr of unknown type. -In a list context, unpacks its SOCKADDR_IN argument and returns an array -consisting of (PORT, ADDRESS). In a scalar context, packs its (PORT, -ADDRESS) arguments as a SOCKADDR_IN and returns it. If this is confusing, -use pack_sockaddr_in() and unpack_sockaddr_in() explicitly. +=head2 $sockaddr = pack_sockaddr_in $port, $ip_address -=item pack_sockaddr_in PORT, IP_ADDRESS +Takes two arguments, a port number and an opaque string (as returned by +inet_aton(), or a v-string). Returns the C<sockaddr_in> structure with those +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(). -Takes two arguments, a port number and an opaque string, IP_ADDRESS -(as returned by inet_aton(), or a v-string). Returns the sockaddr_in -structure with those arguments packed in with AF_INET filled in. For -Internet domain sockets, this structure is normally what you need for -the arguments in bind(), connect(), and send(), and is also returned -by getpeername(), getsockname() and recv(). +=head2 ($port, $ip_address) = unpack_sockaddr_in $sockaddr -=item unpack_sockaddr_in SOCKADDR_IN +Takes a C<sockaddr_in> structure (as returned by pack_sockaddr_in(), +getpeername() or recv()). Returns a list of two elements: the port and an +opaque string representing the IP address (you can use inet_ntoa() to convert +the address to the four-dotted numeric format). Will croak if the structure +does not represent an C<AF_INET> address. -Takes a sockaddr_in structure (as returned by pack_sockaddr_in()) and -returns an array of two elements: the port and an opaque string -representing the IP address (you can use inet_ntoa() to convert the -address to the four-dotted numeric format). Will croak if the -structure does not have AF_INET in the right place. +=head2 $sockaddr = sockaddr_in $port, $ip_address -=item sockaddr_in6 PORT, IP6_ADDRESS, [ SCOPE_ID, [ FLOWINFO ] ] +=head2 ($port, $ip_address) = sockaddr_in $sockaddr -=item sockaddr_in6 SOCKADDR_IN6 +A wrapper of pack_sockaddr_in() or unpack_sockaddr_in(). In list context, +unpacks its argument and returns a list consisting of the port and IP address. +In scalar context, packs its port and IP address arguments as a C<sockaddr_in> +and returns it. -In list context, unpacks its SOCKADDR_IN6 argument according to -unpack_sockaddr_in6(). In scalar context, packs its arguments according to -pack_sockaddr_in6(). +Provided largely for legacy compatibility; it is better to use +pack_sockaddr_in() or unpack_sockaddr_in() explicitly. -=item pack_sockaddr_in6 PORT, IP6_ADDRESS, [ SCOPE_ID, [ FLOWINFO ] ] +=head2 $sockaddr = pack_sockaddr_in6 $port, $ip6_address, [$scope_id, [$flowinfo]] Takes two to four arguments, a port number, an opaque string (as returned by inet_pton()), optionally a scope ID number, and optionally a flow label -number. Returns the sockaddr_in6 structure with those arguments packed in -with AF_INET6 filled in. IPv6 equivalent of pack_sockaddr_in(). +number. Returns the C<sockaddr_in6> structure with those arguments packed in +and C<AF_INET6> filled in. IPv6 equivalent of pack_sockaddr_in(). + +=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 +number, an opaque string representing the IPv6 address, the scope ID, and the +flow label. (You can use inet_ntop() to convert the address to the usual +string format). Will croak if the structure does not represent an C<AF_INET6> +address. + +=head2 $sockaddr = sockaddr_in6 $port, $ip6_address, [$scope_id, [$flowinfo]] + +=head2 ($port, $ip6_address, $scope_id, $flowinfo) = sockaddr_in6 $sockaddr + +A wrapper of pack_sockaddr_in6() or unpack_sockaddr_in6(). In list context, +unpacks its argument according to unpack_sockaddr_in6(). In scalar context, +packs its arguments according to pack_sockaddr_in6(). + +Provided largely for legacy compatibility; it is better to use +pack_sockaddr_in6() or unpack_sockaddr_in6() explicitly. + +=head2 $sockaddr = pack_sockaddr_un $path + +Takes one argument, a pathname. Returns the C<sockaddr_un> structure with that +path packed in with C<AF_UNIX> filled in. For C<PF_UNIX> sockets, this +structure is normally what you need for the arguments in bind(), connect(), +and send(). + +=head2 ($path) = unpack_sockaddr_un $sockaddr + +Takes a C<sockaddr_un> structure (as returned by pack_sockaddr_un(), +getpeername() or recv()). Returns a list of one element: the pathname. Will +croak if the structure does not represent an C<AF_UNIX> address. -=item unpack_sockaddr_in6 SOCKADDR_IN6 +=head2 $sockaddr = sockaddr_un $path -Takes a sockaddr_in6 structure (as returned by pack_sockaddr_in6()) and -returns an array of four elements: the port number, an opaque string -representing the IPv6 address, the scope ID, and the flow label. (You can -use inet_ntop() to convert the address to the usual string format). Will -croak if the structure does not have AF_INET6 in the right place. +=head2 ($path) = sockaddr_un $sockaddr -=item sockaddr_un PATHNAME +A wrapper of pack_sockaddr_un() or unpack_sockaddr_un(). In a list context, +unpacks its argument and returns a list consisting of the pathname. In a +scalar context, packs its pathname as a C<sockaddr_un> and returns it. -=item sockaddr_un SOCKADDR_UN +Provided largely for legacy compatibility; it is better to use +pack_sockaddr_un() or unpack_sockaddr_un() explicitly. -In a list context, unpacks its SOCKADDR_UN argument and returns an array -consisting of (PATHNAME). In a scalar context, packs its PATHNAME -arguments as a SOCKADDR_UN and returns it. If this is confusing, use -pack_sockaddr_un() and unpack_sockaddr_un() explicitly. These are only supported if your system has E<lt>F<sys/un.h>E<gt>. -=item pack_sockaddr_un PATH +=head2 $ipv6_mreq = pack_ipv6_mreq $ip6_address, $ifindex + +Takes an IPv6 address and an interface number. Returns the C<ipv6_mreq> +structure with those arguments packed in. Suitable for use with the +C<IPV6_ADD_MEMBERSHIP> and C<IPV6_DROP_MEMBERSHIP> sockopts. + +=head2 ($ip6_address, $ifindex) = unpack_ipv6_mreq $ipv6_mreq + +Takes an C<ipv6_mreq> structure. Returns a list of two elements; the IPv6 +address and an interface number. + +=cut + +=head1 FUNCTIONS + +=cut + +=head2 $ip_address = inet_aton $string + +Takes a string giving the name of a host, or a textual representation of an IP +address and translates that to an packed binary address structure suitable to +pass to pack_sockaddr_in(). If passed a hostname that cannot be resolved, +returns C<undef>. For multi-homed hosts (hosts with more than one address), +the first address found is returned. -Takes one argument, a pathname. Returns the sockaddr_un structure with -that path packed in with AF_UNIX filled in. For unix domain sockets, this -structure is normally what you need for the arguments in bind(), -connect(), and send(), and is also returned by getpeername(), -getsockname() and recv(). +For portability do not assume that the result of inet_aton() is 32 bits wide, +in other words, that it would contain only the IPv4 address in network order. -=item unpack_sockaddr_un SOCKADDR_UN +This IPv4-only function is provided largely for legacy reasons. Newly-written +code should use getaddrinfo() or inet_pton() instead for IPv6 support. -Takes a sockaddr_un structure (as returned by pack_sockaddr_un()) -and returns the pathname. Will croak if the structure does not -have AF_UNIX in the right place. +=head2 $string = inet_ntoa $ip_address -=item inet_pton ADDRESS_FAMILY, HOSTNAME +Takes a packed binary address structure such as returned by +unpack_sockaddr_in() (or a v-string representing the four octets of the IPv4 +address in network order) and translates it into a string of the form +C<d.d.d.d> where the C<d>s are numbers less than 256 (the normal +human-readable four dotted number notation for Internet addresses). -Takes an address family, either AF_INET or AF_INET6, and a string giving -the name of a host, and translates that to an opaque string -(if programming in C, struct in_addr or struct in6_addr depending on the -address family passed in). The host string may be a string hostname, such -as 'www.perl.org', or an IP address. If using an IP address, the type of -IP address must be consistent with the address family passed into the function. +This IPv4-only function is provided largely for legacy reasons. Newly-written +code should use getnameinfo() or inet_ntop() instead for IPv6 support. -This function is not exported by default. +=head2 $address = inet_pton $family, $string -=item inet_ntop ADDRESS_FAMILY, IP_ADDRESS +Takes an address family (such as C<AF_INET> or C<AF_INET6>) and a string +giving the name of a host, or a textual representation of an IP address and +translates that to an packed binary address structure. -Takes an address family, either AF_INET or AF_INET6, and a string -(an opaque string as returned by inet_aton() or inet_pton()) and -translates it to an IPv4 or IPv6 address string. +See also getaddrinfo() for a more powerful and flexible function to look up +socket addresses given hostnames or textual addresses. -This function is not exported by default. +=head2 $string = inet_ntop $family, $address -=item getaddrinfo HOST, SERVICE, [ HINTS ] +Takes an address family and a packed binary address structure and translates +it into a human-readable textual representation of the address; typically in +C<d.d.d.d> form for C<AF_INET> or C<hhhh:hhhh::hhhh> form for C<AF_INET6>. -Given at least one of a hostname and a service name, returns a list of address -structures to listen on or connect to. HOST and SERVICE should be plain -strings (or a numerical port number for SERVICE). If present, HINTS should be -a reference to a HASH, where the following keys are recognised: +See also getnameinfo() for a more powerful and flexible function to turn +socket addresses into human-readable textual representations. -=over 8 +=head2 ($err, @result) = getaddrinfo $host, $service, [$hints] + +Given both a hostname and service name, this function attempts to resolve the +host name into a list of network addresses, and the service name into a +protocol and port number, and then returns a list of address structures +suitable to connect() to it. + +Given just a host name, this function attempts to resolve it to a list of +network addresses, and then returns a list of address structures giving these +addresses. + +Given just a service name, this function attempts to resolve it to a protocol +and port number, and then returns a list of address structures that represent +it suitable to bind() to. This use should be combined with the C<AI_PASSIVE> +flag; see below. + +Given neither name, it generates an error. + +If present, $hints should be a reference to a hash, where the following keys +are recognised: + +=over 4 =item flags => INT -A bitfield containing C<AI_*> constants +A bitfield containing C<AI_*> constants; see below. =item family => INT @@ -253,31 +342,33 @@ Restrict to only generating addresses for this protocol =back The return value will be a list; the first value being an error indication, -followed by a list of address structures (if no error occured). - - my ( $err, @results ) = getaddrinfo( ... ); +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, -or printable as a human-readable error message string. Each value in the -results list will be a HASH reference containing the following fields: +or printable as a human-readable error message string. If no error occurred it +will be zero numerically and an empty string. + +Each value in the results list will be a hash reference containing the following +fields: -=over 8 +=over 4 =item family => INT -The address family (e.g. AF_INET) +The address family (e.g. C<AF_INET>) =item socktype => INT -The socket type (e.g. SOCK_STREAM) +The socket type (e.g. C<SOCK_STREAM>) =item protocol => INT -The protocol (e.g. IPPROTO_TCP) +The protocol (e.g. C<IPPROTO_TCP>) =item addr => STRING -The address in a packed string (such as would be returned by pack_sockaddr_in) +The address in a packed string (such as would be returned by +pack_sockaddr_in()) =item canonname => STRING @@ -287,303 +378,390 @@ address. =back -=item getnameinfo ADDR, FLAGS +The following flag constants are recognised in the $hints hash. Other flag +constants may exist as provided by the OS. + +=over 4 + +=item AI_PASSIVE -Given a packed socket address (such as from C<getsockname>, C<getpeername>, or -returned by C<getaddrinfo> in a C<addr> field), returns the hostname and -symbolic service name it represents. FLAGS may be a bitmask of C<NI_*> +Indicates that this resolution is for a local bind() for a passive (i.e. +listening) socket, rather than an active (i.e. connecting) socket. + +=item AI_CANONNAME + +Indicates that the caller wishes the canonical hostname (C<canonname>) field +of the result to be filled in. + +=item AI_NUMERICHOST + +Indicates that the caller will pass a numeric address, rather than a hostname, +and that getaddrinfo() must not perform a resolve operation on this name. This +flag will prevent a possibly-slow network lookup operation, and instead return +an error if a hostname is passed. + +=back + +=head2 ($err, $hostname, $servicename) = getnameinfo $sockaddr, [$flags, [$xflags]] + +Given a packed socket address (such as from getsockname(), getpeername(), or +returned by getaddrinfo() in a C<addr> field), returns the hostname and +symbolic service name it represents. $flags may be a bitmask of C<NI_*> 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. - my ( $err, $host, $service ) = getnameinfo( ... ); - The error value will be a dualvar; comparable to the C<EI_*> error constants, or printable as a human-readable error message string. The host and service names will be plain strings. +The following flag constants are recognised as $flags. Other flag constants may +exist as provided by the OS. + +=over 4 + +=item NI_NUMERICHOST + +Requests that a human-readable string representation of the numeric address be +returned directly, rather than performing a name resolve operation that may +convert it into a hostname. This will also avoid potentially-blocking network +IO. + +=item NI_NUMERICSERV + +Requests that the port number be returned directly as a number representation +rather than performing a name resolve operation that may convert it into a +service name. + +=item NI_NAMEREQD + +If a name resolve operation fails to provide a name, then this flag will cause +getnameinfo() to indicate an error, rather than returning the numeric +representation as a human-readable string. + +=item NI_DGRAM + +Indicates that the socket address relates to a C<SOCK_DGRAM> socket, for the +services whose name differs between TCP and UDP protocols. + =back -=over 8 +The following constants may be supplied as $xflags. + +=over 4 -=item pack_ipv6_mreq IP6_MULTIADDR, INTERFACE +=item NIx_NOHOST -Takes an IPv6 address and an interface number. Returns the ipv6_mreq structure -with those arguments packed in. Suitable for use with the -C<IPV6_ADD_MEMBERSHIP> and C<IPV6_DROP_MEMBERSHIP> sockopts. +Indicates that the caller is not interested in the hostname of the result, so +it does not have to be converted. C<undef> will be returned as the hostname. -=item unpack_ipv6_mreq IPV6_MREQ +=item NIx_NOSERV -Takes an ipv6_mreq structure and returns a list of two elements; the IPv6 -address and an interface number. +Indicates that the caller is not interested in the service name of the result, +so it does not have to be converted. C<undef> will be returned as the service +name. + +=back + +=head1 getaddrinfo() / getnameinfo() ERROR CONSTANTS + +The following constants may be returned by getaddrinfo() or getnameinfo(). +Others may be provided by the OS. + +=over 4 + +=item EAI_AGAIN + +A temporary failure occurred during name resolution. The operation may be +successful if it is retried later. + +=item EAI_BADFLAGS + +The value of the C<flags> hint to getaddrinfo(), or the $flags parameter to +getnameinfo() contains unrecognised flags. + +=item EAI_FAMILY + +The C<family> hint to getaddrinfo(), or the family of the socket address +passed to getnameinfo() is not supported. + +=item EAI_NODATA + +The host name supplied to getaddrinfo() did not provide any usable address +data. + +=item EAI_NONAME + +The host name supplied to getaddrinfo() does not exist, or the address +supplied to getnameinfo() is not associated with a host name and the +C<NI_NAMEREQD> flag was supplied. + +=item EAI_SERVICE + +The service name supplied to getaddrinfo() is not available for the socket +type given in the $hints. =back =cut +=head1 EXAMPLES + +=head2 Lookup for connect() + +The getaddrinfo() function converts a hostname and a service name into a list +of structures, each containing a potential way to connect() to the named +service on the named host. + + use IO::Socket; + use Socket qw(SOCK_STREAM getaddrinfo); + + my %hints = (socktype => SOCK_STREAM); + my ($err, @res) = getaddrinfo("localhost", "echo", \%hints); + die "Cannot getaddrinfo - $err" if $err; + + my $sock; + + foreach my $ai (@res) { + my $candidate = IO::Socket->new(); + + $candidate->socket($ai->{family}, $ai->{socktype}, $ai->{protocol}) + or next; + + $candidate->connect($ai->{addr}) + or next; + + $sock = $candidate; + last; + } + + die "Cannot connect to localhost:echo" unless $sock; + + $sock->print("Hello, world!\n"); + print <$sock>; + +Because a list of potential candidates is returned, the C<while> loop tries +each in turn until it it finds one that succeeds both the socket() and +connect() calls. + +This function performs the work of the legacy functions gethostbyname(), +getservbyname(), inet_aton() and pack_sockaddr_in(). + +In practice this logic is better performed by L<IO::Socket::IP>. + +=head2 Making a human-readable string out of an address + +The getnameinfo() function converts a socket address, such as returned by +getsockname() or getpeername(), into a pair of human-readable strings +representing the address and service name. + + use IO::Socket::IP; + use Socket qw(getnameinfo); + + my $server = IO::Socket::IP->new(LocalPort => 12345, Listen => 1) or + die "Cannot listen - $@"; + + my $socket = $server->accept or die "accept: $!"; + + my ($err, $hostname, $servicename) = getnameinfo($socket->peername); + die "Cannot getnameinfo - $err" if $err; + + print "The peer is connected from $hostname\n"; + +Since in this example only the hostname was used, the redundant conversion of +the port number into a service name may be omitted by passing the +C<NIx_NOSERV> flag. + + use Socket qw(getnameinfo NIx_NOSERV); + + my ($err, $hostname) = getnameinfo($socket->peername, 0, NIx_NOSERV); + +This function performs the work of the legacy functions unpack_sockaddr_in(), +inet_ntoa(), gethostbyaddr() and getservbyport(). + +In practice this logic is better performed by L<IO::Socket::IP>. + +=head2 Resolving hostnames into IP addresses + +To turn a hostname into a human-readable plain IP address use getaddrinfo() +to turn the hostname into a list of socket structures, then getnameinfo() on +each one to make it a readable IP address again. + + use Socket qw(:addrinfo SOCK_RAW); + + my ($err, @res) = getaddrinfo($hostname, "", {socktype => SOCK_RAW}); + die "Cannot getaddrinfo - $err" if $err; + + while( my $ai = shift @res ) { + my ($err, $ipaddr) = getnameinfo($ai->{addr}, NI_NUMERICHOST, NIx_NOSERV); + die "Cannot getnameinfo - $err" if $err; + + print "$ipaddr\n"; + } + +The C<socktype> hint to getaddrinfo() filters the results to only include one +socket type and protocol. Without this most OSes return three combinations, +for C<SOCK_STREAM>, C<SOCK_DGRAM> and C<SOCK_RAW>, resulting in triplicate +output of addresses. The C<NI_NUMERICHOST> flag to getnameinfo() causes it to +return a string-formatted plain IP address, rather than reverse resolving it +back into a hostname. + +This combination performs the work of the legacy functions gethostbyname() +and inet_ntoa(). + +=head2 Accessing socket options + +The many C<SO_*> and other constants provide the socket option names for +getsockopt() and setsockopt(). + + use IO::Socket::INET; + use Socket qw(SOL_SOCKET SO_RCVBUF IPPROTO_IP IP_TTL); + + my $socket = IO::Socket::INET->new(LocalPort => 0, Proto => 'udp') + or die "Cannot create socket: $@"; + + $socket->setsockopt(SOL_SOCKET, SO_RCVBUF, 64*1024) or + die "setsockopt: $!"; + + print "Receive buffer is ", $socket->getsockopt(SOL_SOCKET, SO_RCVBUF), + " bytes\n"; + + print "IP TTL is ", $socket->getsockopt(IPPROTO_IP, IP_TTL), "\n"; + +As a convenience, L<IO::Socket>'s setsockopt() method will convert a number +into a packed byte buffer, and getsockopt() will unpack a byte buffer of the +correct size back into a number. + +=cut + +=head1 AUTHOR + +This module was originally maintained in Perl core by the Perl 5 Porters. + +It was extracted to dual-life on CPAN at version 1.95 by +Paul Evans <leonerd@leonerd.org.uk> + +=cut + use Carp; use warnings::register; require Exporter; require XSLoader; -@ISA = qw(Exporter); +our @ISA = qw(Exporter); # <@Nicholas> you can't change @EXPORT without breaking the implicit API # Please put any new constants in @EXPORT_OK! -@EXPORT = qw( - inet_aton inet_ntoa - sockaddr_family - pack_sockaddr_in unpack_sockaddr_in - pack_sockaddr_un unpack_sockaddr_un - pack_sockaddr_in6 unpack_sockaddr_in6 - sockaddr_in sockaddr_in6 sockaddr_un - INADDR_ANY INADDR_BROADCAST INADDR_LOOPBACK INADDR_NONE - AF_802 - AF_AAL - AF_APPLETALK - AF_CCITT - AF_CHAOS - AF_CTF - AF_DATAKIT - AF_DECnet - AF_DLI - AF_ECMA - AF_GOSIP - AF_HYLINK - AF_IMPLINK - AF_INET - AF_INET6 - AF_ISO - AF_KEY - AF_LAST - AF_LAT - AF_LINK - AF_MAX - AF_NBS - AF_NIT - AF_NS - AF_OSI - AF_OSINET - AF_PUP - AF_ROUTE - AF_SNA - AF_UNIX - AF_UNSPEC - AF_USER - AF_WAN - AF_X25 - IOV_MAX - IP_OPTIONS - IP_HDRINCL - IP_TOS - IP_TTL - IP_RECVOPTS - IP_RECVRETOPTS - IP_RETOPTS - 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_MAXIOVLEN - MSG_MCAST - MSG_NOSIGNAL - MSG_OOB - MSG_PEEK - MSG_PROXY - MSG_RST - MSG_SYN - MSG_TRUNC - MSG_URG - MSG_WAITALL - MSG_WIRE - PF_802 - PF_AAL - PF_APPLETALK - PF_CCITT - PF_CHAOS - PF_CTF - PF_DATAKIT - PF_DECnet - PF_DLI - PF_ECMA - PF_GOSIP - PF_HYLINK - PF_IMPLINK - PF_INET - PF_INET6 - PF_ISO - PF_KEY - PF_LAST - PF_LAT - PF_LINK - PF_MAX - PF_NBS - PF_NIT - PF_NS - PF_OSI - PF_OSINET - PF_PUP - PF_ROUTE - PF_SNA - PF_UNIX - PF_UNSPEC - PF_USER - PF_WAN + +# List re-ordered to match documentation above. Try to keep the ordering +# consistent so it's easier to see which ones are or aren't documented. +our @EXPORT = qw( + PF_802 PF_AAL PF_APPLETALK PF_CCITT PF_CHAOS PF_CTF PF_DATAKIT + PF_DECnet PF_DLI PF_ECMA PF_GOSIP PF_HYLINK PF_IMPLINK PF_INET PF_INET6 + PF_ISO PF_KEY PF_LAST PF_LAT PF_LINK PF_MAX PF_NBS PF_NIT PF_NS PF_OSI + PF_OSINET PF_PUP PF_ROUTE PF_SNA PF_UNIX PF_UNSPEC PF_USER PF_WAN PF_X25 - SCM_CONNECT - SCM_CREDENTIALS - SCM_CREDS - SCM_RIGHTS - SCM_TIMESTAMP - SHUT_RD - SHUT_RDWR - SHUT_WR - SOCK_DGRAM - SOCK_RAW - SOCK_RDM - SOCK_SEQPACKET - SOCK_STREAM + + AF_802 AF_AAL AF_APPLETALK AF_CCITT AF_CHAOS AF_CTF AF_DATAKIT + AF_DECnet AF_DLI AF_ECMA AF_GOSIP AF_HYLINK AF_IMPLINK AF_INET AF_INET6 + AF_ISO AF_KEY AF_LAST AF_LAT AF_LINK AF_MAX AF_NBS AF_NIT AF_NS AF_OSI + AF_OSINET AF_PUP AF_ROUTE AF_SNA AF_UNIX AF_UNSPEC AF_USER AF_WAN + AF_X25 + + SOCK_DGRAM SOCK_RAW SOCK_RDM SOCK_SEQPACKET SOCK_STREAM + 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_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 + + IP_OPTIONS IP_HDRINCL IP_TOS IP_TTL IP_RECVOPTS IP_RECVRETOPTS + IP_RETOPTS + + 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_MAXIOVLEN MSG_MCAST MSG_NOSIGNAL MSG_OOB MSG_PEEK MSG_PROXY MSG_RST + MSG_SYN MSG_TRUNC MSG_URG MSG_WAITALL MSG_WIRE + + SHUT_RD SHUT_RDWR SHUT_WR + + INADDR_ANY INADDR_BROADCAST INADDR_LOOPBACK INADDR_NONE + + SCM_CONNECT SCM_CREDENTIALS SCM_CREDS SCM_RIGHTS SCM_TIMESTAMP + 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_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 + + IOV_MAX UIO_MAXIOV + + sockaddr_family + pack_sockaddr_in unpack_sockaddr_in sockaddr_in + pack_sockaddr_in6 unpack_sockaddr_in6 sockaddr_in6 + pack_sockaddr_un unpack_sockaddr_un sockaddr_un + + inet_aton inet_ntoa +); + +# List re-ordered to match documentation above. Try to keep the ordering +# consistent so it's easier to see which ones are or aren't documented. +our @EXPORT_OK = qw( + CR LF CRLF $CR $LF $CRLF + + IPPROTO_IP IPPROTO_IPV6 IPPROTO_RAW IPPROTO_ICMP IPPROTO_TCP + IPPROTO_UDP + + TCP_CONGESTION TCP_CORK TCP_DEFER_ACCEPT TCP_INFO TCP_KEEPALIVE + TCP_KEEPCNT TCP_KEEPIDLE TCP_KEEPINTVL TCP_LINGER2 TCP_MAXRT TCP_MAXSEG + TCP_MD5SIG TCP_NODELAY TCP_QUICKACK TCP_STDURG TCP_SYNCNT + TCP_WINDOW_CLAMP + + IN6ADDR_ANY IN6ADDR_LOOPBACK + + IPV6_ADD_MEMBERSHIP IPV6_DROP_MEMBERSHIP IPV6_MTU IPV6_MTU_DISCOVER + IPV6_MULTICAST_HOPS IPV6_MULTICAST_IF IPV6_MULTICAST_LOOP + IPV6_UNICAST_HOPS IPV6_V6ONLY + + pack_ipv6_mreq unpack_ipv6_mreq + + inet_pton inet_ntop + + getaddrinfo getnameinfo + + AI_ADDRCONFIG AI_ALL AI_CANONIDN AI_CANONNAME AI_IDN + AI_IDN_ALLOW_UNASSIGNED AI_IDN_USE_STD3_ASCII_RULES AI_NUMERICHOST + AI_NUMERICSERV AI_PASSIVE AI_V4MAPPED + + NI_DGRAM NI_IDN NI_IDN_ALLOW_UNASSIGNED NI_IDN_USE_STD3_ASCII_RULES + NI_NAMEREQD NI_NOFQDN NI_NUMERICHOST NI_NUMERICSERV + + NIx_NOHOST NIx_NOSERV + + EAI_ADDRFAMILY EAI_AGAIN EAI_BADFLAGS EAI_BADHINTS EAI_FAIL EAI_FAMILY + EAI_NODATA EAI_NONAME EAI_PROTOCOL EAI_SERVICE EAI_SOCKTYPE EAI_SYSTEM ); -@EXPORT_OK = qw(CR LF CRLF $CR $LF $CRLF - - inet_pton - inet_ntop - - getaddrinfo - getnameinfo - - pack_ipv6_mreq - unpack_ipv6_mreq - - IN6ADDR_ANY IN6ADDR_LOOPBACK - - AI_ADDRCONFIG - AI_ALL - AI_CANONIDN - AI_CANONNAME - AI_IDN - AI_IDN_ALLOW_UNASSIGNED - AI_IDN_USE_STD3_ASCII_RULES - AI_NUMERICHOST - AI_NUMERICSERV - AI_PASSIVE - AI_V4MAPPED - - EAI_ADDRFAMILY - EAI_AGAIN - EAI_BADFLAGS - EAI_BADHINTS - EAI_FAIL - EAI_FAMILY - EAI_NODATA - EAI_NONAME - EAI_PROTOCOL - EAI_SERVICE - EAI_SOCKTYPE - EAI_SYSTEM - - IPPROTO_IP - IPPROTO_IPV6 - IPPROTO_RAW - IPPROTO_ICMP - IPPROTO_TCP - IPPROTO_UDP - - IPV6_ADD_MEMBERSHIP - IPV6_DROP_MEMBERSHIP - IPV6_MTU - IPV6_MTU_DISCOVER - IPV6_MULTICAST_HOPS - IPV6_MULTICAST_IF - IPV6_MULTICAST_LOOP - IPV6_UNICAST_HOPS - IPV6_V6ONLY - - NI_DGRAM - NI_IDN - NI_IDN_ALLOW_UNASSIGNED - NI_IDN_USE_STD3_ASCII_RULES - NI_NAMEREQD - NI_NOFQDN - NI_NUMERICHOST - NI_NUMERICSERV - - TCP_KEEPALIVE - TCP_MAXRT - TCP_MAXSEG - TCP_NODELAY - TCP_STDURG - TCP_CORK - TCP_KEEPIDLE - TCP_KEEPINTVL - TCP_KEEPCNT - TCP_SYNCNT - TCP_LINGER2 - TCP_DEFER_ACCEPT - TCP_WINDOW_CLAMP - TCP_INFO - TCP_QUICKACK - TCP_CONGESTION - TCP_MD5SIG); - -%EXPORT_TAGS = ( - crlf => [qw(CR LF CRLF $CR $LF $CRLF)], - all => [@EXPORT, @EXPORT_OK], +our %EXPORT_TAGS = ( + crlf => [qw(CR LF CRLF $CR $LF $CRLF)], + addrinfo => [qw(getaddrinfo getnameinfo), grep m/^(?:AI|NI|NIx|EAI)_/, @EXPORT_OK], + all => [@EXPORT, @EXPORT_OK], ); BEGIN { sub CR () {"\015"} sub LF () {"\012"} sub CRLF () {"\015\012"} + + # These are not gni() constants; they're extensions for the perl API + # The definitions in Socket.pm and Socket.xs must match + sub NIx_NOHOST() {1 << 0} + sub NIx_NOSERV() {1 << 1} } *CR = \CR(); @@ -593,7 +771,7 @@ BEGIN { sub sockaddr_in { if (@_ == 6 && !wantarray) { # perl5.001m compat; use this && die my($af, $port, @quad) = @_; - warnings::warn "6-ARG sockaddr_in call is deprecated" + warnings::warn "6-ARG sockaddr_in call is deprecated" if warnings::enabled(); pack_sockaddr_in($port, inet_aton(join('.', @quad))); } elsif (wantarray) { @@ -827,7 +1005,7 @@ sub fake_getaddrinfo sub fake_getnameinfo { - my ( $addr, $flags ) = @_; + my ( $addr, $flags, $xflags ) = @_; my ( $port, $inetaddr ); eval { ( $port, $inetaddr ) = Socket::unpack_sockaddr_in( $addr ) } @@ -848,8 +1026,13 @@ sub fake_getnameinfo $flags == 0 or return fake_makeerr( EAI_BADFLAGS() ); + $xflags ||= 0; + my $node; - if( $flag_numerichost ) { + if( $xflags & NIx_NOHOST ) { + $node = undef; + } + elsif( $flag_numerichost ) { $node = Socket::inet_ntoa( $inetaddr ); } else { @@ -866,7 +1049,10 @@ sub fake_getnameinfo } my $service; - if( $flag_numericserv ) { + if( $xflags & NIx_NOSERV ) { + $service = undef; + } + elsif( $flag_numericserv ) { $service = "$port"; } else { diff --git a/cpan/Socket/Socket.xs b/cpan/Socket/Socket.xs index b06cfa6bea..1e3eeb0e61 100644 --- a/cpan/Socket/Socket.xs +++ b/cpan/Socket/Socket.xs @@ -33,7 +33,7 @@ # include <netinet/in.h> #endif #ifdef I_NETDB -# if !defined(ultrix) /* Avoid double definition. */ +# if !defined(ultrix) /* Avoid double definition. */ # include <netdb.h> # endif #endif @@ -68,13 +68,31 @@ NETINET_DEFINE_CONTEXT # define INADDR_BROADCAST 0xffffffff #endif /* INADDR_BROADCAST */ #ifndef INADDR_LOOPBACK -# define INADDR_LOOPBACK 0x7F000001 +# define INADDR_LOOPBACK 0x7F000001 #endif /* INADDR_LOOPBACK */ #ifndef croak_sv # define croak_sv(sv) croak(SvPV_nolen(sv)) #endif +/* perl < 5.8.9 or == 5.10.0 lacks newSVpvn_flags */ +#if PERL_VERSION < 8 +# define NEED_newSVpvn_flags +#elif PERL_VERSION == 8 && PERL_SUBVERSION < 9 +# define NEED_newSVpvn_flags +#elif PERL_VERSION == 10 && PERL_SUBVERSION == 0 +# define NEED_newSVpvn_flags +#endif + +#ifdef NEED_newSVpvn_flags +static SV *newSVpvn_flags(pTHX_ const char *s, STRLEN len, U32 flags) +{ + SV *sv = newSVpvn(s, len); + SvFLAGS(sv) |= (flags & SVf_UTF8); + return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv; +} +#endif + #ifndef HAS_INET_ATON /* @@ -96,7 +114,7 @@ my_inet_aton(register const char *cp, struct in_addr *addr) unsigned int parts[4]; register unsigned int *pp = parts; - if (!cp || !*cp) + if (!cp || !*cp) return 0; for (;;) { /* @@ -180,6 +198,11 @@ my_inet_aton(register const char *cp, struct in_addr *addr) #endif /* ! HAS_INET_ATON */ +/* These are not gni() constants; they're extensions for the perl API */ +/* The definitions in Socket.pm and Socket.xs must match */ +#define NIx_NOHOST (1 << 0) +#define NIx_NOSERV (1 << 1) + static int not_here(const char *s) @@ -201,7 +224,7 @@ not_here(const char *s) * which may or may not be 4 bytes in size. * * Bad Assumption 2: the s_addr field is a simple type -* (such as an int, u_int32_t). It can be a bit field, +* (such as an int, u_int32_t). It can be a bit field, * in which case using & (address-of) on it or taking sizeof() * wouldn't go over too well. (Those are not attempted * now but in case someone thinks to change the below code @@ -290,7 +313,7 @@ static void xs_getaddrinfo(pTHX_ CV *cv) servicename = NULL; } - Zero(&hints_s, sizeof hints_s, char); + Zero(&hints_s, sizeof(hints_s), char); hints_s.ai_family = PF_UNSPEC; if(hints && SvOK(hints)) { @@ -351,6 +374,7 @@ static void xs_getnameinfo(pTHX_ CV *cv) SV *addr; int flags; + int xflags; char host[1024]; char serv[256]; @@ -358,8 +382,10 @@ static void xs_getnameinfo(pTHX_ CV *cv) STRLEN addr_len; int err; - if(items < 1 || items > 2) - croak("Usage: Socket::getnameinfo(addr, flags=0)"); + int want_host, want_serv; + + if(items < 1 || items > 3) + croak("Usage: Socket::getnameinfo(addr, flags=0, xflags=0)"); SP -= items; @@ -370,6 +396,14 @@ static void xs_getnameinfo(pTHX_ CV *cv) else flags = SvIV(ST(1)); + if(items < 3) + xflags = 0; + else + xflags = SvIV(ST(2)); + + want_host = !(xflags & NIx_NOHOST); + want_serv = !(xflags & NIx_NOSERV); + if(!SvPOK(addr)) croak("addr is not a string"); @@ -384,8 +418,8 @@ static void xs_getnameinfo(pTHX_ CV *cv) #endif err = getnameinfo((struct sockaddr *)sa, addr_len, - host, sizeof(host), - serv, sizeof(serv), + want_host ? host : NULL, want_host ? sizeof(host) : 0, + want_serv ? serv : NULL, want_serv ? sizeof(serv) : 0, flags); Safefree(sa); @@ -395,8 +429,8 @@ static void xs_getnameinfo(pTHX_ CV *cv) if(err) XSRETURN(1); - XPUSHs(sv_2mortal(newSVpv(host, 0))); - XPUSHs(sv_2mortal(newSVpv(serv, 0))); + XPUSHs(want_host ? sv_2mortal(newSVpv(host, 0)) : &PL_sv_undef); + XPUSHs(want_serv ? sv_2mortal(newSVpv(serv, 0)) : &PL_sv_undef); XSRETURN(3); } @@ -408,10 +442,10 @@ INCLUDE: const-xs.inc BOOT: #ifdef HAS_GETADDRINFO - newXS("Socket::getaddrinfo", xs_getaddrinfo, __FILE__); + newXS("Socket::getaddrinfo", xs_getaddrinfo, __FILE__); #endif #ifdef HAS_GETNAMEINFO - newXS("Socket::getnameinfo", xs_getnameinfo, __FILE__); + newXS("Socket::getnameinfo", xs_getnameinfo, __FILE__); #endif void @@ -423,13 +457,13 @@ inet_aton(host) struct hostent * phe; if ((*host != '\0') && inet_aton(host, &ip_address)) { - ST(0) = newSVpvn_flags((char *)&ip_address, sizeof ip_address, SVs_TEMP); + ST(0) = sv_2mortal(newSVpvn((char *)&ip_address, sizeof(ip_address))); XSRETURN(1); } phe = gethostbyname(host); if (phe && phe->h_addrtype == AF_INET && phe->h_length == 4) { - ST(0) = newSVpvn_flags((char *)phe->h_addr, phe->h_length, SVs_TEMP); + ST(0) = sv_2mortal(newSVpvn((char *)phe->h_addr, phe->h_length)); XSRETURN(1); } @@ -445,18 +479,17 @@ inet_ntoa(ip_address_sv) struct in_addr addr; char * ip_address; if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1)) - croak("Wide character in %s", "Socket::inet_ntoa"); + croak("Wide character in %s", "Socket::inet_ntoa"); ip_address = SvPVbyte(ip_address_sv, addrlen); if (addrlen == sizeof(addr) || addrlen == 4) - addr.s_addr = + addr.s_addr = (ip_address[0] & 0xFF) << 24 | (ip_address[1] & 0xFF) << 16 | (ip_address[2] & 0xFF) << 8 | (ip_address[3] & 0xFF); else - croak("Bad arg length for %s, length is %d, should be %d", - "Socket::inet_ntoa", - addrlen, sizeof(addr)); + croak("Bad arg length for %s, length is %d, should be %d", + "Socket::inet_ntoa", addrlen, sizeof(addr)); /* We could use inet_ntoa() but that is broken * in HP-UX + GCC + 64bitint (returns "0.0.0.0"), * so let's use this sprintf() workaround everywhere. @@ -475,11 +508,10 @@ sockaddr_family(sockaddr) STRLEN sockaddr_len; char *sockaddr_pv = SvPVbyte(sockaddr, sockaddr_len); CODE: - if (sockaddr_len < offsetof(struct sockaddr, sa_data)) { - croak("Bad arg length for %s, length is %d, should be at least %d", - "Socket::sockaddr_family", sockaddr_len, - offsetof(struct sockaddr, sa_data)); - } + if (sockaddr_len < offsetof(struct sockaddr, sa_data)) + croak("Bad arg length for %s, length is %d, should be at least %d", + "Socket::sockaddr_family", sockaddr_len, + offsetof(struct sockaddr, sa_data)); ST(0) = sv_2mortal(newSViv(((struct sockaddr*)sockaddr_pv)->sa_family)); void @@ -493,36 +525,36 @@ pack_sockaddr_un(pathname) char * pathname_pv; int addr_len; - Zero( &sun_ad, sizeof sun_ad, char ); + 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)) len = sizeof(sun_ad.sun_path); # ifdef OS2 /* Name should start with \socket\ and contain backslashes! */ { - int off; - char *s, *e; - - if (pathname_pv[0] != '/' && pathname_pv[0] != '\\') - croak("Relative UNIX domain socket name '%s' unsupported", - pathname_pv); - else if (len < 8 - || pathname_pv[7] != '/' && pathname_pv[7] != '\\' - || !strnicmp(pathname_pv + 1, "socket", 6)) - off = 7; - else - off = 0; /* Preserve names starting with \socket\ */ - Copy( "\\socket", sun_ad.sun_path, off, char); - Copy( pathname_pv, sun_ad.sun_path + off, len, char ); - - s = sun_ad.sun_path + off - 1; - e = s + len + 1; - while (++s < e) - if (*s = '/') - *s = '\\'; + int off; + char *s, *e; + + if (pathname_pv[0] != '/' && pathname_pv[0] != '\\') + croak("Relative UNIX domain socket name '%s' unsupported", + pathname_pv); + else if (len < 8 + || pathname_pv[7] != '/' && pathname_pv[7] != '\\' + || !strnicmp(pathname_pv + 1, "socket", 6)) + off = 7; + else + off = 0; /* Preserve names starting with \socket\ */ + Copy("\\socket", sun_ad.sun_path, off, char); + Copy(pathname_pv, sun_ad.sun_path + off, len, char); + + s = sun_ad.sun_path + off - 1; + e = s + len + 1; + while (++s < e) + if (*s = '/') + *s = '\\'; } # else /* !( defined OS2 ) */ - Copy( pathname_pv, sun_ad.sun_path, len, char ); + Copy(pathname_pv, sun_ad.sun_path, len, char); # endif if (0) not_here("dummy"); if (len > 1 && sun_ad.sun_path[0] == '\0') { @@ -533,16 +565,16 @@ pack_sockaddr_un(pathname) * end of that character array */ addr_len = (char *)&(sun_ad.sun_path) - (char *)&sun_ad + len; } else { - addr_len = sizeof sun_ad; + addr_len = sizeof(sun_ad); } # ifdef HAS_SOCKADDR_SA_LEN sun_ad.sun_len = addr_len; # endif - ST(0) = newSVpvn_flags((char *)&sun_ad, addr_len, SVs_TEMP); + ST(0) = sv_2mortal(newSVpvn((char *)&sun_ad, addr_len)); #else - ST(0) = (SV *) not_here("pack_sockaddr_un"); + ST(0) = (SV*)not_here("pack_sockaddr_un"); #endif - + } void @@ -558,21 +590,16 @@ unpack_sockaddr_un(sun_sv) # ifndef __linux__ /* On Linux sockaddrlen on sockets returned by accept, recvfrom, getpeername and getsockname is not equal to sizeof(addr). */ - if (sockaddrlen != sizeof(addr)) { - croak("Bad arg length for %s, length is %d, should be %d", - "Socket::unpack_sockaddr_un", - sockaddrlen, sizeof(addr)); - } + if (sockaddrlen != sizeof(addr)) + croak("Bad arg length for %s, length is %d, should be %d", + "Socket::unpack_sockaddr_un", sockaddrlen, sizeof(addr)); # endif - Copy( sun_ad, &addr, sizeof addr, char ); + Copy(sun_ad, &addr, sizeof(addr), char); - if ( addr.sun_family != AF_UNIX ) { - croak("Bad address family for %s, got %d, should be %d", - "Socket::unpack_sockaddr_un", - addr.sun_family, - AF_UNIX); - } + if (addr.sun_family != AF_UNIX) + croak("Bad address family for %s, got %d, should be %d", + "Socket::unpack_sockaddr_un", addr.sun_family, AF_UNIX); if (addr.sun_path[0] == '\0') { /* Linux-style abstract socket address begins with a nul @@ -583,9 +610,9 @@ unpack_sockaddr_un(sun_sv) && addr_len < (int)sizeof(addr.sun_path); addr_len++); } - ST(0) = newSVpvn_flags(addr.sun_path, addr_len, SVs_TEMP); + ST(0) = sv_2mortal(newSVpvn(addr.sun_path, addr_len)); #else - ST(0) = (SV *) not_here("unpack_sockaddr_un"); + ST(0) = (SV*)not_here("unpack_sockaddr_un"); #endif } @@ -600,26 +627,26 @@ pack_sockaddr_in(port, ip_address_sv) STRLEN addrlen; char * ip_address; if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1)) - croak("Wide character in %s", "Socket::pack_sockaddr_in"); + croak("Wide character in %s", "Socket::pack_sockaddr_in"); ip_address = SvPVbyte(ip_address_sv, addrlen); if (addrlen == sizeof(addr) || addrlen == 4) - addr.s_addr = + addr.s_addr = (ip_address[0] & 0xFF) << 24 | (ip_address[1] & 0xFF) << 16 | (ip_address[2] & 0xFF) << 8 | (ip_address[3] & 0xFF); else - croak("Bad arg length for %s, length is %d, should be %d", + croak("Bad arg length for %s, length is %d, should be %d", "Socket::pack_sockaddr_in", addrlen, sizeof(addr)); - Zero( &sin, sizeof sin, char ); + Zero(&sin, sizeof(sin), char); sin.sin_family = AF_INET; sin.sin_port = htons(port); sin.sin_addr.s_addr = htonl(addr.s_addr); # ifdef HAS_SOCKADDR_SA_LEN - sin.sin_len = sizeof (sin); + sin.sin_len = sizeof(sin); # endif - ST(0) = newSVpvn_flags((char *)&sin, sizeof (sin), SVs_TEMP); + ST(0) = sv_2mortal(newSVpvn((char *)&sin, sizeof(sin))); } void @@ -630,26 +657,23 @@ unpack_sockaddr_in(sin_sv) STRLEN sockaddrlen; struct sockaddr_in addr; unsigned short port; - struct in_addr ip_address; + struct in_addr ip_address; char * sin = SvPVbyte(sin_sv,sockaddrlen); if (sockaddrlen != sizeof(addr)) { croak("Bad arg length for %s, length is %d, should be %d", - "Socket::unpack_sockaddr_in", - sockaddrlen, sizeof(addr)); + "Socket::unpack_sockaddr_in", sockaddrlen, sizeof(addr)); } - Copy( sin, &addr,sizeof addr, char ); - if ( addr.sin_family != AF_INET ) { + Copy(sin, &addr, sizeof(addr), char); + if (addr.sin_family != AF_INET) { croak("Bad address family for %s, got %d, should be %d", - "Socket::unpack_sockaddr_in", - addr.sin_family, - AF_INET); + "Socket::unpack_sockaddr_in", addr.sin_family, AF_INET); } port = ntohs(addr.sin_port); ip_address = addr.sin_addr; EXTEND(SP, 2); PUSHs(sv_2mortal(newSViv((IV) port))); - PUSHs(newSVpvn_flags((char *)&ip_address, sizeof(ip_address), SVs_TEMP)); + PUSHs(sv_2mortal(newSVpvn((char *)&ip_address, sizeof(ip_address)))); } void @@ -665,11 +689,11 @@ pack_sockaddr_in6(port, sin6_addr, scope_id=0, flowinfo=0) char * addrbytes; STRLEN addrlen; if (DO_UTF8(sin6_addr) && !sv_utf8_downgrade(sin6_addr, 1)) - croak("Wide character in %s", "Socket::pack_sockaddr_in6"); + croak("Wide character in %s", "Socket::pack_sockaddr_in6"); addrbytes = SvPVbyte(sin6_addr, addrlen); - if(addrlen != sizeof(sin6.sin6_addr)) - croak("Bad arg length %s, length is %d, should be %d", - "Socket::pack_sockaddr_in6", addrlen, sizeof(sin6.sin6_addr)); + if (addrlen != sizeof(sin6.sin6_addr)) + croak("Bad arg length %s, length is %d, should be %d", + "Socket::pack_sockaddr_in6", addrlen, sizeof(sin6.sin6_addr)); Zero(&sin6, sizeof(sin6), char); sin6.sin6_family = AF_INET6; sin6.sin6_port = htons(port); @@ -678,14 +702,14 @@ pack_sockaddr_in6(port, sin6_addr, scope_id=0, flowinfo=0) # ifdef HAS_SIN6_SCOPE_ID sin6.sin6_scope_id = scope_id; # else - if(scope_id != 0) + if (scope_id != 0) warn("%s cannot represent non-zero scope_id %d", - "Socket::pack_sockaddr_in6", scope_id); + "Socket::pack_sockaddr_in6", scope_id); # endif # ifdef HAS_SOCKADDR_SA_LEN sin6.sin6_len = sizeof(sin6); # endif - ST(0) = newSVpvn_flags((char *)&sin6, sizeof(sin6), SVs_TEMP); + ST(0) = sv_2mortal(newSVpvn((char *)&sin6, sizeof(sin6))); #else ST(0) = (SV*)not_here("pack_sockaddr_in6"); #endif @@ -701,14 +725,12 @@ unpack_sockaddr_in6(sin6_sv) struct sockaddr_in6 sin6; char * addrbytes = SvPVbyte(sin6_sv, addrlen); if (addrlen != sizeof(sin6)) - croak("Bad arg length for %s, length is %d, should be %d", - "Socket::unpack_sockaddr_in6", - addrlen, sizeof(sin6)); + croak("Bad arg length for %s, length is %d, should be %d", + "Socket::unpack_sockaddr_in6", addrlen, sizeof(sin6)); Copy(addrbytes, &sin6, sizeof(sin6), char); - if(sin6.sin6_family != AF_INET6) - croak("Bad address family for %s, got %d, should be %d", - "Socket::unpack_sockaddr_in6", - sin6.sin6_family, AF_INET6); + if (sin6.sin6_family != AF_INET6) + croak("Bad address family for %s, got %d, should be %d", + "Socket::unpack_sockaddr_in6", sin6.sin6_family, AF_INET6); EXTEND(SP, 4); mPUSHi(ntohs(sin6.sin6_port)); mPUSHp((char *)&sin6.sin6_addr, sizeof(sin6.sin6_addr)); @@ -725,9 +747,9 @@ unpack_sockaddr_in6(sin6_sv) void inet_ntop(af, ip_address_sv) - int af - SV * ip_address_sv - CODE: + int af + SV * ip_address_sv + CODE: #ifdef HAS_INETNTOP STRLEN addrlen, struct_size; #ifdef AF_INET6 @@ -741,64 +763,62 @@ inet_ntop(af, ip_address_sv) struct_size = sizeof(addr); - if(af != AF_INET + if (af != AF_INET #ifdef AF_INET6 && af != AF_INET6 #endif - ) { - croak("Bad address family for %s, got %d, should be" + ) { + croak("Bad address family for %s, got %d, should be" #ifdef AF_INET6 - " either AF_INET or AF_INET6", + " either AF_INET or AF_INET6", #else - " AF_INET", + " AF_INET", #endif - "Socket::inet_ntop", - af); - } + "Socket::inet_ntop", af); + } - Copy( ip_address, &addr, sizeof addr, char ); + Copy(ip_address, &addr, sizeof addr, char); inet_ntop(af, &addr, str, sizeof str); - ST(0) = newSVpvn_flags(str, strlen(str), SVs_TEMP); + ST(0) = sv_2mortal(newSVpvn(str, strlen(str))); #else - ST(0) = (SV *)not_here("inet_ntop"); + ST(0) = (SV*)not_here("inet_ntop"); #endif void inet_pton(af, host) - int af - const char * host - CODE: + int af + const char * host + CODE: #ifdef HAS_INETPTON - int ok; + int ok; #ifdef AF_INET6 struct in6_addr ip_address; #else struct in_addr ip_address; #endif - if(af != AF_INET + if (af != AF_INET #ifdef AF_INET6 - && af != AF_INET6 + && af != AF_INET6 #endif - ) { + ) { croak("Bad address family for %s, got %d, should be" #ifdef AF_INET6 - " either AF_INET or AF_INET6", + " either AF_INET or AF_INET6", #else - " AF_INET", + " AF_INET", #endif - "Socket::inet_pton", - af); - } - ok = (*host != '\0') && inet_pton(af, host, &ip_address); + "Socket::inet_pton", af); + } + ok = (*host != '\0') && inet_pton(af, host, &ip_address); - ST(0) = sv_newmortal(); - if (ok) { - sv_setpvn( ST(0), (char *)&ip_address, sizeof(ip_address) ); - } + ST(0) = sv_newmortal(); + if (ok) { + sv_setpvn( ST(0), (char *)&ip_address, sizeof(ip_address) ); + } #else - ST(0) = (SV *)not_here("inet_pton"); + ST(0) = (SV*)not_here("inet_pton"); #endif void @@ -812,15 +832,15 @@ pack_ipv6_mreq(addr, interface) char * addrbytes; STRLEN addrlen; if (DO_UTF8(addr) && !sv_utf8_downgrade(addr, 1)) - croak("Wide character in %s", "Socket::pack_ipv6_mreq"); + croak("Wide character in %s", "Socket::pack_ipv6_mreq"); addrbytes = SvPVbyte(addr, addrlen); - if(addrlen != sizeof(mreq.ipv6mr_multiaddr)) - croak("Bad arg length %s, length is %d, should be %d", - "Socket::pack_ipv6_mreq", addrlen, sizeof(mreq.ipv6mr_multiaddr)); + if (addrlen != sizeof(mreq.ipv6mr_multiaddr)) + croak("Bad arg length %s, length is %d, should be %d", + "Socket::pack_ipv6_mreq", addrlen, sizeof(mreq.ipv6mr_multiaddr)); Zero(&mreq, sizeof(mreq), char); Copy(addrbytes, &mreq.ipv6mr_multiaddr, sizeof(mreq.ipv6mr_multiaddr), char); mreq.ipv6mr_interface = interface; - ST(0) = newSVpvn_flags((char *)&mreq, sizeof(mreq), SVs_TEMP); + ST(0) = sv_2mortal(newSVpvn((char *)&mreq, sizeof(mreq))); #else ST(0) = (SV*)not_here("pack_ipv6_mreq"); #endif @@ -836,9 +856,8 @@ unpack_ipv6_mreq(mreq_sv) STRLEN mreqlen; char * mreqbytes = SvPVbyte(mreq_sv, mreqlen); if (mreqlen != sizeof(mreq)) - croak("Bad arg length for %s, length is %d, should be %d", - "Socket::unpack_ipv6_mreq", - mreqlen, sizeof(mreq)); + croak("Bad arg length for %s, length is %d, should be %d", + "Socket::unpack_ipv6_mreq", mreqlen, sizeof(mreq)); Copy(mreqbytes, &mreq, sizeof(mreq), char); EXTEND(SP, 2); mPUSHp((char *)&mreq.ipv6mr_multiaddr, sizeof(mreq.ipv6mr_multiaddr)); diff --git a/cpan/Socket/t/Socket.t b/cpan/Socket/t/Socket.t index f59c265c4c..8450324316 100644 --- a/cpan/Socket/t/Socket.t +++ b/cpan/Socket/t/Socket.t @@ -2,14 +2,14 @@ BEGIN { require Config; import Config; - if ($Config{'extensions'} !~ /\bSocket\b/ && + if ($Config{'extensions'} !~ /\bSocket\b/ && !(($^O eq 'VMS') && $Config{d_socket})) { print "1..0\n"; exit 0; } $has_alarm = $Config{d_alarm}; } - + use Socket qw(:all); use Test::More tests => 26; @@ -28,7 +28,7 @@ SKIP: { arm(5); my $host = $^O eq 'MacOS' || ($^O eq 'irix' && $Config{osvers} == 5) ? - '127.0.0.1' : 'localhost'; + '127.0.0.1' : 'localhost'; my $localhost = inet_aton($host); SKIP: { @@ -58,7 +58,7 @@ SKIP: { arm(0); } - is(($read == 0 || $buff eq "hello"), "PF_INET echo localhost reply"); + ok(($read == 0 || $buff eq "hello"), "PF_INET echo localhost reply"); } } @@ -97,7 +97,7 @@ SKIP: { arm(0); } - is(($read == 0 || $buff eq "olleh"), "PF_INET echo INADDR_LOOPBACK reply"); + ok(($read == 0 || $buff eq "olleh"), "PF_INET echo INADDR_LOOPBACK reply"); } } @@ -159,7 +159,7 @@ SKIP: { } SKIP: { - skip "No inet_ntop", 3 unless $Config{d_inetntop} && $Config{d_inetaton}; + 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'); diff --git a/cpan/Socket/t/getaddrinfo.t b/cpan/Socket/t/getaddrinfo.t index b85af38254..e4ae57c732 100644 --- a/cpan/Socket/t/getaddrinfo.t +++ b/cpan/Socket/t/getaddrinfo.t @@ -2,10 +2,7 @@ use strict; use warnings; use Test::More tests => 30; -use Socket qw( - AI_NUMERICHOST AF_INET SOCK_STREAM IPPROTO_TCP - unpack_sockaddr_in inet_aton getaddrinfo -); +use Socket qw(:addrinfo AF_INET SOCK_STREAM IPPROTO_TCP unpack_sockaddr_in inet_aton); my ( $err, @res ); @@ -13,16 +10,16 @@ my ( $err, @res ); cmp_ok( $err, "==", 0, '$err == 0 for host=127.0.0.1/service=80/socktype=STREAM' ); cmp_ok( $err, "eq", "", '$err eq "" for host=127.0.0.1/service=80/socktype=STREAM' ); is( scalar @res, 1, - '@res has 1 result' ); + '@res has 1 result' ); is( $res[0]->{family}, AF_INET, - '$res[0] family is AF_INET' ); + '$res[0] family is AF_INET' ); is( $res[0]->{socktype}, SOCK_STREAM, - '$res[0] socktype is SOCK_STREAM' ); + '$res[0] socktype is SOCK_STREAM' ); ok( $res[0]->{protocol} == 0 || $res[0]->{protocol} == IPPROTO_TCP, - '$res[0] protocol is 0 or IPPROTO_TCP' ); + '$res[0] protocol is 0 or IPPROTO_TCP' ); ok( defined $res[0]->{addr}, - '$res[0] addr is defined' ); + '$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" ) ], @@ -48,13 +45,13 @@ cmp_ok( $err, "==", 0, '$err == 0 for host=127.0.0.1/service=undef' ); # Test GETMAGIC { - "127.0.0.1" =~ /(.+)/; - ( $err, @res ) = getaddrinfo($1, 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", ??}' ); + "127.0.0.1" =~ /(.+)/; + ( $err, @res ) = getaddrinfo($1, 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", ??}' ); } ( $err, @res ) = getaddrinfo( "", "80", { family => AF_INET, socktype => SOCK_STREAM } ); @@ -63,22 +60,22 @@ is( scalar @res, 1, '@res has 1 result' ); # Just pick the first one is( $res[0]->{family}, AF_INET, - '$res[0] family is AF_INET' ); + '$res[0] family is AF_INET' ); is( $res[0]->{socktype}, SOCK_STREAM, - '$res[0] socktype is SOCK_STREAM' ); + '$res[0] socktype is SOCK_STREAM' ); ok( $res[0]->{protocol} == 0 || $res[0]->{protocol} == IPPROTO_TCP, - '$res[0] protocol is 0 or IPPROTO_TCP' ); + '$res[0] protocol is 0 or IPPROTO_TCP' ); # Now some tests of a few well-known internet hosts my $goodhost = "cpan.perl.org"; SKIP: { - skip "Resolver has no answer for $goodhost", 2 unless gethostbyname( $goodhost ); + skip "Resolver has no answer for $goodhost", 2 unless gethostbyname( $goodhost ); - ( $err, @res ) = getaddrinfo( "cpan.perl.org", "ftp", { socktype => SOCK_STREAM } ); - cmp_ok( $err, "==", 0, '$err == 0 for host=cpan.perl.org/service=ftp/socktype=STREAM' ); - # Might get more than one; e.g. different families - ok( scalar @res > 0, '@res has results' ); + ( $err, @res ) = getaddrinfo( "cpan.perl.org", "ftp", { socktype => SOCK_STREAM } ); + cmp_ok( $err, "==", 0, '$err == 0 for host=cpan.perl.org/service=ftp/socktype=STREAM' ); + # Might get more than one; e.g. different families + ok( scalar @res > 0, '@res has results' ); } # Now something I hope doesn't exist - we put it in a known-missing TLD @@ -88,19 +85,19 @@ my $missinghost = "TbK4jM2M0OS.lm57DWIyu4i"; # any request. We'd better check for them SKIP: { - skip "Resolver has an answer for $missinghost", 1 if gethostbyname( $missinghost ); - - # 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' ); - 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} ) ); - } - } + skip "Resolver has an answer for $missinghost", 1 if gethostbyname( $missinghost ); + + # 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' ); + 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} ) ); + } + } } # Now check that names with AI_NUMERICHOST fail @@ -110,11 +107,11 @@ ok( $err != 0, '$err != 0 for host=localhost/service=ftp/flags=AI_NUMERICHOST/so # Some sanity checking on the hints hash ok( defined eval { getaddrinfo( "127.0.0.1", "80", undef ); 1 }, - 'getaddrinfo() with undef hints works' ); + 'getaddrinfo() with undef hints works' ); ok( !defined eval { getaddrinfo( "127.0.0.1", "80", "hints" ); 1 }, - 'getaddrinfo() with string hints dies' ); + 'getaddrinfo() with string hints dies' ); ok( !defined eval { getaddrinfo( "127.0.0.1", "80", [] ); 1 }, - 'getaddrinfo() with ARRAY hints dies' ); + 'getaddrinfo() with ARRAY hints dies' ); # Ensure it doesn't segfault if args are missing diff --git a/cpan/Socket/t/getnameinfo.t b/cpan/Socket/t/getnameinfo.t index 803e8c0c57..ca24e2c214 100644 --- a/cpan/Socket/t/getnameinfo.t +++ b/cpan/Socket/t/getnameinfo.t @@ -1,11 +1,8 @@ use strict; use warnings; -use Test::More tests => 10; +use Test::More tests => 14; -use Socket qw( - AF_INET NI_NUMERICHOST NI_NUMERICSERV - getnameinfo pack_sockaddr_in inet_aton -); +use Socket qw(:addrinfo AF_INET pack_sockaddr_in inet_aton); my ( $err, $host, $service ); @@ -16,6 +13,14 @@ cmp_ok( $err, "eq", "", '$err eq "" for {family=AF_INET,port=80,sinaddr=127.0.0. is( $host, "127.0.0.1", '$host is 127.0.0.1 for NH/NS' ); is( $service, "80", '$service is 80 for NH/NS' ); +( $err, $host, $service ) = getnameinfo( pack_sockaddr_in( 80, inet_aton( "127.0.0.1" ) ), NI_NUMERICHOST|NI_NUMERICSERV, NIx_NOHOST ); +is( $host, undef, '$host is undef for NIx_NOHOST' ); +is( $service, "80", '$service is 80 for NS, NIx_NOHOST' ); + +( $err, $host, $service ) = getnameinfo( pack_sockaddr_in( 80, inet_aton( "127.0.0.1" ) ), NI_NUMERICHOST|NI_NUMERICSERV, NIx_NOSERV ); +is( $host, "127.0.0.1", '$host is undef for NIx_NOSERV' ); +is( $service, undef, '$service is 80 for NS, NIx_NOSERV' ); + # Probably "localhost" but we'd better ask the system to be sure my $expect_host = gethostbyaddr( inet_aton( "127.0.0.1" ), AF_INET ); defined $expect_host or $expect_host = "127.0.0.1"; diff --git a/cpan/Socket/t/ipv6_mreq.t b/cpan/Socket/t/ipv6_mreq.t index 43fb8f804b..1f0e122660 100644 --- a/cpan/Socket/t/ipv6_mreq.t +++ b/cpan/Socket/t/ipv6_mreq.t @@ -3,7 +3,7 @@ use warnings; use Test::More; use Socket qw( - pack_ipv6_mreq unpack_ipv6_mreq + pack_ipv6_mreq unpack_ipv6_mreq ); # Check that pack/unpack_ipv6_mreq either croak with "Not implemented", or @@ -11,11 +11,11 @@ use Socket qw( my $packed; eval { - $packed = pack_ipv6_mreq "ANADDRESSIN16CHR", 123; + $packed = pack_ipv6_mreq "ANADDRESSIN16CHR", 123; }; if( !defined $packed ) { - plan skip_all => "No pack_ipv6_mreq" if $@ =~ m/ not implemented /; - die $@; + plan skip_all => "No pack_ipv6_mreq" if $@ =~ m/ not implemented /; + die $@; } plan tests => 2; diff --git a/cpan/Socket/t/socketpair.t b/cpan/Socket/t/socketpair.t index 997628c3bd..857b43cfdf 100644 --- a/cpan/Socket/t/socketpair.t +++ b/cpan/Socket/t/socketpair.t @@ -23,20 +23,20 @@ BEGIN { # so we need a self destruct timer. And IO can hang despite an alarm. if( $can_fork) { - my $parent = $$; - $child = fork; - die "Fork failed" unless defined $child; - if (!$child) { - $SIG{INT} = sub {exit 0}; # You have 60 seconds. Your time starts now. - my $must_finish_by = time + 60; - my $remaining; - while (($remaining = $must_finish_by - time) > 0) { - sleep $remaining; - } - warn "Something unexpectedly hung during testing"; - kill "INT", $parent or die "Kill failed: $!"; - exit 1; - } + my $parent = $$; + $child = fork; + die "Fork failed" unless defined $child; + if (!$child) { + $SIG{INT} = sub {exit 0}; # You have 60 seconds. Your time starts now. + my $must_finish_by = time + 60; + my $remaining; + while (($remaining = $must_finish_by - time) > 0) { + sleep $remaining; + } + warn "Something unexpectedly hung during testing"; + kill "INT", $parent or die "Kill failed: $!"; + exit 1; + } } unless ($has_perlio = find PerlIO::Layer 'perlio') { print <<EOF; @@ -54,23 +54,23 @@ use Errno; my $skip_reason; if( !$Config{d_alarm} ) { - plan skip_all => "alarm() not implemented on this platform"; + plan skip_all => "alarm() not implemented on this platform"; } elsif( !$can_fork ) { - plan skip_all => "fork() not implemented on this platform"; + plan skip_all => "fork() not implemented on this platform"; } else { - # This should fail but not die if there is real socketpair - eval {socketpair LEFT, RIGHT, -1, -1, -1}; - if ($@ =~ /^Unsupported socket function "socketpair" called/ || - $! =~ /^The operation requested is not supported./) { # Stratus VOS - plan skip_all => 'No socketpair (real or emulated)'; - } else { - eval {AF_UNIX}; - if ($@ =~ /^Your vendor has not defined Socket macro AF_UNIX/) { - plan skip_all => 'No AF_UNIX'; + # This should fail but not die if there is real socketpair + eval {socketpair LEFT, RIGHT, -1, -1, -1}; + if ($@ =~ /^Unsupported socket function "socketpair" called/ || + $! =~ /^The operation requested is not supported./) { # Stratus VOS + plan skip_all => 'No socketpair (real or emulated)'; } else { - plan tests => 45; + eval {AF_UNIX}; + if ($@ =~ /^Your vendor has not defined Socket macro AF_UNIX/) { + plan skip_all => 'No AF_UNIX'; + } else { + plan tests => 45; + } } - } } # But we'll install an alarm handler in case any of the races below fail. @@ -78,7 +78,7 @@ $SIG{ALRM} = sub {die "Unexpected alarm during testing"}; ok (socketpair (LEFT, RIGHT, AF_UNIX, SOCK_STREAM, PF_UNSPEC), "socketpair (LEFT, RIGHT, AF_UNIX, SOCK_STREAM, PF_UNSPEC)") - or print "# \$\! = $!\n"; + or print "# \$\! = $!\n"; if ($has_perlio) { binmode(LEFT, ":bytes"); @@ -89,12 +89,12 @@ my @left = ("hello ", "world\n"); my @right = ("perl ", "rules!"); # Not like I'm trying to bias any survey here. foreach (@left) { - # is (syswrite (LEFT, $_), length $_, "write " . _qq ($_) . " to left"); - is (syswrite (LEFT, $_), length $_, "syswrite to left"); + # is (syswrite (LEFT, $_), length $_, "write " . _qq ($_) . " to left"); + is (syswrite (LEFT, $_), length $_, "syswrite to left"); } foreach (@right) { - # is (syswrite (RIGHT, $_), length $_, "write " . _qq ($_) . " to right"); - is (syswrite (RIGHT, $_), length $_, "syswrite to right"); + # is (syswrite (RIGHT, $_), length $_, "write " . _qq ($_) . " to right"); + is (syswrite (RIGHT, $_), length $_, "syswrite to right"); } # stream socket, so our writes will become joined: @@ -112,43 +112,43 @@ ok (shutdown(LEFT, SHUT_WR), "shutdown left for writing"); # This will hang forever if eof is buggy, and alarm doesn't interrupt system # Calls. Hence the child process minder. SKIP: { - skip "SCO Unixware / OSR have a bug with shutdown",2 if $^O =~ /^(?:svr|sco)/; - local $SIG{ALRM} = sub { warn "EOF on right took over 3 seconds" }; - local $TODO = "Known problems with unix sockets on $^O" - if $^O eq 'hpux' || $^O eq 'super-ux'; - alarm 3; - $! = 0; - ok (eof RIGHT, "right is at EOF"); - local $TODO = "Known problems with unix sockets on $^O" - if $^O eq 'unicos' || $^O eq 'unicosmk'; - is ($!, '', 'and $! should report no error'); - alarm 60; + skip "SCO Unixware / OSR have a bug with shutdown",2 if $^O =~ /^(?:svr|sco)/; + local $SIG{ALRM} = sub { warn "EOF on right took over 3 seconds" }; + local $TODO = "Known problems with unix sockets on $^O" + if $^O eq 'hpux' || $^O eq 'super-ux'; + alarm 3; + $! = 0; + ok (eof RIGHT, "right is at EOF"); + local $TODO = "Known problems with unix sockets on $^O" + if $^O eq 'unicos' || $^O eq 'unicosmk'; + is ($!, '', 'and $! should report no error'); + alarm 60; } my $err = $!; $SIG{PIPE} = 'IGNORE'; { - local $SIG{ALRM} - = sub { warn "syswrite to left didn't fail within 3 seconds" }; - alarm 3; - # Split the system call from the is() - is() does IO so - # (say) a flush may do a seek which on a pipe may disturb errno - my $ans = syswrite (LEFT, "void"); - $err = $!; - is ($ans, undef, "syswrite to shutdown left should fail"); - alarm 60; + local $SIG{ALRM} = + sub { warn "syswrite to left didn't fail within 3 seconds" }; + alarm 3; + # Split the system call from the is() - is() does IO so + # (say) a flush may do a seek which on a pipe may disturb errno + my $ans = syswrite (LEFT, "void"); + $err = $!; + is ($ans, undef, "syswrite to shutdown left should fail"); + alarm 60; } { - # This may need skipping on some OSes - restoring value saved above - # should help - $! = $err; - ok (($!{EPIPE} or $!{ESHUTDOWN}), '$! should be EPIPE or ESHUTDOWN') - or printf "\$\!=%d(%s)\n", $err, $err; + # This may need skipping on some OSes - restoring value saved above + # should help + $! = $err; + ok (($!{EPIPE} or $!{ESHUTDOWN}), '$! should be EPIPE or ESHUTDOWN') + or printf "\$\!=%d(%s)\n", $err, $err; } my @gripping = (chr 255, chr 127); foreach (@gripping) { - is (syswrite (RIGHT, $_), length $_, "syswrite to right"); + is (syswrite (RIGHT, $_), length $_, "syswrite to right"); } ok (!eof LEFT, "left is not at EOF"); @@ -167,77 +167,75 @@ ok (close RIGHT, "close right"); # guarantee that the stack won't drop a UDP packet, even if it is for localhost. SKIP: { - skip "No usable SOCK_DGRAM for socketpair", 24 if ($^O =~ /^(MSWin32|os2)\z/); - local $TODO = "socketpair not supported on $^O" if $^O eq 'nto'; + skip "No usable SOCK_DGRAM for socketpair", 24 if ($^O =~ /^(MSWin32|os2)\z/); + local $TODO = "socketpair not supported on $^O" if $^O eq 'nto'; -ok (socketpair (LEFT, RIGHT, AF_UNIX, SOCK_DGRAM, PF_UNSPEC), - "socketpair (LEFT, RIGHT, AF_UNIX, SOCK_DGRAM, PF_UNSPEC)") - or print "# \$\! = $!\n"; + ok (socketpair (LEFT, RIGHT, AF_UNIX, SOCK_DGRAM, PF_UNSPEC), + "socketpair (LEFT, RIGHT, AF_UNIX, SOCK_DGRAM, PF_UNSPEC)") + or print "# \$\! = $!\n"; -if ($has_perlio) { - binmode(LEFT, ":bytes"); - binmode(RIGHT, ":bytes"); -} - -foreach (@left) { - # is (syswrite (LEFT, $_), length $_, "write " . _qq ($_) . " to left"); - is (syswrite (LEFT, $_), length $_, "syswrite to left"); -} -foreach (@right) { - # is (syswrite (RIGHT, $_), length $_, "write " . _qq ($_) . " to right"); - is (syswrite (RIGHT, $_), length $_, "syswrite to right"); -} - -# stream socket, so our writes will become joined: -my ($total); -$total = join '', @right; -foreach $expect (@right) { - undef $buffer; - is (sysread (LEFT, $buffer, length $total), length $expect, "read on left"); - is ($buffer, $expect, "content what we expected?"); -} -$total = join '', @left; -foreach $expect (@left) { - undef $buffer; - is (sysread (RIGHT, $buffer, length $total), length $expect, "read on right"); - is ($buffer, $expect, "content what we expected?"); -} + if ($has_perlio) { + binmode(LEFT, ":bytes"); + binmode(RIGHT, ":bytes"); + } -ok (shutdown(LEFT, 1), "shutdown left for writing"); + foreach (@left) { + # is (syswrite (LEFT, $_), length $_, "write " . _qq ($_) . " to left"); + is (syswrite (LEFT, $_), length $_, "syswrite to left"); + } + foreach (@right) { + # is (syswrite (RIGHT, $_), length $_, "write " . _qq ($_) . " to right"); + is (syswrite (RIGHT, $_), length $_, "syswrite to right"); + } -# eof uses buffering. eof is indicated by a sysread of zero. -# but for a datagram socket there's no way it can know nothing will ever be -# sent -SKIP: { - skip "$^O does length 0 udp reads", 2 if ($^O eq 'os390'); - - my $alarmed = 0; - local $SIG{ALRM} = sub { $alarmed = 1; }; - print "# Approximate forever as 3 seconds. Wait 'forever'...\n"; - alarm 3; - undef $buffer; - is (sysread (RIGHT, $buffer, 1), undef, - "read on right should be interrupted"); - is ($alarmed, 1, "alarm should have fired"); -} + # stream socket, so our writes will become joined: + my ($total); + $total = join '', @right; + foreach $expect (@right) { + undef $buffer; + is (sysread (LEFT, $buffer, length $total), length $expect, "read on left"); + is ($buffer, $expect, "content what we expected?"); + } + $total = join '', @left; + foreach $expect (@left) { + undef $buffer; + is (sysread (RIGHT, $buffer, length $total), length $expect, "read on right"); + is ($buffer, $expect, "content what we expected?"); + } -alarm 30; + ok (shutdown(LEFT, 1), "shutdown left for writing"); + + # eof uses buffering. eof is indicated by a sysread of zero. + # but for a datagram socket there's no way it can know nothing will ever be + # sent + SKIP: { + skip "$^O does length 0 udp reads", 2 if ($^O eq 'os390'); + + my $alarmed = 0; + local $SIG{ALRM} = sub { $alarmed = 1; }; + print "# Approximate forever as 3 seconds. Wait 'forever'...\n"; + alarm 3; + undef $buffer; + is (sysread (RIGHT, $buffer, 1), undef, + "read on right should be interrupted"); + is ($alarmed, 1, "alarm should have fired"); + } -#ok (eof RIGHT, "right is at EOF"); + alarm 30; -foreach (@gripping) { - is (syswrite (RIGHT, $_), length $_, "syswrite to right"); -} + foreach (@gripping) { + is (syswrite (RIGHT, $_), length $_, "syswrite to right"); + } -$total = join '', @gripping; -foreach $expect (@gripping) { - undef $buffer; - is (sysread (LEFT, $buffer, length $total), length $expect, "read on left"); - is ($buffer, $expect, "content what we expected?"); -} + $total = join '', @gripping; + foreach $expect (@gripping) { + undef $buffer; + is (sysread (LEFT, $buffer, length $total), length $expect, "read on left"); + is ($buffer, $expect, "content what we expected?"); + } -ok (close LEFT, "close left"); -ok (close RIGHT, "close right"); + ok (close LEFT, "close left"); + ok (close RIGHT, "close right"); } # end of DGRAM SKIP diff --git a/pod/perldelta.pod b/pod/perldelta.pod index e5d254f72f..b2dfa9c84b 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -307,6 +307,10 @@ it was not, adding a note will help whoever compiles perl5160delta. =item * +L<Socket> has been upgraded from version 1.94_02 to version 1.96. + +=item * + L<Unicode::Collate> has been upgraded from version 0.85 to version 0.87. Tailored compatibility ideographs as well as unified ideographs for diff --git a/t/porting/known_pod_issues.dat b/t/porting/known_pod_issues.dat index fee87971e7..5c46916511 100644 --- a/t/porting/known_pod_issues.dat +++ b/t/porting/known_pod_issues.dat @@ -109,6 +109,7 @@ sha1sum(1) Shell Shell::Command sock_init(3) +Socket socketpair(3) SOM splain |