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 | CORE:regcomp (opcode) | Socket::
103 | 1 | 1 | 24µs | 24µs | CORE:match (opcode) | Socket::
1 | 1 | 1 | 12µs | 23µs | BEGIN@3 | Socket::
1 | 1 | 1 | 10µs | 10µs | BEGIN@4 | Socket::
1 | 1 | 1 | 9µs | 20µs | BEGIN@242 | Socket::
1 | 1 | 1 | 8µs | 85µs | BEGIN@11 | Socket::
1 | 1 | 1 | 7µs | 34µs | BEGIN@10 | Socket::
1 | 1 | 1 | 3µs | 3µs | BEGIN@130 | Socket::
2 | 2 | 1 | 3µs | 3µs | CORE:qr (opcode) | Socket::
0 | 0 | 0 | 0s | 0s | __ANON__[:243] | Socket::
0 | 0 | 0 | 0s | 0s | fake_getaddrinfo | Socket::
0 | 0 | 0 | 0s | 0s | fake_getnameinfo | Socket::
0 | 0 | 0 | 0s | 0s | fake_makeerr | Socket::
0 | 0 | 0 | 0s | 0s | sockaddr_in | Socket::
0 | 0 | 0 | 0s | 0s | sockaddr_in6 | Socket::
0 | 0 | 0 | 0s | 0s | sockaddr_un | Socket::
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 |