Checking old code
Checkin from an old version of the code.
This commit is contained in:
		
							
								
								
									
										1
									
								
								Krp.secret-wg.org.+001+27900.key
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										1
									
								
								Krp.secret-wg.org.+001+27900.key
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1 @@ | |||||||
|  | rp.secret-wg.org. IN KEY 256 3 1 AQPkQwQiwlTBYvK8xOx18oOqSpLjuTDmDlfcVUd2Oy5ZWyG2PxN+jDW3 0PQo9Tme337mJfG4s/1m72FjK7xHbPyX | ||||||
							
								
								
									
										10
									
								
								Krp.secret-wg.org.+001+27900.private
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										10
									
								
								Krp.secret-wg.org.+001+27900.private
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,10 @@ | |||||||
|  | Private-key-format: v1.2 | ||||||
|  | Algorithm: 1 (RSA) | ||||||
|  | Modulus: 5EMEIsJUwWLyvMTsdfKDqkqS47kw5g5X3FVHdjsuWVshtj8Tfow1t9D0KPU5nt9+5iXxuLP9Zu9hYyu8R2z8lw== | ||||||
|  | PublicExponent: Aw== | ||||||
|  | PrivateExponent: mCytbIGN1kH3KINITqGtHDG3Qnt17rQ6kuOE+XzJkOYpffN+dJM8Xvz0+BNMSGQClHEWQ9jNRDN5sLLXkF0ICw== | ||||||
|  | Prime1: 8w4oFgLjDum6R4in3v/YNfKLzTQTFMXAzA+61TlJp88= | ||||||
|  | Prime2: 8Gspv8zMTD+bPSwwaDJxRRTwgx7btLrhXspko7WXyLk= | ||||||
|  | Exponent1: oglwDqyXX0Z8L7Bv6f/leUxdM3gMuIPV3V/R43uGb98= | ||||||
|  | Exponent2: oEdxKoiIMtUSKMggRXb2Lg31rL89IydA6dxDF85lMHs= | ||||||
|  | Coefficient: SbKE3QaFyv8Z8+Uqgptjw19eljzgiVhPNp6JWAwcwRg= | ||||||
							
								
								
									
										261
									
								
								httpd.pl
									
									
									
									
									
										Executable file
									
								
							
							
						
						
									
										261
									
								
								httpd.pl
									
									
									
									
									
										Executable file
									
								
							| @@ -0,0 +1,261 @@ | |||||||
|  | #!/usr/local/bin/perl | ||||||
|  | # httpdc | ||||||
|  | # a completely useless tool - a dc desk calculator in the url | ||||||
|  | # 2.3.+.dc.foor.bar will print out the html page | ||||||
|  | # "5" | ||||||
|  | # | ||||||
|  | # this code assumes that a real server lurks behind port 8080 on the local host | ||||||
|  | # | ||||||
|  | use Socket; | ||||||
|  |  | ||||||
|  |  | ||||||
|  | # the port I listen to | ||||||
|  | $port=80; | ||||||
|  |  | ||||||
|  | # the port I redirect all other requests to | ||||||
|  | $http_port = 80 ; | ||||||
|  |  | ||||||
|  |  | ||||||
|  |  | ||||||
|  | $AF_INET = 2 ; | ||||||
|  |  | ||||||
|  | $SOCK_STREAM = 1 ; | ||||||
|  |  | ||||||
|  | $sockaddr = 'S n a4 x8'; | ||||||
|  |  | ||||||
|  | ($name, $aliases, $proto) = getprotobyname('tcp'); | ||||||
|  |  | ||||||
|  |  | ||||||
|  | $this = pack($sockaddr, $AF_INET, $port, "\0\0\0\0"); | ||||||
|  |  | ||||||
|  | socket(S, $AF_INET, $SOCK_STREAM, $proto) || die "socket: $!"; | ||||||
|  | setsockopt(S, SOL_SOCKET, SO_REUSEADDR,1) ; | ||||||
|  |  | ||||||
|  | bind(S,$this) || die "Bind: $!"; | ||||||
|  | listen(S,5) || die "Connect: $!"; | ||||||
|  |  | ||||||
|  | my $runas = 'nobody';   | ||||||
|  | # Change effective id | ||||||
|  | $> = getpwnam($runas); | ||||||
|  |  | ||||||
|  |  | ||||||
|  | use Tie::Syslog; | ||||||
|  | my $x=tie *LOG, 'Tie::Syslog', 'daemon.info','RPHTTPD','pid','unix'; | ||||||
|  | #open(LOG,">>/root/RPNS/httpdc.log"); | ||||||
|  | print(LOG "RPHTTPD Server Listening on port $port\n"); | ||||||
|  | select(S); $|=1; | ||||||
|  | select(LOG); $|=1; | ||||||
|  | select(STDOUT); | ||||||
|  |  | ||||||
|  | for ($con = 1 ; ; $con++) { | ||||||
|  |     sleep 1; | ||||||
|  |     ($addr = accept(NS,S)) || die $!; | ||||||
|  |     if (($child = fork()) == 0) { | ||||||
|  | #	&open_slave() ; | ||||||
|  | #	if (($child = fork()) == 0) { | ||||||
|  | #	    select(NS); $|=1; select(STDOUT); | ||||||
|  | #	    read_slave() ; | ||||||
|  | #	    close(NS) ; | ||||||
|  | #	    exit ; | ||||||
|  | #	} | ||||||
|  | 	select(NS); $|=1; select(STDOUT); | ||||||
|  | 	$host = "" ; | ||||||
|  | 	while ($line = <NS>) { | ||||||
|  | #	    print (LOG  "LINE: $line\n"); | ||||||
|  | 	    if ($line =~ /^GET\s+(\S*)/) { | ||||||
|  | 		$url = $1 ; | ||||||
|  | 	    } | ||||||
|  | 	    elsif ($line =~ /^Host:\s+(.*)$/) { | ||||||
|  | 		$host = $1 ; | ||||||
|  | 		$host =~ s/\r// ; | ||||||
|  | 		$host =~ s/\n// ; | ||||||
|  | 	    } | ||||||
|  | 	    push(@lines,$line) ; | ||||||
|  | 	    if ($line =~ /^\r*\n*$/) { | ||||||
|  | 		if ($host =~ /^(.*)\.rp\./i) { | ||||||
|  | 		    process_host($host, $text); | ||||||
|  | 		    close (NS); | ||||||
|  | 		} | ||||||
|  | 		else { | ||||||
|  | #		    &write_slave() ; | ||||||
|  | 		} | ||||||
|  | 	    } | ||||||
|  | 	     | ||||||
|  | 	} | ||||||
|  |     }else{ | ||||||
|  | 	close(NS); | ||||||
|  | 	 | ||||||
|  |     } | ||||||
|  |      | ||||||
|  | #	&close_slave() ; | ||||||
|  |     close(NS) ; | ||||||
|  |      | ||||||
|  | } | ||||||
|  |  | ||||||
|  | exit ; | ||||||
|  |  | ||||||
|  | ############################ | ||||||
|  | sub process_host { | ||||||
|  |    my($host,$text) = @_ ; | ||||||
|  |  | ||||||
|  |  | ||||||
|  |    @types = ("text/html; charset=ISO-8859-1","text/plain;  | ||||||
|  | charset=ISO-8859-1","application/pdf","application/ps") ; | ||||||
|  |    @gmt = gmtime(time()) ; | ||||||
|  |    $day = ("Sun","Mon","Tue","Wed","Thu","Fri","Sat")[$gmt[6]]; | ||||||
|  |    $mon =  | ||||||
|  | ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec")[$gmt[4]]; | ||||||
|  |    $gmt[5] += 1900 ; | ||||||
|  |    $datestr = sprintf("%s, %02d %s %d %02d:%02d:%02d  | ||||||
|  | GMT",$day,$gmt[3],$mon,$gmt[5],$gmt[2],$gmt[1],$gmt[0]) ; | ||||||
|  |  | ||||||
|  | #  print(LOG "file: $host -> $text\n") ; | ||||||
|  |    if ($host =~ /^(.*)\.rp\./i) { | ||||||
|  |      $dcargs = $1; | ||||||
|  |      $dcargs =~ tr/A-Z/a-z/ ; | ||||||
|  |      $dcargs =~ s/\;// ; | ||||||
|  |      $dcargs =~ s/\'// ; | ||||||
|  |      $dcargs =~ s/\"// ; | ||||||
|  |      $dcargs =~ s/\./ / ; | ||||||
|  |      $dcargs .= " p" ; | ||||||
|  |      $infile = "/tmp/dci.$$" ; | ||||||
|  |      open(I,">$infile") ; | ||||||
|  |      print(I "$dcargs\n") ; | ||||||
|  |      close(I) ; | ||||||
|  |      $outfile = "/tmp/dco.$$" ; | ||||||
|  |      system("/usr/bin/dc <$infile >$outfile") ; | ||||||
|  |      if (!(-s $outfile)) { | ||||||
|  |        open(O,">$outfile") ; | ||||||
|  |        print(O "Beats me. Try using your toes as well as your fingers.\n") ; | ||||||
|  |        close(O) ; | ||||||
|  |        } | ||||||
|  |      $fout = "/tmp/dco.$$.html" ; | ||||||
|  |      open(FO,">$fout"); | ||||||
|  |      print(FO "<html><head><title>DC</title></head>") ; | ||||||
|  |      print(FO "<body BGCOLOR=\"\#FFFFFF\">\n") ; | ||||||
|  |      print(FO "<pre>\n") ; | ||||||
|  |      open(I,"$outfile") ; | ||||||
|  |      while ($line = <I>) { print(FO $line) ; } | ||||||
|  |      close(I) ; | ||||||
|  |      print(FO "</pre></body></html>\n") ; | ||||||
|  |      close(FO) ; | ||||||
|  |      $size = -s $fout ; | ||||||
|  |  | ||||||
|  |      print(NS "HTTP/1.1 200 OK\n") ; | ||||||
|  |      print(NS "Date: $datestr\n") ; | ||||||
|  |      print(NS "Server: The Bert reverse polish server\n") ; | ||||||
|  |      print(NS "Accept-Ranges: bytes\n") ; | ||||||
|  |      print(NS "Content-Length: $size\n") ; | ||||||
|  |      print(NS "Keep-Alive: timeout=15, max=100\n") ; | ||||||
|  |      print(NS "Connection: Keep-Alive\n") ; | ||||||
|  |      print(NS "Context-Type: $types[$text]\n\n") ; | ||||||
|  |  | ||||||
|  | #    print(LOG "HTTP/1.1 200 OK\n") ; | ||||||
|  | #    print(LOG "Date: $datestr\n") ; | ||||||
|  | #    print(LOG "Server: The Bert reverse polish server\n") ; | ||||||
|  | #    print(LOG "Accept-Ranges: bytes\n") ; | ||||||
|  | #    print(LOG "Content-Length: $size\n") ; | ||||||
|  | #    print(LOG "Keep-Alive: timeout=15, max=100\n") ; | ||||||
|  | #    print(LOG "Connection: Keep-Alive\n") ; | ||||||
|  | #    print(LOG "Context-Type: $types[$text]\n\n") ; | ||||||
|  |      open(I,"$fout") ; | ||||||
|  |      while ($buffer = <I>) { | ||||||
|  |        print(NS $buffer) ; | ||||||
|  | #      print(LOG $buffer) ; | ||||||
|  |        } | ||||||
|  |      print(NS "\n") ; | ||||||
|  |      unlink($infile) ; | ||||||
|  |      unlink($outfile)  ; | ||||||
|  |      unlink($fout) ; | ||||||
|  |      } | ||||||
|  |    else { | ||||||
|  |      $fout = "/tmp/404.$$.txt" ; | ||||||
|  |      open(FO,">$fout"); | ||||||
|  |      print(FO "<HTML><HEAD>\n") ; | ||||||
|  |      print(FO "<TITLE>NO CLUE</TITLE>\n") ; | ||||||
|  |      print(FO "</HEAD><BODY>\n") ; | ||||||
|  |      print(FO "<H1>Huh?</H1>\n") ; | ||||||
|  |      print(FO "Beats me. Try using your toes as well as your fingers.<p>\n") ; | ||||||
|  |      print(FO "</BODY></HTML>\n") ; | ||||||
|  |      close(FO) ; | ||||||
|  |      $size = -s $fout ; | ||||||
|  |      $fulf = $fout ; | ||||||
|  |      print(NS "HTTP/1.1 200 OK\n") ; | ||||||
|  |      print(NS "Date: $datestr\n") ; | ||||||
|  |      print(NS "Server: The Bert reverse polish server\n") ; | ||||||
|  |      print(NS "Content-Length: $size\n") ; | ||||||
|  |      print(NS "Keep-Alive: timeout=15, max=100\n") ; | ||||||
|  |      print(NS "Connection: Keep-Alive\n") ; | ||||||
|  |      print(NS "Content-Type: text/html; charset=iso-8859-1\n\n") ; | ||||||
|  | #    print(LOG "HTTP/1.1 200 OK\n") ; | ||||||
|  | #    print(LOG "Date: $datestr\n") ; | ||||||
|  | #    print(LOG "Server: The Bert reverse polish server\n") ; | ||||||
|  | #    print(LOG "Content-Length: $size\n") ; | ||||||
|  | #    print(LOG "Keep-Alive: timeout=15, max=100\n") ; | ||||||
|  | #    print(LOG "Connection: Keep-Alive\n") ; | ||||||
|  | #    print(LOG "Content-Type: text/html; charset=iso-8859-1\n\n") ; | ||||||
|  |      open(I,"$fulf") ; | ||||||
|  |      while ($buffer = <I>) { print(NS $buffer) ; } | ||||||
|  |      unlink($fulf) ; | ||||||
|  |      } | ||||||
|  | } | ||||||
|  |  | ||||||
|  | sub open_slave { | ||||||
|  |    chop($http_hostname = `bert.secret-wg.org`); | ||||||
|  |    $http_defhost = $http_hostname ; | ||||||
|  |    $HTTP_AF_INET = 2 ; | ||||||
|  |    $HTTP_SOCK_STREAM = 1 ; | ||||||
|  |    $http_sockaddr = 'S n a4 x8'; | ||||||
|  |  | ||||||
|  |  | ||||||
|  |    ($http_name, $http_aliases, $http_proto) = getprotobyname('tcp'); | ||||||
|  |    ($http_name, $http_aliases, $http_type, $http_len, $http_thisaddr) =  | ||||||
|  | gethostbyname($http_hostname); | ||||||
|  |    (@http_v) = unpack('C4', $http_thisaddr); | ||||||
|  |    ($http_name, $http_aliases, $http_type, $http_len, $http_thataddr) =  | ||||||
|  | gethostbyname($http_defhost); | ||||||
|  |    (@http_w) = unpack('C4', $http_thataddr); | ||||||
|  |    $http_this = pack($http_sockaddr, $HTTP_AF_INET, 0, $http_thisaddr); | ||||||
|  |    $http_that = pack($http_sockaddr, $HTTP_AF_INET, $http_port,  | ||||||
|  | $http_thataddr); | ||||||
|  |  | ||||||
|  |    socket(H, $HTTP_AF_INET, $HTTP_SOCK_STREAM, $http_proto) || die "socket:  | ||||||
|  | $!"; | ||||||
|  |    bind(H, $http_this) || die "bind: $!"; | ||||||
|  |    connect(H, $http_that) || die "connect: $!"; | ||||||
|  |    select(H) ; $| = 1 ; select(STDOUT); | ||||||
|  |  | ||||||
|  | } | ||||||
|  |  | ||||||
|  | sub read_slave { | ||||||
|  |    while ($len = sysread(H, $buffer,16384)) { | ||||||
|  |     print(NS $buffer); | ||||||
|  |     print(LOG "$con:<-\t$buffer"); | ||||||
|  |      $offset = 0 ; | ||||||
|  |      while($len) { | ||||||
|  |        $written = syswrite(NS, $buffer, $len, $offset); | ||||||
|  |        $offset += $written ; | ||||||
|  |        $len -= $written ; | ||||||
|  |        } | ||||||
|  |      } | ||||||
|  |    close(H) ; | ||||||
|  |    } | ||||||
|  |  | ||||||
|  | sub write_slave { | ||||||
|  |    select(H); $|=1; select(STDOUT); | ||||||
|  |    foreach $line (@lines) { | ||||||
|  |     print(LOG "$con:->\t$line"); | ||||||
|  |      print(H $line) ; | ||||||
|  |      } | ||||||
|  |    $#lines = -1 ; | ||||||
|  |    } | ||||||
|  |  | ||||||
|  | sub close_slave { | ||||||
|  |    if ($#lines >= 0) { | ||||||
|  |      &write_slave() ; | ||||||
|  |      } | ||||||
|  |    close(H) ; | ||||||
|  |    } | ||||||
|  |  | ||||||
|  |  | ||||||
|  |  | ||||||
							
								
								
									
										437
									
								
								ns.pl
									
									
									
									
									
										Executable file
									
								
							
							
						
						
									
										437
									
								
								ns.pl
									
									
									
									
									
										Executable file
									
								
							| @@ -0,0 +1,437 @@ | |||||||
|  | #!/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"; | ||||||
|  |   } | ||||||
|  |  | ||||||
|  |  | ||||||
|  |  | ||||||
|  |  | ||||||
|  |  | ||||||
|  |  | ||||||
|  |  | ||||||
		Reference in New Issue
	
	Block a user