This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Minor bugfixes to Socket::getaddrinfo
[perl5.git] / ext / Socket / Socket.pm
1 package Socket;
2
3 use strict;
4
5 our($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
6 $VERSION = "1.94";
7
8 =head1 NAME
9
10 Socket, sockaddr_in, sockaddr_un, inet_aton, inet_ntoa, inet_pton, inet_ntop - load the C socket.h defines and structure manipulators 
11
12 =head1 SYNOPSIS
13
14     use Socket;
15
16     $proto = getprotobyname('udp');
17     socket(Socket_Handle, PF_INET, SOCK_DGRAM, $proto);
18     $iaddr = gethostbyname('hishost.com');
19     $port = getservbyname('time', 'udp');
20     $sin = sockaddr_in($port, $iaddr);
21     send(Socket_Handle, 0, 0, $sin);
22
23     $proto = getprotobyname('tcp');
24     socket(Socket_Handle, PF_INET, SOCK_STREAM, $proto);
25     $port = getservbyname('smtp', 'tcp');
26     $sin = sockaddr_in($port,inet_aton("127.1"));
27     $sin = sockaddr_in(7,inet_aton("localhost"));
28     $sin = sockaddr_in(7,INADDR_LOOPBACK);
29     connect(Socket_Handle,$sin);
30
31     ($port, $iaddr) = sockaddr_in(getpeername(Socket_Handle));
32     $peer_host = gethostbyaddr($iaddr, AF_INET);
33     $peer_addr = inet_ntoa($iaddr);
34
35     $proto = getprotobyname('tcp');
36     socket(Socket_Handle, PF_UNIX, SOCK_STREAM, $proto);
37     unlink('/var/run/usock');
38     $sun = sockaddr_un('/var/run/usock');
39     connect(Socket_Handle,$sun);
40
41 =head1 DESCRIPTION
42
43 This module is just a translation of the C F<socket.h> file.
44 Unlike the old mechanism of requiring a translated F<socket.ph>
45 file, this uses the B<h2xs> program (see the Perl source distribution)
46 and your native C compiler.  This means that it has a 
47 far more likely chance of getting the numbers right.  This includes
48 all of the commonly used pound-defines like AF_INET, SOCK_STREAM, etc.
49
50 Also, some common socket "newline" constants are provided: the
51 constants C<CR>, C<LF>, and C<CRLF>, as well as C<$CR>, C<$LF>, and
52 C<$CRLF>, which map to C<\015>, C<\012>, and C<\015\012>.  If you do
53 not want to use the literal characters in your programs, then use
54 the constants provided here.  They are not exported by default, but can
55 be imported individually, and with the C<:crlf> export tag:
56
57     use Socket qw(:DEFAULT :crlf);
58
59 In addition, some structure manipulation functions are available:
60
61 =over 4
62
63 =item inet_aton HOSTNAME
64
65 Takes a string giving the name of a host, and translates that to an
66 opaque string (if programming in C, struct in_addr). Takes arguments
67 of both the 'rtfm.mit.edu' type and '18.181.0.24'. If the host name
68 cannot be resolved, returns undef.  For multi-homed hosts (hosts with
69 more than one address), the first address found is returned.
70
71 For portability do not assume that the result of inet_aton() is 32
72 bits wide, in other words, that it would contain only the IPv4 address
73 in network order.
74
75 =item inet_ntoa IP_ADDRESS
76
77 Takes a string (an opaque string as returned by inet_aton(),
78 or a v-string representing the four octets of the IPv4 address in
79 network order) and translates it into a string of the form 'd.d.d.d'
80 where the 'd's are numbers less than 256 (the normal human-readable
81 four dotted number notation for Internet addresses).
82
83 =item INADDR_ANY
84
85 Note: does not return a number, but a packed string.
86
87 Returns the 4-byte wildcard ip address which specifies any
88 of the hosts ip addresses.  (A particular machine can have
89 more than one ip address, each address corresponding to
90 a particular network interface. This wildcard address
91 allows you to bind to all of them simultaneously.)
92 Normally equivalent to inet_aton('0.0.0.0').
93
94 =item INADDR_BROADCAST
95
96 Note: does not return a number, but a packed string.
97
98 Returns the 4-byte 'this-lan' ip broadcast address.
99 This can be useful for some protocols to solicit information
100 from all servers on the same LAN cable.
101 Normally equivalent to inet_aton('255.255.255.255').
102
103 =item INADDR_LOOPBACK
104
105 Note - does not return a number.
106
107 Returns the 4-byte loopback address.  Normally equivalent
108 to inet_aton('localhost').
109
110 =item INADDR_NONE
111
112 Note - does not return a number.
113
114 Returns the 4-byte 'invalid' ip address.  Normally equivalent
115 to inet_aton('255.255.255.255').
116
117 =item IN6ADDR_ANY
118
119 Returns the 16-byte wildcard IPv6 address. Normally equivalent
120 to inet_pton(AF_INET6, "::")
121
122 =item IN6ADDR_LOOPBACK
123
124 Returns the 16-byte loopback IPv6 address. Normally equivalent
125 to inet_pton(AF_INET6, "::1")
126
127 =item sockaddr_family SOCKADDR
128
129 Takes a sockaddr structure (as returned by pack_sockaddr_in(),
130 pack_sockaddr_un() or the perl builtin functions getsockname() and
131 getpeername()) and returns the address family tag.  It will match the
132 constant AF_INET for a sockaddr_in and AF_UNIX for a sockaddr_un.  It
133 can be used to figure out what unpacker to use for a sockaddr of
134 unknown type.
135
136 =item sockaddr_in PORT, ADDRESS
137
138 =item sockaddr_in SOCKADDR_IN
139
140 In a list context, unpacks its SOCKADDR_IN argument and returns an array
141 consisting of (PORT, ADDRESS).  In a scalar context, packs its (PORT,
142 ADDRESS) arguments as a SOCKADDR_IN and returns it.  If this is confusing,
143 use pack_sockaddr_in() and unpack_sockaddr_in() explicitly.
144
145 =item pack_sockaddr_in PORT, IP_ADDRESS
146
147 Takes two arguments, a port number and an opaque string, IP_ADDRESS
148 (as returned by inet_aton(), or a v-string).  Returns the sockaddr_in
149 structure with those arguments packed in with AF_INET filled in.  For
150 Internet domain sockets, this structure is normally what you need for
151 the arguments in bind(), connect(), and send(), and is also returned
152 by getpeername(), getsockname() and recv().
153
154 =item unpack_sockaddr_in SOCKADDR_IN
155
156 Takes a sockaddr_in structure (as returned by pack_sockaddr_in()) and
157 returns an array of two elements: the port and an opaque string
158 representing the IP address (you can use inet_ntoa() to convert the
159 address to the four-dotted numeric format).  Will croak if the
160 structure does not have AF_INET in the right place.
161
162 =item sockaddr_in6 PORT, IP6_ADDRESS, [ SCOPE_ID, [ FLOWINFO ] ]
163
164 =item sockaddr_in6 SOCKADDR_IN6
165
166 In list context, unpacks its SOCKADDR_IN6 argument according to
167 unpack_sockaddr_in6(). In scalar context, packs its arguments according to
168 pack_sockaddr_in6().
169
170 =item pack_sockaddr_in6 PORT, IP6_ADDRESS, [ SCOPE_ID, [ FLOWINFO ] ]
171
172 Takes two to four arguments, a port number, an opaque string (as returned by
173 inet_pton()), optionally a scope ID number, and optionally a flow label
174 number. Returns the sockaddr_in6 structure with those arguments packed in
175 with AF_INET6 filled in. IPv6 equivalent of pack_sockaddr_in().
176
177 =item unpack_sockaddr_in6 SOCKADDR_IN6
178
179 Takes a sockaddr_in6 structure (as returned by pack_sockaddr_in6()) and
180 returns an array of four elements: the port number, an opaque string
181 representing the IPv6 address, the scope ID, and the flow label. (You can
182 use inet_ntop() to convert the address to the usual string format). Will
183 croak if the structure does not have AF_INET6 in the right place.
184
185 =item sockaddr_un PATHNAME
186
187 =item sockaddr_un SOCKADDR_UN
188
189 In a list context, unpacks its SOCKADDR_UN argument and returns an array
190 consisting of (PATHNAME).  In a scalar context, packs its PATHNAME
191 arguments as a SOCKADDR_UN and returns it.  If this is confusing, use
192 pack_sockaddr_un() and unpack_sockaddr_un() explicitly.
193 These are only supported if your system has E<lt>F<sys/un.h>E<gt>.
194
195 =item pack_sockaddr_un PATH
196
197 Takes one argument, a pathname. Returns the sockaddr_un structure with
198 that path packed in with AF_UNIX filled in. For unix domain sockets, this
199 structure is normally what you need for the arguments in bind(),
200 connect(), and send(), and is also returned by getpeername(),
201 getsockname() and recv().
202
203 =item unpack_sockaddr_un SOCKADDR_UN
204
205 Takes a sockaddr_un structure (as returned by pack_sockaddr_un())
206 and returns the pathname.  Will croak if the structure does not
207 have AF_UNIX in the right place.
208
209 =item inet_pton ADDRESS_FAMILY, HOSTNAME
210
211 Takes an address family, either AF_INET or AF_INET6, and a string giving
212 the name of a host, and translates that to an opaque string
213 (if programming in C, struct in_addr or struct in6_addr depending on the 
214 address family passed in).  The host string may be a string hostname, such
215 as 'www.perl.org', or an IP address.  If using an IP address, the type of
216 IP address must be consistent with the address family passed into the function.
217
218 This function is not exported by default.
219
220 =item inet_ntop ADDRESS_FAMILY, IP_ADDRESS
221
222 Takes an address family, either AF_INET or AF_INET6, and a string 
223 (an opaque string as returned by inet_aton() or inet_pton()) and
224 translates it to an IPv4 or IPv6 address string.
225
226 This function is not exported by default.
227
228 =item getaddrinfo HOST, SERVICE, [ HINTS ]
229
230 Given at least one of a hostname and a service name, returns a list of address
231 structures to listen on or connect to. HOST and SERVICE should be plain
232 strings (or a numerical port number for SERVICE). If present, HINTS should be
233 a reference to a HASH, where the following keys are recognised:
234
235 =over 8
236
237 =item flags => INT
238
239 A bitfield containing C<AI_*> constants
240
241 =item family => INT
242
243 Restrict to only generating addresses in this address family
244
245 =item socktype => INT
246
247 Restrict to only generating addresses of this socket type
248
249 =item protocol => INT
250
251 Restrict to only generating addresses for this protocol
252
253 =back
254
255 The return value will be a list; the first value being an error indication,
256 followed by a list of address structures (if no error occured).
257
258  my ( $err, @results ) = getaddrinfo( ... );
259
260 The error value will be a dualvar; comparable to the C<EI_*> error constants,
261 or printable as a human-readable error message string. Each value in the
262 results list will be a HASH reference containing the following fields:
263
264 =over 8
265
266 =item family => INT
267
268 The address family (e.g. AF_INET)
269
270 =item socktype => INT
271
272 The socket type (e.g. SOCK_STREAM)
273
274 =item protocol => INT
275
276 The protocol (e.g. IPPROTO_TCP)
277
278 =item addr => STRING
279
280 The address in a packed string (such as would be returned by pack_sockaddr_in)
281
282 =item canonname => STRING
283
284 The canonical name for the host if the C<AI_CANONNAME> flag was provided, or
285 C<undef> otherwise. This field will only be present on the first returned
286 address.
287
288 =back
289
290 =item getnameinfo ADDR, FLAGS
291
292 Given a packed socket address (such as from C<getsockname>, C<getpeername>, or
293 returned by C<getaddrinfo> in a C<addr> field), returns the hostname and
294 symbolic service name it represents. FLAGS may be a bitmask of C<NI_*>
295 constants, or defaults to 0 if unspecified.
296
297 The return value will be a list; the first value being an error condition,
298 followed by the hostname and service name.
299
300  my ( $err, $host, $service ) = getnameinfo( ... );
301
302 The error value will be a dualvar; comparable to the C<EI_*> error constants,
303 or printable as a human-readable error message string. The host and service
304 names will be plain strings.
305
306 =back
307
308 =cut
309
310 use Carp;
311 use warnings::register;
312
313 require Exporter;
314 require XSLoader;
315 @ISA = qw(Exporter);
316
317 # <@Nicholas> you can't change @EXPORT without breaking the implicit API
318 # Please put any new constants in @EXPORT_OK!
319 @EXPORT = qw(
320         inet_aton inet_ntoa
321         sockaddr_family
322         pack_sockaddr_in unpack_sockaddr_in
323         pack_sockaddr_un unpack_sockaddr_un
324         pack_sockaddr_in6 unpack_sockaddr_in6
325         sockaddr_in sockaddr_in6 sockaddr_un
326         INADDR_ANY INADDR_BROADCAST INADDR_LOOPBACK INADDR_NONE
327         AF_802
328         AF_AAL
329         AF_APPLETALK
330         AF_CCITT
331         AF_CHAOS
332         AF_CTF
333         AF_DATAKIT
334         AF_DECnet
335         AF_DLI
336         AF_ECMA
337         AF_GOSIP
338         AF_HYLINK
339         AF_IMPLINK
340         AF_INET
341         AF_INET6
342         AF_ISO
343         AF_KEY
344         AF_LAST
345         AF_LAT
346         AF_LINK
347         AF_MAX
348         AF_NBS
349         AF_NIT
350         AF_NS
351         AF_OSI
352         AF_OSINET
353         AF_PUP
354         AF_ROUTE
355         AF_SNA
356         AF_UNIX
357         AF_UNSPEC
358         AF_USER
359         AF_WAN
360         AF_X25
361         IOV_MAX
362         IP_OPTIONS
363         IP_HDRINCL
364         IP_TOS
365         IP_TTL
366         IP_RECVOPTS
367         IP_RECVRETOPTS
368         IP_RETOPTS
369         MSG_BCAST
370         MSG_BTAG
371         MSG_CTLFLAGS
372         MSG_CTLIGNORE
373         MSG_CTRUNC
374         MSG_DONTROUTE
375         MSG_DONTWAIT
376         MSG_EOF
377         MSG_EOR
378         MSG_ERRQUEUE
379         MSG_ETAG
380         MSG_FIN
381         MSG_MAXIOVLEN
382         MSG_MCAST
383         MSG_NOSIGNAL
384         MSG_OOB
385         MSG_PEEK
386         MSG_PROXY
387         MSG_RST
388         MSG_SYN
389         MSG_TRUNC
390         MSG_URG
391         MSG_WAITALL
392         MSG_WIRE
393         PF_802
394         PF_AAL
395         PF_APPLETALK
396         PF_CCITT
397         PF_CHAOS
398         PF_CTF
399         PF_DATAKIT
400         PF_DECnet
401         PF_DLI
402         PF_ECMA
403         PF_GOSIP
404         PF_HYLINK
405         PF_IMPLINK
406         PF_INET
407         PF_INET6
408         PF_ISO
409         PF_KEY
410         PF_LAST
411         PF_LAT
412         PF_LINK
413         PF_MAX
414         PF_NBS
415         PF_NIT
416         PF_NS
417         PF_OSI
418         PF_OSINET
419         PF_PUP
420         PF_ROUTE
421         PF_SNA
422         PF_UNIX
423         PF_UNSPEC
424         PF_USER
425         PF_WAN
426         PF_X25
427         SCM_CONNECT
428         SCM_CREDENTIALS
429         SCM_CREDS
430         SCM_RIGHTS
431         SCM_TIMESTAMP
432         SHUT_RD
433         SHUT_RDWR
434         SHUT_WR
435         SOCK_DGRAM
436         SOCK_RAW
437         SOCK_RDM
438         SOCK_SEQPACKET
439         SOCK_STREAM
440         SOL_SOCKET
441         SOMAXCONN
442         SO_ACCEPTCONN
443         SO_ATTACH_FILTER
444         SO_BACKLOG
445         SO_BROADCAST
446         SO_CHAMELEON
447         SO_DEBUG
448         SO_DETACH_FILTER
449         SO_DGRAM_ERRIND
450         SO_DONTLINGER
451         SO_DONTROUTE
452         SO_ERROR
453         SO_FAMILY
454         SO_KEEPALIVE
455         SO_LINGER
456         SO_OOBINLINE
457         SO_PASSCRED
458         SO_PASSIFNAME
459         SO_PEERCRED
460         SO_PROTOCOL
461         SO_PROTOTYPE
462         SO_RCVBUF
463         SO_RCVLOWAT
464         SO_RCVTIMEO
465         SO_REUSEADDR
466         SO_REUSEPORT
467         SO_SECURITY_AUTHENTICATION
468         SO_SECURITY_ENCRYPTION_NETWORK
469         SO_SECURITY_ENCRYPTION_TRANSPORT
470         SO_SNDBUF
471         SO_SNDLOWAT
472         SO_SNDTIMEO
473         SO_STATE
474         SO_TYPE
475         SO_USELOOPBACK
476         SO_XOPEN
477         SO_XSE
478         UIO_MAXIOV
479 );
480
481 @EXPORT_OK = qw(CR LF CRLF $CR $LF $CRLF
482
483                inet_pton
484                inet_ntop
485
486                getaddrinfo
487                getnameinfo
488
489                IN6ADDR_ANY IN6ADDR_LOOPBACK
490
491                AI_CANONNAME
492                AI_NUMERICHOST
493                AI_NUMERICSERV
494                AI_PASSIVE
495
496                EAI_ADDRFAMILY
497                EAI_AGAIN
498                EAI_BADFLAGS
499                EAI_FAIL
500                EAI_FAMILY
501                EAI_NODATA
502                EAI_NONAME
503                EAI_SERVICE
504                EAI_SOCKTYPE
505
506                IPPROTO_IP
507                IPPROTO_IPV6
508                IPPROTO_RAW
509                IPPROTO_ICMP
510                IPPROTO_TCP
511                IPPROTO_UDP
512
513                NI_DGRAM
514                NI_NAMEREQD
515                NI_NUMERICHOST
516                NI_NUMERICSERV
517
518                TCP_KEEPALIVE
519                TCP_MAXRT
520                TCP_MAXSEG
521                TCP_NODELAY
522                TCP_STDURG
523                TCP_CORK
524                TCP_KEEPIDLE
525                TCP_KEEPINTVL
526                TCP_KEEPCNT
527                TCP_SYNCNT
528                TCP_LINGER2
529                TCP_DEFER_ACCEPT
530                TCP_WINDOW_CLAMP
531                TCP_INFO
532                TCP_QUICKACK
533                TCP_CONGESTION
534                TCP_MD5SIG);
535
536 %EXPORT_TAGS = (
537     crlf    => [qw(CR LF CRLF $CR $LF $CRLF)],
538     all     => [@EXPORT, @EXPORT_OK],
539 );
540
541 BEGIN {
542     sub CR   () {"\015"}
543     sub LF   () {"\012"}
544     sub CRLF () {"\015\012"}
545 }
546
547 *CR   = \CR();
548 *LF   = \LF();
549 *CRLF = \CRLF();
550
551 sub sockaddr_in {
552     if (@_ == 6 && !wantarray) { # perl5.001m compat; use this && die
553         my($af, $port, @quad) = @_;
554         warnings::warn "6-ARG sockaddr_in call is deprecated" 
555             if warnings::enabled();
556         pack_sockaddr_in($port, inet_aton(join('.', @quad)));
557     } elsif (wantarray) {
558         croak "usage:   (port,iaddr) = sockaddr_in(sin_sv)" unless @_ == 1;
559         unpack_sockaddr_in(@_);
560     } else {
561         croak "usage:   sin_sv = sockaddr_in(port,iaddr))" unless @_ == 2;
562         pack_sockaddr_in(@_);
563     }
564 }
565
566 sub sockaddr_in6 {
567     if (wantarray) {
568         croak "usage:   (port,in6addr,scope_id,flowinfo) = sockaddr_in6(sin6_sv)" unless @_ == 1;
569         unpack_sockaddr_in6(@_);
570     }
571     else {
572         croak "usage:   sin6_sv = sockaddr_in6(port,in6addr,[scope_id,[flowinfo]])" unless @_ >= 2 and @_ <= 4;
573         pack_sockaddr_in6(@_);
574     }
575 }
576
577 sub sockaddr_un {
578     if (wantarray) {
579         croak "usage:   (filename) = sockaddr_un(sun_sv)" unless @_ == 1;
580         unpack_sockaddr_un(@_);
581     } else {
582         croak "usage:   sun_sv = sockaddr_un(filename)" unless @_ == 1;
583         pack_sockaddr_un(@_);
584     }
585 }
586
587 XSLoader::load();
588
589 my %errstr;
590
591 if( !defined &getaddrinfo ) {
592     require Scalar::Util;
593
594     *getaddrinfo = \&fake_getaddrinfo;
595     *getnameinfo = \&fake_getnameinfo;
596
597     # These numbers borrowed from GNU libc's implementation, but since
598     # they're only used by our emulation, it doesn't matter if the real
599     # platform's values differ
600     my %constants = (
601         AI_PASSIVE     => 1,
602         AI_CANONNAME   => 2,
603         AI_NUMERICHOST => 4,
604         # RFC 2553 doesn't define this but Linux does - lets be nice and
605         # provide it since we can
606         AI_NUMERICSERV => 1024,
607
608         EAI_BADFLAGS   => -1,
609         EAI_NONAME     => -2,
610         EAI_NODATA     => -5,
611         EAI_FAMILY     => -6,
612         EAI_SERVICE    => -8,
613
614         NI_NUMERICHOST => 1,
615         NI_NUMERICSERV => 2,
616         NI_NAMEREQD    => 8,
617         NI_DGRAM       => 16,
618     );
619
620     foreach my $name ( keys %constants ) {
621         my $value = $constants{$name};
622
623         no strict 'refs';
624         defined &$name or *$name = sub () { $value };
625     }
626
627     %errstr = (
628         # These strings from RFC 2553
629         EAI_BADFLAGS()   => "invalid value for ai_flags",
630         EAI_NONAME()     => "nodename nor servname provided, or not known",
631         EAI_NODATA()     => "no address associated with nodename",
632         EAI_FAMILY()     => "ai_family not supported",
633         EAI_SERVICE()    => "servname not supported for ai_socktype",
634     );
635 }
636
637 # The following functions are used if the system does not have a
638 # getaddrinfo(3) function in libc; and are used to emulate it for the AF_INET
639 # family
640
641 # Borrowed from Regexp::Common::net
642 my $REGEXP_IPv4_DECIMAL = qr/25[0-5]|2[0-4][0-9]|1?[0-9][0-9]{1,2}/;
643 my $REGEXP_IPv4_DOTTEDQUAD = qr/$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL/;
644
645 sub fake_makeerr
646 {
647     my ( $errno ) = @_;
648     my $errstr = $errno == 0 ? "" : ( $errstr{$errno} || $errno );
649     return Scalar::Util::dualvar( $errno, $errstr );
650 }
651
652 sub fake_getaddrinfo
653 {
654     my ( $node, $service, $hints ) = @_;
655
656     $node = "" unless defined $node;
657
658     $service = "" unless defined $service;
659
660     my ( $family, $socktype, $protocol, $flags ) = @$hints{qw( family socktype protocol flags )};
661
662     $family ||= Socket::AF_INET(); # 0 == AF_UNSPEC, which we want too
663     $family == Socket::AF_INET() or return fake_makeerr( EAI_FAMILY() );
664
665     $socktype ||= 0;
666
667     $protocol ||= 0;
668
669     $flags ||= 0;
670
671     my $flag_passive     = $flags & AI_PASSIVE();     $flags &= ~AI_PASSIVE();
672     my $flag_canonname   = $flags & AI_CANONNAME();   $flags &= ~AI_CANONNAME();
673     my $flag_numerichost = $flags & AI_NUMERICHOST(); $flags &= ~AI_NUMERICHOST();
674     my $flag_numericserv = $flags & AI_NUMERICSERV(); $flags &= ~AI_NUMERICSERV();
675
676     $flags == 0 or return fake_makeerr( EAI_BADFLAGS() );
677
678     $node eq "" and $service eq "" and return fake_makeerr( EAI_NONAME() );
679
680     my $canonname;
681     my @addrs;
682     if( $node ne "" ) {
683         return fake_makeerr( EAI_NONAME() ) if( $flag_numerichost and $node !~ m/^$REGEXP_IPv4_DOTTEDQUAD$/ );
684         ( $canonname, undef, undef, undef, @addrs ) = gethostbyname( $node );
685         defined $canonname or return fake_makeerr( EAI_NONAME() );
686
687         undef $canonname unless $flag_canonname;
688     }
689     else {
690         $addrs[0] = $flag_passive ? Socket::inet_aton( "0.0.0.0" )
691                                   : Socket::inet_aton( "127.0.0.1" );
692     }
693
694     my @ports; # Actually ARRAYrefs of [ socktype, protocol, port ]
695     my $protname = "";
696     if( $protocol ) {
697         $protname = getprotobynumber( $protocol );
698     }
699
700     if( $service ne "" and $service !~ m/^\d+$/ ) {
701         return fake_makeerr( EAI_NONAME() ) if( $flag_numericserv );
702         getservbyname( $service, $protname ) or return fake_makeerr( EAI_SERVICE() );
703     }
704
705     foreach my $this_socktype ( Socket::SOCK_STREAM(), Socket::SOCK_DGRAM(), Socket::SOCK_RAW() ) {
706         next if $socktype and $this_socktype != $socktype;
707
708         my $this_protname = "raw";
709         $this_socktype == Socket::SOCK_STREAM() and $this_protname = "tcp";
710         $this_socktype == Socket::SOCK_DGRAM()  and $this_protname = "udp";
711
712         next if $protname and $this_protname ne $protname;
713
714         my $port;
715         if( $service ne "" ) {
716             if( $service =~ m/^\d+$/ ) {
717                 $port = "$service";
718             }
719             else {
720                 ( undef, undef, $port, $this_protname ) = getservbyname( $service, $this_protname );
721                 next unless defined $port;
722             }
723         }
724         else {
725             $port = 0;
726         }
727
728         push @ports, [ $this_socktype, scalar getprotobyname( $this_protname ) || 0, $port ];
729     }
730
731     my @ret;
732     foreach my $addr ( @addrs ) {
733         foreach my $portspec ( @ports ) {
734             my ( $socktype, $protocol, $port ) = @$portspec;
735             push @ret, {
736                 family    => $family,
737                 socktype  => $socktype,
738                 protocol  => $protocol,
739                 addr      => Socket::pack_sockaddr_in( $port, $addr ),
740                 canonname => undef,
741             };
742         }
743     }
744
745     # Only supply canonname for the first result
746     if( defined $canonname ) {
747         $ret[0]->{canonname} = $canonname;
748     }
749
750     return ( fake_makeerr( 0 ), @ret );
751 }
752
753 sub fake_getnameinfo
754 {
755     my ( $addr, $flags ) = @_;
756
757     my ( $port, $inetaddr );
758     eval { ( $port, $inetaddr ) = Socket::unpack_sockaddr_in( $addr ) }
759         or return fake_makeerr( EAI_FAMILY() );
760
761     my $family = Socket::AF_INET();
762
763     $flags ||= 0;
764
765     my $flag_numerichost = $flags & NI_NUMERICHOST(); $flags &= ~NI_NUMERICHOST();
766     my $flag_numericserv = $flags & NI_NUMERICSERV(); $flags &= ~NI_NUMERICSERV();
767     my $flag_namereqd    = $flags & NI_NAMEREQD();    $flags &= ~NI_NAMEREQD();
768     my $flag_dgram       = $flags & NI_DGRAM()   ;    $flags &= ~NI_DGRAM();
769
770     $flags == 0 or return fake_makeerr( EAI_BADFLAGS() );
771
772     my $node;
773     if( $flag_numerichost ) {
774         $node = Socket::inet_ntoa( $inetaddr );
775     }
776     else {
777         $node = gethostbyaddr( $inetaddr, $family );
778         if( !defined $node ) {
779             return fake_makeerr( EAI_NONAME() ) if $flag_namereqd;
780             $node = Socket::inet_ntoa( $inetaddr );
781         }
782     }
783
784     my $service;
785     if( $flag_numericserv ) {
786         $service = "$port";
787     }
788     else {
789         my $protname = $flag_dgram ? "udp" : "";
790         $service = getservbyport( $port, $protname );
791         if( !defined $service ) {
792             $service = "$port";
793         }
794     }
795
796     return ( fake_makeerr( 0 ), $node, $service );
797 }
798
799 1;