| Filename | /usr/lib/x86_64-linux-gnu/perl/5.20/Socket.pm |
| Statements | Executed 30 statements in 2.66ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 32µs | 32µs | Socket::CORE:regcomp (opcode) |
| 103 | 1 | 1 | 24µs | 24µs | Socket::CORE:match (opcode) |
| 1 | 1 | 1 | 12µs | 23µs | Socket::BEGIN@3 |
| 1 | 1 | 1 | 10µs | 10µs | Socket::BEGIN@4 |
| 1 | 1 | 1 | 9µs | 20µs | Socket::BEGIN@242 |
| 1 | 1 | 1 | 8µs | 85µs | Socket::BEGIN@11 |
| 1 | 1 | 1 | 7µs | 34µs | Socket::BEGIN@10 |
| 1 | 1 | 1 | 3µs | 3µs | Socket::BEGIN@130 |
| 2 | 2 | 1 | 3µs | 3µs | Socket::CORE:qr (opcode) |
| 0 | 0 | 0 | 0s | 0s | Socket::__ANON__[:243] |
| 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_in |
| 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 | 22µs | 2 | 33µs | # spent 23µs (12+11) within Socket::BEGIN@3 which was called:
# once (12µs+11µs) by Mail::Sendmail::BEGIN@54 at line 3 # spent 23µs making 1 call to Socket::BEGIN@3
# spent 10µs making 1 call to strict::import |
| 4 | 3 | 48µs | 1 | 10µs | # spent 10µs within Socket::BEGIN@4 which was called:
# once (10µs+0s) by Mail::Sendmail::BEGIN@54 at line 4 # spent 10µs making 1 call to Socket::BEGIN@4 |
| 5 | |||||
| 6 | 1 | 400ns | our $VERSION = '2.013'; | ||
| 7 | |||||
| 8 | # Still undocumented: SCM_*, SOMAXCONN, IOV_MAX, UIO_MAXIOV | ||||
| 9 | |||||
| 10 | 2 | 22µs | 2 | 62µs | # spent 34µs (7+28) within Socket::BEGIN@10 which was called:
# once (7µs+28µs) by Mail::Sendmail::BEGIN@54 at line 10 # spent 34µs making 1 call to Socket::BEGIN@10
# spent 28µs making 1 call to Exporter::import |
| 11 | 2 | 238µs | 2 | 162µs | # spent 85µs (8+77) within Socket::BEGIN@11 which was called:
# once (8µs+77µs) by Mail::Sendmail::BEGIN@54 at line 11 # spent 85µs making 1 call to Socket::BEGIN@11
# spent 77µs making 1 call to warnings::register::import |
| 12 | |||||
| 13 | 1 | 700ns | require Exporter; | ||
| 14 | 1 | 600ns | 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 | 10µ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 | 5µ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 | IPTOS_LOWDELAY IPTOS_THROUGHPUT IPTOS_RELIABILITY IPTOS_MINCOST | ||||
| 90 | |||||
| 91 | TCP_CONGESTION TCP_CONNECTIONTIMEOUT TCP_CORK TCP_DEFER_ACCEPT TCP_INFO | ||||
| 92 | TCP_INIT_CWND TCP_KEEPALIVE TCP_KEEPCNT TCP_KEEPIDLE TCP_KEEPINTVL | ||||
| 93 | TCP_LINGER2 TCP_MAXRT TCP_MAXSEG TCP_MD5SIG TCP_NODELAY TCP_NOOPT | ||||
| 94 | TCP_NOPUSH TCP_QUICKACK TCP_SACK_ENABLE TCP_STDURG TCP_SYNCNT | ||||
| 95 | TCP_WINDOW_CLAMP | ||||
| 96 | |||||
| 97 | IN6ADDR_ANY IN6ADDR_LOOPBACK | ||||
| 98 | |||||
| 99 | IPV6_ADD_MEMBERSHIP IPV6_DROP_MEMBERSHIP IPV6_JOIN_GROUP | ||||
| 100 | IPV6_LEAVE_GROUP IPV6_MTU IPV6_MTU_DISCOVER IPV6_MULTICAST_HOPS | ||||
| 101 | IPV6_MULTICAST_IF IPV6_MULTICAST_LOOP IPV6_UNICAST_HOPS IPV6_V6ONLY | ||||
| 102 | |||||
| 103 | pack_ip_mreq unpack_ip_mreq pack_ip_mreq_source unpack_ip_mreq_source | ||||
| 104 | |||||
| 105 | pack_ipv6_mreq unpack_ipv6_mreq | ||||
| 106 | |||||
| 107 | inet_pton inet_ntop | ||||
| 108 | |||||
| 109 | getaddrinfo getnameinfo | ||||
| 110 | |||||
| 111 | AI_ADDRCONFIG AI_ALL AI_CANONIDN AI_CANONNAME AI_IDN | ||||
| 112 | AI_IDN_ALLOW_UNASSIGNED AI_IDN_USE_STD3_ASCII_RULES AI_NUMERICHOST | ||||
| 113 | AI_NUMERICSERV AI_PASSIVE AI_V4MAPPED | ||||
| 114 | |||||
| 115 | NI_DGRAM NI_IDN NI_IDN_ALLOW_UNASSIGNED NI_IDN_USE_STD3_ASCII_RULES | ||||
| 116 | NI_NAMEREQD NI_NOFQDN NI_NUMERICHOST NI_NUMERICSERV | ||||
| 117 | |||||
| 118 | NIx_NOHOST NIx_NOSERV | ||||
| 119 | |||||
| 120 | EAI_ADDRFAMILY EAI_AGAIN EAI_BADFLAGS EAI_BADHINTS EAI_FAIL EAI_FAMILY | ||||
| 121 | EAI_NODATA EAI_NONAME EAI_PROTOCOL EAI_SERVICE EAI_SOCKTYPE EAI_SYSTEM | ||||
| 122 | ); | ||||
| 123 | |||||
| 124 | 1 | 116µs | 103 | 24µs | our %EXPORT_TAGS = ( # spent 24µs making 103 calls to Socket::CORE:match, avg 236ns/call |
| 125 | crlf => [qw(CR LF CRLF $CR $LF $CRLF)], | ||||
| 126 | addrinfo => [qw(getaddrinfo getnameinfo), grep m/^(?:AI|NI|NIx|EAI)_/, @EXPORT_OK], | ||||
| 127 | all => [@EXPORT, @EXPORT_OK], | ||||
| 128 | ); | ||||
| 129 | |||||
| 130 | 1 | 4µs | # spent 3µs within Socket::BEGIN@130 which was called:
# once (3µs+0s) by Mail::Sendmail::BEGIN@54 at line 139 | ||
| 131 | sub CR () {"\015"} | ||||
| 132 | sub LF () {"\012"} | ||||
| 133 | sub CRLF () {"\015\012"} | ||||
| 134 | |||||
| 135 | # These are not gni() constants; they're extensions for the perl API | ||||
| 136 | # The definitions in Socket.pm and Socket.xs must match | ||||
| 137 | sub NIx_NOHOST() {1 << 0} | ||||
| 138 | sub NIx_NOSERV() {1 << 1} | ||||
| 139 | 1 | 372µs | 1 | 3µs | } # spent 3µs making 1 call to Socket::BEGIN@130 |
| 140 | |||||
| 141 | 1 | 900ns | *CR = \CR(); | ||
| 142 | 1 | 300ns | *LF = \LF(); | ||
| 143 | 1 | 200ns | *CRLF = \CRLF(); | ||
| 144 | |||||
| 145 | sub sockaddr_in { | ||||
| 146 | if (@_ == 6 && !wantarray) { # perl5.001m compat; use this && die | ||||
| 147 | my($af, $port, @quad) = @_; | ||||
| 148 | warnings::warn "6-ARG sockaddr_in call is deprecated" | ||||
| 149 | if warnings::enabled(); | ||||
| 150 | pack_sockaddr_in($port, inet_aton(join('.', @quad))); | ||||
| 151 | } elsif (wantarray) { | ||||
| 152 | croak "usage: (port,iaddr) = sockaddr_in(sin_sv)" unless @_ == 1; | ||||
| 153 | unpack_sockaddr_in(@_); | ||||
| 154 | } else { | ||||
| 155 | croak "usage: sin_sv = sockaddr_in(port,iaddr))" unless @_ == 2; | ||||
| 156 | pack_sockaddr_in(@_); | ||||
| 157 | } | ||||
| 158 | } | ||||
| 159 | |||||
| 160 | sub sockaddr_in6 { | ||||
| 161 | if (wantarray) { | ||||
| 162 | croak "usage: (port,in6addr,scope_id,flowinfo) = sockaddr_in6(sin6_sv)" unless @_ == 1; | ||||
| 163 | unpack_sockaddr_in6(@_); | ||||
| 164 | } | ||||
| 165 | else { | ||||
| 166 | croak "usage: sin6_sv = sockaddr_in6(port,in6addr,[scope_id,[flowinfo]])" unless @_ >= 2 and @_ <= 4; | ||||
| 167 | pack_sockaddr_in6(@_); | ||||
| 168 | } | ||||
| 169 | } | ||||
| 170 | |||||
| 171 | sub sockaddr_un { | ||||
| 172 | if (wantarray) { | ||||
| 173 | croak "usage: (filename) = sockaddr_un(sun_sv)" unless @_ == 1; | ||||
| 174 | unpack_sockaddr_un(@_); | ||||
| 175 | } else { | ||||
| 176 | croak "usage: sun_sv = sockaddr_un(filename)" unless @_ == 1; | ||||
| 177 | pack_sockaddr_un(@_); | ||||
| 178 | } | ||||
| 179 | } | ||||
| 180 | |||||
| 181 | 1 | 309µs | 1 | 302µs | XSLoader::load(__PACKAGE__, $VERSION); # spent 302µs making 1 call to XSLoader::load |
| 182 | |||||
| 183 | 1 | 200ns | my %errstr; | ||
| 184 | |||||
| 185 | 1 | 600ns | if( defined &getaddrinfo ) { | ||
| 186 | # These are not part of the API, nothing uses them, and deleting them | ||||
| 187 | # reduces the size of %Socket:: by about 12K | ||||
| 188 | 1 | 1µs | delete $Socket::{fake_getaddrinfo}; | ||
| 189 | 1 | 400ns | delete $Socket::{fake_getnameinfo}; | ||
| 190 | } else { | ||||
| 191 | require Scalar::Util; | ||||
| 192 | |||||
| 193 | *getaddrinfo = \&fake_getaddrinfo; | ||||
| 194 | *getnameinfo = \&fake_getnameinfo; | ||||
| 195 | |||||
| 196 | # These numbers borrowed from GNU libc's implementation, but since | ||||
| 197 | # they're only used by our emulation, it doesn't matter if the real | ||||
| 198 | # platform's values differ | ||||
| 199 | my %constants = ( | ||||
| 200 | AI_PASSIVE => 1, | ||||
| 201 | AI_CANONNAME => 2, | ||||
| 202 | AI_NUMERICHOST => 4, | ||||
| 203 | AI_V4MAPPED => 8, | ||||
| 204 | AI_ALL => 16, | ||||
| 205 | AI_ADDRCONFIG => 32, | ||||
| 206 | # RFC 2553 doesn't define this but Linux does - lets be nice and | ||||
| 207 | # provide it since we can | ||||
| 208 | AI_NUMERICSERV => 1024, | ||||
| 209 | |||||
| 210 | EAI_BADFLAGS => -1, | ||||
| 211 | EAI_NONAME => -2, | ||||
| 212 | EAI_NODATA => -5, | ||||
| 213 | EAI_FAMILY => -6, | ||||
| 214 | EAI_SERVICE => -8, | ||||
| 215 | |||||
| 216 | NI_NUMERICHOST => 1, | ||||
| 217 | NI_NUMERICSERV => 2, | ||||
| 218 | NI_NOFQDN => 4, | ||||
| 219 | NI_NAMEREQD => 8, | ||||
| 220 | NI_DGRAM => 16, | ||||
| 221 | |||||
| 222 | # Constants we don't support. Export them, but croak if anyone tries to | ||||
| 223 | # use them | ||||
| 224 | AI_IDN => 64, | ||||
| 225 | AI_CANONIDN => 128, | ||||
| 226 | AI_IDN_ALLOW_UNASSIGNED => 256, | ||||
| 227 | AI_IDN_USE_STD3_ASCII_RULES => 512, | ||||
| 228 | NI_IDN => 32, | ||||
| 229 | NI_IDN_ALLOW_UNASSIGNED => 64, | ||||
| 230 | NI_IDN_USE_STD3_ASCII_RULES => 128, | ||||
| 231 | |||||
| 232 | # Error constants we'll never return, so it doesn't matter what value | ||||
| 233 | # these have, nor that we don't provide strings for them | ||||
| 234 | EAI_SYSTEM => -11, | ||||
| 235 | EAI_BADHINTS => -1000, | ||||
| 236 | EAI_PROTOCOL => -1001 | ||||
| 237 | ); | ||||
| 238 | |||||
| 239 | foreach my $name ( keys %constants ) { | ||||
| 240 | my $value = $constants{$name}; | ||||
| 241 | |||||
| 242 | 2 | 1.39ms | 2 | 30µs | # spent 20µs (9+11) within Socket::BEGIN@242 which was called:
# once (9µs+11µs) by Mail::Sendmail::BEGIN@54 at line 242 # spent 20µs making 1 call to Socket::BEGIN@242
# spent 11µs making 1 call to strict::unimport |
| 243 | defined &$name or *$name = sub () { $value }; | ||||
| 244 | } | ||||
| 245 | |||||
| 246 | %errstr = ( | ||||
| 247 | # These strings from RFC 2553 | ||||
| 248 | EAI_BADFLAGS() => "invalid value for ai_flags", | ||||
| 249 | EAI_NONAME() => "nodename nor servname provided, or not known", | ||||
| 250 | EAI_NODATA() => "no address associated with nodename", | ||||
| 251 | EAI_FAMILY() => "ai_family not supported", | ||||
| 252 | EAI_SERVICE() => "servname not supported for ai_socktype", | ||||
| 253 | ); | ||||
| 254 | } | ||||
| 255 | |||||
| 256 | # The following functions are used if the system does not have a | ||||
| 257 | # getaddrinfo(3) function in libc; and are used to emulate it for the AF_INET | ||||
| 258 | # family | ||||
| 259 | |||||
| 260 | # Borrowed from Regexp::Common::net | ||||
| 261 | 1 | 6µs | 1 | 2µs | my $REGEXP_IPv4_DECIMAL = qr/25[0-5]|2[0-4][0-9]|1?[0-9][0-9]{1,2}/; # spent 2µs making 1 call to Socket::CORE:qr |
| 262 | 1 | 40µs | 2 | 33µs | my $REGEXP_IPv4_DOTTEDQUAD = qr/$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL/; # spent 32µs making 1 call to Socket::CORE:regcomp
# spent 800ns making 1 call to Socket::CORE:qr |
| 263 | |||||
| 264 | sub fake_makeerr | ||||
| 265 | { | ||||
| 266 | my ( $errno ) = @_; | ||||
| 267 | my $errstr = $errno == 0 ? "" : ( $errstr{$errno} || $errno ); | ||||
| 268 | return Scalar::Util::dualvar( $errno, $errstr ); | ||||
| 269 | } | ||||
| 270 | |||||
| 271 | sub fake_getaddrinfo | ||||
| 272 | { | ||||
| 273 | my ( $node, $service, $hints ) = @_; | ||||
| 274 | |||||
| 275 | $node = "" unless defined $node; | ||||
| 276 | |||||
| 277 | $service = "" unless defined $service; | ||||
| 278 | |||||
| 279 | my ( $family, $socktype, $protocol, $flags ) = @$hints{qw( family socktype protocol flags )}; | ||||
| 280 | |||||
| 281 | $family ||= Socket::AF_INET(); # 0 == AF_UNSPEC, which we want too | ||||
| 282 | $family == Socket::AF_INET() or return fake_makeerr( EAI_FAMILY() ); | ||||
| 283 | |||||
| 284 | $socktype ||= 0; | ||||
| 285 | |||||
| 286 | $protocol ||= 0; | ||||
| 287 | |||||
| 288 | $flags ||= 0; | ||||
| 289 | |||||
| 290 | my $flag_passive = $flags & AI_PASSIVE(); $flags &= ~AI_PASSIVE(); | ||||
| 291 | my $flag_canonname = $flags & AI_CANONNAME(); $flags &= ~AI_CANONNAME(); | ||||
| 292 | my $flag_numerichost = $flags & AI_NUMERICHOST(); $flags &= ~AI_NUMERICHOST(); | ||||
| 293 | my $flag_numericserv = $flags & AI_NUMERICSERV(); $flags &= ~AI_NUMERICSERV(); | ||||
| 294 | |||||
| 295 | # These constants don't apply to AF_INET-only lookups, so we might as well | ||||
| 296 | # just ignore them. For AI_ADDRCONFIG we just presume the host has ability | ||||
| 297 | # to talk AF_INET. If not we'd have to return no addresses at all. :) | ||||
| 298 | $flags &= ~(AI_V4MAPPED()|AI_ALL()|AI_ADDRCONFIG()); | ||||
| 299 | |||||
| 300 | $flags & (AI_IDN()|AI_CANONIDN()|AI_IDN_ALLOW_UNASSIGNED()|AI_IDN_USE_STD3_ASCII_RULES()) and | ||||
| 301 | croak "Socket::getaddrinfo() does not support IDN"; | ||||
| 302 | |||||
| 303 | $flags == 0 or return fake_makeerr( EAI_BADFLAGS() ); | ||||
| 304 | |||||
| 305 | $node eq "" and $service eq "" and return fake_makeerr( EAI_NONAME() ); | ||||
| 306 | |||||
| 307 | my $canonname; | ||||
| 308 | my @addrs; | ||||
| 309 | if( $node ne "" ) { | ||||
| 310 | return fake_makeerr( EAI_NONAME() ) if( $flag_numerichost and $node !~ m/^$REGEXP_IPv4_DOTTEDQUAD$/ ); | ||||
| 311 | ( $canonname, undef, undef, undef, @addrs ) = gethostbyname( $node ); | ||||
| 312 | defined $canonname or return fake_makeerr( EAI_NONAME() ); | ||||
| 313 | |||||
| 314 | undef $canonname unless $flag_canonname; | ||||
| 315 | } | ||||
| 316 | else { | ||||
| 317 | $addrs[0] = $flag_passive ? Socket::inet_aton( "0.0.0.0" ) | ||||
| 318 | : Socket::inet_aton( "127.0.0.1" ); | ||||
| 319 | } | ||||
| 320 | |||||
| 321 | my @ports; # Actually ARRAYrefs of [ socktype, protocol, port ] | ||||
| 322 | my $protname = ""; | ||||
| 323 | if( $protocol ) { | ||||
| 324 | $protname = getprotobynumber( $protocol ); | ||||
| 325 | } | ||||
| 326 | |||||
| 327 | if( $service ne "" and $service !~ m/^\d+$/ ) { | ||||
| 328 | return fake_makeerr( EAI_NONAME() ) if( $flag_numericserv ); | ||||
| 329 | getservbyname( $service, $protname ) or return fake_makeerr( EAI_SERVICE() ); | ||||
| 330 | } | ||||
| 331 | |||||
| 332 | foreach my $this_socktype ( Socket::SOCK_STREAM(), Socket::SOCK_DGRAM(), Socket::SOCK_RAW() ) { | ||||
| 333 | next if $socktype and $this_socktype != $socktype; | ||||
| 334 | |||||
| 335 | my $this_protname = "raw"; | ||||
| 336 | $this_socktype == Socket::SOCK_STREAM() and $this_protname = "tcp"; | ||||
| 337 | $this_socktype == Socket::SOCK_DGRAM() and $this_protname = "udp"; | ||||
| 338 | |||||
| 339 | next if $protname and $this_protname ne $protname; | ||||
| 340 | |||||
| 341 | my $port; | ||||
| 342 | if( $service ne "" ) { | ||||
| 343 | if( $service =~ m/^\d+$/ ) { | ||||
| 344 | $port = "$service"; | ||||
| 345 | } | ||||
| 346 | else { | ||||
| 347 | ( undef, undef, $port, $this_protname ) = getservbyname( $service, $this_protname ); | ||||
| 348 | next unless defined $port; | ||||
| 349 | } | ||||
| 350 | } | ||||
| 351 | else { | ||||
| 352 | $port = 0; | ||||
| 353 | } | ||||
| 354 | |||||
| 355 | push @ports, [ $this_socktype, scalar getprotobyname( $this_protname ) || 0, $port ]; | ||||
| 356 | } | ||||
| 357 | |||||
| 358 | my @ret; | ||||
| 359 | foreach my $addr ( @addrs ) { | ||||
| 360 | foreach my $portspec ( @ports ) { | ||||
| 361 | my ( $socktype, $protocol, $port ) = @$portspec; | ||||
| 362 | push @ret, { | ||||
| 363 | family => $family, | ||||
| 364 | socktype => $socktype, | ||||
| 365 | protocol => $protocol, | ||||
| 366 | addr => Socket::pack_sockaddr_in( $port, $addr ), | ||||
| 367 | canonname => undef, | ||||
| 368 | }; | ||||
| 369 | } | ||||
| 370 | } | ||||
| 371 | |||||
| 372 | # Only supply canonname for the first result | ||||
| 373 | if( defined $canonname ) { | ||||
| 374 | $ret[0]->{canonname} = $canonname; | ||||
| 375 | } | ||||
| 376 | |||||
| 377 | return ( fake_makeerr( 0 ), @ret ); | ||||
| 378 | } | ||||
| 379 | |||||
| 380 | sub fake_getnameinfo | ||||
| 381 | { | ||||
| 382 | my ( $addr, $flags, $xflags ) = @_; | ||||
| 383 | |||||
| 384 | my ( $port, $inetaddr ); | ||||
| 385 | eval { ( $port, $inetaddr ) = Socket::unpack_sockaddr_in( $addr ) } | ||||
| 386 | or return fake_makeerr( EAI_FAMILY() ); | ||||
| 387 | |||||
| 388 | my $family = Socket::AF_INET(); | ||||
| 389 | |||||
| 390 | $flags ||= 0; | ||||
| 391 | |||||
| 392 | my $flag_numerichost = $flags & NI_NUMERICHOST(); $flags &= ~NI_NUMERICHOST(); | ||||
| 393 | my $flag_numericserv = $flags & NI_NUMERICSERV(); $flags &= ~NI_NUMERICSERV(); | ||||
| 394 | my $flag_nofqdn = $flags & NI_NOFQDN(); $flags &= ~NI_NOFQDN(); | ||||
| 395 | my $flag_namereqd = $flags & NI_NAMEREQD(); $flags &= ~NI_NAMEREQD(); | ||||
| 396 | my $flag_dgram = $flags & NI_DGRAM() ; $flags &= ~NI_DGRAM(); | ||||
| 397 | |||||
| 398 | $flags & (NI_IDN()|NI_IDN_ALLOW_UNASSIGNED()|NI_IDN_USE_STD3_ASCII_RULES()) and | ||||
| 399 | croak "Socket::getnameinfo() does not support IDN"; | ||||
| 400 | |||||
| 401 | $flags == 0 or return fake_makeerr( EAI_BADFLAGS() ); | ||||
| 402 | |||||
| 403 | $xflags ||= 0; | ||||
| 404 | |||||
| 405 | my $node; | ||||
| 406 | if( $xflags & NIx_NOHOST ) { | ||||
| 407 | $node = undef; | ||||
| 408 | } | ||||
| 409 | elsif( $flag_numerichost ) { | ||||
| 410 | $node = Socket::inet_ntoa( $inetaddr ); | ||||
| 411 | } | ||||
| 412 | else { | ||||
| 413 | $node = gethostbyaddr( $inetaddr, $family ); | ||||
| 414 | if( !defined $node ) { | ||||
| 415 | return fake_makeerr( EAI_NONAME() ) if $flag_namereqd; | ||||
| 416 | $node = Socket::inet_ntoa( $inetaddr ); | ||||
| 417 | } | ||||
| 418 | elsif( $flag_nofqdn ) { | ||||
| 419 | my ( $shortname ) = split m/\./, $node; | ||||
| 420 | my ( $fqdn ) = gethostbyname $shortname; | ||||
| 421 | $node = $shortname if defined $fqdn and $fqdn eq $node; | ||||
| 422 | } | ||||
| 423 | } | ||||
| 424 | |||||
| 425 | my $service; | ||||
| 426 | if( $xflags & NIx_NOSERV ) { | ||||
| 427 | $service = undef; | ||||
| 428 | } | ||||
| 429 | elsif( $flag_numericserv ) { | ||||
| 430 | $service = "$port"; | ||||
| 431 | } | ||||
| 432 | else { | ||||
| 433 | my $protname = $flag_dgram ? "udp" : ""; | ||||
| 434 | $service = getservbyport( $port, $protname ); | ||||
| 435 | if( !defined $service ) { | ||||
| 436 | $service = "$port"; | ||||
| 437 | } | ||||
| 438 | } | ||||
| 439 | |||||
| 440 | return ( fake_makeerr( 0 ), $node, $service ); | ||||
| 441 | } | ||||
| 442 | |||||
| 443 | 1 | 59µs | 1; | ||
# spent 24µs within Socket::CORE:match which was called 103 times, avg 236ns/call:
# 103 times (24µs+0s) by Mail::Sendmail::BEGIN@54 at line 124, avg 236ns/call | |||||
sub Socket::CORE:qr; # opcode | |||||
# spent 32µs within Socket::CORE:regcomp which was called:
# once (32µs+0s) by Mail::Sendmail::BEGIN@54 at line 262 |