+XSLoader::load();
+
+my %errstr;
+
+if( !defined &getaddrinfo ) {
+ require Scalar::Util;
+
+ *getaddrinfo = \&fake_getaddrinfo;
+ *getnameinfo = \&fake_getnameinfo;
+
+ # These numbers borrowed from GNU libc's implementation, but since
+ # they're only used by our emulation, it doesn't matter if the real
+ # platform's values differ
+ my %constants = (
+ AI_PASSIVE => 1,
+ AI_CANONNAME => 2,
+ AI_NUMERICHOST => 4,
+ # RFC 2553 doesn't define this but Linux does - lets be nice and
+ # provide it since we can
+ AI_NUMERICSERV => 1024,
+
+ EAI_BADFLAGS => -1,
+ EAI_NONAME => -2,
+ EAI_NODATA => -5,
+ EAI_FAMILY => -6,
+ EAI_SERVICE => -8,
+
+ NI_NUMERICHOST => 1,
+ NI_NUMERICSERV => 2,
+ NI_NAMEREQD => 8,
+ NI_DGRAM => 16,
+ );
+
+ foreach my $name ( keys %constants ) {
+ my $value = $constants{$name};
+
+ no strict 'refs';
+ defined &$name or *$name = sub () { $value };
+ }
+
+ %errstr = (
+ # These strings from RFC 2553
+ EAI_BADFLAGS() => "invalid value for ai_flags",
+ EAI_NONAME() => "nodename nor servname provided, or not known",
+ EAI_NODATA() => "no address associated with nodename",
+ EAI_FAMILY() => "ai_family not supported",
+ EAI_SERVICE() => "servname not supported for ai_socktype",
+ );
+}
+
+# The following functions are used if the system does not have a
+# getaddrinfo(3) function in libc; and are used to emulate it for the AF_INET
+# family
+
+# Borrowed from Regexp::Common::net
+my $REGEXP_IPv4_DECIMAL = qr/25[0-5]|2[0-4][0-9]|1?[0-9][0-9]{1,2}/;
+my $REGEXP_IPv4_DOTTEDQUAD = qr/$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL/;
+
+sub fake_makeerr
+{
+ my ( $errno ) = @_;
+ my $errstr = $errno == 0 ? "" : ( $errstr{$errno} || $errno );
+ return Scalar::Util::dualvar( $errno, $errstr );
+}
+
+sub fake_getaddrinfo
+{
+ my ( $node, $service, $hints ) = @_;
+
+ $node = "" unless defined $node;
+
+ $service = "" unless defined $service;
+
+ my ( $family, $socktype, $protocol, $flags ) = @$hints{qw( family socktype protocol flags )};
+
+ $family ||= Socket::AF_INET(); # 0 == AF_UNSPEC, which we want too
+ $family == Socket::AF_INET() or return fake_makeerr( EAI_FAMILY() );
+
+ $socktype ||= 0;
+
+ $protocol ||= 0;
+
+ $flags ||= 0;
+
+ my $flag_passive = $flags & AI_PASSIVE(); $flags &= ~AI_PASSIVE();
+ my $flag_canonname = $flags & AI_CANONNAME(); $flags &= ~AI_CANONNAME();
+ my $flag_numerichost = $flags & AI_NUMERICHOST(); $flags &= ~AI_NUMERICHOST();
+ my $flag_numericserv = $flags & AI_NUMERICSERV(); $flags &= ~AI_NUMERICSERV();
+
+ $flags == 0 or return fake_makeerr( EAI_BADFLAGS() );
+
+ $node eq "" and $service eq "" and return fake_makeerr( EAI_NONAME() );
+
+ my $canonname;
+ my @addrs;
+ if( $node ne "" ) {
+ return fake_makeerr( EAI_NONAME() ) if( $flag_numerichost and $node !~ m/^$REGEXP_IPv4_DOTTEDQUAD$/ );
+ ( $canonname, undef, undef, undef, @addrs ) = gethostbyname( $node );
+ defined $canonname or return fake_makeerr( EAI_NONAME() );
+
+ undef $canonname unless $flag_canonname;
+ }
+ else {
+ $addrs[0] = $flag_passive ? Socket::inet_aton( "0.0.0.0" )
+ : Socket::inet_aton( "127.0.0.1" );
+ }
+
+ my @ports; # Actually ARRAYrefs of [ socktype, protocol, port ]
+ my $protname = "";
+ if( $protocol ) {
+ $protname = getprotobynumber( $protocol );
+ }
+
+ if( $service ne "" and $service !~ m/^\d+$/ ) {
+ return fake_makeerr( EAI_NONAME() ) if( $flag_numericserv );
+ getservbyname( $service, $protname ) or return fake_makeerr( EAI_SERVICE() );
+ }
+
+ foreach my $this_socktype ( Socket::SOCK_STREAM(), Socket::SOCK_DGRAM(), Socket::SOCK_RAW() ) {
+ next if $socktype and $this_socktype != $socktype;
+
+ my $this_protname = "raw";
+ $this_socktype == Socket::SOCK_STREAM() and $this_protname = "tcp";
+ $this_socktype == Socket::SOCK_DGRAM() and $this_protname = "udp";
+
+ next if $protname and $this_protname ne $protname;
+
+ my $port;
+ if( $service ne "" ) {
+ if( $service =~ m/^\d+$/ ) {
+ $port = "$service";
+ }
+ else {
+ ( undef, undef, $port, $this_protname ) = getservbyname( $service, $this_protname );
+ next unless defined $port;
+ }
+ }
+ else {
+ $port = 0;
+ }
+
+ push @ports, [ $this_socktype, scalar getprotobyname( $this_protname ) || 0, $port ];
+ }
+
+ my @ret;
+ foreach my $addr ( @addrs ) {
+ foreach my $portspec ( @ports ) {
+ my ( $socktype, $protocol, $port ) = @$portspec;
+ push @ret, {
+ family => $family,
+ socktype => $socktype,
+ protocol => $protocol,
+ addr => Socket::pack_sockaddr_in( $port, $addr ),
+ canonname => $canonname,
+ };
+ }
+ }
+
+ return ( fake_makeerr( 0 ), @ret );
https://perl5.git.perl.org / perl5.git / blobdiff