This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
509eb2687c220ba3dd1499b84911cd952eb41fc7
[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.
286
287 =back
288
289 =item getnameinfo ADDR, FLAGS
290
291 Given a packed socket address (such as from C<getsockname>, C<getpeername>, or
292 returned by C<getaddrinfo> in a C<addr> field), returns the hostname and
293 symbolic service name it represents. FLAGS may be a bitmask of C<NI_*>
294 constants, or defaults to 0 if unspecified.
295
296 The return value will be a list; the first value being an error condition,
297 followed by the hostname and service name.
298
299  my ( $err, $host, $service ) = getnameinfo( ... );
300
301 The error value will be a dualvar; comparable to the C<EI_*> error constants,
302 or printable as a human-readable error message string. The host and service
303 names will be plain strings.
304
305 =back
306
307 =cut
308
309 use Carp;
310 use warnings::register;
311
312 require Exporter;
313 require XSLoader;
314 @ISA = qw(Exporter);
315
316 # <@Nicholas> you can't change @EXPORT without breaking the implicit API
317 # Please put any new constants in @EXPORT_OK!
318 @EXPORT = qw(
319         inet_aton inet_ntoa
320         sockaddr_family
321         pack_sockaddr_in unpack_sockaddr_in
322         pack_sockaddr_un unpack_sockaddr_un
323         pack_sockaddr_in6 unpack_sockaddr_in6
324         sockaddr_in sockaddr_in6 sockaddr_un
325         INADDR_ANY INADDR_BROADCAST INADDR_LOOPBACK INADDR_NONE
326         AF_802
327         AF_AAL
328         AF_APPLETALK
329         AF_CCITT
330         AF_CHAOS
331         AF_CTF
332         AF_DATAKIT
333         AF_DECnet
334         AF_DLI
335         AF_ECMA
336         AF_GOSIP
337         AF_HYLINK
338         AF_IMPLINK
339         AF_INET
340         AF_INET6
341         AF_ISO
342         AF_KEY
343         AF_LAST
344         AF_LAT
345         AF_LINK
346         AF_MAX
347         AF_NBS
348         AF_NIT
349         AF_NS
350         AF_OSI
351         AF_OSINET
352         AF_PUP
353         AF_ROUTE
354         AF_SNA
355         AF_UNIX
356         AF_UNSPEC
357         AF_USER
358         AF_WAN
359         AF_X25
360         IOV_MAX
361         IP_OPTIONS
362         IP_HDRINCL
363         IP_TOS
364         IP_TTL
365         IP_RECVOPTS
366         IP_RECVRETOPTS
367         IP_RETOPTS
368         MSG_BCAST
369         MSG_BTAG
370         MSG_CTLFLAGS
371         MSG_CTLIGNORE
372         MSG_CTRUNC
373         MSG_DONTROUTE
374         MSG_DONTWAIT
375         MSG_EOF
376         MSG_EOR
377         MSG_ERRQUEUE
378         MSG_ETAG
379         MSG_FIN
380         MSG_MAXIOVLEN
381         MSG_MCAST
382         MSG_NOSIGNAL
383         MSG_OOB
384         MSG_PEEK
385         MSG_PROXY
386         MSG_RST
387         MSG_SYN
388         MSG_TRUNC
389         MSG_URG
390         MSG_WAITALL
391         MSG_WIRE
392         PF_802
393         PF_AAL
394         PF_APPLETALK
395         PF_CCITT
396         PF_CHAOS
397         PF_CTF
398         PF_DATAKIT
399         PF_DECnet
400         PF_DLI
401         PF_ECMA
402         PF_GOSIP
403         PF_HYLINK
404         PF_IMPLINK
405         PF_INET
406         PF_INET6
407         PF_ISO
408         PF_KEY
409         PF_LAST
410         PF_LAT
411         PF_LINK
412         PF_MAX
413         PF_NBS
414         PF_NIT
415         PF_NS
416         PF_OSI
417         PF_OSINET
418         PF_PUP
419         PF_ROUTE
420         PF_SNA
421         PF_UNIX
422         PF_UNSPEC
423         PF_USER
424         PF_WAN
425         PF_X25
426         SCM_CONNECT
427         SCM_CREDENTIALS
428         SCM_CREDS
429         SCM_RIGHTS
430         SCM_TIMESTAMP
431         SHUT_RD
432         SHUT_RDWR
433         SHUT_WR
434         SOCK_DGRAM
435         SOCK_RAW
436         SOCK_RDM
437         SOCK_SEQPACKET
438         SOCK_STREAM
439         SOL_SOCKET
440         SOMAXCONN
441         SO_ACCEPTCONN
442         SO_ATTACH_FILTER
443         SO_BACKLOG
444         SO_BROADCAST
445         SO_CHAMELEON
446         SO_DEBUG
447         SO_DETACH_FILTER
448         SO_DGRAM_ERRIND
449         SO_DONTLINGER
450         SO_DONTROUTE
451         SO_ERROR
452         SO_FAMILY
453         SO_KEEPALIVE
454         SO_LINGER
455         SO_OOBINLINE
456         SO_PASSCRED
457         SO_PASSIFNAME
458         SO_PEERCRED
459         SO_PROTOCOL
460         SO_PROTOTYPE
461         SO_RCVBUF
462         SO_RCVLOWAT
463         SO_RCVTIMEO
464         SO_REUSEADDR
465         SO_REUSEPORT
466         SO_SECURITY_AUTHENTICATION
467         SO_SECURITY_ENCRYPTION_NETWORK
468         SO_SECURITY_ENCRYPTION_TRANSPORT
469         SO_SNDBUF
470         SO_SNDLOWAT
471         SO_SNDTIMEO
472         SO_STATE
473         SO_TYPE
474         SO_USELOOPBACK
475         SO_XOPEN
476         SO_XSE
477         UIO_MAXIOV
478 );
479
480 @EXPORT_OK = qw(CR LF CRLF $CR $LF $CRLF
481
482                inet_pton
483                inet_ntop
484
485                getaddrinfo
486                getnameinfo
487
488                IN6ADDR_ANY IN6ADDR_LOOPBACK
489
490                AI_CANONNAME
491                AI_NUMERICHOST
492                AI_NUMERICSERV
493                AI_PASSIVE
494
495                EAI_ADDRFAMILY
496                EAI_AGAIN
497                EAI_BADFLAGS
498                EAI_FAIL
499                EAI_FAMILY
500                EAI_NODATA
501                EAI_NONAME
502                EAI_SERVICE
503                EAI_SOCKTYPE
504
505                IPPROTO_IP
506                IPPROTO_IPV6
507                IPPROTO_RAW
508                IPPROTO_ICMP
509                IPPROTO_TCP
510                IPPROTO_UDP
511
512                NI_DGRAM
513                NI_NAMEREQD
514                NI_NUMERICHOST
515                NI_NUMERICSERV
516
517                TCP_KEEPALIVE
518                TCP_MAXRT
519                TCP_MAXSEG
520                TCP_NODELAY
521                TCP_STDURG
522                TCP_CORK
523                TCP_KEEPIDLE
524                TCP_KEEPINTVL
525                TCP_KEEPCNT
526                TCP_SYNCNT
527                TCP_LINGER2
528                TCP_DEFER_ACCEPT
529                TCP_WINDOW_CLAMP
530                TCP_INFO
531                TCP_QUICKACK
532                TCP_CONGESTION
533                TCP_MD5SIG);
534
535 %EXPORT_TAGS = (
536     crlf    => [qw(CR LF CRLF $CR $LF $CRLF)],
537     all     => [@EXPORT, @EXPORT_OK],
538 );
539
540 BEGIN {
541     sub CR   () {"\015"}
542     sub LF   () {"\012"}
543     sub CRLF () {"\015\012"}
544 }
545
546 *CR   = \CR();
547 *LF   = \LF();
548 *CRLF = \CRLF();
549
550 sub sockaddr_in {
551     if (@_ == 6 && !wantarray) { # perl5.001m compat; use this && die
552         my($af, $port, @quad) = @_;
553         warnings::warn "6-ARG sockaddr_in call is deprecated" 
554             if warnings::enabled();
555         pack_sockaddr_in($port, inet_aton(join('.', @quad)));
556     } elsif (wantarray) {
557         croak "usage:   (port,iaddr) = sockaddr_in(sin_sv)" unless @_ == 1;
558         unpack_sockaddr_in(@_);
559     } else {
560         croak "usage:   sin_sv = sockaddr_in(port,iaddr))" unless @_ == 2;
561         pack_sockaddr_in(@_);
562     }
563 }
564
565 sub sockaddr_in6 {
566     if (wantarray) {
567         croak "usage:   (port,in6addr,scope_id,flowinfo) = sockaddr_in6(sin6_sv)" unless @_ == 1;
568         unpack_sockaddr_in6(@_);
569     }
570     else {
571         croak "usage:   sin6_sv = sockaddr_in6(port,in6addr,[scope_id,[flowinfo]])" unless @_ >= 2 and @_ <= 4;
572         pack_sockaddr_in6(@_);
573     }
574 }
575
576 sub sockaddr_un {
577     if (wantarray) {
578         croak "usage:   (filename) = sockaddr_un(sun_sv)" unless @_ == 1;
579         unpack_sockaddr_un(@_);
580     } else {
581         croak "usage:   sun_sv = sockaddr_un(filename)" unless @_ == 1;
582         pack_sockaddr_un(@_);
583     }
584 }
585
586 XSLoader::load();
587
588 my %errstr;
589
590 if( !defined &getaddrinfo ) {
591     require Scalar::Util;
592
593     *getaddrinfo = \&fake_getaddrinfo;
594     *getnameinfo = \&fake_getnameinfo;
595
596     # These numbers borrowed from GNU libc's implementation, but since
597     # they're only used by our emulation, it doesn't matter if the real
598     # platform's values differ
599     my %constants = (
600         AI_PASSIVE     => 1,
601         AI_CANONNAME   => 2,
602         AI_NUMERICHOST => 4,
603         # RFC 2553 doesn't define this but Linux does - lets be nice and
604         # provide it since we can
605         AI_NUMERICSERV => 1024,
606
607         EAI_BADFLAGS   => -1,
608         EAI_NONAME     => -2,
609         EAI_NODATA     => -5,
610         EAI_FAMILY     => -6,
611         EAI_SERVICE    => -8,
612
613         NI_NUMERICHOST => 1,
614         NI_NUMERICSERV => 2,
615         NI_NAMEREQD    => 8,
616         NI_DGRAM       => 16,
617     );
618
619     foreach my $name ( keys %constants ) {
620         my $value = $constants{$name};
621
622         no strict 'refs';
623         defined &$name or *$name = sub () { $value };
624     }
625
626     %errstr = (
627         # These strings from RFC 2553
628         EAI_BADFLAGS()   => "invalid value for ai_flags",
629         EAI_NONAME()     => "nodename nor servname provided, or not known",
630         EAI_NODATA()     => "no address associated with nodename",
631         EAI_FAMILY()     => "ai_family not supported",
632         EAI_SERVICE()    => "servname not supported for ai_socktype",
633     );
634 }
635
636 # The following functions are used if the system does not have a
637 # getaddrinfo(3) function in libc; and are used to emulate it for the AF_INET
638 # family
639
640 # Borrowed from Regexp::Common::net
641 my $REGEXP_IPv4_DECIMAL = qr/25[0-5]|2[0-4][0-9]|1?[0-9][0-9]{1,2}/;
642 my $REGEXP_IPv4_DOTTEDQUAD = qr/$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL/;
643
644 sub fake_makeerr
645 {
646     my ( $errno ) = @_;
647     my $errstr = $errno == 0 ? "" : ( $errstr{$errno} || $errno );
648     return Scalar::Util::dualvar( $errno, $errstr );
649 }
650
651 sub fake_getaddrinfo
652 {
653     my ( $node, $service, $hints ) = @_;
654
655     $node = "" unless defined $node;
656
657     $service = "" unless defined $service;
658
659     my ( $family, $socktype, $protocol, $flags ) = @$hints{qw( family socktype protocol flags )};
660
661     $family ||= Socket::AF_INET(); # 0 == AF_UNSPEC, which we want too
662     $family == Socket::AF_INET() or return fake_makeerr( EAI_FAMILY() );
663
664     $socktype ||= 0;
665
666     $protocol ||= 0;
667
668     $flags ||= 0;
669
670     my $flag_passive     = $flags & AI_PASSIVE();     $flags &= ~AI_PASSIVE();
671     my $flag_canonname   = $flags & AI_CANONNAME();   $flags &= ~AI_CANONNAME();
672     my $flag_numerichost = $flags & AI_NUMERICHOST(); $flags &= ~AI_NUMERICHOST();
673     my $flag_numericserv = $flags & AI_NUMERICSERV(); $flags &= ~AI_NUMERICSERV();
674
675     $flags == 0 or return fake_makeerr( EAI_BADFLAGS() );
676
677     $node eq "" and $service eq "" and return fake_makeerr( EAI_NONAME() );
678
679     my $canonname;
680     my @addrs;
681     if( $node ne "" ) {
682         return fake_makeerr( EAI_NONAME() ) if( $flag_numerichost and $node !~ m/^$REGEXP_IPv4_DOTTEDQUAD$/ );
683         ( $canonname, undef, undef, undef, @addrs ) = gethostbyname( $node );
684         defined $canonname or return fake_makeerr( EAI_NONAME() );
685
686         undef $canonname unless $flag_canonname;
687     }
688     else {
689         $addrs[0] = $flag_passive ? Socket::inet_aton( "0.0.0.0" )
690                                   : Socket::inet_aton( "127.0.0.1" );
691     }
692
693     my @ports; # Actually ARRAYrefs of [ socktype, protocol, port ]
694     my $protname = "";
695     if( $protocol ) {
696         $protname = getprotobynumber( $protocol );
697     }
698
699     if( $service ne "" and $service !~ m/^\d+$/ ) {
700         return fake_makeerr( EAI_NONAME() ) if( $flag_numericserv );
701         getservbyname( $service, $protname ) or return fake_makeerr( EAI_SERVICE() );
702     }
703
704     foreach my $this_socktype ( Socket::SOCK_STREAM(), Socket::SOCK_DGRAM(), Socket::SOCK_RAW() ) {
705         next if $socktype and $this_socktype != $socktype;
706
707         my $this_protname = "raw";
708         $this_socktype == Socket::SOCK_STREAM() and $this_protname = "tcp";
709         $this_socktype == Socket::SOCK_DGRAM()  and $this_protname = "udp";
710
711         next if $protname and $this_protname ne $protname;
712
713         my $port;
714         if( $service ne "" ) {
715             if( $service =~ m/^\d+$/ ) {
716                 $port = "$service";
717             }
718             else {
719                 ( undef, undef, $port, $this_protname ) = getservbyname( $service, $this_protname );
720                 next unless defined $port;
721             }
722         }
723         else {
724             $port = 0;
725         }
726
727         push @ports, [ $this_socktype, scalar getprotobyname( $this_protname ) || 0, $port ];
728     }
729
730     my @ret;
731     foreach my $addr ( @addrs ) {
732         foreach my $portspec ( @ports ) {
733             my ( $socktype, $protocol, $port ) = @$portspec;
734             push @ret, {
735                 family    => $family,
736                 socktype  => $socktype,
737                 protocol  => $protocol,
738                 addr      => Socket::pack_sockaddr_in( $port, $addr ),
739                 canonname => $canonname,
740             };
741         }
742     }
743
744     return ( fake_makeerr( 0 ), @ret );
745 }
746
747 sub fake_getnameinfo
748 {
749     my ( $addr, $flags ) = @_;
750
751     my ( $port, $inetaddr );
752     eval { ( $port, $inetaddr ) = Socket::unpack_sockaddr_in( $addr ) }
753         or return fake_makeerr( EAI_FAMILY() );
754
755     my $family = Socket::AF_INET();
756
757     $flags ||= 0;
758
759     my $flag_numerichost = $flags & NI_NUMERICHOST(); $flags &= ~NI_NUMERICHOST();
760     my $flag_numericserv = $flags & NI_NUMERICSERV(); $flags &= ~NI_NUMERICSERV();
761     my $flag_namereqd    = $flags & NI_NAMEREQD();    $flags &= ~NI_NAMEREQD();
762     my $flag_dgram       = $flags & NI_DGRAM()   ;    $flags &= ~NI_DGRAM();
763
764     $flags == 0 or return fake_makeerr( EAI_BADFLAGS() );
765
766     my $node;
767     if( $flag_numerichost ) {
768         $node = Socket::inet_ntoa( $inetaddr );
769     }
770     else {
771         $node = gethostbyaddr( $inetaddr, $family );
772         if( !defined $node ) {
773             return fake_makeerr( EAI_NONAME() ) if $flag_namereqd;
774             $node = Socket::inet_ntoa( $inetaddr );
775         }
776     }
777
778     my $service;
779     if( $flag_numericserv ) {
780         $service = "$port";
781     }
782     else {
783         my $protname = $flag_dgram ? "udp" : "";
784         $service = getservbyport( $port, $protname );
785         if( !defined $service ) {
786             $service = "$port";
787         }
788     }
789
790     return ( fake_makeerr( 0 ), $node, $service );
791 }
792
793 1;