add some crap

Signed-off-by: Florian Pritz <bluewind@xssn.at>

1 files changed, 359 insertions, 0 deletions

diff --git a/nomde.pl b/nomde.pl
new file mode 100644
index 0000000..5217afe
--- /dev/null
+++ b/nomde.pl
@@ -0,0 +1,359 @@
+#!/usr/bin/perl 
+
+$VERSION = 0.1;
+
+use Fcntl;
+use Net::DNS;
+use Net::DNS::Nameserver;
+#use LWP::Simple;
+use LWP::UserAgent;
+use Time::HiRes qw ( usleep gettimeofday );
+use MIME::Base64;
+use MIME::Base32 qw ( RFC );
+use IO::Socket;
+use Class::Struct;
+use threads;
+use threads::shared;
+use Thread::Queue;
+use Getopt::Long;
+use English;
+
+
+my %opts;
+my %mods;
+
+$opts{ptrname} =  "127.0.0.1";
+$opts{filename} = "nomde.pl";
+$opts{forward}  = "sshdns:127.0.0.1:22";
+GetOptions(
+	"ip=s"   =>  \$opts{ip},
+	"filename=s"  =>  \$opts{file},
+    "ptrname"     =>  \$opts{ptrname},
+    "Localforward"=>  \$opts{forward}
+);
+if($ARGV[0]) {
+   $opts{localname} = $ARGV[0];
+   my @tmp = split('\.', $opts{localname});
+   $opts{nameoffset} = $#tmp;
+   undef @tmp;
+}
+
+if(!length($opts{localname}) || !length($opts{ip})){
+
+   print STDERR << "EOD";
+nomde $VERSION:     Experimental DNS Server
+Component of:  OzymanDNS          Dan Kaminsky(dan\@doxpara.com)
+       Usage:  nomde -l 10.0.1.11 servername.foo.com
+     Options:  -i [ip address]:   IP address to host for all A requests
+               -f [filename]  :   Filename to host in TXT records [b64]
+               -p [name]      :   Name/IP to return for reverse lookups[ptr]
+               -L [name:host:port]: Forward function to address, port
+                                    (Default:  sshdns:127.0.0.1:22)
+EOD
+   exit 1;
+}
+
+struct ( dns_sock => {
+	sock     => '$',
+	lasttime => '$',
+	reader   => '$',
+	queue    => '$'
+});
+
+
+struct ( dns_sock_data => {
+	data      => '$',
+	lasttime  => '$'
+});
+
+# set STDIN to nonblock
+$flags='';
+fcntl(STDIN, F_GETFL, $flags) or die "1\n";
+$flags |= O_NONBLOCK;
+fcntl(STDIN, F_SETFL, $flags) or die "2\n";
+
+
+#use strict;
+#use warnings;
+
+$dataclean;
+
+sub reply_handler {
+        my ($qname, $qclass, $qtype, $peerhost, $header, $packet) = @_;
+        my ($rcode, @ans, @auth, @add, $val);
+	
+	my @namelist = split(/\./, $qname);
+	my @reverselist = reverse(@namelist);
+	my $function = $reverselist[$opts{nameoffset}+1];
+	my @args = (@reverselist[$opts{nameoffset}+2..$#reverselist]);
+
+	$rcode = "NXDOMAIN";
+
+	if ($qtype eq "AAAA") { $rcode = "NOTIMPL"; goto end;};
+	if ($qtype eq "SOA") {
+		my $now = gettimeofday(); # yeah that'll give unique serials
+		my $name = $opts{localname};
+                my ($ttl, $rdata) = (3600, "ns.$name root.$name $now 28800 14400 3600000 0");
+                push @ans, Net::DNS::RR->new("$qname $ttl $qclass $qtype $rdata");
+                $rcode = "NOERROR";
+		goto end;
+        }
+	if ($qtype eq "TYPE38") { $rcode = "NOTIMPL"; goto end;};
+	if ($qtype eq "A" && $function eq "glance") {
+		my $addr = $args[0];
+		chomp($addr);
+		$addr =~ s/_/\./g;
+		$addr =~ s/-/\//g;
+		$addr = "http://" . $addr;
+
+		my $ua      = LWP::UserAgent->new;
+		my $request = HTTP::Request->new(HEAD => "$addr");
+		my $response= $ua->request($request);
+		my $modified_time = $response->last_modified;
+		my $expires       = $response->expires;
+		my $date          = $response->date;
+
+		my $ttl     = $expires - $date;
+		
+		my @array = unpack("C*", pack("V", $modified_time));  # will it work? 
+		my $nsip = join(".", @array);
+		if ($ttl < (60*20)) {$ttl = 60*20;}
+		push @ans, Net::DNS::RR->new("$qname $ttl $qclass $qtype $nsip");
+		$rcode = "NOERROR";
+		goto end;
+	}
+	if ($function eq "echo"){
+	
+    	if ($qtype eq "A" && $namelist[0] eq "ns")
+    	{
+    		my $nsip = $args[0];
+    		$nsip =~ s/-/./g;
+    		my ($ttl, $rdata) = (20, $nsip);
+    		push @ans, Net::DNS::RR->new("$qname $ttl $qclass $qtype $rdata");
+    		$rcode = "NOERROR";
+    		goto end;
+    	}
+    	else {
+    		my $nsip = $args[0];
+    		$nsip =~ s/-/./g;
+    		my $ns = "ns." . "$qname";
+    		print "\n$ns\n";
+    		$type = "NS";
+    		if($qtype eq "NS") {
+        		push @ans, Net::DNS::RR->new("$qname 20 $qclass NS $ns");
+    		} else {
+                push @auth, Net::DNS::RR->new("$qname 20 $qclass NS $ns");
+            }
+    		push @add, Net::DNS::RR->new("$ns 20 $qclass A $nsip");
+    		$rcode = "NOERROR";
+    		goto end;
+    	}
+	}
+    
+
+	if ($qtype eq "CNAME") { $rcode = "NOERROR"; goto end;};
+	if ($qtype eq "PTR") {
+		my ($ttl, $rdata) = (0, $opts{ptrname});
+		push @ans, Net::DNS::RR->new("$qname $ttl $qclass $qtype $rdata");
+                $rcode = "NOERROR";
+	}
+	if ($qtype eq "TXT" && $function eq "b64" && $opts{file}) {
+		my $val, $i;
+		seek($opts{file}, $args[0], 0);
+		read($opts{file}, $val, 57*2);
+		$val = encode_base64($val);
+		read($opts{file}, $val2, 57*2);
+		$val2 = encode_base64($val2);
+		my $ttl = 60;
+		push @ans, Net::DNS::RR->new("$qname $ttl $qclass $qtype \"$val\" \"$val2\"" );
+                $rcode = "NOERROR";
+		goto end;
+	}
+
+    my ($servname, $remotehost, $remoteport) = split(":", $opts{forward});
+	if ($function eq "$servname"){
+	   my $op     = $args[0];
+	   my $id     = $args[1];
+	   my ($offset, $nonce) = split("-", $args[2]);
+	   
+	   my $now = gettimeofday();
+	   if(!$sockclean || $now - $sockclean > 240){
+	       $sockclean = gettimeofday();
+	       foreach $scanid (keys %socklist){
+	          if($now - $socklist{$scanid}->lasttime > 10){
+	             $socklist{$scanid}->sock->shutdown(2);
+		     delete $socklist{$scanid};
+	          }
+	       }
+	   }
+       my $scanid;
+	   if(!$dataclean || $now - $dataclean > 20){
+	       $dataclean = gettimeofday();
+	       foreach $scanid (keys %sockdata) {
+	          if(defined($sockdata{"$scanid"})&&
+	              $now - $sockdata{"$scanid"}->lasttime > 60){
+	             delete $sockdata{$scanid};
+	          }
+           }
+       }
+	       
+	   if(!exists $socklist{$id}) {
+	         $socklist{$id}=new dns_sock;
+	         my $sock = IO::Socket::INET->new(
+	            PeerAddr => "$remotehost",
+		        PeerPort => "$remoteport",
+	            Proto    => "tcp",
+		        Type     => SOCK_STREAM,
+	            Blocking => 1);# or die "couldn't spawn socket\n";
+		 $socklist{$id}->queue(Thread::Queue->new);
+         $socklist{$id}->sock($sock);
+		 $socklist{$id}->reader(threads->new(\&reader, $socklist{$id}->sock, $socklist{$id}->queue));
+	   }
+
+	   $socklist{$id}->lasttime($now);
+	   my $sock = $socklist{$id}->sock;
+
+	   my $sockdata_is_fresh=0;
+	   if(!exists $sockdata{$op,$offset,$id}) {
+	         $sockdata{$op,$offset,$id} = new dns_sock_data;
+	         $sockdata{$op,$offset,$id}->lasttime($now);
+	         $sockdata_is_fresh=1;
+	   }
+
+	   my $data = $sockdata{$op,$offset,$id}->data;
+	   if($op eq "up" && $qtype eq "A"){
+	      my $size=0;
+	      $data = uc join("", reverse(@args[3..$#args]));
+	      $data = MIME::Base32::decode($data);
+
+	      if($sockdata_is_fresh){
+	         while($size != length($data)) {
+		    my $outdata;
+		    $outdata = substr($data, $size);
+	            $size += syswrite($sock, $outdata, length($data)-$size);
+		    if($size != length($data)){usleep (100 * 1000);}
+	         }
+	         $data="1"; #for now, we don't store incoming data
+	      }
+	      $sockdata{$op,$offset,$id}->data($data);
+	      my $reply = "$size.0.0.0";
+	      my $ttl  = 0;
+	      push @ans, Net::DNS::RR->new("$qname $ttl $qclass A $reply");
+	      $rcode = "NOERROR";
+	     
+	      goto end;
+	   }
+
+	   sub reader {
+		my @args = @_;
+		my $sock = @args[0];
+		my $queue= @args[1];
+	
+		while(1){
+		   if($queue->pending < 32) {
+			sysread($sock, $data, 220);
+			if(length($data)) {$queue->enqueue($data);}
+			usleep (50 * 1000 / 10);
+		   }
+		}
+	   }
+
+	   if($op eq "down"){ #intentionally not txt checking
+	      if($sockdata_is_fresh || length($data)==0) {
+		 $data = $socklist{$id}->queue->dequeue_nb;
+	         #sysread($sock, $data, 220);
+	      }
+	      $sockdata{$op,$offset,$id}->data($data);
+	      my $data1  = substr($data, 0, 110);
+	      my $data2  = substr($data, 110, 110);
+	      my $txt1 = encode_base64($data1);
+	      my $txt2 = encode_base64($data2);
+	      my $x    = $socklist{$id}->queue->pending;
+	     
+	      push @ans, Net::DNS::RR->new("$qname $ttl $qclass $qtype \"$txt1\" \"$txt2\"");
+	      push @add, Net::DNS::RR->new("pending.$qname $ttl $qclass A $x.0.0.0");
+	      $rcode = "NOERROR";
+	      goto end;
+	   }
+	}
+
+	if ($function eq "b32" && $args[0] eq "set") {
+		my $descrip = $args[1];
+		my @data = @args[2..$#args];
+		my $string = join(".", @data);
+		#my $data   = MIME::Base32::decode($string);
+		$datastore{$descrip} = $qname; #$string;
+		push @ans, Net::DNS::RR->new("$qname $ttl $qclass   A 1.0.0.0");
+		#push @ans, Net::DNS::RR->new("$qname $ttl $qclass TXT \"ok: $descrip = $string\"");
+		$rcode = "NOERROR";
+		goto end;
+	}
+	if ($function eq "b32" && $args[0] eq "get") {
+		my $descrip = $args[1];
+		if(exists $datastore{$descrip}){
+		   push @ans, Net::DNS::RR->new("$qname $ttl $qclass CNAME $datastore{$descrip}");
+		   push @add, Net::DNS::RR->new("$datastore{descrip} $ttl $qclass     A 1.0.0.0");
+		   $rcode = "NOERROR";
+		} else {
+		   $rcode = "NXDOMAIN";
+		}
+		goto end;
+	}
+		
+        if ($qtype eq "TXT") {
+		$val = `/bin/date`;
+		chomp $val;
+		$val = "Hi:  $val";
+                my ($ttl, $rdata) = (0, $val);
+                push @ans, Net::DNS::RR->new("$qname $ttl $qclass $qtype \"$rdata\"");
+                $rcode = "NOERROR";
+		goto end;
+	}
+	if ($qtype eq "NS") {
+        if($args[0] ne "ns"){ my ($ttl, $rdata) = (3600, "ns.$name");}
+        push @ans, Net::DNS::RR->new("$qname $ttl $qclass $qtype $rdata");
+		push @add, Net::DNS::RR->new("$qname $ttl $qclass $qtype $opts{ip}");
+                $rcode = "NOERROR";
+		goto end;
+        }
+		
+
+        if ($qtype eq "A") {
+                my ($ttl, $rdata) = (3600, $opts{ip});
+                push @ans, Net::DNS::RR->new("$qname $ttl $qclass $qtype $rdata");
+                $rcode = "NOERROR";
+		goto end;
+        }
+
+	end:
+	my $element, $name;
+	print "\n";
+	foreach $element (@ans, @auth, @add) {
+		$name = $element->string;
+		chomp $name;
+		print $name, "\n";
+	}
+
+        # mark the answer as authoritive (by setting the 'aa' flag
+        my @response = ($rcode, \@ans, \@auth, \@add, { aa => 1 });
+	return @response;
+}
+if(length($opts{filename})) {open FILE, "$opts{filename}" or die $!;}
+binmode FILE;
+$opts{file}=FILE;
+
+my %datastore;
+
+# note that this socket is blocking -- WAY harder to do nonblocking with
+# callbacks (need fork/ipc).
+my %socklist : shared;
+%sockdata;
+
+my $ns = Net::DNS::Nameserver->new(
+    LocalPort    => 53,
+    ReplyHandler => \&reply_handler,
+    Verbose      => 2,
+) || die "couldn't create nameserver object\n";
+
+$ns->main_loop;
+