summaryrefslogtreecommitdiff
path: root/cpan/Socket
diff options
context:
space:
mode:
authorChris 'BinGOs' Williams <chris@bingosnet.co.uk>2011-12-11 09:42:07 +0000
committerChris 'BinGOs' Williams <chris@bingosnet.co.uk>2011-12-11 20:38:34 +0000
commitc26545556e928dc9ff1dd6241c04ec8aee0e0273 (patch)
tree7e8c945b4948196d47a204231697322e9e138c14 /cpan/Socket
parent32995a382d65b01a758b2fb9c397894c199fce0e (diff)
downloadperl-c26545556e928dc9ff1dd6241c04ec8aee0e0273.tar.gz
Update Socket to CPAN version 1.96
[DELTA] 1.96 CHANGES: * Fix Socket.t to use ok() instead of is() where required - RT73039 * Complete rewrite of module docs; list all the constants and functions, updated SYNOPSIS * Added convenient Exporter tag :addrinfo for all the gai/gni-related symbols * Provide static synthesized newSVpvn_flags() replacement for older Perls * Implement getnameinfo() NIx_NOHOST and NIx_NOSERV extension flags 1.95 CHANGES: * Implement the remaining AI_*, EAI_* and NI_* constants from Socket::GetAddrInfo * Declare configure-time dependency on ExtUtils::Constants 0.23 for when building out of core * Initial attempt at dual-life extraction from bleadperl
Diffstat (limited to 'cpan/Socket')
-rw-r--r--cpan/Socket/Makefile.PL172
-rw-r--r--cpan/Socket/Socket.pm1052
-rw-r--r--cpan/Socket/Socket.xs287
-rw-r--r--cpan/Socket/t/Socket.t12
-rw-r--r--cpan/Socket/t/getaddrinfo.t77
-rw-r--r--cpan/Socket/t/getnameinfo.t15
-rw-r--r--cpan/Socket/t/ipv6_mreq.t8
-rw-r--r--cpan/Socket/t/socketpair.t238
8 files changed, 1039 insertions, 822 deletions
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