### 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;
syntax highlighted by Code2HTML, v. 0.9.1