RPNS/ns.pl
Olaf 4404131d2a Checking old code
Checkin from an old version of the code.
2021-02-09 12:17:34 +01:00

438 lines
9.1 KiB
Perl
Executable File

#!/usr/bin/perl -Tw
# $Id: ns.pl,v 1.6 2005/10/11 11:44:28 olaf Exp $
use Net::DNS;
use Net::DNS::Nameserver;
use Net::DNS::SEC;
use strict;
use Math::RPN;
my $versionstring='"BSRPDNSC version 0.2.4"';
my $rpdomain=lc "rp.secret-wg.org.";
my $rp_ns_name=lc "ns.rp.secret-wg.org";
my $rp_ns_address="213.154.224.43";
my $rp_ns_bind_address="213.154.224.43";
my $rp_ns_port="53";
my $reply_ttl=10;
my $sig_val=60;
my $keypath="/home/olaf/RPNS/Krp.secret-wg.org.+001+27900.private";
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 %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';
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= (
Net::DNS::RR->new( "rp.secret-wg.org. 10 IN DNSKEY 256 3 1 AQPkQwQiwlTBYvK8xOx18oOqSpLjuTDmDlfcVUd2Oy5ZWyG2PxN+jDW3 0PQo9Tme337mJfG4s/1m72FjK7xHbPyX")
)
;
$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);
}
if ($ns) {
$ns->main_loop;
}
else {
die "couldn't create nameserver object\n";
}