view release on metacpan or  search on metacpan

lib/AnyEvent/Socket.pm  view on Meta::CPAN

      if (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0 eq $_[0]) {
         return "::";
      } elsif (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1 eq $_[0]) {
         return "::1";
      } elsif (v0.0.0.0.0.0.0.0.0.0.0.0 eq substr $_[0], 0, 12) {
         # v4compatible
         return "::" . format_ipv4 substr $_[0], 12;
      } elsif (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) {
         # v4mapped
         return "::ffff:" . format_ipv4 substr $_[0], 12;
      } elsif (v0.0.0.0.0.0.0.0.255.255.0.0 eq substr $_[0], 0, 12) {
         # v4translated
         return "::ffff:0:" . format_ipv4 substr $_[0], 12;
      }
   }

   my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0];

   # this is admittedly rather sucky
      $ip =~ s/(?:^|:) 0:0:0:0:0:0:0 (?:$|:)/::/x
   or $ip =~ s/(?:^|:)   0:0:0:0:0:0 (?:$|:)/::/x
   or $ip =~ s/(?:^|:)     0:0:0:0:0 (?:$|:)/::/x
   or $ip =~ s/(?:^|:)       0:0:0:0 (?:$|:)/::/x
   or $ip =~ s/(?:^|:)         0:0:0 (?:$|:)/::/x
   or $ip =~ s/(?:^|:)           0:0 (?:$|:)/::/x;

   $ip
}

sub format_address($) {
   if (4 == length $_[0]) {
      return &format_ipv4;
   } elsif (16 == length $_[0]) {
      return $_[0] =~ /^\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff(....)$/s
         ? format_ipv4 $1
         : &format_ipv6;
   } elsif (AF_UNIX == address_family $_[0]) {
      return "unix/"
   } else {
      return undef
   }
}

*ntoa = \&format_address;

=item inet_aton $name_or_address, $cb->(@addresses)

Works similarly to its Socket counterpart, except that it uses a
callback. Use the length to distinguish between ipv4 and ipv6 (4 octets
for IPv4, 16 for IPv6), or use C<format_address> to convert it to a more
readable format.

Note that C<resolve_sockaddr>, while initially a more complex interface,
resolves host addresses, IDNs, service names and SRV records and gives you
an ordered list of socket addresses to try and should be preferred over
C<inet_aton>.

Example.

   inet_aton "www.google.com", my $cv = AE::cv;
   say unpack "H*", $_
      for $cv->recv;
   # => d155e363
   # => d155e367 etc.

   inet_aton "ipv6.google.com", my $cv = AE::cv;
   say unpack "H*", $_
      for $cv->recv;
   # => 20014860a00300000000000000000068

=cut

sub inet_aton {
   my ($name, $cb) = @_;

   if (my $ipn = &parse_ipv4) {
      $cb->($ipn);
   } elsif (my $ipn = &parse_ipv6) {
      $cb->($ipn);
   } elsif ($name eq "localhost") { # rfc2606 et al.
      $cb->(v127.0.0.1, v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1);
   } else {
      require AnyEvent::DNS unless $AnyEvent::DNS::VERSION;

      my $ipv4 = $AnyEvent::PROTOCOL{ipv4};
      my $ipv6 = $AnyEvent::PROTOCOL{ipv6};

      my @res;

      my $cv = AE::cv {
         $cb->(map @$_, reverse @res);
      };

      $cv->begin;

      if ($ipv4) {
         $cv->begin;
         AnyEvent::DNS::a ($name, sub {
            $res[$ipv4] = [map { parse_ipv4 $_ } @_];
            $cv->end;
         });
      };

      if ($ipv6) {
         $cv->begin;
         AnyEvent::DNS::aaaa ($name, sub {
            $res[$ipv6] = [map { parse_ipv6 $_ } @_];
            $cv->end;
         });
      };

      $cv->end;
   }
}

BEGIN {
   *sockaddr_family = $Socket::VERSION >= 1.75
      ? \&Socket::sockaddr_family
      : # for 5.6.x, we need to do something much more horrible
        (Socket::pack_sockaddr_in 0x5555, "\x55\x55\x55\x55"
           | eval { Socket::pack_sockaddr_un "U" }) =~ /^\x00/
           ? sub { unpack "xC", $_[0] }
           : sub { unpack "S" , $_[0] };
}

# check for broken platforms with an extra field in sockaddr structure
# kind of a rfc vs. bsd issue, as usual (ok, normally it's a