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_02";
   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_CANONNAME
 510                AI_NUMERICHOST
 511                AI_NUMERICSERV
 512                AI_PASSIVE
 513
 514                EAI_ADDRFAMILY
 515                EAI_AGAIN
 516                EAI_BADFLAGS
 517                EAI_FAIL
 518                EAI_FAMILY
 519                EAI_NODATA
 520                EAI_NONAME
 521                EAI_SERVICE
 522                EAI_SOCKTYPE
 523
 524                IPPROTO_IP
 525                IPPROTO_IPV6
 526                IPPROTO_RAW
 527                IPPROTO_ICMP
 528                IPPROTO_TCP
 529                IPPROTO_UDP
 530
 531                IPV6_ADD_MEMBERSHIP
 532                IPV6_DROP_MEMBERSHIP
 533                IPV6_MTU
 534                IPV6_MTU_DISCOVER
 535                IPV6_MULTICAST_HOPS
 536                IPV6_MULTICAST_IF
 537                IPV6_MULTICAST_LOOP
 538                IPV6_UNICAST_HOPS
 539                IPV6_V6ONLY
 540
 541                NI_DGRAM
 542                NI_NAMEREQD
 543                NI_NUMERICHOST
 544                NI_NUMERICSERV
 545
 546                TCP_KEEPALIVE
 547                TCP_MAXRT
 548                TCP_MAXSEG
 549                TCP_NODELAY
 550                TCP_STDURG
 551                TCP_CORK
 552                TCP_KEEPIDLE
 553                TCP_KEEPINTVL
 554                TCP_KEEPCNT
 555                TCP_SYNCNT
 556                TCP_LINGER2
 557                TCP_DEFER_ACCEPT
 558                TCP_WINDOW_CLAMP
 559                TCP_INFO
 560                TCP_QUICKACK
 561                TCP_CONGESTION
 562                TCP_MD5SIG);
 563
 564 %EXPORT_TAGS = (
 565     crlf    => [qw(CR LF CRLF $CR $LF $CRLF)],
 566     all     => [@EXPORT, @EXPORT_OK],
 567 );
 568
 569 BEGIN {
 570     sub CR   () {"\015"}
 571     sub LF   () {"\012"}
 572     sub CRLF () {"\015\012"}
 573 }
 574
 575 *CR   = \CR();
 576 *LF   = \LF();
 577 *CRLF = \CRLF();
 578
 579 sub sockaddr_in {
 580     if (@_ == 6 && !wantarray) { # perl5.001m compat; use this && die
 581         my($af, $port, @quad) = @_;
 582         warnings::warn "6-ARG sockaddr_in call is deprecated"
 583             if warnings::enabled();
 584         pack_sockaddr_in($port, inet_aton(join('.', @quad)));
 585     } elsif (wantarray) {
 586         croak "usage:   (port,iaddr) = sockaddr_in(sin_sv)" unless @_ == 1;
 587         unpack_sockaddr_in(@_);
 588     } else {
 589         croak "usage:   sin_sv = sockaddr_in(port,iaddr))" unless @_ == 2;
 590         pack_sockaddr_in(@_);
 591     }
 592 }
 593
 594 sub sockaddr_in6 {
 595     if (wantarray) {
 596         croak "usage:   (port,in6addr,scope_id,flowinfo) = sockaddr_in6(sin6_sv)" unless @_ == 1;
 597         unpack_sockaddr_in6(@_);
 598     }
 599     else {
 600         croak "usage:   sin6_sv = sockaddr_in6(port,in6addr,[scope_id,[flowinfo]])" unless @_ >= 2 and @_ <= 4;
 601         pack_sockaddr_in6(@_);
 602     }
 603 }
 604
 605 sub sockaddr_un {
 606     if (wantarray) {
 607         croak "usage:   (filename) = sockaddr_un(sun_sv)" unless @_ == 1;
 608         unpack_sockaddr_un(@_);
 609     } else {
 610         croak "usage:   sun_sv = sockaddr_un(filename)" unless @_ == 1;
 611         pack_sockaddr_un(@_);
 612     }
 613 }
 614
 615 XSLoader::load();
 616
 617 my %errstr;
 618
 619 if( defined &getaddrinfo ) {
 620     # These are not part of the API, nothing uses them, and deleting them
 621     # reduces the size of %Socket:: by about 12K
 622     delete $Socket::{fake_getaddrinfo};
 623     delete $Socket::{fake_getnameinfo};
 624 } else {
 625     require Scalar::Util;
 626
 627     *getaddrinfo = \&fake_getaddrinfo;
 628     *getnameinfo = \&fake_getnameinfo;
 629
 630     # These numbers borrowed from GNU libc's implementation, but since
 631     # they're only used by our emulation, it doesn't matter if the real
 632     # platform's values differ
 633     my %constants = (
 634         AI_PASSIVE     => 1,
 635         AI_CANONNAME   => 2,
 636         AI_NUMERICHOST => 4,
 637         # RFC 2553 doesn't define this but Linux does - lets be nice and
 638         # provide it since we can
 639         AI_NUMERICSERV => 1024,
 640
 641         EAI_BADFLAGS   => -1,
 642         EAI_NONAME     => -2,
 643         EAI_NODATA     => -5,
 644         EAI_FAMILY     => -6,
 645         EAI_SERVICE    => -8,
 646
 647         NI_NUMERICHOST => 1,
 648         NI_NUMERICSERV => 2,
 649         NI_NAMEREQD    => 8,
 650         NI_DGRAM       => 16,
 651     );
 652
 653     foreach my $name ( keys %constants ) {
 654         my $value = $constants{$name};
 655
 656         no strict 'refs';
 657         defined &$name or *$name = sub () { $value };
 658     }
 659
 660     %errstr = (
 661         # These strings from RFC 2553
 662         EAI_BADFLAGS()   => "invalid value for ai_flags",
 663         EAI_NONAME()     => "nodename nor servname provided, or not known",
 664         EAI_NODATA()     => "no address associated with nodename",
 665         EAI_FAMILY()     => "ai_family not supported",
 666         EAI_SERVICE()    => "servname not supported for ai_socktype",
 667     );
 668 }
 669
 670 # The following functions are used if the system does not have a
 671 # getaddrinfo(3) function in libc; and are used to emulate it for the AF_INET
 672 # family
 673
 674 # Borrowed from Regexp::Common::net
 675 my $REGEXP_IPv4_DECIMAL = qr/25[0-5]|2[0-4][0-9]|1?[0-9][0-9]{1,2}/;
 676 my $REGEXP_IPv4_DOTTEDQUAD = qr/$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL/;
 677
 678 sub fake_makeerr
 679 {
 680     my ( $errno ) = @_;
 681     my $errstr = $errno == 0 ? "" : ( $errstr{$errno} || $errno );
 682     return Scalar::Util::dualvar( $errno, $errstr );
 683 }
 684
 685 sub fake_getaddrinfo
 686 {
 687     my ( $node, $service, $hints ) = @_;
 688
 689     $node = "" unless defined $node;
 690
 691     $service = "" unless defined $service;
 692
 693     my ( $family, $socktype, $protocol, $flags ) = @$hints{qw( family socktype protocol flags )};
 694
 695     $family ||= Socket::AF_INET(); # 0 == AF_UNSPEC, which we want too
 696     $family == Socket::AF_INET() or return fake_makeerr( EAI_FAMILY() );
 697
 698     $socktype ||= 0;
 699
 700     $protocol ||= 0;
 701
 702     $flags ||= 0;
 703
 704     my $flag_passive     = $flags & AI_PASSIVE();     $flags &= ~AI_PASSIVE();
 705     my $flag_canonname   = $flags & AI_CANONNAME();   $flags &= ~AI_CANONNAME();
 706     my $flag_numerichost = $flags & AI_NUMERICHOST(); $flags &= ~AI_NUMERICHOST();
 707     my $flag_numericserv = $flags & AI_NUMERICSERV(); $flags &= ~AI_NUMERICSERV();
 708
 709     $flags == 0 or return fake_makeerr( EAI_BADFLAGS() );
 710
 711     $node eq "" and $service eq "" and return fake_makeerr( EAI_NONAME() );
 712
 713     my $canonname;
 714     my @addrs;
 715     if( $node ne "" ) {
 716         return fake_makeerr( EAI_NONAME() ) if( $flag_numerichost and $node !~ m/^$REGEXP_IPv4_DOTTEDQUAD$/ );
 717         ( $canonname, undef, undef, undef, @addrs ) = gethostbyname( $node );
 718         defined $canonname or return fake_makeerr( EAI_NONAME() );
 719
 720         undef $canonname unless $flag_canonname;
 721     }
 722     else {
 723         $addrs[0] = $flag_passive ? Socket::inet_aton( "0.0.0.0" )
 724                                   : Socket::inet_aton( "127.0.0.1" );
 725     }
 726
 727     my @ports; # Actually ARRAYrefs of [ socktype, protocol, port ]
 728     my $protname = "";
 729     if( $protocol ) {
 730         $protname = getprotobynumber( $protocol );
 731     }
 732
 733     if( $service ne "" and $service !~ m/^\d+$/ ) {
 734         return fake_makeerr( EAI_NONAME() ) if( $flag_numericserv );
 735         getservbyname( $service, $protname ) or return fake_makeerr( EAI_SERVICE() );
 736     }
 737
 738     foreach my $this_socktype ( Socket::SOCK_STREAM(), Socket::SOCK_DGRAM(), Socket::SOCK_RAW() ) {
 739         next if $socktype and $this_socktype != $socktype;
 740
 741         my $this_protname = "raw";
 742         $this_socktype == Socket::SOCK_STREAM() and $this_protname = "tcp";
 743         $this_socktype == Socket::SOCK_DGRAM()  and $this_protname = "udp";
 744
 745         next if $protname and $this_protname ne $protname;
 746
 747         my $port;
 748         if( $service ne "" ) {
 749             if( $service =~ m/^\d+$/ ) {
 750                 $port = "$service";
 751             }
 752             else {
 753                 ( undef, undef, $port, $this_protname ) = getservbyname( $service, $this_protname );
 754                 next unless defined $port;
 755             }
 756         }
 757         else {
 758             $port = 0;
 759         }
 760
 761         push @ports, [ $this_socktype, scalar getprotobyname( $this_protname ) || 0, $port ];
 762     }
 763
 764     my @ret;
 765     foreach my $addr ( @addrs ) {
 766         foreach my $portspec ( @ports ) {
 767             my ( $socktype, $protocol, $port ) = @$portspec;
 768             push @ret, {
 769                 family    => $family,
 770                 socktype  => $socktype,
 771                 protocol  => $protocol,
 772                 addr      => Socket::pack_sockaddr_in( $port, $addr ),
 773                 canonname => undef,
 774             };
 775         }
 776     }
 777
 778     # Only supply canonname for the first result
 779     if( defined $canonname ) {
 780         $ret[0]->{canonname} = $canonname;
 781     }
 782
 783     return ( fake_makeerr( 0 ), @ret );
 784 }
 785
 786 sub fake_getnameinfo
 787 {
 788     my ( $addr, $flags ) = @_;
 789
 790     my ( $port, $inetaddr );
 791     eval { ( $port, $inetaddr ) = Socket::unpack_sockaddr_in( $addr ) }
 792         or return fake_makeerr( EAI_FAMILY() );
 793
 794     my $family = Socket::AF_INET();
 795
 796     $flags ||= 0;
 797
 798     my $flag_numerichost = $flags & NI_NUMERICHOST(); $flags &= ~NI_NUMERICHOST();
 799     my $flag_numericserv = $flags & NI_NUMERICSERV(); $flags &= ~NI_NUMERICSERV();
 800     my $flag_namereqd    = $flags & NI_NAMEREQD();    $flags &= ~NI_NAMEREQD();
 801     my $flag_dgram       = $flags & NI_DGRAM()   ;    $flags &= ~NI_DGRAM();
 802
 803     $flags == 0 or return fake_makeerr( EAI_BADFLAGS() );
 804
 805     my $node;
 806     if( $flag_numerichost ) {
 807         $node = Socket::inet_ntoa( $inetaddr );
 808     }
 809     else {
 810         $node = gethostbyaddr( $inetaddr, $family );
 811         if( !defined $node ) {
 812             return fake_makeerr( EAI_NONAME() ) if $flag_namereqd;
 813             $node = Socket::inet_ntoa( $inetaddr );
 814         }
 815     }
 816
 817     my $service;
 818     if( $flag_numericserv ) {
 819         $service = "$port";
 820     }
 821     else {
 822         my $protname = $flag_dgram ? "udp" : "";
 823         $service = getservbyport( $port, $protname );
 824         if( !defined $service ) {
 825             $service = "$port";
 826         }
 827     }
 828
 829     return ( fake_makeerr( 0 ), $node, $service );
 830 }
 831
 832 1;