RPNS/ns.pl

#!/usr/local/bin/perl -Tw 
use Proc::Daemon;
use Net::DNS;
use Net::DNS::Nameserver;
use Net::DNS::SEC;
use File::Slurp;
use strict;
use Math::RPN;
my $versionstring='"BSRPDNSC version 0.2.5"';




my $rpdomain=lc "rp.secret-wg.org.";
my $rp_ns_name=lc "ns.rp.secret-wg.org";
my $rp_ns_address="185.49.141.200";
my $rp_ns_bind_address="185.49.141.200";
my $rp_ns_port="53";
my $reply_ttl=10;
my $sig_val=60;
my $keypath="/home/olaf/RPNS/Krp.secret-wg.org.+005+27900.private";
my $pubpath="/home/olaf/RPNS/Krp.secret-wg.org.+005+27900.key";


my $www_address="193.0.4.49";

my $timeout=$sig_val*60-3*$reply_ttl; # resigns itself after so often

print "Using Net::DNS version ".$Net::DNS::VERSION."\n";
print "Using Net::DNS::SEC version ".$Net::DNS::SEC::VERSION."\n";


my $dnskeystring= read_file($pubpath);
# File should contain one key per line (not tested)

my $keyRR =  Net::DNS::RR->new( $dnskeystring);
my $ds = Net::DNS::RR::DS->create(
    $keyRR,
    digtype => 'SHA256',
    ttl     => 3600
    );
print "DS record for parent: \n " .$ds->string() ."\n";




my %sigargs;
$sigargs{"ttl"} = $reply_ttl;
$sigargs{"sigval"}= $sig_val;


my ( @keyRR, $keySIGRR,@versionRR,$nsASIGRR,@nsARR,$nsSIGRR,@nsRR,@apexNSECRR,$apexNSECSIGRR,@nsNSECRR,$nsNSECSIGRR,$soaSIGRR,@soaRR );
my $private=Net::DNS::SEC::Private->new($keypath);


use Tie::Syslog;
my $x=tie *STDOUT, 'Tie::Syslog', 'daemon.info','RPNS','pid','unix';


my $daemon = Proc::Daemon->new();
my $childPID= $daemon->Init;

print "Restarting the server";
resign();
alarm $timeout;




my $ns = Net::DNS::Nameserver->new(
				   LocalAddr        =>  $rp_ns_bind_address,
				   LocalPort        =>  $rp_ns_port,
				   ReplyHandler => \&reply_handler,
				   Verbose          => 1
				   );

$SIG{ALRM} = sub { print "alarm after $timeout seconds (to regenerate SIGs)\n";
	       resign () };



sub resign {

    @keyRR= (
	$keyRR
	)
	;
    
    
     $keySIGRR= create Net::DNS::RR::RRSIG(\@keyRR,
					$private,
					%sigargs,
					);

    
    @versionRR=(
	      Net::DNS::RR->new('version.bind 0 CH TXT '.$versionstring),
	      Net::DNS::RR->new('version.bind 0 CH TXT "http://bert.secret-wg.org/Tools tool 3"')
		);
    
    
    @nsARR=
	(Net::DNS::RR->new("$rp_ns_name $reply_ttl  IN  A $rp_ns_address"),
	 );
    
    $nsASIGRR= create Net::DNS::RR::RRSIG(\@nsARR,
					$private,
					%sigargs,
					);
    
    
    
    
    @nsRR=
	(Net::DNS::RR->new("$rpdomain  $reply_ttl IN NS $rp_ns_name"),
	 );
    $nsSIGRR= create Net::DNS::RR::RRSIG(\@nsRR,
				       $private,
				       %sigargs,
				       );
    
    
    
    
    @apexNSECRR=
	(Net::DNS::RR->new("$rpdomain $reply_ttl  IN  NSEC $rpdomain NSEC RRSIG SOA DNSKEY"),
	 );
    
    
    $apexNSECSIGRR= create Net::DNS::RR::RRSIG(\@apexNSECRR,
					    $private,
					    %sigargs,
					    );
    
    
    
    
    
    @nsNSECRR=
	(Net::DNS::RR->new("$rp_ns_name $reply_ttl  IN  NSEC $rpdomain NSEC RRSIG A"),
	 );
    
    
    $nsNSECSIGRR= create Net::DNS::RR::RRSIG(\@nsNSECRR,
					  $private,
					  %sigargs,
					  );
    
    
    
    

    
    @soaRR=
	( Net::DNS::RR->new("$rpdomain $reply_ttl  IN  SOA $rp_ns_name bert.secret-wg.org 1 20000 20000 100000 10")
	  );
    
    $soaSIGRR= create Net::DNS::RR::RRSIG(\@soaRR,
					$private,
					%sigargs,
					);
    
}



my $runas = 'nobody';  
# Change effective id
$> = getpwnam($runas);


sub reply_handler { 
    my ($qname, $qclass, $qtype,$peerhost, $query ) = @_; 
    my ($rcode, @ans, @auth, @add,);
    $query->print;

    my $opt;
    
    $opt= ($query->additional)[0] if ( $query->additional &&
				       (($query->additional)[0]->type eq "OPT")
				       );
    


    if ($qclass eq "CH"){
	if (lc($qname) eq "version.bind" && $qtype eq "TXT" ){
	    push @ans, @versionRR;
	    $rcode="NOERROR";
	}else{
	    $rcode="REFUSED";
	}
    }elsif (lc($qname) eq $rp_ns_name){
	if ($qtype eq "A"){
	    push @ans, @nsARR;
	    push @ans, $nsASIGRR if $opt;
	    push @add, @keyRR if $opt;	    
	}elsif($qtype eq "ANY"){
	    push @ans, @nsARR;
	    push @ans, $nsASIGRR;
	    push @ans, @nsNSECRR;
	    push @ans, $nsNSECSIGRR;
	    push @add, @keyRR if $opt;
	}else{
    	    my $ttl = $reply_ttl;
	    push @auth, @soaRR;
	    push @auth, $soaSIGRR if $opt;
	    push @auth, @apexNSECRR if $opt;
	    push @auth, $apexNSECSIGRR if $opt;
	    push @add, @keyRR if $opt;
	}
	$rcode = "NOERROR";

    }elsif (lc($qname)."." eq $rpdomain){
	
	if ($qtype eq "NS"){
	    push @ans, @nsRR;
	    push @ans, $nsSIGRR if $opt;
	    push @add, @nsARR;
	    push @add, $nsASIGRR if $opt;

	}elsif ($qtype eq "SOA"){	    
	    push @ans, @soaRR;
	    push @ans, $soaSIGRR if $opt;
	    push @auth, @nsRR;
	    push @auth, $nsSIGRR if $opt;
	    push @add, @nsARR;
	    push @add, $nsASIGRR if $opt;
	    push @add, @keyRR if $opt;

	}elsif ($qtype eq "DNSKEY"){
	    push @ans, @keyRR;
	    push @ans, $keySIGRR if $opt;
	
	}	elsif ($qtype eq "ANY"){
	    push @ans, @soaRR;
	    push @ans, $soaSIGRR;
	    push @ans, @apexNSECRR;
	    push @ans, $apexNSECSIGRR;
	    push @ans, @keyRR;
	    push @ans, $keySIGRR;
	    
	}else{
	    my $ttl = $reply_ttl;
	    push @auth, @soaRR;
	    push @auth, $soaSIGRR if $opt;
	    push @auth, @apexNSECRR if $opt;
	    push @auth, $apexNSECSIGRR if $opt;
	    push @add, @keyRR if $opt;	

	}

	$rcode = "NOERROR";
    }elsif ($qtype eq "NSEC" ){
	my @nxtRR=(
		 Net::DNS::RR->new("$qname $reply_ttl IN NSEC $rpdomain A NSEC TXT RRSIG ")
		   );
	
	push @ans, @nxtRR ;
	if ($opt){
	    my  $nxtSIGRR= create Net::DNS::RR::RRSIG(\@nxtRR,
						    $private,
						    %sigargs,
						    ) ;
	    push @ans, $nxtSIGRR; 
	}
	$rcode = "NOERROR";

    }elsif ( $qtype eq "A" ) {
	
	my $ARR=Net::DNS::RR->new("$qname $reply_ttl IN A $www_address");
	
	my @ARR = (
		   $ARR
		   );
	push @ans, @ARR ;
	my $ASIGRR;
	
	if ($opt )  {
	    $ASIGRR= create Net::DNS::RR::RRSIG(\@ARR,
					      $private,
					      %sigargs,
					      )  ;
	    
	    push @ans, $ASIGRR;
	}
	
	    
	$rcode="NOERROR";
	
    } elsif ($qtype eq "TXT" || $qtype eq "ANY") {     # Any name not the origin or the NS RR.
	if ($qname =~ /666\.666\.\+\.rp\.secret-wg\.org$/ ){
	    if ($qname eq "666.666.+.rp.secret-wg.org"){


		my @nsRR=
		    (Net::DNS::RR->new("$rpdomain  $reply_ttl IN NS $rp_ns_name"),
		     );
		my $nsSIGRR= create Net::DNS::RR::RRSIG(\@nsRR,
						     $private,
						     %sigargs,
						     );
    

		my @nxtRR=(
			 Net::DNS::RR->new("666.666.+.rp.secret-wg.org $reply_ttl IN NSEC 666.666.+.rp.secret-wg.org  NS NSEC RRSIG ")
			   );
		
		
		my  $nxtSIGRR= create Net::DNS::RR::RRSIG(\@nxtRR,
							  $private,
							  %sigargs,
							  ) ;


		push @auth, @nsRR;
		push @auth, $nsSIGRR;

		push @auth, @nxtRR;
		push @auth, $nxtSIGRR;

		push @add, @keyRR if $opt;	
		$rcode = "NOERROR";
    

		
	    }else{  # Anything below 666.666

		my @nxtRR=(
			 Net::DNS::RR->new("666.666.+.rp.secret-wg.org $reply_ttl IN NSEC 666.666.+.rp.secret-wg.org  DS NSEC RRSIG ")
			   );
		
		
		my  $nxtSIGRR= create Net::DNS::RR::RRSIG(\@nxtRR,
							  $private,
							  %sigargs,
							  ) ;
		push @auth, @soaRR;
		push @auth, $soaSIGRR if $opt;
		
		push @auth, @nxtRR if $opt;
		push @auth, $nxtSIGRR if $opt;
		
		push @add, @keyRR if $opt;	
		$rcode = "NXDOMAIN";
		
		
	    }
	}else{  # end special processing 666.666.rp.secret-wg.org
	    
	    my $param=$qname;
	    $param=~s/rp\.secret-wg\.org$//; 
	    $param=~s/\,/---deciMalPoiNt---/g;
	    $param=~s/\\\./---deciMalPoiNt---/g;
	    $param=~s/\./\,/g;
	    $param=~s/---deciMalPoiNt---/\./g;
	    my $answer=rpn($param);
	    
	    if (!defined($answer)){
		$rcode="SERVFAIL";
	    }else{
		my $ttl = $reply_ttl;
		
		my $answerRR=Net::DNS::RR->new("$qname $ttl IN TXT \'$answer\'");
		
		
		my @answerRR = (
				$answerRR
				);
		push @ans, @answerRR ;
		my $answerSIGRR;
		
		if ($opt || $qtype eq "ANY" )  {
		    $answerSIGRR= create Net::DNS::RR::RRSIG(\@answerRR,
							     $private,
							     %sigargs,
							     )  ;
		    
		    push @ans, $answerSIGRR;
		}
		
		
		if ($qtype eq "ANY" ){
		    
		    my $ARR=Net::DNS::RR->new("$qname $ttl IN A $www_address");
		    my @ARR = (
			       $ARR
			       );
		    push @ans, @ARR ;
		    my $ASIGRR= create Net::DNS::RR::RRSIG(\@ARR,
							   $private,
							   %sigargs,
							   )  ;
		    
		    push @ans, $ASIGRR;
		    
		    
		    
		    
		    my @nxtRR=(
			     Net::DNS::RR->new("$qname $reply_ttl IN NSEC $rpdomain A NSEC TXT RRSIG ")
			       );
		    
		    
		    push @ans, @nxtRR ;
		    
		    my  $nxtSIGRR= create Net::DNS::RR::RRSIG(\@nxtRR,
							      $private,
							      %sigargs,
							      ) ;
		    push @ans, $nxtSIGRR; 
		    
		}
		
	    }
	    $rcode = "NOERROR";
	} # END of	processing anything that is not 666.666
	
    } else {
	my $ttl = $reply_ttl;
	
	my @nxtRR=(
		 Net::DNS::RR->new("$qname $reply_ttl IN NSEC $rpdomain NSEC TXT RRSIG ")
		   );
	
	my  $nxtSIGRR= create Net::DNS::RR::RRSIG(\@nxtRR,
						$private,
						%sigargs,
						) if $opt;
	
	
	push @auth, @soaRR;
	push @auth, $soaSIGRR if $opt;

	push @auth, @nxtRR if $opt;
	push @auth, $nxtSIGRR if $opt;

	push @add, @keyRR if $opt;	
	$rcode = "NOERROR";
    }

    push @add,$opt if $opt;
    return ($rcode, \@ans, \@auth, \@add, {aa=>1}) if $rcode eq "NXDOMAIN";
    return ($rcode, \@ans, \@auth, \@add, {aa=>1}) if $rcode eq "NOERROR";
    return ($rcode, \@ans, \@auth, \@add);
}

unless ( $childPID ) {
    
    
    if ($ns) {
	$ns->main_loop;
    }
    else {
	die "couldn't create nameserver object\n";
    }
    
}