view release on metacpan or  search on metacpan

lib/AnyEvent/DNS/EtcHosts.pm  view on Meta::CPAN

    AnyEvent::Socket::resolve_sockaddr $domain, $service, $proto, $family, undef, sub {
        say foreach map { format_address((AnyEvent::Socket::unpack_sockaddr($_->[3]))[1]) } @_;
        $cv->send;
    };

=for markdown ```

=head1 DESCRIPTION

AnyEvent::DNS::EtcHosts changes AnyEvent::DNS behavior. The F</etc/hosts> file
is searched before DNS, so it is possible to override DNS entries.

The DNS lookups are emulated. This resolver returns the standard DNS reply
based on F</etc/hosts> file rather than real DNS.

You can choose a different file by changing C<PERL_ANYEVENT_HOSTS> environment
variable.

This module also disables the original L<AnyEvent::Socket>'s helper function
which reads F</etc/hosts> file after the DNS entry was not found. It prevents
reading this file twice.

The L<AnyEvent::Socket> resolver searches IPv4 and IPv6 addresses separately.
If you don't want to check the addresses in DNS, both IPv4 and IPv6 addresses
should be placed in F</etc/hosts> or the protocol family should be set
explicitly for C<resolve_sockaddr> function.

=for readme stop

=cut

use 5.008_001;

use strict;
use warnings;

our $VERSION = '0.0105';

use base 'AnyEvent::DNS';

use AnyEvent         ();
use AnyEvent::Socket ();

use constant DEBUG => $ENV{PERL_ANYEVENT_DNS_ETCHOSTS_DEBUG};
use if DEBUG, 'Data::Dumper';

our $GUARD;

=head1 IMPORTS

=head2 use AnyEvent::DNS::EtcHosts %args

=for markdown ```perl

use AnyEvent::DNS::EtcHosts server => '8.8.8.8';

$ perl -MAnyEvent::DNS::EtcHosts script.pl

=for markdown ```

Enables this module globally. Additional arguments will be passed to
L<AnyEvent::DNS> constructor.

=cut

sub import {
    my ($class, %args) = @_;
    $GUARD = $class->register(%args);
}

=head2 no AnyEvent::DNS::EtcHosts

Disables this module globally.

=cut

sub unimport {
    my ($class) = @_;
    undef $GUARD;
}

=head1 METHODS

=head2 register

=for markdown ```perl

    require AnyEvent::DNS::EtcHosts;

    $guard = AnyEvent::DNS::EtcHosts->register(%args);

    undef $guard;

=for markdown ```

Enables this module in lexical scope. The module will be disabled out of
scope. Additional arguments will be passed to L<AnyEvent::DNS> constructor.

If you want to use AnyEvent::DNS::EtcHosts in lexical scope only, you should
use C<require> rather than C<use> keyword, because C<import> method enables
AnyEvent::DNS::EtcHosts globally.

=cut

sub register {
    my ($class, %args) = @_;

    my $old_resolver = $AnyEvent::DNS::RESOLVER;

    $AnyEvent::DNS::RESOLVER = do {
        my $resolver = AnyEvent::DNS::EtcHosts->new(
            untaint         => 1,
            max_outstanding => $ENV{PERL_ANYEVENT_MAX_OUTSTANDING_DNS} || 1,
            %args
        );
        if (not $args{server}) {
            $ENV{PERL_ANYEVENT_RESOLV_CONF}
                ? $resolver->_load_resolv_conf_file($ENV{PERL_ANYEVENT_RESOLV_CONF})
                : $resolver->os_config;
        }
        $resolver;
    };

    # Overwrite original helper function only if exists
    my $old_helper = do {
        \&AnyEvent::Socket::_load_hosts_unless
            if ((prototype 'AnyEvent::Socket::_load_hosts_unless') || '') eq '&$@';
    };

    if ($old_helper) {
        no warnings 'redefine';
        *AnyEvent::Socket::_load_hosts_unless = sub (&$@) {
            my ($cont, $cv, @dns) = @_;
            $cv->end;
        };
    }

    return AnyEvent::Util::guard {
        $AnyEvent::DNS::RESOLVER = $old_resolver;
        no warnings 'redefine';
        *AnyEvent::Socket::_load_hosts_unless = $old_helper if $old_helper;
    };
}

# Helper functions taken from AnyEvent::Socket 7.05

our %HOSTS;             # $HOSTS{$nodename}[$ipv6] = [@aliases...]
our @HOSTS_CHECKING;    # callbacks to call when hosts have been loaded
our $HOSTS_MTIME;

sub _parse_hosts($) {
    %HOSTS = ();

    for (split /\n/, $_[0]) {
        s/#.*$//;
        s/^[ \t]+//;
        y/A-Z/a-z/;

        my ($addr, @aliases) = split /[ \t]+/;
        next unless @aliases;