#!/usr/bin/perl -w -T
#
# Dynamic DNS update script. 
#
# Given a name and an IP address, update the server to add
# that name/ip pair as an A record.
#
# This script acts like a very limited DynDns2 protocol server.
# That is, it implements a subset of the functionality of the DynDns
# service which I find to be useful. For example, I don't plan on 
# using wildcard A records, so the 'wildcard' option is not available.
# The same goes with most of the options, really. They can be 
# specified in the URI, but they'll be quietly ignored. The following
# options are accepted:
#
# system
#	The only available value for this parameter is 'dyndns'. It may
#	be omitted if desired, but only because the DynDns.org people saw
#	fit to allow it; if I had my way, such laziness would be punished
#	most severely.
#
# hostname=yourhost.$domain[,nexthost.$domain,...]
#	Any number of hostnames may be updated at once. The domain must
#	be that specified in the $domain variable below. Hostnames not
#	listed in the user file will fail to update (this will not
#	prevent other valid hostnames from updating).
#
# myip=ipaddress
#	This is, *sigh*, also optional. If it's not provided, we try to
#	look up the IP from the http request. If that's not available, we
#	give up. We're obviously not trying too hard here.
#
# For example, a request might look something like this:
#
#	http://dyn.server.com/nic/update?system=dyndns \ 
#         &hostname=foo.test.org&myip=1.1.1.1
#
# This script should be protected using basic http authentication in order
# to mimic the DynDns.org system. 
#
# The users.dat file contains username:hostname pairs which dictate hostnames
# that particular logins have authorization to update. The usernames
# should be those used by the http authentication.
#
# Prerequisites & Notes
#
#	The Net::DNS Perl module must be installed. It's available at CPAN.
#
#	Your DNS server must support dynamic updates and authentication via
#	TSIG. You should define a TSIG key in the configuration file and
#	set up the intended dynamic zone to allow updates using this key.
#
#	Your dynamic zone should definitely be separate from zones containing
#	important information, such as, say, your mailserver's A record. It
#	should be in a separate directory, even, because you main zone directory
#	isn't writeable by the DNS server user, right?
#
#	Don't worry too much about setting a human-readable serial for your
#	dynamic zone's SOA, since it'll be incremented every time a client
#	makes an update. You should set the ttl, retry, and refresh values to
#	something sensible for a zone that will potentially see frequent updates;
#	I admit that my knowledge of this is fairly limited, but it seems that
#	smaller time to live, refresh, and retry values would do well in a
#	dynamic situation.
#
#	It goes without saying that as this file contains secret information
#	(the TSIG key), it should not be readable to the average user.
#
#	Pseudo-license: 
#		You may use this code for any purpose and are free to make any
#		changes, provided you credit me as the original author. I wouldn't
#		mind seeing the changes if you've done something cool, and if
#		by some unimaginable set of circumstances this script ends up making
#		you rich, please remember that I like being rich too.
#
# $Id: update,v 1.6 2003/11/10 18:25:56 flander Exp $
#
# Contact flander AT smurf DOT to with comments, patches, etc.

use CGI qw/:standard/;
use Net::DNS;

#########################################################################
### Modify values in this section per your system settings.

# TSIG data. Use dnskeygen or similar to generate.
$keynm = "yourkeyname";
$secret = "";

# Dynamic domain
$domain = "your.dynamic.domain.com";

# DNS server IP address
$dnsip = "127.0.0.1";

### Don't modify values beyond this line
##########################################################################

# phase 0, read users and hostnames from users file

print header;

my %u_hosts = get_users();
if (!defined(%u_hosts)) {
	# return nohost error
	print "911\n";
	exit 0;
}

# phase 1, input checking
# -- make sure input is well-formed (except for hostnames, which
#		are dealt with in turn)

my $query = new CGI;

my $newip = $query->param('myip');
my $newhoststring = $query->param('hostname');
my $system = $query->param('system');


if (defined($system) && !($system =~ (/dyndns/i))) {
	print "badsys\n";
	exit 0;
}

if (!(defined($newip))) {
	$newip = get_client_ip($query->remote_host());
} elsif (!isIPAddr($newip)) {
	$newip = get_client_ip($query->remote_host()); 
}

#try again

if (!isIPAddr($newip)) {
	# bad ip address provided or could not be looked up
	print "dnserr\n";
	exit 0;
}

if(!defined($newhoststring)) {
	print "notfqdn\n";
	exit 0;
}

# split hostnames string up into individual hostnames

my @newhosts = split(/,/,$newhoststring);

my $host;

foreach $host (@newhosts) {
	my $user_tmp;

	$host =~ (/(\w+)\.(.*)/);
	if (!defined($2) || $2 ne $domain) {
		print "notfqdn\n";
	} else {
		my $hs = $1;
		$hs =~ tr/A-Z/a-z/;
		undef($user_tmp);
		$user_tmp = $u_hosts{$hs};
		
		if (!defined($user_tmp)) {
			print "nohost\n";
		} elsif (!defined($query->remote_user()) || 
					!($query->remote_user() =~ /$user_tmp/i))
		{
			print $query->remote_user();
			print $user_tmp;
			print "!yours\n";
		}else{
			#it's okay, so do the normal stuff	
	
			# check whether this is an update or add	
			my $is_update = nameExists($host);

			my $dns_ret;

			if ($is_update == 0) {
				$dns_ret = add_entry($host, $newip);
			} else {
				$dns_ret = update_entry($host, $newip);
			}	
	
			if ($dns_ret == 0) {
				print "good " . $newip . "\n";
			} else {
				print "dnserr\n";
				exit 0;
			}
		}	
	}
}

#################### end of main routine

# get_users()
sub get_users {
	my %u = ();

	open(IN, "users.dat");

	if (!defined(IN)) {
		undef(%u);
		return %u;
	}

	while(<IN>){
		my ($user, $host) = split(/:/);
		chomp($user);
		chomp($host);
		$u{$host} = $user;
	}

	close(IN);

	return %u;
}

# add_entry(host, ip)
sub add_entry {
	my ($host, $ip) = @_;

	my $update = Net::DNS::Update->new($domain);

	# if it's an add, the hostname can't already exist
	$update->push("pre", nxrrset($host . ". A"));
	$update->push("update", rr_add($host . ". 86400 A " . $ip));
	$update->sign_tsig($keynm, $secret);

	my $res = Net::DNS::Resolver->new;
	$res->nameservers($dnsip);

	my $reply = $res->send($update);

	if (defined $reply) {
		if ($reply->header->rcode eq "NOERROR") {
			return 0;
		} else {
			return -1;
		}
	} else {
		return -1;
	}
}

# host, ip
sub update_entry {
	my ($host, $ip) = @_;

	if (delete_entry($host) == 0) {
		return -1;
	}
	
   my $update = Net::DNS::Update->new($domain);

   # if it's an add, the hostname can't already exist
   $update->push("pre", nxrrset($host . ". A"));
   $update->push("update", rr_add($host . ". 86400 A " . $ip));
	$update->sign_tsig($keynm, $secret);

   my $res = Net::DNS::Resolver->new;
   $res->nameservers($dnsip);

   my $reply = $res->send($update);

   if (defined $reply) {
      if ($reply->header->rcode eq "NOERROR") {
         return 0;
      } else {
         return -1;
      }
   } else {
      return -1;
   }
}

#delete_entry(host)

sub delete_entry {
	my ($host) = @_;

   my $update = Net::DNS::Update->new($domain);

   $update->push("pre", yxrrset($host . ". A"));
   $update->push("update", rr_del($host . " A"));
	$update->sign_tsig($keynm, $secret);

   my $res = Net::DNS::Resolver->new;
   $res->nameservers($dnsip);

   my $reply = $res->send($update);

   if (defined $reply) {
      if ($reply->header->rcode eq "NOERROR") {
         return -1;
      } else {
         return 0;
      }
   } else {
      return 0;
   }
}

sub nameExists {
	my $host = shift(@_);

	my $res = Net::DNS::Resolver->new;

	if (defined $res->query($host)) {
		return 1;
	} else {
		return 0;
	}
}


sub isIPAddr {
	my $ip = shift(@_);

	if($ip =~ (/(\d+).(\d+).(\d+).(\d+)/)) {

	if ((int($1) < 0 || int($1) > 254) ||
		(int($2) < 0 || int($2) > 254) ||
		(int($3) < 0 || int($3) > 254) ||
		(int($4) < 0 || int($4) > 254))
	{
		return 0;
	} else {
		return 1;
	}
	} else { return 0; }
}

sub get_client_ip {
	my $remote_host = shift(@_);
	my $ip;

	undef($ip);

	if (!isIPAddr($remote_host)) {
		my $res = Net::DNS::Resolver->new;
		my $q = $res->search($remote_host);
	} else {
		$ip = $remote_host;
	}

	if ($q) {
		foreach my $rr ($q->answer) {
			next unless $rr->type eq "A";
			$ip = $rr->address;
		}
	}

	return $ip;
}