#!/usr/bin/perl -w
#
# update-dyndns
# John Simpson <jms1@jms1.net> 2008-03-30
#
# 2008-05-26 jms1 - changing hostname/key list to an external text file
#   instead of making people edit the script itself. adding a lot of new
#   comments and sanity checks.
#
###############################################################################
#
# Copyright (C) 2008 John Simpson.
#
# 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 or version 3 of the
# license, at your option.
#
# 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, see <http://www.gnu.org/licenses/>.
#
###############################################################################

require 5.003 ;
use strict ;

###############################################################################
#
# configuration

my $datadir = "data" ;		# directory to write files

my $keyfile = "hostkeys" ;	# file of hostnames, ttl, keys

# program to rebuild tinydns data
my $trigger = "/service/tinydns/root/trigger-make" ;

###############################################################################
#
# global variables

my %keys ;
my %ttlv ;

###############################################################################
#
# hostname_is_valid(): check if a hostname is valid according to RFC 1034
#   as revised by RFC 1123 and RFC 2181.

sub hostname_is_valid($$)
{
	my $name	= ( shift || "" ) ;
	my $fromfile	= ( shift || 0  ) ;
	my $err		= "" ;

	my $fi = ( $fromfile ? "file" : "input" ) ;

	$name =~ s/\.$// ;
	my @labels = split ( /\./ , $name ) ;

	if ( length ( $name ) > 255 )
	{
		print "WARNING: $fi hostname \"$name\""
			. " longer than 255 characters,"
			. " see RFC 1034 section 3.1\n" ;
		exit 0 ;
	}

	for my $l ( @labels )
	{
		if ( length ( $l ) > 63 )
		{
			$err .= "WARNING: $fi hostname label \"$l\""
				. " longer than 63 characters,"
				. " see RFC 1034 section 3.5\n" ;
		}
	}

	if ( $err )
	{
		print $err ;
		return 0 ;
	}

	return 1 ;
}

###############################################################################
#
# ip_is_valid(): make sure an IP address is valid

sub ip_is_valid($)
{
	my $ip = ( shift || "" ) ;

	unless ( $ip =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ )
	{
		print "ERROR: IP address \"$ip\" invalid format\n" ;
		return 0 ;
	}

	my ( $a , $b , $c , $d ) = ( $1 , $2 , $3 , $4 ) ;
	if ( ( $a > 255 ) || ( $b > 255 ) || ( $c > 255 ) || ( $d > 255 ) )
	{
		print "ERROR: IP address \"$ip\" invalid numbers\n" ;
		return 0 ;
	}

	return 1 ;
}

###############################################################################
#
# readkeys(): read list of hostnames/ttl/keys from $keyfile
#
#   ignores empty or whitespace-only lines, as well as comments (which are
#   lines where the first non-whitespace character is "#".
#
#   note that because of how the code trims and splits the lines, the keys
#   cannot start or end with whitespace characters (they will be ignored if
#   present) but may contain whitespace characters within the keys.

sub readkeys()
{
	unless ( open ( I , "<$keyfile" ) )
	{
		print "ERROR: Can't read $keyfile: $!\n" ;
		exit 0 ;
	}

	while ( my $line = <I> )
	{
		########################################
		# trim spaces, skip empty lines and comments

		$line =~ s/\s+$// ;
		$line =~ s/^\s+// ;
		next unless ( $line ) ;
		next if ( $line =~ /^#/ ) ;

		########################################
		# split hostname and key

		my ( $h , $t , $k ) = split ( /\s+/ , $line , 3 ) ;

		########################################
		# lowercase and check hostname, ignore invalid hostnames

		$h = lc $h ;
		next unless hostname_is_valid ( $h , 1 ) ;

		########################################
		# make sure TTL value is sane

		if ( $t !~ /^\d+$/ )
		{
			print "Ignoring hostname \"$h\" with invalid TTL\n" ;
			next ;
		}

		if ( $t < 60 )
		{
			$t = 60 ;
		}

		########################################
		# remember hostnames with keys, ignore others

		if ( length ( $k ) > 0 )
		{
			$keys{$h} = $k ;
			$ttlv{$h} = $t ;
		}
		else
		{
			print "Ignoring hostname \"$h\" with no key\n" ;
		}
	}
	close I ;
}

###############################################################################
###############################################################################
###############################################################################
#
# read input from the pipe

my $line = <> ;
chomp $line ;
my ( $name , $ip , $key ) = split ( /\s+/ , $line , 3 ) ;

########################################
# sanity checks on input data

unless ( $name && $ip && ( length ( $key ) > 0 ) )
{
	print "ERROR: missing or invalid input\n" ;
	exit 0 ;
}

unless ( hostname_is_valid ( $name , 0 ) )
{
	exit 0 ;
}

unless ( ip_is_valid ( $ip ) )
{
	exit 0 ;
}

unless ( length ( $key ) > 0 )
{
	print "ERROR: empty or missing key\n" ;
	exit 0 ;
}

########################################
# make sure the name is on our list

readkeys() ;

$name = lc $name ;
unless ( exists $keys{$name} )
{
	print "ERROR: unknown name \"$name\" (key \"$key\") [$ip]\n" ;
	exit 0 ;
}

########################################
# make sure the key is correct

if ( $keys{$name} ne $key )
{
	print "ERROR: wrong key \"$name\" (key \"$key\") [$ip]\n" ;
	exit 0 ;
}

########################################
# make sure the IP changed
# if not, ignore the request

if ( open ( I , "<$datadir/$name" ) )
{
	my $line = <I> ;
	close I ;
	my @w = split ( /\:/ , $line ) ;
	if ( $w[1] eq $ip )
	{
		print "unchanged \"$name\" [$ip]\n" ;
		exit 0 ;
	}
}

########################################
# write the file with the new IP

my $ttl = $ttlv{$name} ;

unless ( open ( O , ">$datadir/$name" ) )
{
	print "ERROR: can't create $datadir/$name\n" ;
	exit 0 ;
}

print O "=$name:$ip:$ttl\n" ;
close O ;
chmod ( 0644 , "$datadir/$name" ) ;
print "Updated \"$name\" [$ip]\n" ;

########################################
# update the DNS data

unless ( exec $trigger )
{
	print "ERROR: exec \"$trigger\" failed\n" ;
}

exit 0 ;