view release on metacpan or  search on metacpan

lib/App/DNS/Adblock.pm  view on Meta::CPAN

my $attributes;

sub new {
	my ( $class, %self ) = @_;
	my $self = { %self };
	bless $self, $class;

	$attributes = freeze($self);
	$self->read_config();

	my $host = Sys::HostIP->new;
	my %devices = reverse %{ $host->interfaces };
	my $hostip = $host->ip;

	$self->{interface} = $devices{ $hostip };
	$self->{host} = $hostip unless $self->{host};
	$self->{port} = 53 unless $self->{port};
	$self->{debug} = 0 unless $self->{debug};

	my $ns = Net::DNS::Nameserver->new(
		LocalAddr    => $self->{host},
		LocalPort    => $self->{port},
		ReplyHandler => sub { $self->reply_handler(@_); },
		Verbose	     => ($self->{debug} > 1 ? 1 : 0)
	) || die "couldn't create nameserver object:  $!";

	$self->{nameserver} = $ns;

	my $res = Net::DNS::Resolver->new(
		nameservers => [ @{ $self->{forwarders} } ],
		port	    => $self->{forwarders_port} || 53,
		recurse     => 1,
		debug       => ($self->{debug} > 2 ? 1 : 0),
	);

	$self->{resolver} = $res;

	return $self;
}

sub run {
	my ( $self ) = shift;

	$self->set_local_dns() if $self->{setdns};

	$SIG{KILL} = sub { $self->signal_handler(@_) };
	$SIG{QUIT} = sub { $self->signal_handler(@_) };
	$SIG{TERM} = sub { $self->signal_handler(@_) };
	$SIG{INT}  = sub { $self->signal_handler(@_) };
	$SIG{HUP}  = sub { $self->read_config() };

	$self->log("nameserver accessible locally @ $self->{host}", 1);

	$self->{nameserver}->main_loop;
};

sub set_local_dns {
	my ( $self ) = shift;

	my $stdout;
	my $stderr;
	my @result;

        if ($^O	=~ /darwin/i) {                                                          # is osx
	        eval {
	                ($self->{service}, $stderr, @result) = capture { system("networksetup -listallhardwareports | grep -B 1 $self->{interface} | cut -c 16-32") };
			if ($stderr || ($result[0] < 0)) {
			       die $stderr || $result[0];
			} else {
			       $self->{service} =~ s/\n//g;
			       system("networksetup -setdnsservers $self->{service} $self->{host}");
			       system("networksetup -setsearchdomains $self->{service} empty");
			}
		}
	}

	if (!grep { $^O eq $_ } qw(VMS MSWin32 os2 dos MacOS darwin NetWare beos vos)) { # is unix
	        eval {
	                ($stdout, $stderr, @result) = capture { system("cp /etc/resolv.conf /etc/resolv.bk") };
			if ($stderr || ($result[0] < 0)) {
			       die $stderr || $result[0];
			} else {
			       open(CONF, ">", "/etc/resolv.conf");
			       print CONF "nameserver $self->{host}\n";
			       close CONF;
			}
                }
	}

	if ($stderr||$result[0]) {
	       $self->log("switching of local dns settings failed: $@", 1);
	       undef $self->{setdns};
	} else {
	       $self->log("local dns settings ($self->{interface}) switched", 1);
	}
}

sub restore_local_dns {
	my ( $self ) = shift;

	my $stdout;
	my $stderr;
	my @result;

        if ($^O	=~ /darwin/i) {                                                         # is osx
	        eval {
		        ($stdout, $stderr, @result) = capture { system("networksetup -setdnsservers $self->{service} empty") };
			if ($stderr || ($result[0] < 0)) {
			       die $stderr || $result[0];
			} else {
                               system("networksetup -setsearchdomains $self->{service} empty");
			}
                }
	}

	if (!grep { $^O eq $_ } qw(VMS MSWin32 os2 dos MacOS darwin NetWare beos vos)) { # is unix
	        eval {
                        ($stdout, $stderr, @result) = capture { system("mv /etc/resolv.bk /etc/resolv.conf") };
			die $stderr || $result[0];
                }
        }

	($stderr||$result[0]) ? $self->log("local dns settings failed to restore: $@", 1)
	        : $self->log("local dns settings restored", 1);
}

sub signal_handler {
	my ( $self, $signal ) = @_;

	$self->log("shutting down: signal $signal");

    $self->restore_local_dns() if $self->{setdns};

	exit;
}

sub reply_handler {
	my ($self, $qname, $qclass, $qtype, $peerhost, $query,$conn) = @_;

	my ($rcode, @ans, @auth, @add);

 	if ($self->{adfilter} && ($qtype eq 'AAAA' || $qtype eq 'A' || $qtype eq 'PTR')) {
    
 		if (my $ip = $self->query_adfilter( $qname, $qtype )) {

                 	$self->log("received query from $peerhost: qtype '$qtype', qname '$qname'");
 			$self->log("[local] resolved $qname to $ip NOERROR");

 			my ($ttl, $rdata) = ( 300, $ip );
        
 			push @ans, Net::DNS::RR->new("$qname $ttl $qclass $qtype $rdata");

 			$rcode = "NOERROR";
      
 			return ($rcode, \@ans, \@auth, \@add, { aa => 1, ra => 1 });
 		}
 	}

	my $answer = $self->{resolver}->send($qname, $qtype, $qclass);

	if ($answer) {

       	        $rcode = $answer->header->rcode;
       	        @ans   = $answer->answer;
       	        @auth  = $answer->authority;
       	        @add   = $answer->additional;
    
	        $self->log("[proxy] response from remote resolver: $qname $rcode");

		return ($rcode, \@ans, \@auth, \@add);
	} else  {

		$self->log("[proxy] can not resolve $qtype $qname - no answer from remote resolver. Sending NXDOMAIN response.");

		$rcode = "NXDOMAIN";

		return ($rcode, \@ans, \@auth, \@add, { aa => 1, ra => 1 });
	}
}

sub log {
	my ( $self, $msg, $force_flag ) = @_;
	print "[" . strftime('%Y-%m-%d %H:%M:%S', localtime(time)) . "] " . $msg . "\n" if $self->{debug} || $force_flag;