1#  You may distribute under the terms of either the GNU General Public License
2#  or the Artistic License (the same terms as Perl itself)
3#
4#  (C) Paul Evans, 2011-2013 -- leonerd@leonerd.org.uk
5
6package IO::Async::Resolver::DNS::NetDNSImpl;
7
8use strict;
9use warnings;
10
11our $VERSION = '0.06';
12
13use Net::DNS::Resolver;
14
15use IO::Async::Resolver;
16use constant HAVE_IO_ASYNC_RESOLVER_EXTENDED_ERROR => ( $IO::Async::Resolver::VERSION >= '0.68' );
17
18use IO::Async::Resolver::DNS::Constants qw( /^ERR_/ );
19
20# Net::DNS::Resolver sometimes just sets its error strings to the stringified version of $!
21use constant EAGAIN_STR => do { $! = Errno::EAGAIN; "$!" };
22
23my $res;
24sub _resolve
25{
26   my ( $method, $dname, $class, $type ) = @_;
27
28   $res ||= Net::DNS::Resolver->new;
29
30   my $pkt = $res->$method( $dname, $type, $class ); # !order
31   if( !$pkt ) {
32      my $errorstring = $res->errorstring;
33      # Net::DNS::Resolver yields NOERROR for successful DNS queries that just
34      # didn't yield any records of the type we wanted. Rewrite that into
35      # NODATA instead
36      $errorstring = "NODATA" if $errorstring eq "NOERROR";
37
38      if( HAVE_IO_ASYNC_RESOLVER_EXTENDED_ERROR ) {
39         # Attempt to convert Net::DNS::Resolver's error strings to our own
40         # constants
41         my $err = ERR_UNRECOVERABLE;
42         for( $errorstring ) {
43            # RCODE errors in the DNS packet response
44            m/^NODATA$/      and $err = ERR_NO_ADDRESS, last;
45            m/^NXDOMAIN$/    and $err = ERR_NO_HOST,    last;
46            m/^SRVFAIL$/     and $err = ERR_TEMPORARY,  last;
47            # libc errno values which arrive as strings :(
48            $_ eq EAGAIN_STR and $err = ERR_TEMPORARY,  last;
49            # It is quite likely this mapping is incomplete. :(
50         }
51
52         die [ "$errorstring", $err ];
53      }
54      else {
55         die "$errorstring\n";
56      }
57   }
58
59   # placate Net::DNS::Packet bug
60   $pkt->answer; $pkt->authority; $pkt->additional;
61
62   return $pkt->data;
63}
64
65sub IO::Async::Resolver::DNS::res_query  { _resolve( query  => @_ ) }
66sub IO::Async::Resolver::DNS::res_search { _resolve( search => @_ ) }
67
680x55AA;
69