view release on metacpan or  search on metacpan

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

            $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;
                            }
                        );
                    } else {
                        (shift @HOSTS_CHECKING)->() while @HOSTS_CHECKING;
                    }
                }
            );
        }
    }
}

=head2 request

=for markdown ```perl

    $resolver->request($req, $cb->($res))

=for markdown ```

This is a wrapper for L<AnyEvent::DNS>->request method.

=cut

sub request {
    my ($self, $req, $cb) = @_;
    warn "req = " . Dumper $req if DEBUG;

    my $node = my $domain = $req->{qd}[0][0];
    $node =~ s/^_[a-z0-9-]*\._[a-z0-9-]*\.// if ($req->{qd}[0][1] eq 'srv');

    my $type = $req->{qd}[0][1];

    my (@ipv4, @ipv6, @srv);

    my $cv = AE::cv;

    $cv->begin;
    _load_hosts_unless {
        if (exists $HOSTS{$node}) {
            if ($type =~ /^([*]|srv)$/) {
                push @srv, $node;
            }
            if (ref $HOSTS{$node} eq 'ARRAY') {
                if ($type =~ /^([*]|a)$/ and exists $HOSTS{$node}[0]) {
                    push @ipv4, @{ $HOSTS{$node}[0] };
                }
                if ($type =~ /^([*]|aaaa)$/ and exists $HOSTS{$node}[1]) {