view release on metacpan or  search on metacpan

lib/IO/Socket/DNS.pm  view on Meta::CPAN

package IO::Socket::DNS;

use strict;
use warnings;
use Carp qw(croak);
use base qw(Tie::Handle);

our $VERSION = '0.021';

our $count = 0;
# DNS Encoding is simply Base32 encoding using the following alphabet:
our $a32 = [0..9, "a".."w"];

# Max number of bytes to send in each DNS query
our $MAX_WRITE = 100;

# Sentinel value meaning "Incorrect Password"
our $INVALID_PASS = 999;

# new
# This just returns the tie'd file handle
sub new {
    my $class = shift;
    require IO::Handle;
    my $fh = IO::Handle->new;
    my $obj = eval {tie *$fh, $class, @_} or return undef;
    bless $fh, $class;
    return $fh;
}

sub _obj {
    my $self = shift;
    if (my $how = eval {tied *$self}) {
        $self = $how;
    }
    return $self;
}

sub suffix {
    my $self = _obj(shift);
    $self->{Suffix} ||= $ENV{DNS_SUFFIX} || "";
    $self->{Suffix} = lc $self->{Suffix};
    return $self->{Suffix};
}

sub TXT_resolver {
    my $self = shift;
    return $self->{resolver_txt} ||= eval {
        require Net::DNS::Resolver;
    } ? sub {
        my $name = shift;
        # Faster method, but Net::DNS must be installed for this to work.
        return eval { [$self->resolver->query($name, "TXT")->answer]->[0]->txtdata };
    } : do {
        my %args = $self->resolver_args;
        my $nameservers = $args{nameservers};
        if ($nameservers) {
            $nameservers = [split m/ /, $nameservers] if !ref $nameservers;
        }
        $nameservers ||= [""];
        warn "WARNING: Unable to find Net::DNS so reverting to nslookup (slow spawn) method ...\n";
        # Return a closure containing the lexically scoped $nameservers variable.
        sub {
            my $name = shift;
            # Make sure it is rooted to reduce unnecessary search scanning.
            $name =~ s/\.*$/./;
            # Try each resolver (if specified) until one works.
            foreach my $server (@$nameservers) {
                # Yes, it's slower, but is likely to work even if Net::DNS is gone.
                if (`nslookup -type=TXT $name $server 2>&1`=~/"(.+)"/) {
                    return $1;
                }
            }
            return undef;
        };
    };
};

sub resolver_args {
    my $self = _obj(shift);
    my @args = !$self->{Resolver} ? ()
        : !ref($self->{Resolver}) ? (nameservers => $self->{Resolver})
        : "ARRAY" eq ref($self->{Resolver}) ? (@{ $self->{Resolver} })
        : "HASH"  eq ref($self->{Resolver}) ? (@{ %{ $self->{Resolver} } })
        : ();
    return @args;
}

sub resolver {
    my $self = _obj(shift);
    return ($self->{net_dns} ||= eval {
        require Net::DNS::Resolver;
        return Net::DNS::Resolver->new($self->resolver_args);
    } || eval {
        # Try emergency "nslookup"
        my $suffix = $self->suffix;
        my $try = `nslookup -type=TXT nslookup.$suffix 2>&1`;
        if ($try =~ /"(.+)"/) {
            my $shell = $1;
            $shell =~ s/\bperl\b/$^X/g;
            system $shell;
            warn "Reloading Net::DNS ...\n";
            delete $INC{"Net/DNS.pm"};
            delete $INC{"Net/DNS/Resolver.pm"};
            require Net::DNS::Resolver;
            return $self->resolver;
        }
        return undef;
    } or do {
        warn  "Unable to obtain resolver. Please pass in your own net_dns setting: $@";
        exit 1;
    });
}

sub dnsencode {
    my $self = shift;
    my $decode = shift;
    my $x = unpack "B*", $decode;