view release on metacpan or  search on metacpan

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

package AnyEvent::DNS::Nameserver;
our $VERSION = "1.2";
use Net::DNS;
use AnyEvent::Handle::UDP;
use Socket qw(sockaddr_in sockaddr_in6 inet_ntop sockaddr_family AF_INET6);
use strict;

sub new {
    my $class = shift;
    my %p = @_;
    my $self = {};
    $self->{LocalAddr}      = $p{LocalAddr} || '0.0.0.0';
    $self->{LocalPort}      = $p{LocalPort} || 53;
    $self->{ReplyHandler}   = $p{ReplyHandler} or die "ReplyHandler invalid\n";
    $self->{Verbose}        = $p{Verbose}   || 0;
    $self->{Truncate}       = $p{Truncate}  || 1;
    $self->{IdleTimeout}    = $p{IdleTimeout} || 120;
    $self->{NotifyHandler}  = $p{NotifyHandler};

    $self->{watchers}       = [];

    my @LocalAddr =ref $self->{LocalAddr} eq 'ARRAY'?@{$self->{LocalAddr}}:($self->{LocalAddr});
    for my $la (@LocalAddr){ 
        my $hdl;$hdl = AnyEvent::Handle::UDP->new(
            bind    =>  [$la,$self->{LocalPort}],
            on_recv => sub {
                my ($data, $ae_handle, $client_addr) = @_;
                my $family = sockaddr_family($client_addr);
                my ($peerport, $peerhost) = ( $family == AF_INET6 ) ? sockaddr_in6($client_addr) : sockaddr_in($client_addr);
                $peerhost = inet_ntop($family, $peerhost);
                my $query = new Net::DNS::Packet( \$data );
                if ( my $err = $@ ) {
                    print "Error decoding query packet: $err\n" if $self->{Verbose};
                    undef $query; 
                }   
                my $conn = {
                        sockhost=>$la,
                        sockport=>$self->{LocalPort},
                        peerhost=>$peerhost,
                        peerport=>$peerport,
                };
                print "UDP connection from $peerhost:$peerport to $conn->{sockhost}:$conn->{sockport}\n" if $self->{Verbose};
                my $reply = make_reply($self,$query,$peerhost,$conn) || return;
                my $max_len = ( $query && $self->{Truncate} ) ? $query->edns->size : undef;
                if ( $self->{Verbose} ) {
                    local $| = 1;
                    print "Maximum UDP size advertised by $peerhost:$peerport: $max_len bytes\n" if $max_len;
                    print "Sending response to $peerhost:$peerport\n";
                    $reply->print ;
                }
                $ae_handle->push_send($reply->data($max_len), $client_addr);
            },
        );
        push @{$self->{watchers}},$hdl;
    }
    return bless $self,$class;
}

#copy from Net::DNS::Nameserver
sub make_reply {
        my ( $self, $query, $peerhost, $conn ) = @_;
 
        unless ($query) {
                print "ERROR: invalid packet\n" if $self->{Verbose};
                my $empty = new Net::DNS::Packet();             # create empty reply packet
                my $reply = $empty->reply();
                $reply->header->rcode("FORMERR");
                return $reply;
        }
 
        if ( $query->header->qr() ) {
                print "ERROR: invalid packet (qr set), dropping\n" if $self->{Verbose};
                return;
        }
 
        my $reply  = $query->reply();
        my $header = $reply->header;