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