#!/usr/local/bin/perl -Tw

#
# Demonstration server.
# Implemented as a proxy . 

# Forwards questions to a authoritative server

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

use Data::Dumper; 
use Net::DNS qw(name2labels labels2name);
use Net::DNS::Nameserver;
use Net::DNS::Resolver;
use Net::DNS::SEC::Private;
use Net::DNS::SEC::NSECepsilon;

$Net::DNS::HAVE_XS=0;   # In order to properly deal with \000 in domain names


use strict;
my $versionstring='"Epsilon Generating proxy version 0.001"';

my $egdomain=lc "eg.secret-wg.org.";
my $eg_ns_name=lc "ns.eg.secret-wg.org";
my $eg_ns_address="193.0.3.29";    # This is the address the server is visible on
my $eg_ns_port="53";

my $authoritative_serveraddr="10.0.53.208"; # this is the bind server serving
			                    # serving the prepared zones.





my $reply_ttl=0;
my $sig_val=60;
my $keypath="/root/EGNS/Keg.secret-wg.org.+005+10457.private";



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





my $res=Net::DNS::Resolver->new(
				nameservers => [ $authoritative_serveraddr ],
				recurse     => 0,
				debug       => 0,
				retrans     => 0,
				);

$res->print;


# This is really a hack, we server "berts reverse polish secure dnssec
# nameserver" from the same IP. I do not want to break that.

my $res_rp=Net::DNS::Resolver->new(
				nameservers => [ "10.0.53.233" ],
				recurse     => 0,
				debug       => 0,
				retrans     => 0,
				);


$res_rp->print;
print "$versionstring\n";
print "Net::DNS::VERSION: ".$Net::DNS::VERSION."\n";
print "Net::DNS::SEC::VERSION: ".$Net::DNS::SEC::VERSION."\n";

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



	  

my $private=Net::DNS::SEC::Private->new($keypath);





my (
     @versionRR,

);



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

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



    @versionRR=(
	      Net::DNS::RR->new('version.bind 0 CH TXT '.$versionstring),
	      Net::DNS::RR->new('version.bind 0 CH TXT "NSEC+-Epsilon Generator"'),
	      Net::DNS::RR->new('version.bind 0 CH TXT "A Proof of concept".')
		);
    



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

    $rcode="SERVFAIL"; #default dropthrough

    if ($qclass eq "CH"){
	if (lc($qname) eq "version.bind" && $qtype eq "TXT" ){
	    push @ans, @versionRR;
	    $rcode="NOERROR";
	}else{
	    $rcode="REFUSED";
	}
    }

    if ($qclass ne "IN"){    
	$rcode="REFUSED";
	return ($rcode, \@ans, \@auth, \@add, {aa => 1});
    }



    # This is because I need to sacrifice the RPDNS server
    
    

    if ($qname =~ /rp\.secret-wg\.org(\.)?$/){

	$res_rp->dnssec(0);
	foreach my $possible_opt ($query->additional()){
	    next if ($possible_opt->type ne "OPT");
	    # very rudimentary.. we do not check ENDS version etc
	    $res_rp->dnssec(1) if ( ($possible_opt->ednsflags()) & 0x8000);
	    last;  
	}
	# $res_rp->dnssec() can now be used to do determine if we need to do
	# dnssec processing.

	my $answer=$res_rp->send(
			      $qname,
			      $qtype,
			      $qclass,
			      );

	if (!defined($answer))	    {
	    print $res_rp->errorstring."\n";
	    return ("SERVFAIL", \@ans, \@auth, \@add ) ;
	}
	@ans=$answer->answer() if $answer->header->ancount;
	@auth=$answer->authority()if $answer->header->nscount;
	@add=$answer->additional()if $answer->header->arcount;

	$rcode=$answer->header->rcode, 	
	return ($rcode, \@ans, \@auth, \@add, {aa => 1});	

    }	    
	

    # You do not have any business here if you are
    # not delegated here (don't bother with upward delegations for now)
    
    if ( $qname !~ /eg\.secret-wg\.org(\.)?$/){
	$rcode="REFUSED";
	return ($rcode, \@ans, \@auth, \@add);
    }


    # Refusing zone enumeration is the point.
    if($qtype eq "AXFR" ){
	$rcode="REFUSED";
	return ($rcode, \@ans, \@auth, \@add);
    }



    #  We do not allow to directly query for domain names that were
    #  the result of "white lies" generation.  We use the max_sort and
    #  min_sort as magic characters. Thereby excluding these to be
    #  ever visible if they really exist in a zone.

    # I do not think this is strictly needed. But it is a hack to 
    # deny clients to find out that the server is formally incomplient
    # with the specification (NSECs having owner names or targets that do 
    # not exist.
    
    if ($qname =~ /\\255/ || $qname =~ /\\000/ ){
	$rcode="REFUSED";
	return ($rcode, \@ans, \@auth, \@add);
    }

    
    
    
    my @question= $query->question;
    #EDNS processing to look if dnssec is enabled.
    $res->dnssec(0);
    foreach my $possible_opt ($query->additional()){
	next if ($possible_opt->type ne "OPT");
	# very rudimentary.. we do not check ENDS version etc
	$res->dnssec(1) if ( ($possible_opt->ednsflags()) & 0x8000);
	last;  
    }
    # $res->dnssec() can now be used to do determine if we need to do
    # dnssec processing.

    #print "DNSSEC query\n" if $res->dnssec();
    my $authpacket=$res->send(
			      $qname,
			      $qtype,
			      $qclass,
			      );
    
    if (! $authpacket ){
	$rcode="SERVFAIL";

	return ($rcode, \@ans, \@auth, \@add);
    }
    
    if($authpacket->header->rcode eq "REFUSED"){
	$rcode="REFUSED";
	return ($rcode, \@ans, \@auth, \@add);
    }
    
    if($authpacket->header->rcode eq "NOERROR"){
	@ans=$authpacket->answer()if $authpacket->header->ancount;
	@add=$authpacket->additional()if $authpacket->header->adcount;
	@auth=$authpacket->authority ()if $authpacket->header->nscount;

	$rcode="NOERROR";
	if ($res->dnssec()){
	    # Add proof of name error for the qname if a wildcard was returned.

	    my $no_data_flag=is_empty_non_term(\$authpacket,$qname);

	    @auth=strip_nsec($qname,@auth) if 
		$authpacket->header->nscount;
	    if (is_wildcard_answer($qname,@ans) ){
		add_epsilon_nsec(1,$qname,\@auth);
	    }elsif(  $no_data_flag ){
		print "#Empty Non Terminal proof added";
		add_epsilon_nsec(0,$qname,\@auth);
	    }
	}
	return ($rcode, \@ans, \@auth, \@add, {aa => 1});
    }

    if($authpacket->header->rcode eq "NXDOMAIN"){
	@auth=strip_nsec("",$authpacket->authority());

	if ( $qtype eq "NSEC" ) {
	    $rcode="REFUSED";
	    return ($rcode, \@ans, \@auth, \@add, {aa => 1});
	}

	$rcode="NXDOMAIN";
	if ($res->dnssec()){
	    # Add proof of non-direct mathc
	    add_epsilon_nsec(1,$qname,\@auth);
	    
	    # Add proof for no matching wildcard
	    my @labels=name2labels($qname,$egdomain);
	    # Since allready established that qname is a subdomain of egdomain
	    # labels will always contain elements.
	    if ($labels[0]ne"*"){
		#skip this if the query was for a wildcard, we do not have to
		# proof its nonexistence twice.
		
		$labels[0]="*";
		my $name=labels2name(@labels);
		add_epsilon_nsec(1,$name,\@auth);
	    }
	}
	return ($rcode, \@ans, \@auth, \@add, {aa => 1});

    }



    return ($rcode, \@ans, \@auth, \@add);
}



# is_empty_non_term

# in $packet  reference to a Net::DNS::Packet object that the authorative
# server returned.
# return 1 if the answer was a NoError nodata answer due to the
# existence of an empty non-terminal.
# returns0 if not or unknown

sub is_empty_non_term {
    my $packetref=shift;
    my $qname=shift;
    print "Count:".$$packetref->header->ancount()."\n";

    my $no_match_found=1;
    if (($$packetref->header->rcode() eq "NOERROR" ) &&
	! $$packetref->header->ancount() ){
	foreach my $rr ($$packetref->authority()){
	    next if ($rr->type ne "NSEC");

	    $no_match_found=0 if ($qname eq $rr->name);
	}
    }else{
	$no_match_found=0 ;	
    }
    print $no_match_found?"EMPTY NONTERM":"MATCHING";
    return $no_match_found;
}
					   


# add_epsilon_nsec
#
# in $nxdomain $qname $rrarray_ref
# $nxdomain is a boolean, if true the NSEC is generated to proof NXDOMAIN
# otherwise a NOERROR 
# $qname is the query name
# $rrarray_ref is an array to which the answer will be added.
#
# This function creates an NSEC-epsilon NSEC +epsilon
#

sub add_epsilon_nsec {
    my $nxdomain=shift;
    my $qname=shift;
    my $arrayref=shift;

    my $nsecrr=Net::DNS::RR->new (
				  name_min_epsilon($qname,$egdomain )."  0   IN   NSEC  ".
				  name_plus_epsilon($qname,$egdomain,$nxdomain)." NULL");


    push @$arrayref, $nsecrr;

    my @nsecRR=( $nsecrr );
    my $nsecRRsig = create Net::DNS::RR::RRSIG(\@nsecRR,
					       $private,
					       %sigargs,
					       );
    
    push @$arrayref, $nsecRRsig;
    return 0;    
}

# is_wildcard_answer;
# in:  $qname, @RR
# out: boolean
#
#
# @RR is supposed to contain ans DNSSEC answer section.
# Using the signature count in the RRSIG the function tries to
# determine if records with owner name $qname are genersted using
# a wildcard
#
# This is very crude. CNAME redirection to a wildcard owned name does not work

sub is_wildcard_answer{
    my $qname=shift;
    my @RR=@_;
    $qname =~s/\.$//;

    my $labelcount= name2labels($qname);
    foreach my $rr (@RR){
	return 1 if (
	    ($rr->name eq $qname) && 
	    ($rr->type eq "RRSIG") &&
	    ($rr->labels < $labelcount)
	    )
	}
    return (0);
}

#strip_nsec
# 
# in: $name, @RRs
# $name:  name of domain for wich to preserve NSEC RRs" 
# @RR:    array of Net::DNS::RR 
# return: array of Net::DNS::RR 
#
# Strips NSEC RRs and their corresponding RRSIGs, returns all other
# RRs 


sub strip_nsec {
    my $notstrip_name=shift;
    $notstrip_name =~s/\.$//;
    my @auth=@_;
    my %hasnsec;
    my @ret;
    foreach my $rr (@auth){
	$hasnsec{$rr->name}=1 if (($rr->type eq "NSEC" )
				  && ($rr->name ne $notstrip_name)
				  &&($rr->name !~ /^\*\./)
				  );
    }

    foreach my $rr (@auth){
	if ($hasnsec{$rr->name }){
	    if ( ($rr->type ne "NSEC") && ($rr->type ne "RRSIG")){
		push (@ret, $rr );
	    }elsif( ($rr->type eq "NSEC" ) ||
		    (($rr->type eq "RRSIG") &&  ($rr->typecovered eq "NSEC")) 
		    ){
		# Skip this beast "
	    }else{
		push (@ret, $rr );
	    }
	}else{
	    push (@ret, $rr );
	}
    }
    return @ret;
}




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


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