### Local Variables: ***
### mode:perl ***
### comment-column:0 ***
### comment-start: "### " ***
### comment-end: "***" ***
### End: ***
#
# ****************DO NOT MOVE OR CHANGE LINES ABOVE THIS*********************
#
# The first set of lines runs perl from any shell. The second set of lines
# identifies the rest of the file as PERL for EMACS autoformatting.
# See end of copyright for more information.
#
# 
# -------------------------------------------------------------------
#                                   X-BONE
#
#                          http://www.isi.edu/xbone
#                USC Information Sciences Institute (USC/ISI)
#                   Marina del Rey, California 90292, USA
#                          Copyright (c) 1998-2005
# 
# -------------------------------------------------------------------
#
# Copyright (c) 1998-2005 by the University of Southern California.
# All rights reserved.
#
# Permission to use, copy, modify, and distribute this software and
# its documentation in source and binary forms for non-commercial
# purposes and without fee is hereby granted, provided that the above
# copyright notice appear in all copies and that both the copyright
# notice and this permission notice appear in supporting
# documentation, and that any documentation, advertising materials,
# and other materials related to such distribution and use acknowledge
# that the software was developed by the University of Southern
# California, Information Sciences Institute.  The name of the
# University may not be used to endorse or promote products derived
# from this software without specific prior written permission.
# 
# THE UNIVERSITY OF SOUTHERN CALIFORNIA MAKES NO REPRESENTATIONS ABOUT
# THE SUITABILITY OF THIS SOFTWARE FOR ANY PURPOSE.  THIS SOFTWARE IS
# PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES,
# INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
# Other copyrights might apply to parts of this software and are so
# noted when applicable.
#
# -------------------------------------------------------------------
#
# Effort partly sponsored by the Defense Advanced Research Projects
# Agency (DARPA) and Air Force Research Laboratory, Air Force Materiel
# Command, USAF, under agreement numbers F30602-98-1-0200 (X-Bone) and
# F30602-01-2-0529 (DynaBone). The views and conclusions contained
# herein are those of the authors and should not be interpreted as
# necessarily representing the official policies or endorsements,
# either expressed or implied, of the Defense Advanced Research
# Projects Agency (DARPA), the Air Force Research Laboratory, or the
# U.S. Government.
#
# This work was partly supported by the NSF STI-XTEND (ANI-0230789)
# and NETFS (ANI-0129689) projects. Any opinions, findings, and
# conclusions or recommendations expressed in this material are those
# of the authors and do not necessarily reflect the views of the
# National Science Foundation.
#
# -------------------------------------------------------------------
#  $RCSfile: XB_VN_DNS.pm,v $
#
# $Revision: 1.14 $
#   $Author: pingali $
#     $Date: 2005/03/31 07:04:00 $
#    $State: Exp $
# ----------------------------------------------------------------------------
#
# Primary Author: Runfang Zhou
# Description:    Dynamic DNS update module used by XBONE

package XB_VN_DNS;

require Exporter;
@ISA       = qw(Exporter);
@EXPORT    = qw();
@EXPORT_OK = qw(update_dns test_dns);

use strict;
use XB_Log;
use XB_Params;
use Net::DNS;
use Net::IP;
use Data::Dumper;

my $modname = "XB_VN_DNS::";

# Description:
#     Update a bunch of Resource Records to a specific zone. Only
#     authenticated users are allowed to do the update thing.
# Arguments:
#     update object
# Returns:
#     1  on success
#     0  on failure
# Exceptions:
#     "update" on failure, nothing to cleanup by caller

sub send_message($){
  my $update = shift;

  my $procname = "send_message";
  XB_Log::log "info", "-> $modname$procname";

  eval {

    ########## Obtain the keys first
    open(KEYFILE, "<$XB_Params::node_opts{dns_key_file}") ||
      (XB_Log::log "err",
       "[$procname] unable to open DNS TSIG file $XB_Params::node_opts{dns_key_file}\n" and
       die ("key-file"));

    my $line = <KEYFILE>;
    close(KEYFILE);

    if ($line eq  ""){
      XB_Log::log "err",
	  "[$procname] empty first line in file $XB_Params::node_opts{dns_key_file}\n" and
      die ("key-file");
    }

    # the format of the line is:
    #key-test. IN KEY 256 3 157 PdfLjJF6pM6vc76nz+v60Q==
    my @components = split(" ", $line);

    my $key_name = $components[0];
    $key_name =~ s/\.$//g; # remove the . at the end.
    my $key = $components[6];

    ########## sign the message
    # Signing the packet with shared secret key
    unless ($update->sign_tsig ($key_name, $key))
      {
	XB_Log::log "err", "[$procname] unable to sign packet with the key \n"
	    and die "sign_tsig";
      }

    ########## send the message
    #Send the update to the zone's primary master
    my $res;
    unless ($res = Net::DNS::Resolver->new){
      XB_Log::log "err", "[$procname] unable to create a name server object\n"
      and die "resolver";
    }
    unless ($res->nameservers($XB_Params::node_opts{name_server})){
      XB_Log::log "err", "[$procname] unable to connect to the name server\n"
      and die "nameservers";
    }

    my $reply = $res->send($update);
    if (defined $reply)
    {
      if ($reply->header->rcode eq "NOERROR")
	{
	  XB_Log::log "debug", "Update succeeded";
	}
      else
      {
        XB_Log::log "debug", "Update failed: reply " . Dumper($reply)
	and die "send";
      }
    }
    else
    {
      XB_Log::log "debug", "Update failed: $res->errorstring" and
      die "send";
    }
  }; # eval

  XB_Log::log "info", "<- $modname$procname";
  return 1 unless $@;
  unless ($@ =~ /(key-file|nameservers|sign-tsig|send)/){
    XB_Log::log "warning", "! $procname caught unknown exception: $@";
  }
  die "$procname";
}


# Description:
#     Update a bunch of Resource Records to a specific zone. Only
#     authenticated users are allowed to do the update thing.
# Arguments:
#  a hash
#    (
#       op => $operator    add or delete
#       address_type => ipv4 or ipv6
#       overlay => $overlay overlay name
#       map => $node_ipaddr hash of RRs
#             the hash consists of  name => ip;ip;ip;..
#    )
# Returns:
#     1  on success
#     0  on failure
# Exceptions:
#     "update" on failure, nothing to cleanup by caller

sub update_dns($){

  my ($args) = shift;
  my $procname = "update_dns";
  XB_Log::log "info", "-> $modname$procname";

  eval {

    my $operator = $args->{op};
    my $overlay = $args->{overlay};
    my $map = $args->{map};
    my $address_type = $args->{address_type};

    if ($operator !~ /(add|delete)/){
      XB_Log::log "err"," [$procname] incorrect operation";
      die ("args");
    }

    if ($args->{address_type} !~ /(ipv4|ipv6)/) {
      XB_Log::log "err"," [$procname] unknown address type passed as argument ";
      die ("args");
    }

    my ($type, $node, $str, $update);
    ######################################################3
    # first add the forward records. adding of records can
    # be done independently of the address type. code is clean.
    ######################################################3
    $type = ($args->{address_type} =~ /ipv4/)? 'A' : 'AAAA';

    # for the forward operations the domain is forward_zone
    unless ($update = Net::DNS::Update->new($XB_Params::node_opts{forward_zone})){
      XB_Log::log "err", " [$procname] unable to create a packet object"
	  and die "new";
    }

    foreach $node (keys %{$map})
      {
	
	# put a constraint that this hostname is not defined.
	#  $str = "www.xbone.test.   A" for the pre-requisite
	$str = "$node.$overlay.$XB_Params::node_opts{forward_zone}.  $type";

	# now create the actual resource records
	#  $str = "www.xbone.test.   86400 A 10.0.0.1"  for adding A
	if ($operator =~ /add/){
	  $update->push("pre", nxrrset($str));
	  #$str = "$node.$overlay.$XB_Params::node_opts{forward_zone}. 86400 $type ";
	  $str = "$node.$overlay.$XB_Params::node_opts{forward_zone}. $type ";
	}else{
	  $update->push("pre", yxrrset($str));
	  $str = "$node.$overlay.$XB_Params::node_opts{forward_zone}. $type ";
	}
	
	# go through the list of address for the given hostname
	my @addrlist = split(';', $map->{$node});
	foreach my $addr (@addrlist) {

	  my $n = new Net::IP($addr);
	  if (not defined $n) {
	    XB_Log::log "info", "invalid address specified for $type records: $addr ";
	    die("address");
	  }
	  my $ipaddr = $n->reverse_ip(); 
	  # this always returns the addr with arpa at the end. 
	  # so fix if necessary.
	  if ($ipaddr =~ /arpa/i){ 
	    $ipaddr =~ s/ip6.arpa/ip6.int/i; 
	  }

	  if ($ipaddr !~ /$XB_Params::node_opts{reverse_zone}/i and
	      $ipaddr !~ /$XB_Params::node_opts{reverse_zone6}/i) {
	    XB_Log::log "info", "does not match the reverse zone: $addr ";
	    die("address");
	  }

	  if ($operator =~ /add/){
	    $update->push("update", rr_add($str . $addr));
	  } else {
	    $update->push("update", rr_del($str));
	  }
	} #foreach addr
	
      };# foreach node

    send_message($update);
    $update = undef;

    ######################################################3
    # first add the forward records. adding of records can
    # be done independently of the address type. code is clean.
    ######################################################3
    # add the reverse entries now.
    my $domain; 
    if ( $address_type =~ /ipv4/){
      $domain = $XB_Params::node_opts{reverse_zone};
    } else {
      $domain = $XB_Params::node_opts{reverse_zone6};
    }
	
    # create another object to refer to the reverse zone
    unless ($update = Net::DNS::Update->new($domain)){
      XB_Log::log "err", " [$procname] unable to create a packet object"
	  and die "new";
    }

    foreach $node (keys %{$map})
      {

	# look at all the
	my @addrlist = split(';', $map->{$node});
	foreach my $addr (@addrlist) {

	  my $name = "$node.$overlay.$XB_Params::node_opts{forward_zone}";

	  my $n = new Net::IP($addr);
	  if (not defined $n) {
	    XB_Log::log "info", "invalid address: $addr ";
	    die("address");
	  }
	  my $ipaddr = $n->reverse_ip();
	  # this always returns the addr with arpa at the end. 
	  # so fix if necessary.
	  if ($ipaddr =~ /arpa/i){ 
	    $ipaddr =~ s/ip6.arpa/ip6.int/i; 
	  }

	  if ($ipaddr !~ /$XB_Params::node_opts{reverse_zone}/i and
	      $ipaddr !~ /$XB_Params::node_opts{reverse_zone6}/i) {
	    XB_Log::log "info", "does not match the reverse zone: $addr ";
	    die("address");
	  }
	
	  if ($operator =~ /add/){
	    $update->push("pre", nxrrset("$ipaddr. PTR"));
	    $update->push("update", rr_add("$ipaddr. 86400 PTR $name"));
	  } else {
	    $update->push("pre", yxrrset("$ipaddr. PTR"));
	    $update->push("update", rr_del("$ipaddr. PTR"));
	  }

	} # go through all the addresses
      } # foreach node

    send_message($update);
  }; # eval

  XB_Log::log "info", "<- $modname$procname";
  return 1 unless $@;
  unless ($@ =~ /(args|new|operator|sign-tsig|resolve|nameservers|send|address)/){
    XB_Log::log "warning", "! $procname caught unknown exception: $@";
  }
  die "$procname";
}; # update_dns

# Description:
#     DNS support 
# Arguments:
#  a hash
#    (
#       op => $operator    add or delete
#       address_type => ipv4 or ipv6
#       overlay => $overlay overlay name
#       map => $node_ipaddr hash of RRs
#             the hash consists of  name => ip;ip;ip;..
#    )
# Returns:
#     1  on success
#     0  on failure
# Exceptions:
#     "update" on failure, nothing to cleanup by caller

sub test_dns {

  my $procname = "test_dns";
  XB_Log::log "info", "-> $modname$procname";


#    op => $operator    add or delete
#    address_type => ipv4 or ipv6
#    overlay => $overlay overlay name
#    map => $node_ipaddr hash of RRs
#             the hash consists of  name => ip;ip;ip;..

    my %map = (
	       "host_0" => "172.26.0.1;",
	       "router_0" => "172.26.1.1;"
	       );

    my %test1 = ( 
		  op => "add",
		  "address_type" => "ipv4",
		  "overlay" => "test1",
		  "map" => \%map
		  );
    
    update_dns(\%test1); 

  XB_Log::log "info", "<- $modname$procname";
  return 1;

};


1;