| Filename | /usr/lib/perl/5.18/Socket.pm |
| Statements | Executed 600036 statements in 2.37s |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 200002 | 2 | 1 | 1.61s | 2.00s | Socket::sockaddr_in |
| 100001 | 1 | 1 | 456ms | 456ms | Socket::inet_ntoa (xsub) |
| 200002 | 1 | 1 | 390ms | 390ms | Socket::unpack_sockaddr_in (xsub) |
| 1 | 1 | 1 | 33µs | 33µs | Socket::CORE:regcomp (opcode) |
| 99 | 1 | 1 | 22µs | 22µs | Socket::CORE:match (opcode) |
| 1 | 1 | 1 | 9µs | 17µs | Socket::BEGIN@3 |
| 1 | 1 | 1 | 8µs | 8µs | Socket::BEGIN@4 |
| 1 | 1 | 1 | 8µs | 86µs | Socket::BEGIN@11 |
| 1 | 1 | 1 | 7µs | 17µs | Socket::BEGIN@240 |
| 1 | 1 | 1 | 6µs | 38µs | Socket::BEGIN@10 |
| 1 | 1 | 1 | 5µs | 5µs | Socket::pack_sockaddr_in (xsub) |
| 2 | 2 | 1 | 4µs | 4µs | Socket::CORE:qr (opcode) |
| 1 | 1 | 1 | 3µs | 3µs | Socket::BEGIN@128 |
| 0 | 0 | 0 | 0s | 0s | Socket::__ANON__[:241] |
| 0 | 0 | 0 | 0s | 0s | Socket::fake_getaddrinfo |
| 0 | 0 | 0 | 0s | 0s | Socket::fake_getnameinfo |
| 0 | 0 | 0 | 0s | 0s | Socket::fake_makeerr |
| 0 | 0 | 0 | 0s | 0s | Socket::sockaddr_in6 |
| 0 | 0 | 0 | 0s | 0s | Socket::sockaddr_un |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Socket; | ||||
| 2 | |||||
| 3 | 2 | 19µs | 2 | 26µs | # spent 17µs (9+9) within Socket::BEGIN@3 which was called:
# once (9µs+9µs) by IO::Socket::BEGIN@12 at line 3 # spent 17µs making 1 call to Socket::BEGIN@3
# spent 9µs making 1 call to strict::import |
| 4 | 3 | 44µs | 1 | 8µs | # spent 8µs within Socket::BEGIN@4 which was called:
# once (8µs+0s) by IO::Socket::BEGIN@12 at line 4 # spent 8µs making 1 call to Socket::BEGIN@4 |
| 5 | |||||
| 6 | 1 | 500ns | our $VERSION = '2.009'; | ||
| 7 | |||||
| 8 | # Still undocumented: SCM_*, SOMAXCONN, IOV_MAX, UIO_MAXIOV | ||||
| 9 | |||||
| 10 | 2 | 19µs | 2 | 69µs | # spent 38µs (6+31) within Socket::BEGIN@10 which was called:
# once (6µs+31µs) by IO::Socket::BEGIN@12 at line 10 # spent 38µs making 1 call to Socket::BEGIN@10
# spent 31µs making 1 call to Exporter::import |
| 11 | 2 | 302µs | 2 | 163µs | # spent 86µs (8+78) within Socket::BEGIN@11 which was called:
# once (8µs+78µs) by IO::Socket::BEGIN@12 at line 11 # spent 86µs making 1 call to Socket::BEGIN@11
# spent 78µs making 1 call to warnings::register::import |
| 12 | |||||
| 13 | 1 | 500ns | require Exporter; | ||
| 14 | 1 | 400ns | require XSLoader; | ||
| 15 | 1 | 5µs | our @ISA = qw(Exporter); | ||
| 16 | |||||
| 17 | # <@Nicholas> you can't change @EXPORT without breaking the implicit API | ||||
| 18 | # Please put any new constants in @EXPORT_OK! | ||||
| 19 | |||||
| 20 | # List re-ordered to match documentation above. Try to keep the ordering | ||||
| 21 | # consistent so it's easier to see which ones are or aren't documented. | ||||
| 22 | 1 | 19µs | our @EXPORT = qw( | ||
| 23 | PF_802 PF_AAL PF_APPLETALK PF_CCITT PF_CHAOS PF_CTF PF_DATAKIT | ||||
| 24 | PF_DECnet PF_DLI PF_ECMA PF_GOSIP PF_HYLINK PF_IMPLINK PF_INET PF_INET6 | ||||
| 25 | PF_ISO PF_KEY PF_LAST PF_LAT PF_LINK PF_MAX PF_NBS PF_NIT PF_NS PF_OSI | ||||
| 26 | PF_OSINET PF_PUP PF_ROUTE PF_SNA PF_UNIX PF_UNSPEC PF_USER PF_WAN | ||||
| 27 | PF_X25 | ||||
| 28 | |||||
| 29 | AF_802 AF_AAL AF_APPLETALK AF_CCITT AF_CHAOS AF_CTF AF_DATAKIT | ||||
| 30 | AF_DECnet AF_DLI AF_ECMA AF_GOSIP AF_HYLINK AF_IMPLINK AF_INET AF_INET6 | ||||
| 31 | AF_ISO AF_KEY AF_LAST AF_LAT AF_LINK AF_MAX AF_NBS AF_NIT AF_NS AF_OSI | ||||
| 32 | AF_OSINET AF_PUP AF_ROUTE AF_SNA AF_UNIX AF_UNSPEC AF_USER AF_WAN | ||||
| 33 | AF_X25 | ||||
| 34 | |||||
| 35 | SOCK_DGRAM SOCK_RAW SOCK_RDM SOCK_SEQPACKET SOCK_STREAM | ||||
| 36 | |||||
| 37 | SOL_SOCKET | ||||
| 38 | |||||
| 39 | SO_ACCEPTCONN SO_ATTACH_FILTER SO_BACKLOG SO_BROADCAST SO_CHAMELEON | ||||
| 40 | SO_DEBUG SO_DETACH_FILTER SO_DGRAM_ERRIND SO_DOMAIN SO_DONTLINGER | ||||
| 41 | SO_DONTROUTE SO_ERROR SO_FAMILY SO_KEEPALIVE SO_LINGER SO_OOBINLINE | ||||
| 42 | SO_PASSCRED SO_PASSIFNAME SO_PEERCRED SO_PROTOCOL SO_PROTOTYPE | ||||
| 43 | SO_RCVBUF SO_RCVLOWAT SO_RCVTIMEO SO_REUSEADDR SO_REUSEPORT | ||||
| 44 | SO_SECURITY_AUTHENTICATION SO_SECURITY_ENCRYPTION_NETWORK | ||||
| 45 | SO_SECURITY_ENCRYPTION_TRANSPORT SO_SNDBUF SO_SNDLOWAT SO_SNDTIMEO | ||||
| 46 | SO_STATE SO_TYPE SO_USELOOPBACK SO_XOPEN SO_XSE | ||||
| 47 | |||||
| 48 | IP_OPTIONS IP_HDRINCL IP_TOS IP_TTL IP_RECVOPTS IP_RECVRETOPTS | ||||
| 49 | IP_RETOPTS | ||||
| 50 | |||||
| 51 | MSG_BCAST MSG_BTAG MSG_CTLFLAGS MSG_CTLIGNORE MSG_CTRUNC MSG_DONTROUTE | ||||
| 52 | MSG_DONTWAIT MSG_EOF MSG_EOR MSG_ERRQUEUE MSG_ETAG MSG_FIN | ||||
| 53 | MSG_MAXIOVLEN MSG_MCAST MSG_NOSIGNAL MSG_OOB MSG_PEEK MSG_PROXY MSG_RST | ||||
| 54 | MSG_SYN MSG_TRUNC MSG_URG MSG_WAITALL MSG_WIRE | ||||
| 55 | |||||
| 56 | SHUT_RD SHUT_RDWR SHUT_WR | ||||
| 57 | |||||
| 58 | INADDR_ANY INADDR_BROADCAST INADDR_LOOPBACK INADDR_NONE | ||||
| 59 | |||||
| 60 | SCM_CONNECT SCM_CREDENTIALS SCM_CREDS SCM_RIGHTS SCM_TIMESTAMP | ||||
| 61 | |||||
| 62 | SOMAXCONN | ||||
| 63 | |||||
| 64 | IOV_MAX | ||||
| 65 | UIO_MAXIOV | ||||
| 66 | |||||
| 67 | sockaddr_family | ||||
| 68 | pack_sockaddr_in unpack_sockaddr_in sockaddr_in | ||||
| 69 | pack_sockaddr_in6 unpack_sockaddr_in6 sockaddr_in6 | ||||
| 70 | pack_sockaddr_un unpack_sockaddr_un sockaddr_un | ||||
| 71 | |||||
| 72 | inet_aton inet_ntoa | ||||
| 73 | ); | ||||
| 74 | |||||
| 75 | # List re-ordered to match documentation above. Try to keep the ordering | ||||
| 76 | # consistent so it's easier to see which ones are or aren't documented. | ||||
| 77 | 1 | 9µs | our @EXPORT_OK = qw( | ||
| 78 | CR LF CRLF $CR $LF $CRLF | ||||
| 79 | |||||
| 80 | SOCK_NONBLOCK SOCK_CLOEXEC | ||||
| 81 | |||||
| 82 | IP_ADD_MEMBERSHIP IP_ADD_SOURCE_MEMBERSHIP IP_DROP_MEMBERSHIP | ||||
| 83 | IP_DROP_SOURCE_MEMBERSHIP IP_MULTICAST_IF IP_MULTICAST_LOOP | ||||
| 84 | IP_MULTICAST_TTL | ||||
| 85 | |||||
| 86 | IPPROTO_IP IPPROTO_IPV6 IPPROTO_RAW IPPROTO_ICMP IPPROTO_TCP | ||||
| 87 | IPPROTO_UDP | ||||
| 88 | |||||
| 89 | TCP_CONGESTION TCP_CONNECTIONTIMEOUT TCP_CORK TCP_DEFER_ACCEPT TCP_INFO | ||||
| 90 | TCP_INIT_CWND TCP_KEEPALIVE TCP_KEEPCNT TCP_KEEPIDLE TCP_KEEPINTVL | ||||
| 91 | TCP_LINGER2 TCP_MAXRT TCP_MAXSEG TCP_MD5SIG TCP_NODELAY TCP_NOOPT | ||||
| 92 | TCP_NOPUSH TCP_QUICKACK TCP_SACK_ENABLE TCP_STDURG TCP_SYNCNT | ||||
| 93 | TCP_WINDOW_CLAMP | ||||
| 94 | |||||
| 95 | IN6ADDR_ANY IN6ADDR_LOOPBACK | ||||
| 96 | |||||
| 97 | IPV6_ADD_MEMBERSHIP IPV6_DROP_MEMBERSHIP IPV6_JOIN_GROUP | ||||
| 98 | IPV6_LEAVE_GROUP IPV6_MTU IPV6_MTU_DISCOVER IPV6_MULTICAST_HOPS | ||||
| 99 | IPV6_MULTICAST_IF IPV6_MULTICAST_LOOP IPV6_UNICAST_HOPS IPV6_V6ONLY | ||||
| 100 | |||||
| 101 | pack_ip_mreq unpack_ip_mreq pack_ip_mreq_source unpack_ip_mreq_source | ||||
| 102 | |||||
| 103 | pack_ipv6_mreq unpack_ipv6_mreq | ||||
| 104 | |||||
| 105 | inet_pton inet_ntop | ||||
| 106 | |||||
| 107 | getaddrinfo getnameinfo | ||||
| 108 | |||||
| 109 | AI_ADDRCONFIG AI_ALL AI_CANONIDN AI_CANONNAME AI_IDN | ||||
| 110 | AI_IDN_ALLOW_UNASSIGNED AI_IDN_USE_STD3_ASCII_RULES AI_NUMERICHOST | ||||
| 111 | AI_NUMERICSERV AI_PASSIVE AI_V4MAPPED | ||||
| 112 | |||||
| 113 | NI_DGRAM NI_IDN NI_IDN_ALLOW_UNASSIGNED NI_IDN_USE_STD3_ASCII_RULES | ||||
| 114 | NI_NAMEREQD NI_NOFQDN NI_NUMERICHOST NI_NUMERICSERV | ||||
| 115 | |||||
| 116 | NIx_NOHOST NIx_NOSERV | ||||
| 117 | |||||
| 118 | EAI_ADDRFAMILY EAI_AGAIN EAI_BADFLAGS EAI_BADHINTS EAI_FAIL EAI_FAMILY | ||||
| 119 | EAI_NODATA EAI_NONAME EAI_PROTOCOL EAI_SERVICE EAI_SOCKTYPE EAI_SYSTEM | ||||
| 120 | ); | ||||
| 121 | |||||
| 122 | 1 | 140µs | 99 | 22µs | our %EXPORT_TAGS = ( # spent 22µs making 99 calls to Socket::CORE:match, avg 224ns/call |
| 123 | crlf => [qw(CR LF CRLF $CR $LF $CRLF)], | ||||
| 124 | addrinfo => [qw(getaddrinfo getnameinfo), grep m/^(?:AI|NI|NIx|EAI)_/, @EXPORT_OK], | ||||
| 125 | all => [@EXPORT, @EXPORT_OK], | ||||
| 126 | ); | ||||
| 127 | |||||
| 128 | 1 | 4µs | # spent 3µs within Socket::BEGIN@128 which was called:
# once (3µs+0s) by IO::Socket::BEGIN@12 at line 137 | ||
| 129 | sub CR () {"\015"} | ||||
| 130 | sub LF () {"\012"} | ||||
| 131 | sub CRLF () {"\015\012"} | ||||
| 132 | |||||
| 133 | # These are not gni() constants; they're extensions for the perl API | ||||
| 134 | # The definitions in Socket.pm and Socket.xs must match | ||||
| 135 | sub NIx_NOHOST() {1 << 0} | ||||
| 136 | sub NIx_NOSERV() {1 << 1} | ||||
| 137 | 1 | 307µs | 1 | 3µs | } # spent 3µs making 1 call to Socket::BEGIN@128 |
| 138 | |||||
| 139 | 1 | 500ns | *CR = \CR(); | ||
| 140 | 1 | 200ns | *LF = \LF(); | ||
| 141 | 1 | 0s | *CRLF = \CRLF(); | ||
| 142 | |||||
| 143 | # spent 2.00s (1.61+390ms) within Socket::sockaddr_in which was called 200002 times, avg 10µs/call:
# 100001 times (1.03s+300ms) by IO::Socket::INET::peeraddr at line 291 of IO/Socket/INET.pm, avg 13µs/call
# 100001 times (577ms+89.7ms) by IO::Socket::INET::peerport at line 298 of IO/Socket/INET.pm, avg 7µs/call | ||||
| 144 | 200002 | 972ms | if (@_ == 6 && !wantarray) { # perl5.001m compat; use this && die | ||
| 145 | my($af, $port, @quad) = @_; | ||||
| 146 | warnings::warn "6-ARG sockaddr_in call is deprecated" | ||||
| 147 | if warnings::enabled(); | ||||
| 148 | pack_sockaddr_in($port, inet_aton(join('.', @quad))); | ||||
| 149 | } elsif (wantarray) { | ||||
| 150 | 200002 | 97.8ms | croak "usage: (port,iaddr) = sockaddr_in(sin_sv)" unless @_ == 1; | ||
| 151 | 200002 | 1.30s | 200002 | 390ms | unpack_sockaddr_in(@_); # spent 390ms making 200002 calls to Socket::unpack_sockaddr_in, avg 2µs/call |
| 152 | } else { | ||||
| 153 | croak "usage: sin_sv = sockaddr_in(port,iaddr))" unless @_ == 2; | ||||
| 154 | pack_sockaddr_in(@_); | ||||
| 155 | } | ||||
| 156 | } | ||||
| 157 | |||||
| 158 | sub sockaddr_in6 { | ||||
| 159 | if (wantarray) { | ||||
| 160 | croak "usage: (port,in6addr,scope_id,flowinfo) = sockaddr_in6(sin6_sv)" unless @_ == 1; | ||||
| 161 | unpack_sockaddr_in6(@_); | ||||
| 162 | } | ||||
| 163 | else { | ||||
| 164 | croak "usage: sin6_sv = sockaddr_in6(port,in6addr,[scope_id,[flowinfo]])" unless @_ >= 2 and @_ <= 4; | ||||
| 165 | pack_sockaddr_in6(@_); | ||||
| 166 | } | ||||
| 167 | } | ||||
| 168 | |||||
| 169 | sub sockaddr_un { | ||||
| 170 | if (wantarray) { | ||||
| 171 | croak "usage: (filename) = sockaddr_un(sun_sv)" unless @_ == 1; | ||||
| 172 | unpack_sockaddr_un(@_); | ||||
| 173 | } else { | ||||
| 174 | croak "usage: sun_sv = sockaddr_un(filename)" unless @_ == 1; | ||||
| 175 | pack_sockaddr_un(@_); | ||||
| 176 | } | ||||
| 177 | } | ||||
| 178 | |||||
| 179 | 1 | 279µs | 1 | 271µs | XSLoader::load(__PACKAGE__, $VERSION); # spent 271µs making 1 call to XSLoader::load |
| 180 | |||||
| 181 | 1 | 200ns | my %errstr; | ||
| 182 | |||||
| 183 | 1 | 500ns | if( defined &getaddrinfo ) { | ||
| 184 | # These are not part of the API, nothing uses them, and deleting them | ||||
| 185 | # reduces the size of %Socket:: by about 12K | ||||
| 186 | 1 | 1µs | delete $Socket::{fake_getaddrinfo}; | ||
| 187 | 1 | 500ns | delete $Socket::{fake_getnameinfo}; | ||
| 188 | } else { | ||||
| 189 | require Scalar::Util; | ||||
| 190 | |||||
| 191 | *getaddrinfo = \&fake_getaddrinfo; | ||||
| 192 | *getnameinfo = \&fake_getnameinfo; | ||||
| 193 | |||||
| 194 | # These numbers borrowed from GNU libc's implementation, but since | ||||
| 195 | # they're only used by our emulation, it doesn't matter if the real | ||||
| 196 | # platform's values differ | ||||
| 197 | my %constants = ( | ||||
| 198 | AI_PASSIVE => 1, | ||||
| 199 | AI_CANONNAME => 2, | ||||
| 200 | AI_NUMERICHOST => 4, | ||||
| 201 | AI_V4MAPPED => 8, | ||||
| 202 | AI_ALL => 16, | ||||
| 203 | AI_ADDRCONFIG => 32, | ||||
| 204 | # RFC 2553 doesn't define this but Linux does - lets be nice and | ||||
| 205 | # provide it since we can | ||||
| 206 | AI_NUMERICSERV => 1024, | ||||
| 207 | |||||
| 208 | EAI_BADFLAGS => -1, | ||||
| 209 | EAI_NONAME => -2, | ||||
| 210 | EAI_NODATA => -5, | ||||
| 211 | EAI_FAMILY => -6, | ||||
| 212 | EAI_SERVICE => -8, | ||||
| 213 | |||||
| 214 | NI_NUMERICHOST => 1, | ||||
| 215 | NI_NUMERICSERV => 2, | ||||
| 216 | NI_NOFQDN => 4, | ||||
| 217 | NI_NAMEREQD => 8, | ||||
| 218 | NI_DGRAM => 16, | ||||
| 219 | |||||
| 220 | # Constants we don't support. Export them, but croak if anyone tries to | ||||
| 221 | # use them | ||||
| 222 | AI_IDN => 64, | ||||
| 223 | AI_CANONIDN => 128, | ||||
| 224 | AI_IDN_ALLOW_UNASSIGNED => 256, | ||||
| 225 | AI_IDN_USE_STD3_ASCII_RULES => 512, | ||||
| 226 | NI_IDN => 32, | ||||
| 227 | NI_IDN_ALLOW_UNASSIGNED => 64, | ||||
| 228 | NI_IDN_USE_STD3_ASCII_RULES => 128, | ||||
| 229 | |||||
| 230 | # Error constants we'll never return, so it doesn't matter what value | ||||
| 231 | # these have, nor that we don't provide strings for them | ||||
| 232 | EAI_SYSTEM => -11, | ||||
| 233 | EAI_BADHINTS => -1000, | ||||
| 234 | EAI_PROTOCOL => -1001 | ||||
| 235 | ); | ||||
| 236 | |||||
| 237 | foreach my $name ( keys %constants ) { | ||||
| 238 | my $value = $constants{$name}; | ||||
| 239 | |||||
| 240 | 2 | 968µs | 2 | 28µs | # spent 17µs (7+11) within Socket::BEGIN@240 which was called:
# once (7µs+11µs) by IO::Socket::BEGIN@12 at line 240 # spent 17µs making 1 call to Socket::BEGIN@240
# spent 10µs making 1 call to strict::unimport |
| 241 | defined &$name or *$name = sub () { $value }; | ||||
| 242 | } | ||||
| 243 | |||||
| 244 | %errstr = ( | ||||
| 245 | # These strings from RFC 2553 | ||||
| 246 | EAI_BADFLAGS() => "invalid value for ai_flags", | ||||
| 247 | EAI_NONAME() => "nodename nor servname provided, or not known", | ||||
| 248 | EAI_NODATA() => "no address associated with nodename", | ||||
| 249 | EAI_FAMILY() => "ai_family not supported", | ||||
| 250 | EAI_SERVICE() => "servname not supported for ai_socktype", | ||||
| 251 | ); | ||||
| 252 | } | ||||
| 253 | |||||
| 254 | # The following functions are used if the system does not have a | ||||
| 255 | # getaddrinfo(3) function in libc; and are used to emulate it for the AF_INET | ||||
| 256 | # family | ||||
| 257 | |||||
| 258 | # Borrowed from Regexp::Common::net | ||||
| 259 | 1 | 8µs | 1 | 4µs | my $REGEXP_IPv4_DECIMAL = qr/25[0-5]|2[0-4][0-9]|1?[0-9][0-9]{1,2}/; # spent 4µs making 1 call to Socket::CORE:qr |
| 260 | 1 | 42µs | 2 | 34µs | my $REGEXP_IPv4_DOTTEDQUAD = qr/$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL/; # spent 33µs making 1 call to Socket::CORE:regcomp
# spent 800ns making 1 call to Socket::CORE:qr |
| 261 | |||||
| 262 | sub fake_makeerr | ||||
| 263 | { | ||||
| 264 | my ( $errno ) = @_; | ||||
| 265 | my $errstr = $errno == 0 ? "" : ( $errstr{$errno} || $errno ); | ||||
| 266 | return Scalar::Util::dualvar( $errno, $errstr ); | ||||
| 267 | } | ||||
| 268 | |||||
| 269 | sub fake_getaddrinfo | ||||
| 270 | { | ||||
| 271 | my ( $node, $service, $hints ) = @_; | ||||
| 272 | |||||
| 273 | $node = "" unless defined $node; | ||||
| 274 | |||||
| 275 | $service = "" unless defined $service; | ||||
| 276 | |||||
| 277 | my ( $family, $socktype, $protocol, $flags ) = @$hints{qw( family socktype protocol flags )}; | ||||
| 278 | |||||
| 279 | $family ||= Socket::AF_INET(); # 0 == AF_UNSPEC, which we want too | ||||
| 280 | $family == Socket::AF_INET() or return fake_makeerr( EAI_FAMILY() ); | ||||
| 281 | |||||
| 282 | $socktype ||= 0; | ||||
| 283 | |||||
| 284 | $protocol ||= 0; | ||||
| 285 | |||||
| 286 | $flags ||= 0; | ||||
| 287 | |||||
| 288 | my $flag_passive = $flags & AI_PASSIVE(); $flags &= ~AI_PASSIVE(); | ||||
| 289 | my $flag_canonname = $flags & AI_CANONNAME(); $flags &= ~AI_CANONNAME(); | ||||
| 290 | my $flag_numerichost = $flags & AI_NUMERICHOST(); $flags &= ~AI_NUMERICHOST(); | ||||
| 291 | my $flag_numericserv = $flags & AI_NUMERICSERV(); $flags &= ~AI_NUMERICSERV(); | ||||
| 292 | |||||
| 293 | # These constants don't apply to AF_INET-only lookups, so we might as well | ||||
| 294 | # just ignore them. For AI_ADDRCONFIG we just presume the host has ability | ||||
| 295 | # to talk AF_INET. If not we'd have to return no addresses at all. :) | ||||
| 296 | $flags &= ~(AI_V4MAPPED()|AI_ALL()|AI_ADDRCONFIG()); | ||||
| 297 | |||||
| 298 | $flags & (AI_IDN()|AI_CANONIDN()|AI_IDN_ALLOW_UNASSIGNED()|AI_IDN_USE_STD3_ASCII_RULES()) and | ||||
| 299 | croak "Socket::getaddrinfo() does not support IDN"; | ||||
| 300 | |||||
| 301 | $flags == 0 or return fake_makeerr( EAI_BADFLAGS() ); | ||||
| 302 | |||||
| 303 | $node eq "" and $service eq "" and return fake_makeerr( EAI_NONAME() ); | ||||
| 304 | |||||
| 305 | my $canonname; | ||||
| 306 | my @addrs; | ||||
| 307 | if( $node ne "" ) { | ||||
| 308 | return fake_makeerr( EAI_NONAME() ) if( $flag_numerichost and $node !~ m/^$REGEXP_IPv4_DOTTEDQUAD$/ ); | ||||
| 309 | ( $canonname, undef, undef, undef, @addrs ) = gethostbyname( $node ); | ||||
| 310 | defined $canonname or return fake_makeerr( EAI_NONAME() ); | ||||
| 311 | |||||
| 312 | undef $canonname unless $flag_canonname; | ||||
| 313 | } | ||||
| 314 | else { | ||||
| 315 | $addrs[0] = $flag_passive ? Socket::inet_aton( "0.0.0.0" ) | ||||
| 316 | : Socket::inet_aton( "127.0.0.1" ); | ||||
| 317 | } | ||||
| 318 | |||||
| 319 | my @ports; # Actually ARRAYrefs of [ socktype, protocol, port ] | ||||
| 320 | my $protname = ""; | ||||
| 321 | if( $protocol ) { | ||||
| 322 | $protname = getprotobynumber( $protocol ); | ||||
| 323 | } | ||||
| 324 | |||||
| 325 | if( $service ne "" and $service !~ m/^\d+$/ ) { | ||||
| 326 | return fake_makeerr( EAI_NONAME() ) if( $flag_numericserv ); | ||||
| 327 | getservbyname( $service, $protname ) or return fake_makeerr( EAI_SERVICE() ); | ||||
| 328 | } | ||||
| 329 | |||||
| 330 | foreach my $this_socktype ( Socket::SOCK_STREAM(), Socket::SOCK_DGRAM(), Socket::SOCK_RAW() ) { | ||||
| 331 | next if $socktype and $this_socktype != $socktype; | ||||
| 332 | |||||
| 333 | my $this_protname = "raw"; | ||||
| 334 | $this_socktype == Socket::SOCK_STREAM() and $this_protname = "tcp"; | ||||
| 335 | $this_socktype == Socket::SOCK_DGRAM() and $this_protname = "udp"; | ||||
| 336 | |||||
| 337 | next if $protname and $this_protname ne $protname; | ||||
| 338 | |||||
| 339 | my $port; | ||||
| 340 | if( $service ne "" ) { | ||||
| 341 | if( $service =~ m/^\d+$/ ) { | ||||
| 342 | $port = "$service"; | ||||
| 343 | } | ||||
| 344 | else { | ||||
| 345 | ( undef, undef, $port, $this_protname ) = getservbyname( $service, $this_protname ); | ||||
| 346 | next unless defined $port; | ||||
| 347 | } | ||||
| 348 | } | ||||
| 349 | else { | ||||
| 350 | $port = 0; | ||||
| 351 | } | ||||
| 352 | |||||
| 353 | push @ports, [ $this_socktype, scalar getprotobyname( $this_protname ) || 0, $port ]; | ||||
| 354 | } | ||||
| 355 | |||||
| 356 | my @ret; | ||||
| 357 | foreach my $addr ( @addrs ) { | ||||
| 358 | foreach my $portspec ( @ports ) { | ||||
| 359 | my ( $socktype, $protocol, $port ) = @$portspec; | ||||
| 360 | push @ret, { | ||||
| 361 | family => $family, | ||||
| 362 | socktype => $socktype, | ||||
| 363 | protocol => $protocol, | ||||
| 364 | addr => Socket::pack_sockaddr_in( $port, $addr ), | ||||
| 365 | canonname => undef, | ||||
| 366 | }; | ||||
| 367 | } | ||||
| 368 | } | ||||
| 369 | |||||
| 370 | # Only supply canonname for the first result | ||||
| 371 | if( defined $canonname ) { | ||||
| 372 | $ret[0]->{canonname} = $canonname; | ||||
| 373 | } | ||||
| 374 | |||||
| 375 | return ( fake_makeerr( 0 ), @ret ); | ||||
| 376 | } | ||||
| 377 | |||||
| 378 | sub fake_getnameinfo | ||||
| 379 | { | ||||
| 380 | my ( $addr, $flags, $xflags ) = @_; | ||||
| 381 | |||||
| 382 | my ( $port, $inetaddr ); | ||||
| 383 | eval { ( $port, $inetaddr ) = Socket::unpack_sockaddr_in( $addr ) } | ||||
| 384 | or return fake_makeerr( EAI_FAMILY() ); | ||||
| 385 | |||||
| 386 | my $family = Socket::AF_INET(); | ||||
| 387 | |||||
| 388 | $flags ||= 0; | ||||
| 389 | |||||
| 390 | my $flag_numerichost = $flags & NI_NUMERICHOST(); $flags &= ~NI_NUMERICHOST(); | ||||
| 391 | my $flag_numericserv = $flags & NI_NUMERICSERV(); $flags &= ~NI_NUMERICSERV(); | ||||
| 392 | my $flag_nofqdn = $flags & NI_NOFQDN(); $flags &= ~NI_NOFQDN(); | ||||
| 393 | my $flag_namereqd = $flags & NI_NAMEREQD(); $flags &= ~NI_NAMEREQD(); | ||||
| 394 | my $flag_dgram = $flags & NI_DGRAM() ; $flags &= ~NI_DGRAM(); | ||||
| 395 | |||||
| 396 | $flags & (NI_IDN()|NI_IDN_ALLOW_UNASSIGNED()|NI_IDN_USE_STD3_ASCII_RULES()) and | ||||
| 397 | croak "Socket::getnameinfo() does not support IDN"; | ||||
| 398 | |||||
| 399 | $flags == 0 or return fake_makeerr( EAI_BADFLAGS() ); | ||||
| 400 | |||||
| 401 | $xflags ||= 0; | ||||
| 402 | |||||
| 403 | my $node; | ||||
| 404 | if( $xflags & NIx_NOHOST ) { | ||||
| 405 | $node = undef; | ||||
| 406 | } | ||||
| 407 | elsif( $flag_numerichost ) { | ||||
| 408 | $node = Socket::inet_ntoa( $inetaddr ); | ||||
| 409 | } | ||||
| 410 | else { | ||||
| 411 | $node = gethostbyaddr( $inetaddr, $family ); | ||||
| 412 | if( !defined $node ) { | ||||
| 413 | return fake_makeerr( EAI_NONAME() ) if $flag_namereqd; | ||||
| 414 | $node = Socket::inet_ntoa( $inetaddr ); | ||||
| 415 | } | ||||
| 416 | elsif( $flag_nofqdn ) { | ||||
| 417 | my ( $shortname ) = split m/\./, $node; | ||||
| 418 | my ( $fqdn ) = gethostbyname $shortname; | ||||
| 419 | $node = $shortname if defined $fqdn and $fqdn eq $node; | ||||
| 420 | } | ||||
| 421 | } | ||||
| 422 | |||||
| 423 | my $service; | ||||
| 424 | if( $xflags & NIx_NOSERV ) { | ||||
| 425 | $service = undef; | ||||
| 426 | } | ||||
| 427 | elsif( $flag_numericserv ) { | ||||
| 428 | $service = "$port"; | ||||
| 429 | } | ||||
| 430 | else { | ||||
| 431 | my $protname = $flag_dgram ? "udp" : ""; | ||||
| 432 | $service = getservbyport( $port, $protname ); | ||||
| 433 | if( !defined $service ) { | ||||
| 434 | $service = "$port"; | ||||
| 435 | } | ||||
| 436 | } | ||||
| 437 | |||||
| 438 | return ( fake_makeerr( 0 ), $node, $service ); | ||||
| 439 | } | ||||
| 440 | |||||
| 441 | 1 | 69µs | 1; | ||
# spent 22µs within Socket::CORE:match which was called 99 times, avg 224ns/call:
# 99 times (22µs+0s) by IO::Socket::BEGIN@12 at line 122, avg 224ns/call | |||||
sub Socket::CORE:qr; # opcode | |||||
# spent 33µs within Socket::CORE:regcomp which was called:
# once (33µs+0s) by IO::Socket::BEGIN@12 at line 260 | |||||
# spent 456ms within Socket::inet_ntoa which was called 100001 times, avg 5µs/call:
# 100001 times (456ms+0s) by IO::Socket::INET::peerhost at line 305 of IO/Socket/INET.pm, avg 5µs/call | |||||
# spent 5µs within Socket::pack_sockaddr_in which was called:
# once (5µs+0s) by IO::Socket::INET::bind at line 263 of IO/Socket/INET.pm | |||||
# spent 390ms within Socket::unpack_sockaddr_in which was called 200002 times, avg 2µs/call:
# 200002 times (390ms+0s) by Socket::sockaddr_in at line 151, avg 2µs/call |