This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Snapshot of P/PE/PEVANS/Socket-1.94_07.tar.gz
[perl5.git] / cpan / Socket / Socket.pm
1 package Socket;
2
3 use strict;
4
5 our($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
6 $VERSION = "1.94_07";
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 =over 8
309
310 =item pack_ipv6_mreq IP6_MULTIADDR, INTERFACE
311
312 Takes an IPv6 address and an interface number. Returns the ipv6_mreq structure
313 with those arguments packed in. Suitable for use with the
314 C<IPV6_ADD_MEMBERSHIP> and C<IPV6_DROP_MEMBERSHIP> sockopts.
315
316 =item unpack_ipv6_mreq IPV6_MREQ
317
318 Takes an ipv6_mreq structure and returns a list of two elements; the IPv6
319 address and an interface number.
320
321 =back
322
323 =cut
324
325 use Carp;
326 use warnings::register;
327
328 require Exporter;
329 require XSLoader;
330 @ISA = qw(Exporter);
331
332 # <@Nicholas> you can't change @EXPORT without breaking the implicit API
333 # Please put any new constants in @EXPORT_OK!
334 @EXPORT = qw(
335         inet_aton inet_ntoa
336         sockaddr_family
337         pack_sockaddr_in unpack_sockaddr_in
338         pack_sockaddr_un unpack_sockaddr_un
339         pack_sockaddr_in6 unpack_sockaddr_in6
340         sockaddr_in sockaddr_in6 sockaddr_un
341         INADDR_ANY INADDR_BROADCAST INADDR_LOOPBACK INADDR_NONE
342         AF_802
343         AF_AAL
344         AF_APPLETALK
345         AF_CCITT
346         AF_CHAOS
347         AF_CTF
348         AF_DATAKIT
349         AF_DECnet
350         AF_DLI
351         AF_ECMA
352         AF_GOSIP
353         AF_HYLINK
354         AF_IMPLINK
355         AF_INET
356         AF_INET6
357         AF_ISO
358         AF_KEY
359         AF_LAST
360         AF_LAT
361         AF_LINK
362         AF_MAX
363         AF_NBS
364         AF_NIT
365         AF_NS
366         AF_OSI
367         AF_OSINET
368         AF_PUP
369         AF_ROUTE
370         AF_SNA
371         AF_UNIX
372         AF_UNSPEC
373         AF_USER
374         AF_WAN
375         AF_X25
376         IOV_MAX
377         IP_OPTIONS
378         IP_HDRINCL
379         IP_TOS
380         IP_TTL
381         IP_RECVOPTS
382         IP_RECVRETOPTS
383         IP_RETOPTS
384         MSG_BCAST
385         MSG_BTAG
386         MSG_CTLFLAGS
387         MSG_CTLIGNORE
388         MSG_CTRUNC
389         MSG_DONTROUTE
390         MSG_DONTWAIT
391         MSG_EOF
392         MSG_EOR
393         MSG_ERRQUEUE
394         MSG_ETAG
395         MSG_FIN
396         MSG_MAXIOVLEN
397         MSG_MCAST
398         MSG_NOSIGNAL
399         MSG_OOB
400         MSG_PEEK
401         MSG_PROXY
402         MSG_RST
403         MSG_SYN
404         MSG_TRUNC
405         MSG_URG
406         MSG_WAITALL
407         MSG_WIRE
408         PF_802
409         PF_AAL
410         PF_APPLETALK
411         PF_CCITT
412         PF_CHAOS
413         PF_CTF
414         PF_DATAKIT
415         PF_DECnet
416         PF_DLI
417         PF_ECMA
418         PF_GOSIP
419         PF_HYLINK
420         PF_IMPLINK
421         PF_INET
422         PF_INET6
423         PF_ISO
424         PF_KEY
425         PF_LAST
426         PF_LAT
427         PF_LINK
428         PF_MAX
429         PF_NBS
430         PF_NIT
431         PF_NS
432         PF_OSI
433         PF_OSINET
434         PF_PUP
435         PF_ROUTE
436         PF_SNA
437         PF_UNIX
438         PF_UNSPEC
439         PF_USER
440         PF_WAN
441         PF_X25
442         SCM_CONNECT
443         SCM_CREDENTIALS
444         SCM_CREDS
445         SCM_RIGHTS
446         SCM_TIMESTAMP
447         SHUT_RD
448         SHUT_RDWR
449         SHUT_WR
450         SOCK_DGRAM
451         SOCK_RAW
452         SOCK_RDM
453         SOCK_SEQPACKET
454         SOCK_STREAM
455         SOL_SOCKET
456         SOMAXCONN
457         SO_ACCEPTCONN
458         SO_ATTACH_FILTER
459         SO_BACKLOG
460         SO_BROADCAST
461         SO_CHAMELEON
462         SO_DEBUG
463         SO_DETACH_FILTER
464         SO_DGRAM_ERRIND
465         SO_DONTLINGER
466         SO_DONTROUTE
467         SO_ERROR
468         SO_FAMILY
469         SO_KEEPALIVE
470         SO_LINGER
471         SO_OOBINLINE
472         SO_PASSCRED
473         SO_PASSIFNAME
474         SO_PEERCRED
475         SO_PROTOCOL
476         SO_PROTOTYPE
477         SO_RCVBUF
478         SO_RCVLOWAT
479         SO_RCVTIMEO
480         SO_REUSEADDR
481         SO_REUSEPORT
482         SO_SECURITY_AUTHENTICATION
483         SO_SECURITY_ENCRYPTION_NETWORK
484         SO_SECURITY_ENCRYPTION_TRANSPORT
485         SO_SNDBUF
486         SO_SNDLOWAT
487         SO_SNDTIMEO
488         SO_STATE
489         SO_TYPE
490         SO_USELOOPBACK
491         SO_XOPEN
492         SO_XSE
493         UIO_MAXIOV
494 );
495
496 @EXPORT_OK = qw(CR LF CRLF $CR $LF $CRLF
497
498                inet_pton
499                inet_ntop
500
501                getaddrinfo
502                getnameinfo
503
504                pack_ipv6_mreq
505                unpack_ipv6_mreq
506
507                IN6ADDR_ANY IN6ADDR_LOOPBACK
508
509                AI_ADDRCONFIG
510                AI_ALL
511                AI_CANONIDN
512                AI_CANONNAME
513                AI_IDN
514                AI_IDN_ALLOW_UNASSIGNED
515                AI_IDN_USE_STD3_ASCII_RULES
516                AI_NUMERICHOST
517                AI_NUMERICSERV
518                AI_PASSIVE
519                AI_V4MAPPED
520
521                EAI_ADDRFAMILY
522                EAI_AGAIN
523                EAI_BADFLAGS
524                EAI_BADHINTS
525                EAI_FAIL
526                EAI_FAMILY
527                EAI_NODATA
528                EAI_NONAME
529                EAI_PROTOCOL
530                EAI_SERVICE
531                EAI_SOCKTYPE
532                EAI_SYSTEM
533
534                IPPROTO_IP
535                IPPROTO_IPV6
536                IPPROTO_RAW
537                IPPROTO_ICMP
538                IPPROTO_TCP
539                IPPROTO_UDP
540
541                IPV6_ADD_MEMBERSHIP
542                IPV6_DROP_MEMBERSHIP
543                IPV6_MTU
544                IPV6_MTU_DISCOVER
545                IPV6_MULTICAST_HOPS
546                IPV6_MULTICAST_IF
547                IPV6_MULTICAST_LOOP
548                IPV6_UNICAST_HOPS
549                IPV6_V6ONLY
550
551                NI_DGRAM
552                NI_IDN
553                NI_IDN_ALLOW_UNASSIGNED
554                NI_IDN_USE_STD3_ASCII_RULES
555                NI_NAMEREQD
556                NI_NOFQDN
557                NI_NUMERICHOST
558                NI_NUMERICSERV
559
560                TCP_KEEPALIVE
561                TCP_MAXRT
562                TCP_MAXSEG
563                TCP_NODELAY
564                TCP_STDURG
565                TCP_CORK
566                TCP_KEEPIDLE
567                TCP_KEEPINTVL
568                TCP_KEEPCNT
569                TCP_SYNCNT
570                TCP_LINGER2
571                TCP_DEFER_ACCEPT
572                TCP_WINDOW_CLAMP
573                TCP_INFO
574                TCP_QUICKACK
575                TCP_CONGESTION
576                TCP_MD5SIG);
577
578 %EXPORT_TAGS = (
579     crlf    => [qw(CR LF CRLF $CR $LF $CRLF)],
580     all     => [@EXPORT, @EXPORT_OK],
581 );
582
583 BEGIN {
584     sub CR   () {"\015"}
585     sub LF   () {"\012"}
586     sub CRLF () {"\015\012"}
587 }
588
589 *CR   = \CR();
590 *LF   = \LF();
591 *CRLF = \CRLF();
592
593 sub sockaddr_in {
594     if (@_ == 6 && !wantarray) { # perl5.001m compat; use this && die
595         my($af, $port, @quad) = @_;
596         warnings::warn "6-ARG sockaddr_in call is deprecated"
597             if warnings::enabled();
598         pack_sockaddr_in($port, inet_aton(join('.', @quad)));
599     } elsif (wantarray) {
600         croak "usage:   (port,iaddr) = sockaddr_in(sin_sv)" unless @_ == 1;
601         unpack_sockaddr_in(@_);
602     } else {
603         croak "usage:   sin_sv = sockaddr_in(port,iaddr))" unless @_ == 2;
604         pack_sockaddr_in(@_);
605     }
606 }
607
608 sub sockaddr_in6 {
609     if (wantarray) {
610         croak "usage:   (port,in6addr,scope_id,flowinfo) = sockaddr_in6(sin6_sv)" unless @_ == 1;
611         unpack_sockaddr_in6(@_);
612     }
613     else {
614         croak "usage:   sin6_sv = sockaddr_in6(port,in6addr,[scope_id,[flowinfo]])" unless @_ >= 2 and @_ <= 4;
615         pack_sockaddr_in6(@_);
616     }
617 }
618
619 sub sockaddr_un {
620     if (wantarray) {
621         croak "usage:   (filename) = sockaddr_un(sun_sv)" unless @_ == 1;
622         unpack_sockaddr_un(@_);
623     } else {
624         croak "usage:   sun_sv = sockaddr_un(filename)" unless @_ == 1;
625         pack_sockaddr_un(@_);
626     }
627 }
628
629 XSLoader::load(__PACKAGE__, $VERSION);
630
631 my %errstr;
632
633 if( defined &getaddrinfo ) {
634     # These are not part of the API, nothing uses them, and deleting them
635     # reduces the size of %Socket:: by about 12K
636     delete $Socket::{fake_getaddrinfo};
637     delete $Socket::{fake_getnameinfo};
638 } else {
639     require Scalar::Util;
640
641     *getaddrinfo = \&fake_getaddrinfo;
642     *getnameinfo = \&fake_getnameinfo;
643
644     # These numbers borrowed from GNU libc's implementation, but since
645     # they're only used by our emulation, it doesn't matter if the real
646     # platform's values differ
647     my %constants = (
648         AI_PASSIVE     => 1,
649         AI_CANONNAME   => 2,
650         AI_NUMERICHOST => 4,
651         AI_V4MAPPED    => 8,
652         AI_ALL         => 16,
653         AI_ADDRCONFIG  => 32,
654         # RFC 2553 doesn't define this but Linux does - lets be nice and
655         # provide it since we can
656         AI_NUMERICSERV => 1024,
657
658         EAI_BADFLAGS   => -1,
659         EAI_NONAME     => -2,
660         EAI_NODATA     => -5,
661         EAI_FAMILY     => -6,
662         EAI_SERVICE    => -8,
663
664         NI_NUMERICHOST => 1,
665         NI_NUMERICSERV => 2,
666         NI_NOFQDN      => 4,
667         NI_NAMEREQD    => 8,
668         NI_DGRAM       => 16,
669
670         # Constants we don't support. Export them, but croak if anyone tries to
671         # use them
672         AI_IDN                      => 64,
673         AI_CANONIDN                 => 128,
674         AI_IDN_ALLOW_UNASSIGNED     => 256,
675         AI_IDN_USE_STD3_ASCII_RULES => 512,
676         NI_IDN                      => 32,
677         NI_IDN_ALLOW_UNASSIGNED     => 64,
678         NI_IDN_USE_STD3_ASCII_RULES => 128,
679
680         # Error constants we'll never return, so it doesn't matter what value
681         # these have, nor that we don't provide strings for them
682         EAI_SYSTEM   => -11,
683         EAI_BADHINTS => -1000,
684         EAI_PROTOCOL => -1001
685     );
686
687     foreach my $name ( keys %constants ) {
688         my $value = $constants{$name};
689
690         no strict 'refs';
691         defined &$name or *$name = sub () { $value };
692     }
693
694     %errstr = (
695         # These strings from RFC 2553
696         EAI_BADFLAGS()   => "invalid value for ai_flags",
697         EAI_NONAME()     => "nodename nor servname provided, or not known",
698         EAI_NODATA()     => "no address associated with nodename",
699         EAI_FAMILY()     => "ai_family not supported",
700         EAI_SERVICE()    => "servname not supported for ai_socktype",
701     );
702 }
703
704 # The following functions are used if the system does not have a
705 # getaddrinfo(3) function in libc; and are used to emulate it for the AF_INET
706 # family
707
708 # Borrowed from Regexp::Common::net
709 my $REGEXP_IPv4_DECIMAL = qr/25[0-5]|2[0-4][0-9]|1?[0-9][0-9]{1,2}/;
710 my $REGEXP_IPv4_DOTTEDQUAD = qr/$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL/;
711
712 sub fake_makeerr
713 {
714     my ( $errno ) = @_;
715     my $errstr = $errno == 0 ? "" : ( $errstr{$errno} || $errno );
716     return Scalar::Util::dualvar( $errno, $errstr );
717 }
718
719 sub fake_getaddrinfo
720 {
721     my ( $node, $service, $hints ) = @_;
722
723     $node = "" unless defined $node;
724
725     $service = "" unless defined $service;
726
727     my ( $family, $socktype, $protocol, $flags ) = @$hints{qw( family socktype protocol flags )};
728
729     $family ||= Socket::AF_INET(); # 0 == AF_UNSPEC, which we want too
730     $family == Socket::AF_INET() or return fake_makeerr( EAI_FAMILY() );
731
732     $socktype ||= 0;
733
734     $protocol ||= 0;
735
736     $flags ||= 0;
737
738     my $flag_passive     = $flags & AI_PASSIVE();     $flags &= ~AI_PASSIVE();
739     my $flag_canonname   = $flags & AI_CANONNAME();   $flags &= ~AI_CANONNAME();
740     my $flag_numerichost = $flags & AI_NUMERICHOST(); $flags &= ~AI_NUMERICHOST();
741     my $flag_numericserv = $flags & AI_NUMERICSERV(); $flags &= ~AI_NUMERICSERV();
742
743     # These constants don't apply to AF_INET-only lookups, so we might as well
744     # just ignore them. For AI_ADDRCONFIG we just presume the host has ability
745     # to talk AF_INET. If not we'd have to return no addresses at all. :)
746     $flags &= ~(AI_V4MAPPED()|AI_ALL()|AI_ADDRCONFIG());
747
748     $flags & (AI_IDN()|AI_CANONIDN()|AI_IDN_ALLOW_UNASSIGNED()|AI_IDN_USE_STD3_ASCII_RULES()) and
749         croak "Socket::getaddrinfo() does not support IDN";
750
751     $flags == 0 or return fake_makeerr( EAI_BADFLAGS() );
752
753     $node eq "" and $service eq "" and return fake_makeerr( EAI_NONAME() );
754
755     my $canonname;
756     my @addrs;
757     if( $node ne "" ) {
758         return fake_makeerr( EAI_NONAME() ) if( $flag_numerichost and $node !~ m/^$REGEXP_IPv4_DOTTEDQUAD$/ );
759         ( $canonname, undef, undef, undef, @addrs ) = gethostbyname( $node );
760         defined $canonname or return fake_makeerr( EAI_NONAME() );
761
762         undef $canonname unless $flag_canonname;
763     }
764     else {
765         $addrs[0] = $flag_passive ? Socket::inet_aton( "0.0.0.0" )
766                                   : Socket::inet_aton( "127.0.0.1" );
767     }
768
769     my @ports; # Actually ARRAYrefs of [ socktype, protocol, port ]
770     my $protname = "";
771     if( $protocol ) {
772         $protname = getprotobynumber( $protocol );
773     }
774
775     if( $service ne "" and $service !~ m/^\d+$/ ) {
776         return fake_makeerr( EAI_NONAME() ) if( $flag_numericserv );
777         getservbyname( $service, $protname ) or return fake_makeerr( EAI_SERVICE() );
778     }
779
780     foreach my $this_socktype ( Socket::SOCK_STREAM(), Socket::SOCK_DGRAM(), Socket::SOCK_RAW() ) {
781         next if $socktype and $this_socktype != $socktype;
782
783         my $this_protname = "raw";
784         $this_socktype == Socket::SOCK_STREAM() and $this_protname = "tcp";
785         $this_socktype == Socket::SOCK_DGRAM()  and $this_protname = "udp";
786
787         next if $protname and $this_protname ne $protname;
788
789         my $port;
790         if( $service ne "" ) {
791             if( $service =~ m/^\d+$/ ) {
792                 $port = "$service";
793             }
794             else {
795                 ( undef, undef, $port, $this_protname ) = getservbyname( $service, $this_protname );
796                 next unless defined $port;
797             }
798         }
799         else {
800             $port = 0;
801         }
802
803         push @ports, [ $this_socktype, scalar getprotobyname( $this_protname ) || 0, $port ];
804     }
805
806     my @ret;
807     foreach my $addr ( @addrs ) {
808         foreach my $portspec ( @ports ) {
809             my ( $socktype, $protocol, $port ) = @$portspec;
810             push @ret, {
811                 family    => $family,
812                 socktype  => $socktype,
813                 protocol  => $protocol,
814                 addr      => Socket::pack_sockaddr_in( $port, $addr ),
815                 canonname => undef,
816             };
817         }
818     }
819
820     # Only supply canonname for the first result
821     if( defined $canonname ) {
822         $ret[0]->{canonname} = $canonname;
823     }
824
825     return ( fake_makeerr( 0 ), @ret );
826 }
827
828 sub fake_getnameinfo
829 {
830     my ( $addr, $flags ) = @_;
831
832     my ( $port, $inetaddr );
833     eval { ( $port, $inetaddr ) = Socket::unpack_sockaddr_in( $addr ) }
834         or return fake_makeerr( EAI_FAMILY() );
835
836     my $family = Socket::AF_INET();
837
838     $flags ||= 0;
839
840     my $flag_numerichost = $flags & NI_NUMERICHOST(); $flags &= ~NI_NUMERICHOST();
841     my $flag_numericserv = $flags & NI_NUMERICSERV(); $flags &= ~NI_NUMERICSERV();
842     my $flag_nofqdn      = $flags & NI_NOFQDN();      $flags &= ~NI_NOFQDN();
843     my $flag_namereqd    = $flags & NI_NAMEREQD();    $flags &= ~NI_NAMEREQD();
844     my $flag_dgram       = $flags & NI_DGRAM()   ;    $flags &= ~NI_DGRAM();
845
846     $flags & (NI_IDN()|NI_IDN_ALLOW_UNASSIGNED()|NI_IDN_USE_STD3_ASCII_RULES()) and
847         croak "Socket::getnameinfo() does not support IDN";
848
849     $flags == 0 or return fake_makeerr( EAI_BADFLAGS() );
850
851     my $node;
852     if( $flag_numerichost ) {
853         $node = Socket::inet_ntoa( $inetaddr );
854     }
855     else {
856         $node = gethostbyaddr( $inetaddr, $family );
857         if( !defined $node ) {
858             return fake_makeerr( EAI_NONAME() ) if $flag_namereqd;
859             $node = Socket::inet_ntoa( $inetaddr );
860         }
861         elsif( $flag_nofqdn ) {
862             my ( $shortname ) = split m/\./, $node;
863             my ( $fqdn ) = gethostbyname $shortname;
864             $node = $shortname if defined $fqdn and $fqdn eq $node;
865         }
866     }
867
868     my $service;
869     if( $flag_numericserv ) {
870         $service = "$port";
871     }
872     else {
873         my $protname = $flag_dgram ? "udp" : "";
874         $service = getservbyport( $port, $protname );
875         if( !defined $service ) {
876             $service = "$port";
877         }
878     }
879
880     return ( fake_makeerr( 0 ), $node, $service );
881 }
882
883 1;