summaryrefslogtreecommitdiffstats
path: root/nomde.pl
diff options
context:
space:
mode:
Diffstat (limited to 'nomde.pl')
-rw-r--r--nomde.pl359
1 files changed, 0 insertions, 359 deletions
diff --git a/nomde.pl b/nomde.pl
deleted file mode 100644
index 5217afe..0000000
--- a/nomde.pl
+++ /dev/null
@@ -1,359 +0,0 @@
-#!/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;
-
generated by cgit v1.2.3-24-g4f1b (git 2.32.0) at 2024-11-21 18:53:28 +0100