view release on metacpan or  search on metacpan

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

    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;

        if (my $ipv4 = AnyEvent::Socket::parse_ipv4 $addr) {
            ($ipv4) = $ipv4 =~ /^(.*)$/s if AnyEvent::TAINT;
            push @{ $HOSTS{$_}[0] }, $ipv4 for @aliases;
        } elsif (my $ipv6 = AnyEvent::Socket::parse_ipv6 $addr) {
            ($ipv6) = $ipv6 =~ /^(.*)$/s if AnyEvent::TAINT;
            push @{ $HOSTS{$_}[1] }, $ipv6 for @aliases;
        }
    }
}

# helper function - unless dns delivered results, check and parse hosts, then call continuation code
sub _load_hosts_unless(&$@) {
    my ($cont, $cv, @dns) = @_;

    if (@dns) {
        $cv->end;
    } else {
        my $etc_hosts
            = length $ENV{PERL_ANYEVENT_HOSTS} ? $ENV{PERL_ANYEVENT_HOSTS}
            : AnyEvent::WIN32                  ? "$ENV{SystemRoot}/system32/drivers/etc/hosts"
            :                                    "/etc/hosts";

        push @HOSTS_CHECKING, sub {
            $cont->();
            $cv->end;
        };

        unless ($#HOSTS_CHECKING) {

            # we are not the first, so we actually have to do the work
            require AnyEvent::IO;

            AnyEvent::IO::aio_stat(
                $etc_hosts,
                sub {
                    if ((stat _)[9] ne ($HOSTS_MTIME || 0)) {
                        AE::log 8 => "(re)loading $etc_hosts.";
                        $HOSTS_MTIME = (stat _)[9];

                        # we might load a newer version of hosts,but that's a harmless race,
                        # as the next call will just load it again.
                        AnyEvent::IO::aio_load(
                            $etc_hosts,
                            sub {
                                _parse_hosts $_[0];
                                (shift @HOSTS_CHECKING)->() while @HOSTS_CHECKING;
                            }