view release on metacpan or  search on metacpan

local/lib/perl5/IO/Async/Resolver.pm  view on Meta::CPAN

use IO::Async::OS;

# Try to use HiRes alarm, but we don't strictly need it.
# MSWin32 doesn't implement it
BEGIN {
   require Time::HiRes;
   eval { Time::HiRes::alarm(0) } and Time::HiRes->import( qw( alarm ) );
}

use Carp;

my $started = 0;
my %METHODS;

=head1 NAME

C<IO::Async::Resolver> - performing name resolutions asynchronously

=head1 SYNOPSIS

This object is used indirectly via an L<IO::Async::Loop>:

 use IO::Async::Loop;
 my $loop = IO::Async::Loop->new;

 $loop->resolver->getaddrinfo(
    host    => "www.example.com",
    service => "http",
 )->on_done( sub {
    foreach my $addr ( @_ ) {
       printf "http://www.example.com can be reached at " .
          "socket(%d,%d,%d) + connect('%v02x')\n",
          @{$addr}{qw( family socktype protocol addr )};
    }
 });

 $loop->resolve( type => 'getpwuid', data => [ $< ] )
    ->on_done( sub {
    print "My passwd ent: " . join( "|", @_ ) . "\n";
 });

 $loop->run;

=head1 DESCRIPTION

This module extends an L<IO::Async::Loop> to use the system's name resolver
functions asynchronously. It provides a number of named resolvers, each one
providing an asynchronous wrapper around a single resolver function.

Because the system may not provide asynchronous versions of its resolver
functions, this class is implemented using a L<IO::Async::Function> object
that wraps the normal (blocking) functions. In this case, name resolutions
will be performed asynchronously from the rest of the program, but will likely
be done by a single background worker process, so will be processed in the
order they were requested; a single slow lookup will hold up the queue of
other requests behind it. To mitigate this, multiple worker processes can be
used; see the C<workers> argument to the constructor.

The C<idle_timeout> parameter for the underlying L<IO::Async::Function> object
is set to a default of 30 seconds, and C<min_workers> is set to 0. This
ensures that there are no spare processes sitting idle during the common case
of no outstanding requests.

=cut

sub _init
{
   my $self = shift;
   my ( $params ) = @_;
   $self->SUPER::_init( @_ );

   $params->{code} = sub {
      my ( $type, $timeout, @data ) = @_;

      if( my $code = $METHODS{$type} ) {
         local $SIG{ALRM} = sub { die "Timed out\n" };

         alarm( $timeout );
         my @ret = eval { $code->( @data ) };
         alarm( 0 );

         die $@ if $@;
         return @ret;
      }
      else {
         die "Unrecognised resolver request '$type'";
      }
   };

   $params->{idle_timeout} = 30;
   $params->{min_workers}  = 0;

   $started = 1;
}

=head1 METHODS

The following methods documented with a trailing call to C<< ->get >> return
L<Future> instances.

=cut

=head2 resolve

   @result = $loop->resolve( %params )->get

Performs a single name resolution operation, as given by the keys in the hash.

The C<%params> hash keys the following keys:

=over 8

=item type => STRING

Name of the resolution operation to perform. See BUILT-IN RESOLVERS for the
list of available operations.

=item data => ARRAY

Arguments to pass to the resolver function. Exact meaning depends on the
specific function chosen by the C<type>; see BUILT-IN RESOLVERS.

=item timeout => NUMBER

Optional. Timeout in seconds, after which the resolver operation will abort
with a timeout exception. If not supplied, a default of 10 seconds will apply.

=back

On failure, the fail category name is C<resolve>; the details give the
individual resolver function name (e.g. C<getaddrinfo>), followed by other
error details specific to the resolver in question.

 ->fail( $message, resolve => $type => @details )

=head2 resolve (void)

   $resolver->resolve( %params )

When not returning a future, additional parameters can be given containing the
continuations to invoke on success or failure:

=over 8

=item on_resolved => CODE

A continuation that is invoked when the resolver function returns a successful
result. It will be passed the array returned by the resolver function.

 $on_resolved->( @result )

=item on_error => CODE

A continuation that is invoked when the resolver function fails. It will be
passed the exception thrown by the function.

=back

=cut

sub resolve
{
   my $self = shift;
   my %args = @_;

   my $type = $args{type};
   defined $type or croak "Expected 'type'";

   if( $type eq "getaddrinfo_hash" ) {
      $type = "getaddrinfo";
   }

   exists $METHODS{$type} or croak "Expected 'type' to be an existing resolver method, got '$type'";

   my $on_resolved;
   if( $on_resolved = $args{on_resolved} ) {
      ref $on_resolved or croak "Expected 'on_resolved' to be a reference";
   }
   elsif( !defined wantarray ) {
      croak "Expected 'on_resolved' or to return a Future";
   }

   my $on_error;
   if( $on_error = $args{on_error} ) {
      ref $on_error or croak "Expected 'on_error' to be a reference";
   }
   elsif( !defined wantarray ) {
      croak "Expected 'on_error' or to return a Future";
   }

   my $timeout = $args{timeout} || 10;

   my $future = $self->call(
      args => [ $type, $timeout, @{$args{data}} ],
   )->else( sub {
      my ( $message, @detail ) = @_;
      Future->fail( $message, resolve => $type => @detail );
   });

   $future->on_done( $on_resolved ) if $on_resolved;
   $future->on_fail( $on_error    ) if $on_error;

   return $future if defined wantarray;

   # Caller is not going to keep hold of the Future, so we have to ensure it
   # stays alive somehow
   $self->adopt_future( $future->else( sub { Future->done } ) );
}

=head2 getaddrinfo

   @addrs = $resolver->getaddrinfo( %args )->get

A shortcut wrapper around the C<getaddrinfo> resolver, taking its arguments in
a more convenient form.

=over 8

=item host => STRING

=item service => STRING

The host and service names to look up. At least one must be provided.

=item family => INT or STRING

=item socktype => INT or STRING

=item protocol => INT

Hint values used to filter the results.

=item flags => INT

Flags to control the C<getaddrinfo(3)> function. See the C<AI_*> constants in
L<Socket>'s C<getaddrinfo> function for more detail.

=item passive => BOOL

If true, sets the C<AI_PASSIVE> flag. This is provided as a convenience to
avoid the caller from having to import the C<AI_PASSIVE> constant from
C<Socket>.

=item timeout => NUMBER

Time in seconds after which to abort the lookup with a C<Timed out> exception

=back

On success, the future will yield the result as a list of HASH references;
each containing one result. Each result will contain fields called C<family>,
C<socktype>, C<protocol> and C<addr>. If requested by C<AI_CANONNAME> then the
C<canonname> field will also be present.

On failure, the detail field will give the error number, which should match
one of the C<Socket::EAI_*> constants.

 ->fail( $message, resolve => getaddrinfo => $eai_errno )

As a specific optimisation, this method will try to perform a lookup of
numeric values synchronously, rather than asynchronously, if it looks likely
to succeed.

Specifically, if the service name is entirely numeric, and the hostname looks
like an IPv4 or IPv6 string, a synchronous lookup will first be performed
using the C<AI_NUMERICHOST> flag. If this gives an C<EAI_NONAME> error, then
the lookup is performed asynchronously instead.

=head2 getaddrinfo (void)

   $resolver->getaddrinfo( %args )

When not returning a future, additional parameters can be given containing the
continuations to invoke on success or failure:

=over 8

=item on_resolved => CODE

Callback which is invoked after a successful lookup.

 $on_resolved->( @addrs )

=item on_error => CODE

Callback which is invoked after a failed lookup, including for a timeout.

 $on_error->( $exception )

=back

=cut

sub getaddrinfo
{
   my $self = shift;
   my %args = @_;

   $args{on_resolved} or defined wantarray or
      croak "Expected 'on_resolved' or to return a Future";

   $args{on_error} or defined wantarray or
      croak "Expected 'on_error' or to return a Future";

   my $host    = $args{host}    || "";
   my $service = $args{service}; defined $service or $service = "";

local/lib/perl5/IO/Async/Resolver.pm  view on Meta::CPAN

       else {
          my $future = $self->loop->new_future->fail( $err, resolve => getaddrinfo => $err+0 );
          $future->on_fail( $args{on_error} ) if $args{on_error};
          return $future;
       }
   }

   my $future = $self->resolve(
      type    => "getaddrinfo",
      data    => [
         host    => $host,
         service => $service,
         flags   => $flags,
         map { exists $args{$_} ? ( $_ => $args{$_} ) : () } qw( family socktype protocol ),
      ],
      timeout => $args{timeout},
   );

   $future->on_done( $args{on_resolved} ) if $args{on_resolved};
   $future->on_fail( $args{on_error}    ) if $args{on_error};

   return $future if defined wantarray;

   # Caller is not going to keep hold of the Future, so we have to ensure it
   # stays alive somehow
   $self->adopt_future( $future->else( sub { Future->done } ) );
}

=head2 getnameinfo

   ( $host, $service ) = $resolver->getnameinfo( %args )->get

A shortcut wrapper around the C<getnameinfo> resolver, taking its arguments in
a more convenient form.

=over 8

=item addr => STRING

The packed socket address to look up.

=item flags => INT

Flags to control the C<getnameinfo(3)> function. See the C<NI_*> constants in
L<Socket>'s C<getnameinfo> for more detail.

=item numerichost => BOOL

=item numericserv => BOOL

=item dgram => BOOL

If true, set the C<NI_NUMERICHOST>, C<NI_NUMERICSERV> or C<NI_DGRAM> flags.

=item numeric => BOOL

If true, sets both C<NI_NUMERICHOST> and C<NI_NUMERICSERV> flags.

=item timeout => NUMBER

Time in seconds after which to abort the lookup with a C<Timed out> exception

=back

On failure, the detail field will give the error number, which should match
one of the C<Socket::EAI_*> constants.

 ->fail( $message, resolve => getnameinfo => $eai_errno )

As a specific optimisation, this method will try to perform a lookup of
numeric values synchronously, rather than asynchronously, if both the
C<NI_NUMERICHOST> and C<NI_NUMERICSERV> flags are given.

=head2 getnameinfo (void)

   $resolver->getnameinfo( %args )

When not returning a future, additional parameters can be given containing the
continuations to invoke on success or failure:

=over 8

=item on_resolved => CODE

Callback which is invoked after a successful lookup.

 $on_resolved->( $host, $service )

=item on_error => CODE

Callback which is invoked after a failed lookup, including for a timeout.

 $on_error->( $exception )

=back

=cut

sub getnameinfo
{
   my $self = shift;
   my %args = @_;

   $args{on_resolved} or defined wantarray or
      croak "Expected 'on_resolved' or to return a Future";

   $args{on_error} or defined wantarray or
      croak "Expected 'on_error' or to return a Future";

   my $flags = $args{flags} || 0;

   $flags |= NI_NUMERICHOST if $args{numerichost};
   $flags |= NI_NUMERICSERV if $args{numericserv};
   $flags |= NI_DGRAM       if $args{dgram};

   $flags |= NI_NUMERICHOST|NI_NUMERICSERV if $args{numeric};

   if( $flags & (NI_NUMERICHOST|NI_NUMERICSERV) ) {
      # This is a numeric-only lookup that can be done synchronously
      my ( $err, $host, $service ) = Socket::getnameinfo( $args{addr}, $flags );