#!/usr/bin/perl -w
#
# dnsupdate.pl - An automatic IP address update program for dynamic DNS.
# Copyright (C) 2003, 2004 Masaki Suzuki.  All rights reserved.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
# 02111-1307, USA.
#
# $Id: dnsupdate.pl,v 0.44 2004/06/24 00:45:22 masaki Exp $

require 5.004;
use strict;

$| = 1;

my $NAME    = $0;
substr($NAME, 0, rindex( $0, '/') + 1) =  '';
my $VERSION = sprintf("%d.%d", '$Revision: 0.44 $' =~ /(\d+)\.(\d+)/);
my $DATE    = sprintf("%s", '$Date: 2004/06/24 00:45:22 $' =~ /^\S+ (.+) \S+$/);

my $CONFIG_FILE = '/etc/dnsupdate/dnsupdate.conf';
my $LOG_FILE    = '/var/log/dnsupdate.log';
my $PID_FILE    = '/var/run/dnsupdate.pid';

my $TRUE    = 1;
my $ERROR   = 0;
my $SUCCESS = 1;

my ($add_addr, $del_addr, $add_alias, $del_alias, $config_file,
    $daemon, $interval, $debug, $force, $help, $key, $kill,
    $log, $log_file, $ttl, $quiet, $reload, $restart, $version,
    $pid_file, $saved_addr, %param, $domain, $cgi_host, $cgi_path,
    $nameserver, @addr, $key_file, $key_name, $secret);

sub OptionError($);
sub PrintHelp();
sub ReloadConfig();
sub TerminateDaemon();
sub ParseConfig();
sub SetPidFile();
sub SetInterval();
sub ReadSavedAddress();
sub GetCurrentAddress();
sub FindNameServer();
sub GetAddress();
sub CheckAddress();
sub ReadKey();
sub SetTTL();
sub UpdateRecord();
sub Abort();
sub PrintMessage($);

while ($ARGV[0]) {
	my $arg = shift;
	if ($arg eq '--add' || $arg eq '--del') {
		my $option = $arg;
		$arg = shift;
                if (defined $arg && $arg =~ /^[^\-]/) {
			if ($arg =~ /^(\d{1,3}\.){3}\d{1,3}$/) {
				if ($option eq '--add') {
					$add_addr = $arg;
				} elsif ($option eq '--del') {
					$del_addr = $arg;
				}
			} else {
				OptionError("Option `$option' with an invalid IP address");
			}
		} else {
			OptionError("Option `$option' with no IP address");
		}
		next;
	}
	if ($arg eq '--addalias' || $arg eq '--delalias') {
		my $option = $arg;
		$arg = shift;
		if (defined $arg && $arg =~ /^[^\-]/) {
			$arg =~ s/^(.+[a-zA-Z0-9])\.+$/$1/;
			if ($arg =~ /^[a-zA-Z0-9\-]+\.([a-zA-Z0-9\-\.]+)$/) {
				if ($option eq '--addalias') {
					$add_alias = $arg;
				} elsif ($option eq '--delalias') {
					$del_alias = $arg;
				}
			} else {
				OptionError("Option `$option' with an invalid domain name");
			}
		} else {
			OptionError("Option `$option' with no domain name");
		}
		next;
	}
	if ($arg eq '-c' || $arg eq '--config') {
		my $option = $arg;
		$arg = shift;
		if (defined $arg && $arg =~ /^[^\-]/) {
			$config_file = $arg;
		} else {
			OptionError("Option `$option' with no config file");
		}
		next;
	}
	if ($arg eq '-d' || $arg eq '--daemon') {
		my $option = $arg;
		$arg = shift;
		if (defined $arg) {
			if ($arg =~ /^[^\-]/) {
				if ($arg =~ /^\d+$/) {
					$interval = $arg;
				} else {
					OptionError("Option `$option' with an invalid update interval");
				}
			} else {
				unshift @ARGV, $arg;
			}
		}
		$daemon = $TRUE;
		next;
	}
	($arg eq '--debug' || $arg eq '--verbose') && ($debug = $TRUE) && next;
	($arg eq '-f' || $arg eq '--force') && ($force = $TRUE) && next;
	($arg eq '-h' || $arg eq '--help') && ($help = $TRUE) && last;
	if ($arg eq '-i' || $arg eq '--interval') {
		my $option = $arg;
		$arg = shift;
		if (defined $arg && $arg =~ /^[^\-]/) {
			if ($arg =~ /^\d+$/) {
				$interval = $arg;
			} else {
				OptionError("Option `$option' with an invalid update interval");
			}
		} else {
			OptionError("Option `$option' with no update interval");
		}
		next;
	}
	if ($arg eq '-k' || $arg eq '--key') {
		my $option = $arg;
		$arg = shift;
		if (defined $arg && $arg =~ /^[^\-]/) {
			$key = $arg;
		} else {
			OptionError("Option `$option' with no key file");
		}
		next;
	}
	($arg eq '--kill') && ($kill = $TRUE) && next;
	if ($arg eq '-l' || $arg eq '--log') {
		$arg = shift;
		if (defined $arg) {
			if ($arg =~ /^[^\-]/) {
				$log_file = $arg;
			} else {
				unshift @ARGV, $arg;
			}
		}
		$log = $TRUE;
		next;
	}
	($arg eq '-q' || $arg eq '--quiet') && ($quiet = $TRUE) && next;
	($arg eq '--reload') && ($reload = $TRUE) && next;
	($arg eq '--restart') && ($restart = $TRUE) && next;
	if ($arg eq '-t' || $arg eq '--ttl') {
		my $option = $arg;
		$arg = shift;
		if (defined $arg && $arg =~ /^[^\-]/) {
			if ($arg =~ /^\d+$/) {
				$ttl = $arg;
			} else {
				OptionError("Option `$option' with an invalid ttl");
			}
		} else {
			OptionError("Option `$option' with no ttl");
		}
		next;
	}
	($arg eq '-v' || $arg eq '--version') && ($version = $TRUE) && last;
	if ($arg =~ /^-/) {
		OptionError("Invalid option `$arg'");
	} else {
		OptionError("Invalid argument `$arg'");
	}
}

if ($help) {
	print "$NAME $VERSION ($DATE)\n";
	PrintHelp();
	exit;
}

if ($version) {
	print "$NAME $VERSION ($DATE)\n";
	exit;
}

defined $config_file || ($config_file = $CONFIG_FILE);
defined $log_file || ($log_file = $LOG_FILE);

if ($reload) {
	PrintMessage("$NAME: reload");
	ReloadConfig() || Abort();
	exit;
}

if ($kill) {
	PrintMessage("$NAME: terminate");
	TerminateDaemon() || Abort();
	exit;
}

if ($restart) {
	PrintMessage("$NAME: restart");
	TerminateDaemon() || Abort();
	$daemon = $TRUE;
	undef $kill;
}

if ($daemon) {

	$log   = $TRUE;
	$quiet = $TRUE;

	PrintMessage("$NAME $VERSION");

	Abort() unless (ParseConfig() && SetPidFile());
	if (-e $pid_file) {
		PrintMessage("ERROR: `$pid_file' already exist");
		Abort();
	}
	SetInterval();
	Abort() unless ReadKey();
	SetTTL();

	my $pid;

	if ($pid = fork) {

		PrintMessage("Starting a daemon, ttl: $ttl, interval: $interval, pid: $pid");

		unless (open(PID, ">$pid_file")) {
			PrintMessage("ERROR: Can't open `$pid_file' ($!)");
			Abort();
		}
		print PID $pid;
		close(PID);
	} elsif (defined $pid) {

		my $sleep;

		$SIG{'INT'} = $SIG{'KILL'} = $SIG{'TERM'} =
		sub { PrintMessage('Exiting a daemon');
		      unlink $pid_file || PrintMessage("ERROR: Can't remove `$pid_file' ($!)");
		      exit;
		};

		$SIG{'HUP'} =
		sub { $reload = $TRUE;
		      undef $param{'TTL'};
		      undef $param{'INTERVAL'};
		      ParseConfig() || PrintMessage('Use the current value(s)');
		      SetInterval();
		      ReadKey() || PrintMessage('Use the current key');
		      SetTTL();
		      PrintMessage("Reloaded the configurations, ttl: $ttl, interval: $interval");
		      $sleep = $interval;
		};
		
		undef $add_alias;
		undef $del_alias;
		undef $force;

		while () {

			undef $add_addr;
			undef $del_addr;

			unless (defined $sleep) {
				$sleep = $interval;
			} else {
				sleep $sleep;
			}

			ReadSavedAddress() || next;
			GetCurrentAddress() || next;
			if ($saved_addr && $add_addr eq $saved_addr) {
				$debug && PrintMessage("No need to update `$param{'DOMAIN'}. A $saved_addr'");
				next;
			}
			FindNameServer() || next;
			GetAddress() || next;
			CheckAddress() || next;
			UpdateRecord();
		}
	} else {
		PrintMessage("ERROR: Can't fork daemon process ($!)");
		Abort();
	}
} else {

	PrintMessage("$NAME $VERSION");
	ParseConfig() && ReadKey() || Abort();
	SetTTL();

	if ($add_addr || $del_addr || $add_alias || $del_alias) {
		FindNameServer() || Abort();

	} else {
		unless ($force) {
			ReadSavedAddress() || Abort();
		}
		GetCurrentAddress() || Abort();
		if ($saved_addr && $add_addr eq $saved_addr) {
			PrintMessage("No need to update `$param{'DOMAIN'}. A $saved_addr'");
			exit;
		}
		FindNameServer() && GetAddress() && CheckAddress() || Abort();
	}
	UpdateRecord();
}


sub OptionError($) {
	die "$NAME: $_[0]\nTry `$NAME -h' or `$NAME --help' for more information\n";
}


sub PrintHelp() {

	print <<"EOF";

Usage: $NAME [option]...

Options:
      --add address         Add an address record for the domain manually.
      --del address         Delete an address record for the domain manually.
      --addalias alias      Add an alias for the domain manually.
      --delalias alias      Delete an alias for the domain manually.
  -c, --config config_file  Set the configuration file.
                            (the default is `$CONFIG_FILE')
  -d, --daemon [interval]   Execute dnsupdate as a daemon.
      --debug, --verbose    Display verbose messages for debugging.
  -f, --force               Ignore the saved IP address and update.
  -h, --help                Display this help and exit.
  -i, --interval interval   Set update interval for daemon.
                            It overrides the config parameter `INTERVAL'.
                            (the default is 600 in seconds)
  -k, --key [key_name:]key_file 
                            Set key name and key file.
                            It overrides the config parameters `KEY_NAME' and
                            `KEY_FILE'.
      --kill                Terminate a daemon.
  -l, --log [log_file]      Do logging messages (to `log_file').
                            (the default log file is `$LOG_FILE')
  -q, --quiet               Display nothing but stderr.
      --reload              Reload configurations for the daemon running.
      --restart             Restart a daemon.
  -t, --ttl ttl             Set ttl.
                            It overrides the config parameter `TTL'.
                            (the defaults is 600 in seconds)
  -v, --version             Display version information and exit.

Please report bug to <masaki\@btree.org>
EOF
}


sub ReloadConfig() {

	ParseConfig() || return $ERROR;

	SetPidFile() || return $ERROR;

	if (-e $pid_file) {

		my $pid;

		open(PID, $pid_file) || PrintMessage("ERROR: Can't open `$pid_file' ($!)") && return $ERROR;
		$pid = <PID>;
		close(PID);

		if ($pid && $pid =~ /^\d+$/) {

			my $HUP = 1;

			if(kill($HUP, $pid)) {
				PrintMessage("Reloading configurations, pid: $pid");
			} else {
				PrintMessage("ERROR: Can't reload configurations, pid: $pid ($!)");
				return $ERROR;
			}
		} else {
			PrintMessage("ERROR: Invalid pid in `$pid_file'");
			return $ERROR;
		}
	} else {
		PrintMessage("ERROR: `$pid_file' does not exist");
		return $ERROR;
	}
	$SUCCESS;
}


sub TerminateDaemon() {

	ParseConfig();

	SetPidFile() || return $ERROR;

	if (-e $pid_file) {

		my $pid;

		open(PID, $pid_file) || PrintMessage("ERROR: Can't open `$pid_file' ($!)") && return $ERROR;
		$pid = <PID>;
		close(PID);

		if ($pid && $pid =~ /^\d+$/) {

			my $TERM = 15;

			if(kill($TERM, $pid)) {
				PrintMessage("Terminated $NAME daemon, pid: $pid");
			} else {
				PrintMessage("ERROR: Can't terminate $NAME daemon, pid: $pid ($!)");
				return $ERROR;
			}
		} else {
			PrintMessage("ERROR: Invalid pid in `$pid_file'");
			return $ERROR;
		}
	} else {
		PrintMessage("ERROR: `$pid_file' does not exist");
		return $ERROR;
	}
	$SUCCESS;
}


sub ParseConfig() {

	my (@stat, @list, $param);

	unless (open(CONFIG, $config_file)) {
		PrintMessage("ERROR: Can't open `$config_file' ($!)");
		return $ERROR; 
	}
	@stat = stat $config_file;
	($stat[2] &= 044) && PrintMessage("WARNING: `$config_file' is group/world readable");
	$debug && PrintMessage("Reading `$config_file'");
	while (<CONFIG>) {
		my ($key, $val);
		/^#/ && next;
		s/\s//g;
		$_ || next;
		($key, $val) = split('=', $_);
		$param{$key} = $val;
		if ($debug && $param{$key}) {
			if ($key eq 'KEY_NAME') {
				PrintMessage("$key = ********");
			} else {
				PrintMessage("$key = $val");
			}
		}
	}
	close(CONFIG);

	return if $kill;

	@list  = ('DOMAIN', 'CGI', 'ADDR_FILE', 'KEY_FILE');
	$param = '';

	foreach (@list) {

		unless (defined $param{$_}) {
			unless (defined $key && $_ eq 'KEY_FILE') {
				$param .= ", `$_'";
			}
			next;
		}

		if ($_ eq 'DOMAIN') {
			$param{$_} =~ s/^(.+[a-zA-Z0-9])\.+$/$1/;
			if ($param{$_} =~ /^[a-zA-Z0-9\-]+\.([a-zA-Z0-9\-\.]+)$/) {
				$domain = $1;
			} else {
				$param .= ", `$_'";
			}
			next;
		}
		if ($_ eq 'CGI') {
			$param{$_} =~ s/^http:\/\///i;
			if ($param{$_} =~ /^([a-zA-Z0-9\-\]+\.[a-zA-Z0-9\-\.:]+)(\/[a-zA-Z0-9_\-\.\/]+)$/) {
				$cgi_host = $1;
				$cgi_path = $2;
			} else {
				$param .= ", `$_'";
			}
		}
	}

	if ($param) {
		$param =~ s/^, //;
		PrintMessage("ERROR: $param not set or invalid");
		return $ERROR;
	}
	$SUCCESS;
}


sub SetPidFile() {

	if ($param{'PID_FILE'}) {
		if ($param{'PID_FILE'} =~ /^\//) {
			$pid_file = $param{'PID_FILE'};
		} elsif ($param{'PID_FILE'} =~ /^[^\/]/) {
			$pid_file = "/var/run/$param{'PID_FILE'}";
		} else {
			PrintMessage("ERROR: Invalid `PID_FILE' in `$config_file'");
			return $ERROR;
		}
	} else {
		$pid_file = $PID_FILE;
	}
	$SUCCESS;
}


sub SetInterval() {

	my $INTERVAL = 600;

	return if (defined $interval && !$reload);

	if (defined $param{'INTERVAL'} && $param{'INTERVAL'} ne '') {
		if ($param{'INTERVAL'} =~ /^\d+$/) {
			$interval = $param{'INTERVAL'};
		} else {
			PrintMessage("WARNING: Invalid `INTERVAL', use the default $INTERVAL");
			$interval = $INTERVAL;
		}
	} elsif (!$reload) {
		$interval = $INTERVAL;
	}
}


sub ReadSavedAddress() {

	if (-e $param{'ADDR_FILE'}) {
		unless (open(ADDR, $param{'ADDR_FILE'})) {
			PrintMessage("ERROR: Can't open `$param{'ADDR_FILE'}' ($!)");
			return $ERROR;
		}
		$saved_addr = <ADDR>;
		close(ADDR);
		if ($saved_addr && $saved_addr =~ /^(\d{1,3}\.){3}\d{1,3}$/) {
			$debug && PrintMessage("saved address: $saved_addr");
		} else {
			PrintMessage("ERROR: Invalid address data in `$param{'ADDR_FILE'}'");
			return $ERROR;
		}
	} else {
		PrintMessage("WARNING: `$param{'ADDR_FILE'}' does not exist");
	}
	$SUCCESS;
}


sub GetCurrentAddress() {

	use Socket;

	my $PORT    = 80;
	my $TIMEOUT = 60;
	my ($port, $addr, $proto, $pack_addr, $oldfh);

	($cgi_host, $port) = split(':', $cgi_host);
	if (defined $port) {
		unless ($port =~ /^\d+$/) {
			PrintMessage("WARNING: Invalid port for HTTP, use the default $PORT");
			$port = $PORT;
		}
	} else {
		$port = $PORT;
	}

	$debug && PrintMessage("Resolving the cgi-host `$cgi_host'");
	unless ($addr = inet_aton($cgi_host)) {
		PrintMessage("ERROR: Can't look up the cgi-host `$cgi_host' (No such host)");
		return $ERROR;
	}
	$proto = getprotobyname('tcp');
	unless (socket(SOCKET, PF_INET, SOCK_STREAM, $proto)) {
		PrintMessage("ERROR: Can't create socket ($!)");
		return $ERROR;
	}
	$pack_addr = pack_sockaddr_in($port, $addr);
	$SIG{'ALRM'} = sub { return; };
	alarm($TIMEOUT);
	$debug && PrintMessage("Connecting to `$cgi_host:$port'");
	unless (connect(SOCKET, $pack_addr)) {
		close(SOCKET);
		alarm(0);
		PrintMessage("ERROR: Can't connect to `$cgi_host:$port' ($!)");
		return $ERROR;
	} else {
		$oldfh = select(SOCKET);
		$| = 1;
		select($oldfh);
		$debug && PrintMessage("Sending HTTP request to `$cgi_host'");
		print SOCKET "GET /$cgi_path HTTP/1.0\r\n",
		             "User-Agent: $NAME/$VERSION\r\n",
		             "\r\n";

		$debug && PrintMessage("Receiving data from `$cgi_host'");
		while (<SOCKET>){
			/^\r\n$/ && last;
		}
		$add_addr = <SOCKET>;
		close(SOCKET);
		alarm(0);
		if ($add_addr && $add_addr =~ /^(\d{1,3}\.){3}\d{1,3}$/) {
			$debug && PrintMessage("current address: $add_addr");
			return $SUCCESS;
		} else {
			PrintMessage("ERROR: Can't get a current address (cgi error)");
			return $ERROR;
		}
	}
}


sub FindNameServer() {

	use Net::DNS;

	my ($res, $query, @nameservers);

	$res = Net::DNS::Resolver->new;
	$debug && PrintMessage("Finding the nameservers for `$domain'");
	unless ($query = $res->query($domain, 'NS')) {
		my $errorstring = $res->errorstring;
		PrintMessage("ERROR: Can't find nameservers for `$domain' ($errorstring)");
		return $ERROR;
	}
	foreach ($query->answer) {
		next unless $_->type eq 'NS';
		my $ns = $_->nsdname;
		$debug && PrintMessage("server: $ns");
		push @nameservers, $ns;
	}

	$res->recurse(0);
	$debug && PrintMessage("Finding the primary master nameserver for `$domain'");
	foreach (@nameservers) {
		unless ($res->nameservers($_)) {
			if ($debug) {
				my $errorstring = $res->errorstring;
				PrintMessage("Can't look up server `$_' ($errorstring)");
			}
			next;
		}
		unless ($query = $res->query($domain, 'SOA')) {
			if ($debug) {
				my $errorstring = $res->errorstring;
				PrintMessage("Can't query, server: $_, domain: $domain, type: SOA ($errorstring)");
			}
			next;
		}
		#($query->answer)[0]->print;
		$nameserver = ($query->answer)[0]->mname;
		last;
	}

	if ($nameserver) {
		$debug && PrintMessage("primary master namesever: $nameserver");
		return $SUCCESS;
	} else {
		PrintMessage("Can't find the primary master nameserver for `$domain'");
		return $ERROR;
	}
}


sub GetAddress() {

	use Net::DNS;

	my ($res, $query);

	$res = Net::DNS::Resolver->new;
	$res->recurse(0);

	unless($res->nameservers($nameserver)) {
		my $errorstring = $res->errorstring;
		PrintMessage("ERROR: Can't look up server `$nameserver' ($errorstring)");
		return $ERROR;
	}
	$debug && PrintMessage("Finding CNAME record(s) for `$param{'DOMAIN'}'");
	if ($query = $res->query($param{'DOMAIN'}, 'CNAME')) {
		foreach ($query->answer) {
			next unless $_->type eq 'CNAME';
			my $cname = $_->cname;
			PrintMessage("ERROR: `$param{'DOMAIN'}' is an alias of `$cname'");
			return $ERROR;
		}
	} else {
		my $errorstring = $res->errorstring;
		if ($errorstring eq 'NOERROR') {
			$debug && PrintMessage("No CNAME record for `$param{'DOMAIN'}'");
		} elsif ($errorstring eq 'NXDOMAIN') {
			PrintMessage("WARNING: `$param{'DOMAIN'}' does not exist");
			return $SUCCESS;
		} else {
			PrintMessage("ERROR: Can't query, server: $nameserver, domain: $param{'DOMAIN'}, type: CNAME ($errorstring)");
			return $ERROR;
		}
	}

	$debug && PrintMessage("Finding A record(s) for `$param{'DOMAIN'}'");
	if ($query = $res->query($param{'DOMAIN'}, 'A')) {
		foreach ($query->answer) {
			next unless $_->type eq 'A';
			my $addr = $_->address;
			$debug && PrintMessage("address: $addr");
			push @addr, $addr;
		}
	} else {
		my $errorstring = $res->errorstring;
		if ($errorstring eq 'NOERROR') {
			PrintMessage("WARNING: No A record for `$param{'DOMAIN'}'");
		} else {
			PrintMessage("ERROR: Can't query, server: $nameserver, domain: $param{'DOMAIN'}, type: A ($errorstring)");
			return $ERROR;
		}
	}
	$SUCCESS;
}


sub CheckAddress() {

	if ($force) {
		if ($addr[1]) {
			PrintMessage("ERROR: Can't update, because multiple A records for `$param{'DOMAIN'}' exist");
			return $ERROR;
		} elsif ($addr[0]) {
			$del_addr = $addr[0];
		}
		return $SUCCESS;
	} elsif (@addr) {
		if ($saved_addr) {
			foreach(@addr) {
				if ($_ eq $saved_addr) {
					$del_addr = $_;
					last;
				}
			}
			unless ($del_addr) {
				PrintMessage("ERROR: Can't update, because the last updated A record for `$param{'DOMAIN'}' is not found");
				return $ERROR;
			}
		} else {
			PrintMessage("ERROR: Can't update, because one or more A records for `$param{'DOMAIN'}' have already exist");
			return $ERROR;
		}
	}
	$SUCCESS;
}

sub ReadKey() {

	if (defined $key) {
		if ($key =~ /^(\S+):(\S+)$/) {
			$key_name = $1;
			$key_file = $2;
		} else {
			$key_file = $key;
		}
	}

	defined $key_file || ($key_file = $param{'KEY_FILE'});

	unless (open(KEY, $key_file)) {
		PrintMessage("ERROR: Can't open `$key_file' ($!)");
		return $ERROR;
	}
	my @stat = stat $key_file;
	($stat[2] &= 044) && PrintMessage("WARNING: `$key_file' is group/world readable");
	my $string = <KEY>;
	close(KEY);
	if (defined $string) {
		if ($string =~ /^(\S+)\. IN KEY \d+ \d+ \d+ (.+)$/) {
			$key_name = $1;
			$secret   = $2;
		} else {
			unless (defined $key_name) {
				if (defined $param{'KEY_NAME'}) {
					$key_name = $param{'KEY_NAME'};
				} else {
					PrintMessage("ERROR: Configuration parameter `KEY_NAME' is not set");
					return $ERROR;
				}
			}
			$secret = $string;
		}
		$SUCCESS;
	} else {
		PrintMessage("ERROR: No key in `$key_file'");
		$ERROR;
	}
}


sub SetTTL() {

	my $TTL = 600;

	return if (defined $ttl && !$reload);

	if (defined $param{'TTL'} && $param{'TTL'} ne '') {
		if ($param{'TTL'} =~ /^\d+$/) {
			$ttl = $param{'TTL'};
		} else {
			PrintMessage("WARNING: Invalid `TTL', use the default $TTL");
			$ttl = $TTL;
		}
	} elsif (!$reload) {
		$ttl = $TTL;
	}
}


sub UpdateRecord() {

	use Net::DNS;

	my ($update, $res, $reply);

	$update = Net::DNS::Update->new($domain);
	$debug && PrintMessage("Sending update requests to `$nameserver'");
	if ($del_addr) {
		$debug && PrintMessage("prereq yxrrset `$param{'DOMAIN'}. A $del_addr'");
		$update->push('pre', yxrrset("$param{'DOMAIN'}. A $del_addr"));
		$debug && PrintMessage("update delete `$param{'DOMAIN'}. A $del_addr'");
		#$update->push('update', rr_del("$param{'DOMAIN'}. A $del_addr"));
	}
	if ($add_addr) {
		$debug && PrintMessage("prereq nxrrset `$param{'DOMAIN'}. CNAME'");
		$update->push('pre', nxrrset("$param{'DOMAIN'}. CNAME"));
		$debug && PrintMessage("update add `$param{'DOMAIN'}. $ttl A $add_addr'");
		#$update->push('update', rr_add("$param{'DOMAIN'}. $ttl A $add_addr"));
	}
	if ($del_alias) {
		$debug && PrintMessage("prereq yxrrset `$del_alias. CNAME $param{'DOMAIN'}.'");
		$update->push('pre', yxrrset("$del_alias. CNAME $param{'DOMAIN'}."));
		$debug && PrintMessage("update delete `$del_alias. CNAME $param{'DOMAIN'}.'");
		$update->push('update', rr_del("$del_alias. CNAME $param{'DOMAIN'}."));
	}
	if ($add_alias) {
		$debug && PrintMessage("prereq yxrrset `$param{'DOMAIN'}. A'");
		$update->push('pre', yxrrset("$param{'DOMAIN'}. A"));
		$debug && PrintMessage("prereq nxrrset `$add_alias. A'");
		$update->push('pre', nxrrset("$add_alias. A"));
		$debug && PrintMessage("prereq nxrrset `$add_alias. CNAME'");
		$update->push('pre', nxrrset("$add_alias. CNAME"));
		$debug && PrintMessage("update add `$add_alias. $ttl CNAME $param{'DOMAIN'}.'");
		$update->push('update', rr_add("$add_alias. $ttl CNAME $param{'DOMAIN'}."));
	}

	$update->sign_tsig($key_name, $secret);
	$res = Net::DNS::Resolver->new;
	$res->nameservers($nameserver);
	$reply = $res->send($update);

	$debug && PrintMessage("Receiving response from `$nameserver'");
	if ($reply) {
		my $rcode = $reply->header->rcode;
		if ($rcode eq 'NOERROR') {
			if ($del_addr) {
				PrintMessage("Update succeeded: delete `$param{'DOMAIN'}. A $del_addr'");
			}
			if ($add_addr) {
				PrintMessage("Update succeeded: add `$param{'DOMAIN'}. $ttl A $add_addr'");
			}
			if ($del_alias) {
				PrintMessage("Update succeeded: delete `$del_alias. CNAME $param{'DOMAIN'}.'");
			}
			if ($add_alias) {
				PrintMessage("Update succeeded: add '$add_alias. $ttl CNAME $param{'DOMAIN'}.'");
			}
			if ($add_addr) {
				unless (open(ADDR, ">$param{'ADDR_FILE'}")) {
					PrintMessage("ERROR: Can't open `$param{'ADDR_FILE'}' ($!)");
					return $ERROR;
				}
				print ADDR $add_addr;
				close(ADDR);
			}
		} else {
			PrintMessage("Update failed: $rcode");
		}
	} else {
		my $errorstring = $res->errorstring;
		PrintMessage("Update failed: $errorstring");
	}
	$SUCCESS;
}


sub Abort() {

	if ($log) {
		$quiet = $TRUE;
		PrintMessage('Aborted with an error');
	}
	die "Aborted with an error\n";
}


sub PrintMessage($) {

	if ($log) {
		open(LOG, ">>$log_file") || die "Can't open `$log_file' ($!)\n";
		my $date = localtime();
		$date =~ s/^\S+ (.+) \S+$/$1/;
		print LOG "$date $_[0]\n";
		close(LOG);
	}
	print "$_[0]\n" unless $quiet;
	$SUCCESS;
}