| Filename | /home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/5.22.0/IO/Socket/IP.pm |
| Statements | Executed 222264 statements in 621ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 2002 | 1 | 1 | 134ms | 611ms | IO::Socket::IP::_io_socket_ip__configure |
| 2002 | 1 | 1 | 109ms | 109ms | IO::Socket::IP::CORE:connect (opcode) |
| 2002 | 1 | 1 | 60.3ms | 225ms | IO::Socket::IP::connect |
| 2003 | 2 | 1 | 49.0ms | 49.0ms | IO::Socket::IP::CORE:gpbyname (opcode) |
| 2002 | 1 | 1 | 39.2ms | 316ms | IO::Socket::IP::setup |
| 2002 | 1 | 1 | 32.9ms | 674ms | IO::Socket::IP::configure |
| 2002 | 1 | 1 | 19.1ms | 856ms | IO::Socket::IP::new |
| 2002 | 1 | 1 | 18.5ms | 29.6ms | IO::Socket::IP::split_addr |
| 2002 | 1 | 1 | 14.8ms | 52.1ms | IO::Socket::IP::socket |
| 2003 | 2 | 1 | 9.41ms | 9.41ms | IO::Socket::IP::CORE:regcomp (opcode) |
| 2002 | 1 | 1 | 6.77ms | 6.77ms | IO::Socket::IP::CORE:sselect (opcode) |
| 6006 | 2 | 1 | 3.27ms | 3.27ms | IO::Socket::IP::CORE:match (opcode) |
| 1 | 1 | 1 | 2.07ms | 3.63ms | IO::Socket::IP::BEGIN@33 |
| 2002 | 1 | 1 | 1.05ms | 1.05ms | IO::Socket::IP::CORE:subst (opcode) |
| 1 | 1 | 1 | 16µs | 16µs | IO::Socket::IP::BEGIN@921 |
| 1 | 1 | 1 | 9µs | 57µs | IO::Socket::IP::BEGIN@39 |
| 1 | 1 | 1 | 8µs | 72µs | IO::Socket::IP::BEGIN@19 |
| 1 | 1 | 1 | 8µs | 50µs | IO::Socket::IP::_ForINET::BEGIN@1122 |
| 1 | 1 | 1 | 6µs | 60µs | IO::Socket::IP::BEGIN@15 |
| 1 | 1 | 1 | 6µs | 45µs | IO::Socket::IP::BEGIN@36 |
| 1 | 1 | 1 | 6µs | 6µs | IO::Socket::IP::BEGIN@9 |
| 1 | 1 | 1 | 6µs | 32µs | IO::Socket::IP::BEGIN@34 |
| 1 | 1 | 1 | 5µs | 35µs | IO::Socket::IP::_ForINET6::BEGIN@1136 |
| 1 | 1 | 1 | 5µs | 7µs | IO::Socket::IP::BEGIN@13 |
| 1 | 1 | 1 | 5µs | 29µs | IO::Socket::IP::BEGIN@17 |
| 1 | 1 | 1 | 4µs | 10µs | IO::Socket::IP::BEGIN@14 |
| 1 | 1 | 1 | 900ns | 900ns | IO::Socket::IP::CORE:qr (opcode) |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::IP::CAN_DISABLE_V6ONLY |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::IP::_ForINET6::configure |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::IP::_ForINET::configure |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::IP::__ANON__[:930] |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::IP::_get_host_service |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::IP::_unpack_sockaddr |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::IP::accept |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::IP::as_inet |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::IP::connected |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::IP::import |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::IP::join_addr |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::IP::peeraddr |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::IP::peerhost |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::IP::peerhost_service |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::IP::peerhostname |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::IP::peerport |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::IP::peerservice |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::IP::sockaddr |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::IP::sockhost |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::IP::sockhost_service |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::IP::sockhostname |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::IP::sockport |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::IP::sockservice |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | # You may distribute under the terms of either the GNU General Public License | ||||
| 2 | # or the Artistic License (the same terms as Perl itself) | ||||
| 3 | # | ||||
| 4 | # (C) Paul Evans, 2010-2015 -- leonerd@leonerd.org.uk | ||||
| 5 | |||||
| 6 | package IO::Socket::IP; | ||||
| 7 | # $VERSION needs to be set before use base 'IO::Socket' | ||||
| 8 | # - https://rt.cpan.org/Ticket/Display.html?id=92107 | ||||
| 9 | # spent 6µs within IO::Socket::IP::BEGIN@9 which was called:
# once (6µs+0s) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 11 | ||||
| 10 | 1 | 3µs | $VERSION = '0.37'; | ||
| 11 | 1 | 14µs | 1 | 6µs | } # spent 6µs making 1 call to IO::Socket::IP::BEGIN@9 |
| 12 | |||||
| 13 | 2 | 14µs | 2 | 9µs | # spent 7µs (5+2) within IO::Socket::IP::BEGIN@13 which was called:
# once (5µs+2µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 13 # spent 7µs making 1 call to IO::Socket::IP::BEGIN@13
# spent 2µs making 1 call to strict::import |
| 14 | 2 | 16µs | 2 | 15µs | # spent 10µs (4+5) within IO::Socket::IP::BEGIN@14 which was called:
# once (4µs+5µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 14 # spent 10µs making 1 call to IO::Socket::IP::BEGIN@14
# spent 6µs making 1 call to warnings::import |
| 15 | 2 | 18µs | 2 | 114µs | # spent 60µs (6+54) within IO::Socket::IP::BEGIN@15 which was called:
# once (6µs+54µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 15 # spent 60µs making 1 call to IO::Socket::IP::BEGIN@15
# spent 54µs making 1 call to base::import |
| 16 | |||||
| 17 | 2 | 28µs | 2 | 54µs | # spent 29µs (5+24) within IO::Socket::IP::BEGIN@17 which was called:
# once (5µs+24µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 17 # spent 29µs making 1 call to IO::Socket::IP::BEGIN@17
# spent 24µs making 1 call to Exporter::import |
| 18 | |||||
| 19 | 1 | 3µs | 1 | 55µs | # spent 72µs (8+64) within IO::Socket::IP::BEGIN@19 which was called:
# once (8µs+64µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 30 # spent 55µs making 1 call to Exporter::import |
| 20 | getaddrinfo getnameinfo | ||||
| 21 | sockaddr_family | ||||
| 22 | AF_INET | ||||
| 23 | AI_PASSIVE | ||||
| 24 | IPPROTO_TCP IPPROTO_UDP | ||||
| 25 | IPPROTO_IPV6 IPV6_V6ONLY | ||||
| 26 | NI_DGRAM NI_NUMERICHOST NI_NUMERICSERV NIx_NOHOST NIx_NOSERV | ||||
| 27 | SO_REUSEADDR SO_REUSEPORT SO_BROADCAST SO_ERROR | ||||
| 28 | SOCK_DGRAM SOCK_STREAM | ||||
| 29 | SOL_SOCKET | ||||
| 30 | 2 | 44µs | 2 | 81µs | ); # spent 72µs making 1 call to IO::Socket::IP::BEGIN@19
# spent 9µs making 1 call to UNIVERSAL::VERSION |
| 31 | 2 | 900ns | my $AF_INET6 = eval { Socket::AF_INET6() }; # may not be defined | ||
| 32 | 2 | 400ns | my $AI_ADDRCONFIG = eval { Socket::AI_ADDRCONFIG() } || 0; | ||
| 33 | 2 | 68µs | 2 | 4.50ms | # spent 3.63ms (2.07+1.56) within IO::Socket::IP::BEGIN@33 which was called:
# once (2.07ms+1.56ms) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 33 # spent 3.63ms making 1 call to IO::Socket::IP::BEGIN@33
# spent 869µs making 1 call to POSIX::import |
| 34 | 2 | 22µs | 2 | 58µs | # spent 32µs (6+26) within IO::Socket::IP::BEGIN@34 which was called:
# once (6µs+26µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 34 # spent 32µs making 1 call to IO::Socket::IP::BEGIN@34
# spent 26µs making 1 call to Exporter::import |
| 35 | |||||
| 36 | 2 | 28µs | 2 | 84µs | # spent 45µs (6+39) within IO::Socket::IP::BEGIN@36 which was called:
# once (6µs+39µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 36 # spent 45µs making 1 call to IO::Socket::IP::BEGIN@36
# spent 39µs making 1 call to constant::import |
| 37 | |||||
| 38 | # At least one OS (Android) is known not to have getprotobyname() | ||||
| 39 | 3 | 1.69ms | 3 | 104µs | # spent 57µs (9+47) within IO::Socket::IP::BEGIN@39 which was called:
# once (9µs+47µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 39 # spent 57µs making 1 call to IO::Socket::IP::BEGIN@39
# spent 26µs making 1 call to IO::Socket::IP::CORE:gpbyname
# spent 22µs making 1 call to constant::import |
| 40 | |||||
| 41 | 1 | 6µs | my $IPv6_re = do { | ||
| 42 | # translation of RFC 3986 3.2.2 ABNF to re | ||||
| 43 | 1 | 100ns | my $IPv4address = do { | ||
| 44 | 1 | 100ns | my $dec_octet = q<(?:[0-9]|[1-9][0-9]|1[0-9][0-9]|2[0-4][0-9]|25[0-5])>; | ||
| 45 | 1 | 900ns | qq<$dec_octet(?: \\. $dec_octet){3}>; | ||
| 46 | }; | ||||
| 47 | 1 | 100ns | my $IPv6address = do { | ||
| 48 | 1 | 100ns | my $h16 = qq<[0-9A-Fa-f]{1,4}>; | ||
| 49 | 1 | 900ns | my $ls32 = qq<(?: $h16 : $h16 | $IPv4address)>; | ||
| 50 | 1 | 4µs | qq<(?: | ||
| 51 | (?: $h16 : ){6} $ls32 | ||||
| 52 | | :: (?: $h16 : ){5} $ls32 | ||||
| 53 | | (?: $h16 )? :: (?: $h16 : ){4} $ls32 | ||||
| 54 | | (?: (?: $h16 : ){0,1} $h16 )? :: (?: $h16 : ){3} $ls32 | ||||
| 55 | | (?: (?: $h16 : ){0,2} $h16 )? :: (?: $h16 : ){2} $ls32 | ||||
| 56 | | (?: (?: $h16 : ){0,3} $h16 )? :: $h16 : $ls32 | ||||
| 57 | | (?: (?: $h16 : ){0,4} $h16 )? :: $ls32 | ||||
| 58 | | (?: (?: $h16 : ){0,5} $h16 )? :: $h16 | ||||
| 59 | | (?: (?: $h16 : ){0,6} $h16 )? :: | ||||
| 60 | )> | ||||
| 61 | }; | ||||
| 62 | 1 | 169µs | 2 | 158µs | qr<$IPv6address>xo; # spent 157µs making 1 call to IO::Socket::IP::CORE:regcomp
# spent 900ns making 1 call to IO::Socket::IP::CORE:qr |
| 63 | }; | ||||
| 64 | |||||
| 65 | =head1 NAME | ||||
| 66 | |||||
| 67 | C<IO::Socket::IP> - Family-neutral IP socket supporting both IPv4 and IPv6 | ||||
| 68 | |||||
| 69 | =head1 SYNOPSIS | ||||
| 70 | |||||
| 71 | use IO::Socket::IP; | ||||
| 72 | |||||
| 73 | my $sock = IO::Socket::IP->new( | ||||
| 74 | PeerHost => "www.google.com", | ||||
| 75 | PeerPort => "http", | ||||
| 76 | Type => SOCK_STREAM, | ||||
| 77 | ) or die "Cannot construct socket - $@"; | ||||
| 78 | |||||
| 79 | my $familyname = ( $sock->sockdomain == PF_INET6 ) ? "IPv6" : | ||||
| 80 | ( $sock->sockdomain == PF_INET ) ? "IPv4" : | ||||
| 81 | "unknown"; | ||||
| 82 | |||||
| 83 | printf "Connected to google via %s\n", $familyname; | ||||
| 84 | |||||
| 85 | =head1 DESCRIPTION | ||||
| 86 | |||||
| 87 | This module provides a protocol-independent way to use IPv4 and IPv6 sockets, | ||||
| 88 | intended as a replacement for L<IO::Socket::INET>. Most constructor arguments | ||||
| 89 | and methods are provided in a backward-compatible way. For a list of known | ||||
| 90 | differences, see the C<IO::Socket::INET> INCOMPATIBILITES section below. | ||||
| 91 | |||||
| 92 | It uses the C<getaddrinfo(3)> function to convert hostnames and service names | ||||
| 93 | or port numbers into sets of possible addresses to connect to or listen on. | ||||
| 94 | This allows it to work for IPv6 where the system supports it, while still | ||||
| 95 | falling back to IPv4-only on systems which don't. | ||||
| 96 | |||||
| 97 | =head1 REPLACING C<IO::Socket> DEFAULT BEHAVIOUR | ||||
| 98 | |||||
| 99 | By placing C<-register> in the import list, L<IO::Socket> uses | ||||
| 100 | C<IO::Socket::IP> rather than C<IO::Socket::INET> as the class that handles | ||||
| 101 | C<PF_INET>. C<IO::Socket> will also use C<IO::Socket::IP> rather than | ||||
| 102 | C<IO::Socket::INET6> to handle C<PF_INET6>, provided that the C<AF_INET6> | ||||
| 103 | constant is available. | ||||
| 104 | |||||
| 105 | Changing C<IO::Socket>'s default behaviour means that calling the | ||||
| 106 | C<IO::Socket> constructor with either C<PF_INET> or C<PF_INET6> as the | ||||
| 107 | C<Domain> parameter will yield an C<IO::Socket::IP> object. | ||||
| 108 | |||||
| 109 | use IO::Socket::IP -register; | ||||
| 110 | |||||
| 111 | my $sock = IO::Socket->new( | ||||
| 112 | Domain => PF_INET6, | ||||
| 113 | LocalHost => "::1", | ||||
| 114 | Listen => 1, | ||||
| 115 | ) or die "Cannot create socket - $@\n"; | ||||
| 116 | |||||
| 117 | print "Created a socket of type " . ref($sock) . "\n"; | ||||
| 118 | |||||
| 119 | Note that C<-register> is a global setting that applies to the entire program; | ||||
| 120 | it cannot be applied only for certain callers, removed, or limited by lexical | ||||
| 121 | scope. | ||||
| 122 | |||||
| 123 | =cut | ||||
| 124 | |||||
| 125 | sub import | ||||
| 126 | { | ||||
| 127 | my $pkg = shift; | ||||
| 128 | my @symbols; | ||||
| 129 | |||||
| 130 | foreach ( @_ ) { | ||||
| 131 | if( $_ eq "-register" ) { | ||||
| 132 | IO::Socket::IP::_ForINET->register_domain( AF_INET ); | ||||
| 133 | IO::Socket::IP::_ForINET6->register_domain( $AF_INET6 ) if defined $AF_INET6; | ||||
| 134 | } | ||||
| 135 | else { | ||||
| 136 | push @symbols, $_; | ||||
| 137 | } | ||||
| 138 | } | ||||
| 139 | |||||
| 140 | @_ = ( $pkg, @symbols ); | ||||
| 141 | goto &IO::Socket::import; | ||||
| 142 | } | ||||
| 143 | |||||
| 144 | # Convenient capability test function | ||||
| 145 | { | ||||
| 146 | 1 | 200ns | my $can_disable_v6only; | ||
| 147 | sub CAN_DISABLE_V6ONLY | ||||
| 148 | { | ||||
| 149 | return $can_disable_v6only if defined $can_disable_v6only; | ||||
| 150 | |||||
| 151 | socket my $testsock, Socket::PF_INET6(), SOCK_STREAM, 0 or | ||||
| 152 | die "Cannot socket(PF_INET6) - $!"; | ||||
| 153 | |||||
| 154 | if( setsockopt $testsock, IPPROTO_IPV6, IPV6_V6ONLY, 0 ) { | ||||
| 155 | return $can_disable_v6only = 1; | ||||
| 156 | } | ||||
| 157 | elsif( $! == EINVAL ) { | ||||
| 158 | return $can_disable_v6only = 0; | ||||
| 159 | } | ||||
| 160 | else { | ||||
| 161 | die "Cannot setsockopt() - $!"; | ||||
| 162 | } | ||||
| 163 | } | ||||
| 164 | } | ||||
| 165 | |||||
| 166 | =head1 CONSTRUCTORS | ||||
| 167 | |||||
| 168 | =cut | ||||
| 169 | |||||
| 170 | =head2 $sock = IO::Socket::IP->new( %args ) | ||||
| 171 | |||||
| 172 | Creates a new C<IO::Socket::IP> object, containing a newly created socket | ||||
| 173 | handle according to the named arguments passed. The recognised arguments are: | ||||
| 174 | |||||
| 175 | =over 8 | ||||
| 176 | |||||
| 177 | =item PeerHost => STRING | ||||
| 178 | |||||
| 179 | =item PeerService => STRING | ||||
| 180 | |||||
| 181 | Hostname and service name for the peer to C<connect()> to. The service name | ||||
| 182 | may be given as a port number, as a decimal string. | ||||
| 183 | |||||
| 184 | =item PeerAddr => STRING | ||||
| 185 | |||||
| 186 | =item PeerPort => STRING | ||||
| 187 | |||||
| 188 | For symmetry with the accessor methods and compatibility with | ||||
| 189 | C<IO::Socket::INET>, these are accepted as synonyms for C<PeerHost> and | ||||
| 190 | C<PeerService> respectively. | ||||
| 191 | |||||
| 192 | =item PeerAddrInfo => ARRAY | ||||
| 193 | |||||
| 194 | Alternate form of specifying the peer to C<connect()> to. This should be an | ||||
| 195 | array of the form returned by C<Socket::getaddrinfo>. | ||||
| 196 | |||||
| 197 | This parameter takes precedence over the C<Peer*>, C<Family>, C<Type> and | ||||
| 198 | C<Proto> arguments. | ||||
| 199 | |||||
| 200 | =item LocalHost => STRING | ||||
| 201 | |||||
| 202 | =item LocalService => STRING | ||||
| 203 | |||||
| 204 | Hostname and service name for the local address to C<bind()> to. | ||||
| 205 | |||||
| 206 | =item LocalAddr => STRING | ||||
| 207 | |||||
| 208 | =item LocalPort => STRING | ||||
| 209 | |||||
| 210 | For symmetry with the accessor methods and compatibility with | ||||
| 211 | C<IO::Socket::INET>, these are accepted as synonyms for C<LocalHost> and | ||||
| 212 | C<LocalService> respectively. | ||||
| 213 | |||||
| 214 | =item LocalAddrInfo => ARRAY | ||||
| 215 | |||||
| 216 | Alternate form of specifying the local address to C<bind()> to. This should be | ||||
| 217 | an array of the form returned by C<Socket::getaddrinfo>. | ||||
| 218 | |||||
| 219 | This parameter takes precedence over the C<Local*>, C<Family>, C<Type> and | ||||
| 220 | C<Proto> arguments. | ||||
| 221 | |||||
| 222 | =item Family => INT | ||||
| 223 | |||||
| 224 | The address family to pass to C<getaddrinfo> (e.g. C<AF_INET>, C<AF_INET6>). | ||||
| 225 | Normally this will be left undefined, and C<getaddrinfo> will search using any | ||||
| 226 | address family supported by the system. | ||||
| 227 | |||||
| 228 | =item Type => INT | ||||
| 229 | |||||
| 230 | The socket type to pass to C<getaddrinfo> (e.g. C<SOCK_STREAM>, | ||||
| 231 | C<SOCK_DGRAM>). Normally defined by the caller; if left undefined | ||||
| 232 | C<getaddrinfo> may attempt to infer the type from the service name. | ||||
| 233 | |||||
| 234 | =item Proto => STRING or INT | ||||
| 235 | |||||
| 236 | The IP protocol to use for the socket (e.g. C<'tcp'>, C<IPPROTO_TCP>, | ||||
| 237 | C<'udp'>,C<IPPROTO_UDP>). Normally this will be left undefined, and either | ||||
| 238 | C<getaddrinfo> or the kernel will choose an appropriate value. May be given | ||||
| 239 | either in string name or numeric form. | ||||
| 240 | |||||
| 241 | =item GetAddrInfoFlags => INT | ||||
| 242 | |||||
| 243 | More flags to pass to the C<getaddrinfo()> function. If not supplied, a | ||||
| 244 | default of C<AI_ADDRCONFIG> will be used. | ||||
| 245 | |||||
| 246 | These flags will be combined with C<AI_PASSIVE> if the C<Listen> argument is | ||||
| 247 | given. For more information see the documentation about C<getaddrinfo()> in | ||||
| 248 | the L<Socket> module. | ||||
| 249 | |||||
| 250 | =item Listen => INT | ||||
| 251 | |||||
| 252 | If defined, puts the socket into listening mode where new connections can be | ||||
| 253 | accepted using the C<accept> method. The value given is used as the | ||||
| 254 | C<listen(2)> queue size. | ||||
| 255 | |||||
| 256 | =item ReuseAddr => BOOL | ||||
| 257 | |||||
| 258 | If true, set the C<SO_REUSEADDR> sockopt | ||||
| 259 | |||||
| 260 | =item ReusePort => BOOL | ||||
| 261 | |||||
| 262 | If true, set the C<SO_REUSEPORT> sockopt (not all OSes implement this sockopt) | ||||
| 263 | |||||
| 264 | =item Broadcast => BOOL | ||||
| 265 | |||||
| 266 | If true, set the C<SO_BROADCAST> sockopt | ||||
| 267 | |||||
| 268 | =item V6Only => BOOL | ||||
| 269 | |||||
| 270 | If defined, set the C<IPV6_V6ONLY> sockopt when creating C<PF_INET6> sockets | ||||
| 271 | to the given value. If true, a listening-mode socket will only listen on the | ||||
| 272 | C<AF_INET6> addresses; if false it will also accept connections from | ||||
| 273 | C<AF_INET> addresses. | ||||
| 274 | |||||
| 275 | If not defined, the socket option will not be changed, and default value set | ||||
| 276 | by the operating system will apply. For repeatable behaviour across platforms | ||||
| 277 | it is recommended this value always be defined for listening-mode sockets. | ||||
| 278 | |||||
| 279 | Note that not all platforms support disabling this option. Some, at least | ||||
| 280 | OpenBSD and MirBSD, will fail with C<EINVAL> if you attempt to disable it. | ||||
| 281 | To determine whether it is possible to disable, you may use the class method | ||||
| 282 | |||||
| 283 | if( IO::Socket::IP->CAN_DISABLE_V6ONLY ) { | ||||
| 284 | ... | ||||
| 285 | } | ||||
| 286 | else { | ||||
| 287 | ... | ||||
| 288 | } | ||||
| 289 | |||||
| 290 | If your platform does not support disabling this option but you still want to | ||||
| 291 | listen for both C<AF_INET> and C<AF_INET6> connections you will have to create | ||||
| 292 | two listening sockets, one bound to each protocol. | ||||
| 293 | |||||
| 294 | =item MultiHomed | ||||
| 295 | |||||
| 296 | This C<IO::Socket::INET>-style argument is ignored, except if it is defined | ||||
| 297 | but false. See the C<IO::Socket::INET> INCOMPATIBILITES section below. | ||||
| 298 | |||||
| 299 | However, the behaviour it enables is always performed by C<IO::Socket::IP>. | ||||
| 300 | |||||
| 301 | =item Blocking => BOOL | ||||
| 302 | |||||
| 303 | If defined but false, the socket will be set to non-blocking mode. Otherwise | ||||
| 304 | it will default to blocking mode. See the NON-BLOCKING section below for more | ||||
| 305 | detail. | ||||
| 306 | |||||
| 307 | =item Timeout => NUM | ||||
| 308 | |||||
| 309 | If defined, gives a maximum time in seconds to block per C<connect()> call | ||||
| 310 | when in blocking mode. If missing, no timeout is applied other than that | ||||
| 311 | provided by the underlying operating system. When in non-blocking mode this | ||||
| 312 | parameter is ignored. | ||||
| 313 | |||||
| 314 | Note that if the hostname resolves to multiple address candidates, the same | ||||
| 315 | timeout will apply to each connection attempt individually, rather than to the | ||||
| 316 | operation as a whole. Further note that the timeout does not apply to the | ||||
| 317 | initial hostname resolve operation, if connecting by hostname. | ||||
| 318 | |||||
| 319 | This behviour is copied inspired by C<IO::Socket::INET>; for more fine grained | ||||
| 320 | control over connection timeouts, consider performing a nonblocking connect | ||||
| 321 | directly. | ||||
| 322 | |||||
| 323 | =back | ||||
| 324 | |||||
| 325 | If neither C<Type> nor C<Proto> hints are provided, a default of | ||||
| 326 | C<SOCK_STREAM> and C<IPPROTO_TCP> respectively will be set, to maintain | ||||
| 327 | compatibility with C<IO::Socket::INET>. Other named arguments that are not | ||||
| 328 | recognised are ignored. | ||||
| 329 | |||||
| 330 | If neither C<Family> nor any hosts or addresses are passed, nor any | ||||
| 331 | C<*AddrInfo>, then the constructor has no information on which to decide a | ||||
| 332 | socket family to create. In this case, it performs a C<getaddinfo> call with | ||||
| 333 | the C<AI_ADDRCONFIG> flag, no host name, and a service name of C<"0">, and | ||||
| 334 | uses the family of the first returned result. | ||||
| 335 | |||||
| 336 | If the constructor fails, it will set C<$@> to an appropriate error message; | ||||
| 337 | this may be from C<$!> or it may be some other string; not every failure | ||||
| 338 | necessarily has an associated C<errno> value. | ||||
| 339 | |||||
| 340 | =head2 $sock = IO::Socket::IP->new( $peeraddr ) | ||||
| 341 | |||||
| 342 | As a special case, if the constructor is passed a single argument (as | ||||
| 343 | opposed to an even-sized list of key/value pairs), it is taken to be the value | ||||
| 344 | of the C<PeerAddr> parameter. This is parsed in the same way, according to the | ||||
| 345 | behaviour given in the C<PeerHost> AND C<LocalHost> PARSING section below. | ||||
| 346 | |||||
| 347 | =cut | ||||
| 348 | |||||
| 349 | sub new | ||||
| 350 | 1 | 300ns | # spent 856ms (19.1+836) within IO::Socket::IP::new which was called 2002 times, avg 427µs/call:
# 2002 times (19.1ms+836ms) by HTTP::Tiny::Handle::connect at line 921 of HTTP/Tiny.pm, avg 427µs/call | ||
| 351 | 2002 | 826µs | my $class = shift; | ||
| 352 | 2002 | 6.83ms | my %arg = (@_ == 1) ? (PeerHost => $_[0]) : @_; | ||
| 353 | 2002 | 18.8ms | 2002 | 836ms | return $class->SUPER::new(%arg); # spent 836ms making 2002 calls to IO::Socket::new, avg 418µs/call |
| 354 | } | ||||
| 355 | |||||
| 356 | # IO::Socket may call this one; neaten up the arguments from IO::Socket::INET | ||||
| 357 | # before calling our real _configure method | ||||
| 358 | sub configure | ||||
| 359 | # spent 674ms (32.9+641) within IO::Socket::IP::configure which was called 2002 times, avg 336µs/call:
# 2002 times (32.9ms+641ms) by IO::Socket::new at line 49 of IO/Socket.pm, avg 336µs/call | ||||
| 360 | 2002 | 702µs | my $self = shift; | ||
| 361 | 2002 | 766µs | my ( $arg ) = @_; | ||
| 362 | |||||
| 363 | $arg->{PeerHost} = delete $arg->{PeerAddr} | ||||
| 364 | 2002 | 1.03ms | if exists $arg->{PeerAddr} && !exists $arg->{PeerHost}; | ||
| 365 | |||||
| 366 | $arg->{PeerService} = delete $arg->{PeerPort} | ||||
| 367 | 2002 | 3.12ms | if exists $arg->{PeerPort} && !exists $arg->{PeerService}; | ||
| 368 | |||||
| 369 | $arg->{LocalHost} = delete $arg->{LocalAddr} | ||||
| 370 | 2002 | 641µs | if exists $arg->{LocalAddr} && !exists $arg->{LocalHost}; | ||
| 371 | |||||
| 372 | $arg->{LocalService} = delete $arg->{LocalPort} | ||||
| 373 | 2002 | 595µs | if exists $arg->{LocalPort} && !exists $arg->{LocalService}; | ||
| 374 | |||||
| 375 | 2002 | 1.75ms | for my $type (qw(Peer Local)) { | ||
| 376 | 4004 | 1.72ms | my $host = $type . 'Host'; | ||
| 377 | 4004 | 1.53ms | my $service = $type . 'Service'; | ||
| 378 | |||||
| 379 | 4004 | 3.06ms | if( defined $arg->{$host} ) { | ||
| 380 | 2002 | 5.57ms | 2002 | 29.6ms | ( $arg->{$host}, my $s ) = $self->split_addr( $arg->{$host} ); # spent 29.6ms making 2002 calls to IO::Socket::IP::split_addr, avg 15µs/call |
| 381 | # IO::Socket::INET compat - *Host parsed port always takes precedence | ||||
| 382 | 2002 | 1.12ms | $arg->{$service} = $s if defined $s; | ||
| 383 | } | ||||
| 384 | } | ||||
| 385 | |||||
| 386 | 2002 | 19.4ms | 2002 | 611ms | $self->_io_socket_ip__configure( $arg ); # spent 611ms making 2002 calls to IO::Socket::IP::_io_socket_ip__configure, avg 305µs/call |
| 387 | } | ||||
| 388 | |||||
| 389 | # Avoid simply calling it _configure, as some subclasses of IO::Socket::INET on CPAN already take that | ||||
| 390 | sub _io_socket_ip__configure | ||||
| 391 | # spent 611ms (134+477) within IO::Socket::IP::_io_socket_ip__configure which was called 2002 times, avg 305µs/call:
# 2002 times (134ms+477ms) by IO::Socket::IP::configure at line 386, avg 305µs/call | ||||
| 392 | 2002 | 579µs | my $self = shift; | ||
| 393 | 2002 | 579µs | my ( $arg ) = @_; | ||
| 394 | |||||
| 395 | 2002 | 517µs | my %hints; | ||
| 396 | my @localinfos; | ||||
| 397 | my @peerinfos; | ||||
| 398 | |||||
| 399 | 2002 | 1.00ms | my $listenqueue = $arg->{Listen}; | ||
| 400 | 2002 | 701µs | if( defined $listenqueue and | ||
| 401 | ( defined $arg->{PeerHost} || defined $arg->{PeerService} || defined $arg->{PeerAddrInfo} ) ) { | ||||
| 402 | croak "Cannot Listen with a peer address"; | ||||
| 403 | } | ||||
| 404 | |||||
| 405 | 2002 | 1.57ms | if( defined $arg->{GetAddrInfoFlags} ) { | ||
| 406 | $hints{flags} = $arg->{GetAddrInfoFlags}; | ||||
| 407 | } | ||||
| 408 | else { | ||||
| 409 | 2002 | 1.54ms | $hints{flags} = $AI_ADDRCONFIG; | ||
| 410 | } | ||||
| 411 | |||||
| 412 | 2002 | 1.12ms | if( defined( my $family = $arg->{Family} ) ) { | ||
| 413 | $hints{family} = $family; | ||||
| 414 | } | ||||
| 415 | |||||
| 416 | 2002 | 2.35ms | if( defined( my $type = $arg->{Type} ) ) { | ||
| 417 | $hints{socktype} = $type; | ||||
| 418 | } | ||||
| 419 | |||||
| 420 | 2002 | 1.48ms | if( defined( my $proto = $arg->{Proto} ) ) { | ||
| 421 | 2002 | 18.1ms | 2002 | 1.50ms | unless( $proto =~ m/^\d+$/ ) { # spent 1.50ms making 2002 calls to IO::Socket::IP::CORE:match, avg 749ns/call |
| 422 | my $protonum = HAVE_GETPROTOBYNAME | ||||
| 423 | ? getprotobyname( $proto ) | ||||
| 424 | 2002 | 61.4ms | 2002 | 49.0ms | : eval { Socket->${\"IPPROTO_\U$proto"}() }; # spent 49.0ms making 2002 calls to IO::Socket::IP::CORE:gpbyname, avg 24µs/call |
| 425 | 2002 | 773µs | defined $protonum or croak "Unrecognised protocol $proto"; | ||
| 426 | 2002 | 1.01ms | $proto = $protonum; | ||
| 427 | } | ||||
| 428 | |||||
| 429 | 2002 | 1.35ms | $hints{protocol} = $proto; | ||
| 430 | } | ||||
| 431 | |||||
| 432 | # To maintain compatibility with IO::Socket::INET, imply a default of | ||||
| 433 | # SOCK_STREAM + IPPROTO_TCP if neither hint is given | ||||
| 434 | 2002 | 1.12ms | if( !defined $hints{socktype} and !defined $hints{protocol} ) { | ||
| 435 | $hints{socktype} = SOCK_STREAM; | ||||
| 436 | $hints{protocol} = IPPROTO_TCP; | ||||
| 437 | } | ||||
| 438 | |||||
| 439 | # Some OSes (NetBSD) don't seem to like just a protocol hint without a | ||||
| 440 | # socktype hint as well. We'll set a couple of common ones | ||||
| 441 | 2002 | 1.06ms | if( !defined $hints{socktype} and defined $hints{protocol} ) { | ||
| 442 | $hints{socktype} = SOCK_STREAM if $hints{protocol} == IPPROTO_TCP; | ||||
| 443 | $hints{socktype} = SOCK_DGRAM if $hints{protocol} == IPPROTO_UDP; | ||||
| 444 | } | ||||
| 445 | |||||
| 446 | 2002 | 2.90ms | if( my $info = $arg->{LocalAddrInfo} ) { | ||
| 447 | ref $info eq "ARRAY" or croak "Expected 'LocalAddrInfo' to be an ARRAY ref"; | ||||
| 448 | @localinfos = @$info; | ||||
| 449 | } | ||||
| 450 | elsif( defined $arg->{LocalHost} or | ||||
| 451 | defined $arg->{LocalService} or | ||||
| 452 | HAVE_MSWIN32 and $arg->{Listen} ) { | ||||
| 453 | # Either may be undef | ||||
| 454 | my $host = $arg->{LocalHost}; | ||||
| 455 | my $service = $arg->{LocalService}; | ||||
| 456 | |||||
| 457 | unless ( defined $host or defined $service ) { | ||||
| 458 | $service = 0; | ||||
| 459 | } | ||||
| 460 | |||||
| 461 | local $1; # Placate a taint-related bug; [perl #67962] | ||||
| 462 | defined $service and $service =~ s/\((\d+)\)$// and | ||||
| 463 | my $fallback_port = $1; | ||||
| 464 | |||||
| 465 | my %localhints = %hints; | ||||
| 466 | $localhints{flags} |= AI_PASSIVE; | ||||
| 467 | ( my $err, @localinfos ) = getaddrinfo( $host, $service, \%localhints ); | ||||
| 468 | |||||
| 469 | if( $err and defined $fallback_port ) { | ||||
| 470 | ( $err, @localinfos ) = getaddrinfo( $host, $fallback_port, \%localhints ); | ||||
| 471 | } | ||||
| 472 | |||||
| 473 | if( $err ) { | ||||
| 474 | $@ = "$err"; | ||||
| 475 | $! = EINVAL; | ||||
| 476 | return; | ||||
| 477 | } | ||||
| 478 | } | ||||
| 479 | |||||
| 480 | 2002 | 2.11ms | if( my $info = $arg->{PeerAddrInfo} ) { | ||
| 481 | ref $info eq "ARRAY" or croak "Expected 'PeerAddrInfo' to be an ARRAY ref"; | ||||
| 482 | @peerinfos = @$info; | ||||
| 483 | } | ||||
| 484 | elsif( defined $arg->{PeerHost} or defined $arg->{PeerService} ) { | ||||
| 485 | 2002 | 1.21ms | defined( my $host = $arg->{PeerHost} ) or | ||
| 486 | croak "Expected 'PeerHost'"; | ||||
| 487 | 2002 | 1.23ms | defined( my $service = $arg->{PeerService} ) or | ||
| 488 | croak "Expected 'PeerService'"; | ||||
| 489 | |||||
| 490 | 2002 | 1.65ms | local $1; # Placate a taint-related bug; [perl #67962] | ||
| 491 | 2002 | 11.6ms | 2002 | 1.05ms | defined $service and $service =~ s/\((\d+)\)$// and # spent 1.05ms making 2002 calls to IO::Socket::IP::CORE:subst, avg 527ns/call |
| 492 | my $fallback_port = $1; | ||||
| 493 | |||||
| 494 | 2002 | 121ms | 2002 | 110ms | ( my $err, @peerinfos ) = getaddrinfo( $host, $service, \%hints ); # spent 110ms making 2002 calls to Socket::getaddrinfo, avg 55µs/call |
| 495 | |||||
| 496 | 2002 | 550µs | if( $err and defined $fallback_port ) { | ||
| 497 | ( $err, @peerinfos ) = getaddrinfo( $host, $fallback_port, \%hints ); | ||||
| 498 | } | ||||
| 499 | |||||
| 500 | 2002 | 2.09ms | if( $err ) { | ||
| 501 | $@ = "$err"; | ||||
| 502 | $! = EINVAL; | ||||
| 503 | return; | ||||
| 504 | } | ||||
| 505 | } | ||||
| 506 | |||||
| 507 | 2002 | 419µs | my @sockopts_enabled; | ||
| 508 | 2002 | 1.08ms | push @sockopts_enabled, SO_REUSEADDR if $arg->{ReuseAddr}; | ||
| 509 | 2002 | 809µs | push @sockopts_enabled, SO_REUSEPORT if $arg->{ReusePort}; | ||
| 510 | 2002 | 741µs | push @sockopts_enabled, SO_BROADCAST if $arg->{Broadcast}; | ||
| 511 | |||||
| 512 | 2002 | 821µs | my $blocking = $arg->{Blocking}; | ||
| 513 | 2002 | 888µs | defined $blocking or $blocking = 1; | ||
| 514 | |||||
| 515 | 2002 | 741µs | my $v6only = $arg->{V6Only}; | ||
| 516 | |||||
| 517 | # IO::Socket::INET defines this key. IO::Socket::IP always implements the | ||||
| 518 | # behaviour it requests, so we can ignore it, unless the caller is for some | ||||
| 519 | # reason asking to disable it. | ||||
| 520 | 2002 | 681µs | if( defined $arg->{MultiHomed} and !$arg->{MultiHomed} ) { | ||
| 521 | croak "Cannot disable the MultiHomed parameter"; | ||||
| 522 | } | ||||
| 523 | |||||
| 524 | 2002 | 347µs | my @infos; | ||
| 525 | 2002 | 3.11ms | foreach my $local ( @localinfos ? @localinfos : {} ) { | ||
| 526 | 2002 | 2.14ms | foreach my $peer ( @peerinfos ? @peerinfos : {} ) { | ||
| 527 | next if defined $local->{family} and defined $peer->{family} and | ||||
| 528 | 2002 | 866µs | $local->{family} != $peer->{family}; | ||
| 529 | next if defined $local->{socktype} and defined $peer->{socktype} and | ||||
| 530 | 2002 | 637µs | $local->{socktype} != $peer->{socktype}; | ||
| 531 | next if defined $local->{protocol} and defined $peer->{protocol} and | ||||
| 532 | 2002 | 641µs | $local->{protocol} != $peer->{protocol}; | ||
| 533 | |||||
| 534 | 2002 | 1.54ms | my $family = $local->{family} || $peer->{family} or next; | ||
| 535 | 2002 | 1.18ms | my $socktype = $local->{socktype} || $peer->{socktype} or next; | ||
| 536 | 2002 | 1.07ms | my $protocol = $local->{protocol} || $peer->{protocol} || 0; | ||
| 537 | |||||
| 538 | push @infos, { | ||||
| 539 | family => $family, | ||||
| 540 | socktype => $socktype, | ||||
| 541 | protocol => $protocol, | ||||
| 542 | localaddr => $local->{addr}, | ||||
| 543 | peeraddr => $peer->{addr}, | ||||
| 544 | 2002 | 5.91ms | }; | ||
| 545 | } | ||||
| 546 | } | ||||
| 547 | |||||
| 548 | 2002 | 761µs | if( !@infos ) { | ||
| 549 | # If there was a Family hint then create a plain unbound, unconnected socket | ||||
| 550 | if( defined $hints{family} ) { | ||||
| 551 | @infos = ( { | ||||
| 552 | family => $hints{family}, | ||||
| 553 | socktype => $hints{socktype}, | ||||
| 554 | protocol => $hints{protocol}, | ||||
| 555 | } ); | ||||
| 556 | } | ||||
| 557 | # If there wasn't, use getaddrinfo()'s AI_ADDRCONFIG side-effect to guess a | ||||
| 558 | # suitable family first. | ||||
| 559 | else { | ||||
| 560 | ( my $err, @infos ) = getaddrinfo( "", "0", \%hints ); | ||||
| 561 | if( $err ) { | ||||
| 562 | $@ = "$err"; | ||||
| 563 | $! = EINVAL; | ||||
| 564 | return; | ||||
| 565 | } | ||||
| 566 | |||||
| 567 | # We'll take all the @infos anyway, because some OSes (HPUX) are known to | ||||
| 568 | # ignore the AI_ADDRCONFIG hint and return AF_INET6 even if they don't | ||||
| 569 | # support them | ||||
| 570 | } | ||||
| 571 | } | ||||
| 572 | |||||
| 573 | # In the nonblocking case, caller will be calling ->setup multiple times. | ||||
| 574 | # Store configuration in the object for the ->setup method | ||||
| 575 | # Yes, these are messy. Sorry, I can't help that... | ||||
| 576 | |||||
| 577 | 2002 | 2.17ms | ${*$self}{io_socket_ip_infos} = \@infos; | ||
| 578 | |||||
| 579 | 2002 | 1.39ms | ${*$self}{io_socket_ip_idx} = -1; | ||
| 580 | |||||
| 581 | 2002 | 1.19ms | ${*$self}{io_socket_ip_sockopts} = \@sockopts_enabled; | ||
| 582 | 2002 | 884µs | ${*$self}{io_socket_ip_v6only} = $v6only; | ||
| 583 | 2002 | 1.03ms | ${*$self}{io_socket_ip_listenqueue} = $listenqueue; | ||
| 584 | 2002 | 1.07ms | ${*$self}{io_socket_ip_blocking} = $blocking; | ||
| 585 | |||||
| 586 | 2002 | 3.84ms | ${*$self}{io_socket_ip_errors} = [ undef, undef, undef ]; | ||
| 587 | |||||
| 588 | # ->setup is allowed to return false in nonblocking mode | ||||
| 589 | 2002 | 4.49ms | 2002 | 316ms | $self->setup or !$blocking or return undef; # spent 316ms making 2002 calls to IO::Socket::IP::setup, avg 158µs/call |
| 590 | |||||
| 591 | 2002 | 9.63ms | return $self; | ||
| 592 | } | ||||
| 593 | |||||
| 594 | sub setup | ||||
| 595 | # spent 316ms (39.2+277) within IO::Socket::IP::setup which was called 2002 times, avg 158µs/call:
# 2002 times (39.2ms+277ms) by IO::Socket::IP::_io_socket_ip__configure at line 589, avg 158µs/call | ||||
| 596 | 2002 | 693µs | my $self = shift; | ||
| 597 | |||||
| 598 | 2002 | 543µs | while(1) { | ||
| 599 | 2002 | 1.01ms | ${*$self}{io_socket_ip_idx}++; | ||
| 600 | 2002 | 1.95ms | last if ${*$self}{io_socket_ip_idx} >= @{ ${*$self}{io_socket_ip_infos} }; | ||
| 601 | |||||
| 602 | 2002 | 2.03ms | my $info = ${*$self}{io_socket_ip_infos}->[${*$self}{io_socket_ip_idx}]; | ||
| 603 | |||||
| 604 | $self->socket( @{$info}{qw( family socktype protocol )} ) or | ||||
| 605 | 2002 | 5.94ms | 2002 | 52.1ms | ( ${*$self}{io_socket_ip_errors}[2] = $!, next ); # spent 52.1ms making 2002 calls to IO::Socket::IP::socket, avg 26µs/call |
| 606 | |||||
| 607 | 2002 | 1.23ms | $self->blocking( 0 ) unless ${*$self}{io_socket_ip_blocking}; | ||
| 608 | |||||
| 609 | 2002 | 3.37ms | foreach my $sockopt ( @{ ${*$self}{io_socket_ip_sockopts} } ) { | ||
| 610 | 1 | 2µs | $self->setsockopt( SOL_SOCKET, $sockopt, pack "i", 1 ) or ( $@ = "$!", return undef ); # spent 2µs making 1 call to main::CORE:pack | ||
| 611 | } | ||||
| 612 | |||||
| 613 | 2002 | 1.06ms | if( defined ${*$self}{io_socket_ip_v6only} and defined $AF_INET6 and $info->{family} == $AF_INET6 ) { | ||
| 614 | my $v6only = ${*$self}{io_socket_ip_v6only}; | ||||
| 615 | $self->setsockopt( IPPROTO_IPV6, IPV6_V6ONLY, pack "i", $v6only ) or ( $@ = "$!", return undef ); | ||||
| 616 | } | ||||
| 617 | |||||
| 618 | 2002 | 1.14ms | if( defined( my $addr = $info->{localaddr} ) ) { | ||
| 619 | $self->bind( $addr ) or | ||||
| 620 | ( ${*$self}{io_socket_ip_errors}[1] = $!, next ); | ||||
| 621 | } | ||||
| 622 | |||||
| 623 | 2002 | 1.35ms | if( defined( my $listenqueue = ${*$self}{io_socket_ip_listenqueue} ) ) { | ||
| 624 | $self->listen( $listenqueue ) or ( $@ = "$!", return undef ); | ||||
| 625 | } | ||||
| 626 | |||||
| 627 | 2002 | 1.34ms | if( defined( my $addr = $info->{peeraddr} ) ) { | ||
| 628 | 2002 | 3.80ms | 2002 | 225ms | if( $self->connect( $addr ) ) { # spent 225ms making 2002 calls to IO::Socket::IP::connect, avg 112µs/call |
| 629 | 2002 | 1.54ms | $! = 0; | ||
| 630 | 2002 | 11.3ms | return 1; | ||
| 631 | } | ||||
| 632 | |||||
| 633 | if( $! == EINPROGRESS or $! == EWOULDBLOCK ) { | ||||
| 634 | ${*$self}{io_socket_ip_connect_in_progress} = 1; | ||||
| 635 | return 0; | ||||
| 636 | } | ||||
| 637 | |||||
| 638 | # If connect failed but we have no system error there must be an error | ||||
| 639 | # at the application layer, like a bad certificate with | ||||
| 640 | # IO::Socket::SSL. | ||||
| 641 | # In this case don't continue IP based multi-homing because the problem | ||||
| 642 | # cannot be solved at the IP layer. | ||||
| 643 | return 0 if ! $!; | ||||
| 644 | |||||
| 645 | ${*$self}{io_socket_ip_errors}[0] = $!; | ||||
| 646 | next; | ||||
| 647 | } | ||||
| 648 | |||||
| 649 | return 1; | ||||
| 650 | } | ||||
| 651 | |||||
| 652 | # Pick the most appropriate error, stringified | ||||
| 653 | $! = ( grep defined, @{ ${*$self}{io_socket_ip_errors}} )[0]; | ||||
| 654 | $@ = "$!"; | ||||
| 655 | return undef; | ||||
| 656 | } | ||||
| 657 | |||||
| 658 | # spent 225ms (60.3+164) within IO::Socket::IP::connect which was called 2002 times, avg 112µs/call:
# 2002 times (60.3ms+164ms) by IO::Socket::IP::setup at line 628, avg 112µs/call | ||||
| 659 | { | ||||
| 660 | 2002 | 592µs | my $self = shift; | ||
| 661 | |||||
| 662 | # It seems that IO::Socket hides EINPROGRESS errors, making them look like | ||||
| 663 | # a success. This is annoying here. | ||||
| 664 | # Instead of putting up with its frankly-irritating intentional breakage of | ||||
| 665 | # useful APIs I'm just going to end-run around it and call core's connect() | ||||
| 666 | # directly | ||||
| 667 | |||||
| 668 | 2002 | 956µs | if( @_ ) { | ||
| 669 | 2002 | 776µs | my ( $addr ) = @_; | ||
| 670 | |||||
| 671 | # Annoyingly IO::Socket's connect() is where the timeout logic is | ||||
| 672 | # implemented, so we'll have to reinvent it here | ||||
| 673 | 2002 | 1.65ms | my $timeout = ${*$self}{'io_socket_timeout'}; | ||
| 674 | |||||
| 675 | 2002 | 619µs | return connect( $self, $addr ) unless defined $timeout; | ||
| 676 | |||||
| 677 | 2002 | 3.76ms | 2002 | 14.3ms | my $was_blocking = $self->blocking( 0 ); # spent 14.3ms making 2002 calls to IO::Socket::blocking, avg 7µs/call |
| 678 | |||||
| 679 | 2002 | 127ms | 2002 | 109ms | my $err = defined connect( $self, $addr ) ? 0 : $!+0; # spent 109ms making 2002 calls to IO::Socket::IP::CORE:connect, avg 54µs/call |
| 680 | |||||
| 681 | 2002 | 2.51ms | if( !$err ) { | ||
| 682 | # All happy | ||||
| 683 | $self->blocking( $was_blocking ); | ||||
| 684 | return 1; | ||||
| 685 | } | ||||
| 686 | elsif( not( $err == EINPROGRESS or $err == EWOULDBLOCK ) ) { | ||||
| 687 | # Failed for some other reason | ||||
| 688 | return undef; | ||||
| 689 | } | ||||
| 690 | elsif( !$was_blocking ) { | ||||
| 691 | # We shouldn't block anyway | ||||
| 692 | return undef; | ||||
| 693 | } | ||||
| 694 | |||||
| 695 | 4004 | 8.65ms | 2002 | 3.52ms | my $vec = ''; vec( $vec, $self->fileno, 1 ) = 1; # spent 3.52ms making 2002 calls to IO::Handle::fileno, avg 2µs/call |
| 696 | 2002 | 11.6ms | 2002 | 6.77ms | if( !select( undef, $vec, $vec, $timeout ) ) { # spent 6.77ms making 2002 calls to IO::Socket::IP::CORE:sselect, avg 3µs/call |
| 697 | $! = ETIMEDOUT; | ||||
| 698 | return undef; | ||||
| 699 | } | ||||
| 700 | |||||
| 701 | # Hoist the error by connect()ing a second time | ||||
| 702 | 2002 | 4.91ms | 2002 | 22.6ms | $err = $self->getsockopt( SOL_SOCKET, SO_ERROR ); # spent 22.6ms making 2002 calls to IO::Socket::getsockopt, avg 11µs/call |
| 703 | 2002 | 910µs | $err = 0 if $err == EISCONN; # Some OSes give EISCONN | ||
| 704 | |||||
| 705 | 2002 | 2.35ms | 2002 | 8.59ms | $self->blocking( $was_blocking ); # spent 8.59ms making 2002 calls to IO::Socket::blocking, avg 4µs/call |
| 706 | |||||
| 707 | 2002 | 637µs | $! = $err, return undef if $err; | ||
| 708 | 2002 | 11.0ms | return 1; | ||
| 709 | } | ||||
| 710 | |||||
| 711 | return 1 if !${*$self}{io_socket_ip_connect_in_progress}; | ||||
| 712 | |||||
| 713 | # See if a connect attempt has just failed with an error | ||||
| 714 | if( my $errno = $self->getsockopt( SOL_SOCKET, SO_ERROR ) ) { | ||||
| 715 | delete ${*$self}{io_socket_ip_connect_in_progress}; | ||||
| 716 | ${*$self}{io_socket_ip_errors}[0] = $! = $errno; | ||||
| 717 | return $self->setup; | ||||
| 718 | } | ||||
| 719 | |||||
| 720 | # No error, so either connect is still in progress, or has completed | ||||
| 721 | # successfully. We can tell by trying to connect() again; either it will | ||||
| 722 | # succeed or we'll get EISCONN (connected successfully), or EALREADY | ||||
| 723 | # (still in progress). This even works on MSWin32. | ||||
| 724 | my $addr = ${*$self}{io_socket_ip_infos}[${*$self}{io_socket_ip_idx}]{peeraddr}; | ||||
| 725 | |||||
| 726 | if( connect( $self, $addr ) or $! == EISCONN ) { | ||||
| 727 | delete ${*$self}{io_socket_ip_connect_in_progress}; | ||||
| 728 | $! = 0; | ||||
| 729 | return 1; | ||||
| 730 | } | ||||
| 731 | else { | ||||
| 732 | $! = EINPROGRESS; | ||||
| 733 | return 0; | ||||
| 734 | } | ||||
| 735 | } | ||||
| 736 | |||||
| 737 | sub connected | ||||
| 738 | { | ||||
| 739 | my $self = shift; | ||||
| 740 | return defined $self->fileno && | ||||
| 741 | !${*$self}{io_socket_ip_connect_in_progress} && | ||||
| 742 | defined getpeername( $self ); # ->peername caches, we need to detect disconnection | ||||
| 743 | } | ||||
| 744 | |||||
| 745 | =head1 METHODS | ||||
| 746 | |||||
| 747 | As well as the following methods, this class inherits all the methods in | ||||
| 748 | L<IO::Socket> and L<IO::Handle>. | ||||
| 749 | |||||
| 750 | =cut | ||||
| 751 | |||||
| 752 | sub _get_host_service | ||||
| 753 | { | ||||
| 754 | my $self = shift; | ||||
| 755 | my ( $addr, $flags, $xflags ) = @_; | ||||
| 756 | |||||
| 757 | defined $addr or | ||||
| 758 | $! = ENOTCONN, return; | ||||
| 759 | |||||
| 760 | $flags |= NI_DGRAM if $self->socktype == SOCK_DGRAM; | ||||
| 761 | |||||
| 762 | my ( $err, $host, $service ) = getnameinfo( $addr, $flags, $xflags || 0 ); | ||||
| 763 | croak "getnameinfo - $err" if $err; | ||||
| 764 | |||||
| 765 | return ( $host, $service ); | ||||
| 766 | } | ||||
| 767 | |||||
| 768 | sub _unpack_sockaddr | ||||
| 769 | { | ||||
| 770 | my ( $addr ) = @_; | ||||
| 771 | my $family = sockaddr_family $addr; | ||||
| 772 | |||||
| 773 | if( $family == AF_INET ) { | ||||
| 774 | return ( Socket::unpack_sockaddr_in( $addr ) )[1]; | ||||
| 775 | } | ||||
| 776 | elsif( defined $AF_INET6 and $family == $AF_INET6 ) { | ||||
| 777 | return ( Socket::unpack_sockaddr_in6( $addr ) )[1]; | ||||
| 778 | } | ||||
| 779 | else { | ||||
| 780 | croak "Unrecognised address family $family"; | ||||
| 781 | } | ||||
| 782 | } | ||||
| 783 | |||||
| 784 | =head2 ( $host, $service ) = $sock->sockhost_service( $numeric ) | ||||
| 785 | |||||
| 786 | Returns the hostname and service name of the local address (that is, the | ||||
| 787 | socket address given by the C<sockname> method). | ||||
| 788 | |||||
| 789 | If C<$numeric> is true, these will be given in numeric form rather than being | ||||
| 790 | resolved into names. | ||||
| 791 | |||||
| 792 | The following four convenience wrappers may be used to obtain one of the two | ||||
| 793 | values returned here. If both host and service names are required, this method | ||||
| 794 | is preferable to the following wrappers, because it will call | ||||
| 795 | C<getnameinfo(3)> only once. | ||||
| 796 | |||||
| 797 | =cut | ||||
| 798 | |||||
| 799 | sub sockhost_service | ||||
| 800 | { | ||||
| 801 | my $self = shift; | ||||
| 802 | my ( $numeric ) = @_; | ||||
| 803 | |||||
| 804 | $self->_get_host_service( $self->sockname, $numeric ? NI_NUMERICHOST|NI_NUMERICSERV : 0 ); | ||||
| 805 | } | ||||
| 806 | |||||
| 807 | =head2 $addr = $sock->sockhost | ||||
| 808 | |||||
| 809 | Return the numeric form of the local address as a textual representation | ||||
| 810 | |||||
| 811 | =head2 $port = $sock->sockport | ||||
| 812 | |||||
| 813 | Return the numeric form of the local port number | ||||
| 814 | |||||
| 815 | =head2 $host = $sock->sockhostname | ||||
| 816 | |||||
| 817 | Return the resolved name of the local address | ||||
| 818 | |||||
| 819 | =head2 $service = $sock->sockservice | ||||
| 820 | |||||
| 821 | Return the resolved name of the local port number | ||||
| 822 | |||||
| 823 | =cut | ||||
| 824 | |||||
| 825 | sub sockhost { my $self = shift; scalar +( $self->_get_host_service( $self->sockname, NI_NUMERICHOST, NIx_NOSERV ) )[0] } | ||||
| 826 | sub sockport { my $self = shift; scalar +( $self->_get_host_service( $self->sockname, NI_NUMERICSERV, NIx_NOHOST ) )[1] } | ||||
| 827 | |||||
| 828 | sub sockhostname { my $self = shift; scalar +( $self->_get_host_service( $self->sockname, 0, NIx_NOSERV ) )[0] } | ||||
| 829 | sub sockservice { my $self = shift; scalar +( $self->_get_host_service( $self->sockname, 0, NIx_NOHOST ) )[1] } | ||||
| 830 | |||||
| 831 | =head2 $addr = $sock->sockaddr | ||||
| 832 | |||||
| 833 | Return the local address as a binary octet string | ||||
| 834 | |||||
| 835 | =cut | ||||
| 836 | |||||
| 837 | sub sockaddr { my $self = shift; _unpack_sockaddr $self->sockname } | ||||
| 838 | |||||
| 839 | =head2 ( $host, $service ) = $sock->peerhost_service( $numeric ) | ||||
| 840 | |||||
| 841 | Returns the hostname and service name of the peer address (that is, the | ||||
| 842 | socket address given by the C<peername> method), similar to the | ||||
| 843 | C<sockhost_service> method. | ||||
| 844 | |||||
| 845 | The following four convenience wrappers may be used to obtain one of the two | ||||
| 846 | values returned here. If both host and service names are required, this method | ||||
| 847 | is preferable to the following wrappers, because it will call | ||||
| 848 | C<getnameinfo(3)> only once. | ||||
| 849 | |||||
| 850 | =cut | ||||
| 851 | |||||
| 852 | sub peerhost_service | ||||
| 853 | { | ||||
| 854 | my $self = shift; | ||||
| 855 | my ( $numeric ) = @_; | ||||
| 856 | |||||
| 857 | $self->_get_host_service( $self->peername, $numeric ? NI_NUMERICHOST|NI_NUMERICSERV : 0 ); | ||||
| 858 | } | ||||
| 859 | |||||
| 860 | =head2 $addr = $sock->peerhost | ||||
| 861 | |||||
| 862 | Return the numeric form of the peer address as a textual representation | ||||
| 863 | |||||
| 864 | =head2 $port = $sock->peerport | ||||
| 865 | |||||
| 866 | Return the numeric form of the peer port number | ||||
| 867 | |||||
| 868 | =head2 $host = $sock->peerhostname | ||||
| 869 | |||||
| 870 | Return the resolved name of the peer address | ||||
| 871 | |||||
| 872 | =head2 $service = $sock->peerservice | ||||
| 873 | |||||
| 874 | Return the resolved name of the peer port number | ||||
| 875 | |||||
| 876 | =cut | ||||
| 877 | |||||
| 878 | sub peerhost { my $self = shift; scalar +( $self->_get_host_service( $self->peername, NI_NUMERICHOST, NIx_NOSERV ) )[0] } | ||||
| 879 | sub peerport { my $self = shift; scalar +( $self->_get_host_service( $self->peername, NI_NUMERICSERV, NIx_NOHOST ) )[1] } | ||||
| 880 | |||||
| 881 | sub peerhostname { my $self = shift; scalar +( $self->_get_host_service( $self->peername, 0, NIx_NOSERV ) )[0] } | ||||
| 882 | sub peerservice { my $self = shift; scalar +( $self->_get_host_service( $self->peername, 0, NIx_NOHOST ) )[1] } | ||||
| 883 | |||||
| 884 | =head2 $addr = $peer->peeraddr | ||||
| 885 | |||||
| 886 | Return the peer address as a binary octet string | ||||
| 887 | |||||
| 888 | =cut | ||||
| 889 | |||||
| 890 | sub peeraddr { my $self = shift; _unpack_sockaddr $self->peername } | ||||
| 891 | |||||
| 892 | # This unbelievably dodgy hack works around the bug that IO::Socket doesn't do | ||||
| 893 | # it | ||||
| 894 | # https://rt.cpan.org/Ticket/Display.html?id=61577 | ||||
| 895 | sub accept | ||||
| 896 | { | ||||
| 897 | my $self = shift; | ||||
| 898 | my ( $new, $peer ) = $self->SUPER::accept( @_ ) or return; | ||||
| 899 | |||||
| 900 | ${*$new}{$_} = ${*$self}{$_} for qw( io_socket_domain io_socket_type io_socket_proto ); | ||||
| 901 | |||||
| 902 | return wantarray ? ( $new, $peer ) | ||||
| 903 | : $new; | ||||
| 904 | } | ||||
| 905 | |||||
| 906 | # This second unbelievably dodgy hack guarantees that $self->fileno doesn't | ||||
| 907 | # change, which is useful during nonblocking connect | ||||
| 908 | # spent 52.1ms (14.8+37.3) within IO::Socket::IP::socket which was called 2002 times, avg 26µs/call:
# 2002 times (14.8ms+37.3ms) by IO::Socket::IP::setup at line 605, avg 26µs/call | ||||
| 909 | { | ||||
| 910 | 2002 | 629µs | my $self = shift; | ||
| 911 | 2002 | 12.0ms | 4004 | 37.3ms | return $self->SUPER::socket(@_) if not defined $self->fileno; # spent 33.1ms making 2002 calls to IO::Socket::socket, avg 17µs/call
# spent 4.21ms making 2002 calls to IO::Handle::fileno, avg 2µs/call |
| 912 | |||||
| 913 | # I hate core prototypes sometimes... | ||||
| 914 | socket( my $tmph, $_[0], $_[1], $_[2] ) or return undef; | ||||
| 915 | |||||
| 916 | dup2( $tmph->fileno, $self->fileno ) or die "Unable to dup2 $tmph onto $self - $!"; | ||||
| 917 | } | ||||
| 918 | |||||
| 919 | # Versions of IO::Socket before 1.35 may leave socktype undef if from, say, an | ||||
| 920 | # ->fdopen call. In this case we'll apply a fix | ||||
| 921 | # spent 16µs within IO::Socket::IP::BEGIN@921 which was called:
# once (16µs+0s) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 932 | ||||
| 922 | 1 | 15µs | if( eval($IO::Socket::VERSION) < 1.35 ) { # spent 2µs executing statements in string eval | ||
| 923 | *socktype = sub { | ||||
| 924 | my $self = shift; | ||||
| 925 | my $type = $self->SUPER::socktype; | ||||
| 926 | if( !defined $type ) { | ||||
| 927 | $type = $self->sockopt( Socket::SO_TYPE() ); | ||||
| 928 | } | ||||
| 929 | return $type; | ||||
| 930 | }; | ||||
| 931 | } | ||||
| 932 | 1 | 192µs | 1 | 16µs | } # spent 16µs making 1 call to IO::Socket::IP::BEGIN@921 |
| 933 | |||||
| 934 | =head2 $inet = $sock->as_inet | ||||
| 935 | |||||
| 936 | Returns a new L<IO::Socket::INET> instance wrapping the same filehandle. This | ||||
| 937 | may be useful in cases where it is required, for backward-compatibility, to | ||||
| 938 | have a real object of C<IO::Socket::INET> type instead of C<IO::Socket::IP>. | ||||
| 939 | The new object will wrap the same underlying socket filehandle as the | ||||
| 940 | original, so care should be taken not to continue to use both objects | ||||
| 941 | concurrently. Ideally the original C<$sock> should be discarded after this | ||||
| 942 | method is called. | ||||
| 943 | |||||
| 944 | This method checks that the socket domain is C<PF_INET> and will throw an | ||||
| 945 | exception if it isn't. | ||||
| 946 | |||||
| 947 | =cut | ||||
| 948 | |||||
| 949 | sub as_inet | ||||
| 950 | { | ||||
| 951 | my $self = shift; | ||||
| 952 | croak "Cannot downgrade a non-PF_INET socket to IO::Socket::INET" unless $self->sockdomain == AF_INET; | ||||
| 953 | return IO::Socket::INET->new_from_fd( $self->fileno, "r+" ); | ||||
| 954 | } | ||||
| 955 | |||||
| 956 | =head1 NON-BLOCKING | ||||
| 957 | |||||
| 958 | If the constructor is passed a defined but false value for the C<Blocking> | ||||
| 959 | argument then the socket is put into non-blocking mode. When in non-blocking | ||||
| 960 | mode, the socket will not be set up by the time the constructor returns, | ||||
| 961 | because the underlying C<connect(2)> syscall would otherwise have to block. | ||||
| 962 | |||||
| 963 | The non-blocking behaviour is an extension of the C<IO::Socket::INET> API, | ||||
| 964 | unique to C<IO::Socket::IP>, because the former does not support multi-homed | ||||
| 965 | non-blocking connect. | ||||
| 966 | |||||
| 967 | When using non-blocking mode, the caller must repeatedly check for | ||||
| 968 | writeability on the filehandle (for instance using C<select> or C<IO::Poll>). | ||||
| 969 | Each time the filehandle is ready to write, the C<connect> method must be | ||||
| 970 | called, with no arguments. Note that some operating systems, most notably | ||||
| 971 | C<MSWin32> do not report a C<connect()> failure using write-ready; so you must | ||||
| 972 | also C<select()> for exceptional status. | ||||
| 973 | |||||
| 974 | While C<connect> returns false, the value of C<$!> indicates whether it should | ||||
| 975 | be tried again (by being set to the value C<EINPROGRESS>, or C<EWOULDBLOCK> on | ||||
| 976 | MSWin32), or whether a permanent error has occurred (e.g. C<ECONNREFUSED>). | ||||
| 977 | |||||
| 978 | Once the socket has been connected to the peer, C<connect> will return true | ||||
| 979 | and the socket will now be ready to use. | ||||
| 980 | |||||
| 981 | Note that calls to the platform's underlying C<getaddrinfo(3)> function may | ||||
| 982 | block. If C<IO::Socket::IP> has to perform this lookup, the constructor will | ||||
| 983 | block even when in non-blocking mode. | ||||
| 984 | |||||
| 985 | To avoid this blocking behaviour, the caller should pass in the result of such | ||||
| 986 | a lookup using the C<PeerAddrInfo> or C<LocalAddrInfo> arguments. This can be | ||||
| 987 | achieved by using L<Net::LibAsyncNS>, or the C<getaddrinfo(3)> function can be | ||||
| 988 | called in a child process. | ||||
| 989 | |||||
| 990 | use IO::Socket::IP; | ||||
| 991 | use Errno qw( EINPROGRESS EWOULDBLOCK ); | ||||
| 992 | |||||
| 993 | my @peeraddrinfo = ... # Caller must obtain the getaddinfo result here | ||||
| 994 | |||||
| 995 | my $socket = IO::Socket::IP->new( | ||||
| 996 | PeerAddrInfo => \@peeraddrinfo, | ||||
| 997 | Blocking => 0, | ||||
| 998 | ) or die "Cannot construct socket - $@"; | ||||
| 999 | |||||
| 1000 | while( !$socket->connect and ( $! == EINPROGRESS || $! == EWOULDBLOCK ) ) { | ||||
| 1001 | my $wvec = ''; | ||||
| 1002 | vec( $wvec, fileno $socket, 1 ) = 1; | ||||
| 1003 | my $evec = ''; | ||||
| 1004 | vec( $evec, fileno $socket, 1 ) = 1; | ||||
| 1005 | |||||
| 1006 | select( undef, $wvec, $evec, undef ) or die "Cannot select - $!"; | ||||
| 1007 | } | ||||
| 1008 | |||||
| 1009 | die "Cannot connect - $!" if $!; | ||||
| 1010 | |||||
| 1011 | ... | ||||
| 1012 | |||||
| 1013 | The example above uses C<select()>, but any similar mechanism should work | ||||
| 1014 | analogously. C<IO::Socket::IP> takes care when creating new socket filehandles | ||||
| 1015 | to preserve the actual file descriptor number, so such techniques as C<poll> | ||||
| 1016 | or C<epoll> should be transparent to its reallocation of a different socket | ||||
| 1017 | underneath, perhaps in order to switch protocol family between C<PF_INET> and | ||||
| 1018 | C<PF_INET6>. | ||||
| 1019 | |||||
| 1020 | For another example using C<IO::Poll> and C<Net::LibAsyncNS>, see the | ||||
| 1021 | F<examples/nonblocking_libasyncns.pl> file in the module distribution. | ||||
| 1022 | |||||
| 1023 | =cut | ||||
| 1024 | |||||
| 1025 | =head1 C<PeerHost> AND C<LocalHost> PARSING | ||||
| 1026 | |||||
| 1027 | To support the C<IO::Socket::INET> API, the host and port information may be | ||||
| 1028 | passed in a single string rather than as two separate arguments. | ||||
| 1029 | |||||
| 1030 | If either C<LocalHost> or C<PeerHost> (or their C<...Addr> synonyms) have any | ||||
| 1031 | of the following special forms then special parsing is applied. | ||||
| 1032 | |||||
| 1033 | The value of the C<...Host> argument will be split to give both the hostname | ||||
| 1034 | and port (or service name): | ||||
| 1035 | |||||
| 1036 | hostname.example.org:http # Host name | ||||
| 1037 | 192.0.2.1:80 # IPv4 address | ||||
| 1038 | [2001:db8::1]:80 # IPv6 address | ||||
| 1039 | |||||
| 1040 | In each case, the port or service name (e.g. C<80>) is passed as the | ||||
| 1041 | C<LocalService> or C<PeerService> argument. | ||||
| 1042 | |||||
| 1043 | Either of C<LocalService> or C<PeerService> (or their C<...Port> synonyms) can | ||||
| 1044 | be either a service name, a decimal number, or a string containing both a | ||||
| 1045 | service name and number, in a form such as | ||||
| 1046 | |||||
| 1047 | http(80) | ||||
| 1048 | |||||
| 1049 | In this case, the name (C<http>) will be tried first, but if the resolver does | ||||
| 1050 | not understand it then the port number (C<80>) will be used instead. | ||||
| 1051 | |||||
| 1052 | If the C<...Host> argument is in this special form and the corresponding | ||||
| 1053 | C<...Service> or C<...Port> argument is also defined, the one parsed from | ||||
| 1054 | the C<...Host> argument will take precedence and the other will be ignored. | ||||
| 1055 | |||||
| 1056 | =head2 ( $host, $port ) = IO::Socket::IP->split_addr( $addr ) | ||||
| 1057 | |||||
| 1058 | Utility method that provides the parsing functionality described above. | ||||
| 1059 | Returns a 2-element list, containing either the split hostname and port | ||||
| 1060 | description if it could be parsed, or the given address and C<undef> if it was | ||||
| 1061 | not recognised. | ||||
| 1062 | |||||
| 1063 | IO::Socket::IP->split_addr( "hostname:http" ) | ||||
| 1064 | # ( "hostname", "http" ) | ||||
| 1065 | |||||
| 1066 | IO::Socket::IP->split_addr( "192.0.2.1:80" ) | ||||
| 1067 | # ( "192.0.2.1", "80" ) | ||||
| 1068 | |||||
| 1069 | IO::Socket::IP->split_addr( "[2001:db8::1]:80" ) | ||||
| 1070 | # ( "2001:db8::1", "80" ) | ||||
| 1071 | |||||
| 1072 | IO::Socket::IP->split_addr( "something.else" ) | ||||
| 1073 | # ( "something.else", undef ) | ||||
| 1074 | |||||
| 1075 | =cut | ||||
| 1076 | |||||
| 1077 | sub split_addr | ||||
| 1078 | # spent 29.6ms (18.5+11.0) within IO::Socket::IP::split_addr which was called 2002 times, avg 15µs/call:
# 2002 times (18.5ms+11.0ms) by IO::Socket::IP::configure at line 380, avg 15µs/call | ||||
| 1079 | 2002 | 484µs | shift; | ||
| 1080 | 2002 | 723µs | my ( $addr ) = @_; | ||
| 1081 | |||||
| 1082 | 2002 | 2.88ms | local ( $1, $2 ); # Placate a taint-related bug; [perl #67962] | ||
| 1083 | 2002 | 21.2ms | 6006 | 11.0ms | if( $addr =~ m/\A\[($IPv6_re)\](?::([^\s:]*))?\z/ or # spent 9.25ms making 2002 calls to IO::Socket::IP::CORE:regcomp, avg 5µs/call
# spent 1.78ms making 4004 calls to IO::Socket::IP::CORE:match, avg 443ns/call |
| 1084 | $addr =~ m/\A([^\s:]*):([^\s:]*)\z/ ) { | ||||
| 1085 | return ( $1, $2 ) if defined $2 and length $2; | ||||
| 1086 | return ( $1, undef ); | ||||
| 1087 | } | ||||
| 1088 | |||||
| 1089 | 2002 | 7.12ms | return ( $addr, undef ); | ||
| 1090 | } | ||||
| 1091 | |||||
| 1092 | =head2 $addr = IO::Socket::IP->join_addr( $host, $port ) | ||||
| 1093 | |||||
| 1094 | Utility method that performs the reverse of C<split_addr>, returning a string | ||||
| 1095 | formed by joining the specified host address and port number. The host address | ||||
| 1096 | will be wrapped in C<[]> brackets if required (because it is a raw IPv6 | ||||
| 1097 | numeric address). | ||||
| 1098 | |||||
| 1099 | This can be especially useful when combined with the C<sockhost_service> or | ||||
| 1100 | C<peerhost_service> methods. | ||||
| 1101 | |||||
| 1102 | say "Connected to ", IO::Socket::IP->join_addr( $sock->peerhost_service ); | ||||
| 1103 | |||||
| 1104 | =cut | ||||
| 1105 | |||||
| 1106 | sub join_addr | ||||
| 1107 | { | ||||
| 1108 | shift; | ||||
| 1109 | my ( $host, $port ) = @_; | ||||
| 1110 | |||||
| 1111 | $host = "[$host]" if $host =~ m/:/; | ||||
| 1112 | |||||
| 1113 | return join ":", $host, $port if defined $port; | ||||
| 1114 | return $host; | ||||
| 1115 | } | ||||
| 1116 | |||||
| 1117 | # Since IO::Socket->new( Domain => ... ) will delete the Domain parameter | ||||
| 1118 | # before calling ->configure, we need to keep track of which it was | ||||
| 1119 | |||||
| 1120 | package # hide from indexer | ||||
| 1121 | IO::Socket::IP::_ForINET; | ||||
| 1122 | 2 | 56µs | 2 | 93µs | # spent 50µs (8+42) within IO::Socket::IP::_ForINET::BEGIN@1122 which was called:
# once (8µs+42µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 1122 # spent 50µs making 1 call to IO::Socket::IP::_ForINET::BEGIN@1122
# spent 42µs making 1 call to base::import |
| 1123 | |||||
| 1124 | sub configure | ||||
| 1125 | { | ||||
| 1126 | # This is evil | ||||
| 1127 | my $self = shift; | ||||
| 1128 | my ( $arg ) = @_; | ||||
| 1129 | |||||
| 1130 | bless $self, "IO::Socket::IP"; | ||||
| 1131 | $self->configure( { %$arg, Family => Socket::AF_INET() } ); | ||||
| 1132 | } | ||||
| 1133 | |||||
| 1134 | package # hide from indexer | ||||
| 1135 | IO::Socket::IP::_ForINET6; | ||||
| 1136 | 2 | 67µs | 2 | 65µs | # spent 35µs (5+30) within IO::Socket::IP::_ForINET6::BEGIN@1136 which was called:
# once (5µs+30µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 1136 # spent 35µs making 1 call to IO::Socket::IP::_ForINET6::BEGIN@1136
# spent 30µs making 1 call to base::import |
| 1137 | |||||
| 1138 | sub configure | ||||
| 1139 | { | ||||
| 1140 | # This is evil | ||||
| 1141 | my $self = shift; | ||||
| 1142 | my ( $arg ) = @_; | ||||
| 1143 | |||||
| 1144 | bless $self, "IO::Socket::IP"; | ||||
| 1145 | $self->configure( { %$arg, Family => Socket::AF_INET6() } ); | ||||
| 1146 | } | ||||
| 1147 | |||||
| 1148 | =head1 C<IO::Socket::INET> INCOMPATIBILITES | ||||
| 1149 | |||||
| 1150 | =over 4 | ||||
| 1151 | |||||
| 1152 | =item * | ||||
| 1153 | |||||
| 1154 | The behaviour enabled by C<MultiHomed> is in fact implemented by | ||||
| 1155 | C<IO::Socket::IP> as it is required to correctly support searching for a | ||||
| 1156 | useable address from the results of the C<getaddrinfo(3)> call. The | ||||
| 1157 | constructor will ignore the value of this argument, except if it is defined | ||||
| 1158 | but false. An exception is thrown in this case, because that would request it | ||||
| 1159 | disable the C<getaddrinfo(3)> search behaviour in the first place. | ||||
| 1160 | |||||
| 1161 | =item * | ||||
| 1162 | |||||
| 1163 | C<IO::Socket::IP> implements both the C<Blocking> and C<Timeout> parameters, | ||||
| 1164 | but it implements the interaction of both in a different way. | ||||
| 1165 | |||||
| 1166 | In C<::INET>, supplying a timeout overrides the non-blocking behaviour, | ||||
| 1167 | meaning that the C<connect()> operation will still block despite that the | ||||
| 1168 | caller asked for a non-blocking socket. This is not explicitly specified in | ||||
| 1169 | its documentation, nor does this author believe that is a useful behaviour - | ||||
| 1170 | it appears to come from a quirk of implementation. | ||||
| 1171 | |||||
| 1172 | In C<::IP> therefore, the C<Blocking> parameter takes precedence - if a | ||||
| 1173 | non-blocking socket is requested, no operation will block. The C<Timeout> | ||||
| 1174 | parameter here simply defines the maximum time that a blocking C<connect()> | ||||
| 1175 | call will wait, if it blocks at all. | ||||
| 1176 | |||||
| 1177 | In order to specifically obtain the "blocking connect then non-blocking send | ||||
| 1178 | and receive" behaviour of specifying this combination of options to C<::INET> | ||||
| 1179 | when using C<::IP>, perform first a blocking connect, then afterwards turn the | ||||
| 1180 | socket into nonblocking mode. | ||||
| 1181 | |||||
| 1182 | my $sock = IO::Socket::IP->new( | ||||
| 1183 | PeerHost => $peer, | ||||
| 1184 | Timeout => 20, | ||||
| 1185 | ) or die "Cannot connect - $@"; | ||||
| 1186 | |||||
| 1187 | $sock->blocking( 0 ); | ||||
| 1188 | |||||
| 1189 | This code will behave identically under both C<IO::Socket::INET> and | ||||
| 1190 | C<IO::Socket::IP>. | ||||
| 1191 | |||||
| 1192 | =back | ||||
| 1193 | |||||
| 1194 | =cut | ||||
| 1195 | |||||
| 1196 | =head1 TODO | ||||
| 1197 | |||||
| 1198 | =over 4 | ||||
| 1199 | |||||
| 1200 | =item * | ||||
| 1201 | |||||
| 1202 | Investigate whether C<POSIX::dup2> upsets BSD's C<kqueue> watchers, and if so, | ||||
| 1203 | consider what possible workarounds might be applied. | ||||
| 1204 | |||||
| 1205 | =back | ||||
| 1206 | |||||
| 1207 | =head1 AUTHOR | ||||
| 1208 | |||||
| 1209 | Paul Evans <leonerd@leonerd.org.uk> | ||||
| 1210 | |||||
| 1211 | =cut | ||||
| 1212 | |||||
| 1213 | 1 | 7µs | 0x55AA; | ||
# spent 109ms within IO::Socket::IP::CORE:connect which was called 2002 times, avg 54µs/call:
# 2002 times (109ms+0s) by IO::Socket::IP::connect at line 679, avg 54µs/call | |||||
sub IO::Socket::IP::CORE:gpbyname; # opcode | |||||
sub IO::Socket::IP::CORE:match; # opcode | |||||
# spent 900ns within IO::Socket::IP::CORE:qr which was called:
# once (900ns+0s) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 62 | |||||
sub IO::Socket::IP::CORE:regcomp; # opcode | |||||
# spent 6.77ms within IO::Socket::IP::CORE:sselect which was called 2002 times, avg 3µs/call:
# 2002 times (6.77ms+0s) by IO::Socket::IP::connect at line 696, avg 3µs/call | |||||
# spent 1.05ms within IO::Socket::IP::CORE:subst which was called 2002 times, avg 527ns/call:
# 2002 times (1.05ms+0s) by IO::Socket::IP::_io_socket_ip__configure at line 491, avg 527ns/call |