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;