#!/usr/bin/perl -w
#
# dnsmax.pl v1.0 - A dynamic DNS update client
#
# This program is currently compatible with the dnsmax.com and
# thatip.com DNS services.
#
# Copyright 2004 Algenta Technologies.
#
# 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
#


use strict;
use XML::Simple qw(:strict);
use Digest::MD5 qw(md5_hex);
use LWP::UserAgent;
use HTTP::Request::Common;
use HTTP::Response;


my $ifconfig = '/sbin/ifconfig';
my $protocol = "https";


#
# sub declarations
#
sub printUsage();
sub configure();
sub fetchHosts();
sub chooseHosts();
sub updateIP();

sub readConfig();
sub writeConfig();


sub getUserInput($$);



my $clientName = "dnsmax.pl";
my $clientVersion = "1.0.1";
my $protocolVersion = "2.0";


# *****************************************************************************
# Program execution
# *****************************************************************************


#
# If there are no arguments, show how to use the program.
#
if (@ARGV < 1)
{
	printUsage();
	exit();
}


#
# Determine the path of the configuration file to use.
# If one is not specified as the second parameter, 
# use dnsmax.conf in the working directory.
#
my $confFile = "dnsmax.conf";
if (@ARGV >= 2)
{
	$confFile = $ARGV[1];
}



#
# Determine whether the configuration file already exists,
# and read it if it does.
#
my $isNewConfig = 1;
my $config;
if (-e $confFile)
{
	$isNewConfig = 0;

	# Read the contents of the configuration file.
	$config = readConfig();
	
	#print Dumper($config);
}


#
# Execute the operation they specified.
#
if ($ARGV[0] eq "--configure")
{
	configure();
}

elsif ($ARGV[0] eq "--fetchhosts")
{
	fetchHosts();
}

elsif ($ARGV[0] eq "--choosehosts")
{
	chooseHosts();
}

elsif ($ARGV[0] eq "--updateip")
{
	updateIP();
}

else
{
	printUsage();
}



exit();


# *****************************************************************************
# End program execution, begin functions
# *****************************************************************************


#
# sub printUsage()
# Print usage information to standard output.
#
sub printUsage()
{
	print "\n";
	print "Usage:  dnsmax.pl MODE [configuration_file]\n";
	print "\n";
	print "Available Modes\n";
	print "\n";
	print "--configure   Create or edit a configuration file; set the account's\n";
	print "              user name, password, and other settings.\n";
	print "--fetchhosts  Retrieve the latest list of dynamic DNS records for\n";
	print "              the configured account. Determine which records\n";
	print "              should be updated when an IP change is detected.\n";
	print "--choosehosts Choose which hosts will be updated when an IP change is\n";
	print "              detected.\n";
	print "--updateip    Determine whether the network's IP has changed since the\n";
	print "              the last time it was checked, and send an update if\n";
	print "              necessary.\n";
	print "\n";
	print "If configuration_file is not specified, a file named dnsmax.conf located\n";
	print "in the working directory will be assumed.\n";
	print "\n";
}


#
# sub configure()
#
#
sub configure()
{
	#
	# Print some instructions.
	#
	print "\n";
	print "Configuring $confFile\n";
	print "\n";
	print "Please enter the appropriate settings for the following\n";
	print "items. If you see a value between brackets, you can simply\n";
	print "press enter to use that value.\n";
	print "\n";



	#
	# Set defaults based on the existing configuration.
	#
	my $defaultUsername = "";
	my $defaultPassword = "";
	my $defaultServerHost = "update.dnsmax.com";
	my $defaultServerPort = "443";
	my $defaultDoGatewayCheck = "no";
	my $defaultGatewayCheckPort = "22123";
	if (defined($config))
	{
		$defaultUsername = $config->{Accounts}->{Account}->{Username};
		$defaultServerHost = $config->{Accounts}->{Account}->{ServerHost};
		$defaultServerPort = $config->{Accounts}->{Account}->{ServerPort};
		$defaultDoGatewayCheck = 
			($config->{DoGatewayCheck} eq "true") ? "yes" : "no";
		$defaultGatewayCheckPort = $config->{GatewayCheckPort};
	}
		

	#
	# Go through all the settings and ask the user
	# what they should be. Use any existing settings
	# that we have read in as defaults.
	#
	my $username = getUserInput(
		"username @ service (e.g., username\@thatip.com or username\@dnsmax.com", 
		$defaultUsername);
	my $password = getUserInput("Password", $defaultPassword);
	my $serverHost = getUserInput("Update server", $defaultServerHost);
	my $serverPort = getUserInput("Update server port", $defaultServerPort);
	
	my $doGatewayCheck = getUserInput("Perform gateway check", $defaultDoGatewayCheck);
	$doGatewayCheck =  (substr(lc($doGatewayCheck), 0, 1) eq "y") ? "yes" : "no";

	my $gatewayCheckPort = $defaultGatewayCheckPort;
	if ($doGatewayCheck eq "yes")
	{
		$gatewayCheckPort = getUserInput("Port to use for gateway check", $defaultGatewayCheckPort);
	}
	
	#
	# Update the variables in our config object.
	#
	$config->{Accounts}->{Account}->{Username} = $username;
	$config->{Accounts}->{Account}->{Md5Password} = md5_hex($password);
	$config->{Accounts}->{Account}->{ServerHost} = $serverHost;
	$config->{Accounts}->{Account}->{ServerPort} = $serverPort;
	$config->{DoGatewayCheck} = ($doGatewayCheck eq "yes") ? "true" : "false";
	$config->{GatewayCheckPort} = $gatewayCheckPort;


	#
	# Write the configuration file.
	#
	writeConfig();
	print "Your configuration has been saved in $confFile.\n";


	#
	# If this is a new account, fetch the records from the server.
	#
	if ($isNewConfig == 1)
	{
		fetchHosts();
		chooseHosts();
	}
}


#
# sub fetchHosts()
#
#
sub fetchHosts()
{
	print "Fetching records from the server...\n";

	#
	# Make a copy of our current list of records.
	# We need this so we remember whether the records
	# that are still around should be set to update or not.
	#
	my @newRecords = ();
	my @oldRecords = ();
	if(exists $config->{Accounts}->{Account}->{Records}) {
		@oldRecords = @{$config->{Accounts}->{Account}->{Records}->{DnsRecord}};
	}
	
	# Get rid of the existing records now that we have a backup.
	$config->{Accounts}->{Account}->{Records} = ();


	#
	# Construct the URI of the update server.
	#
	my $updateServer = $config->{Accounts}->{Account}->{ServerHost};
	my $updatePort = $config->{Accounts}->{Account}->{ServerPort};

	if (!defined($updateServer) or !defined($updatePort))
	{
		print "The update server or port could not be determined.\n";
		print "Please make sure your configuration file is valid and that\n";
		print "you have specified an update server and port.\n";
		print "Please try running dnsmax.pl --configure.\n";
		die();
	}

	my $recordsUri = "$protocol://$updateServer:$updatePort/records/";
	print "Using $recordsUri\n";

	#
	# Make our HTTP request for the records.
	#
	my $ua = LWP::UserAgent->new;
	my $response = $ua->request(POST "$recordsUri",
                  [
					username => $config->{Accounts}->{Account}->{Username},
					passwordmd5 => $config->{Accounts}->{Account}->{Md5Password},
					clientname => $clientName,
					clientversion => $clientVersion,
					protocolversion => $protocolVersion,
					contenttype => "text/plain",
				  ]
	          );


	#
	# Parse the response to create our list of current records.
	#
	if (!$response->is_success)
	{
		print "There was a problem fetching your records from the server.\n";
		print $response->status_line . "\n";
		exit();
	}

	# Split on a colon. We need exactly two fields.
	my @lines = split(/\n/, $response->content);
	foreach my $line (@lines)
	{
		my ($key, $val) = split(/:/, $line);

		if ($key eq "serial")
		{
			$config->{Accounts}->{Account}->{Serial} = $val;
		}
		elsif($key eq "record")
		{
			# Split this by tabs. We need at least 3 tokens.
			# <recordid> <record name> <record type> <optional group>
			my @tokens = split(/\t/, $val);

			my $numTokens = @tokens;
			if ($numTokens < 4)
			{
				print "Invalid record. $val\n";
				next;
			}

			# Create a new record and set the properties.
			my $record;
			$record->{Id} = $tokens[0];
			$record->{Host} = $tokens[1];
			$record->{Zone} = $tokens[2];
			$record->{Type} = $tokens[3];
			$record->{Dynamic} = 'true';
			$record->{Update} = 'false';

			# Set the group if appropriate.
			if ($numTokens >= 5)
			{
				$record->{Group} = $tokens[4];
			}

			push(@newRecords, $record);
		}
		elsif($key eq "errorcode")
		{
			print "Error code: $val\n";
		}
		elsif($key eq "errortext")
		{
			print "Error details: $val\n";
		}
		else
		{
			print "Unknown response. $key: $val\n";
		}
	}


	#
	# Go through the list of current records. If the same record
	# existed before this fetch, set whether to update it to
	# whatever it was set to previously.
	#
	foreach my $newRecord (@newRecords)
	{
		# Loop through the old records to see if any match this one.
		foreach my $oldRecord (@oldRecords)
		{
			if ($newRecord->{Id} == $oldRecord->{Id} and
				$newRecord->{Host} eq $oldRecord->{Host} and
				$newRecord->{Zone} eq $oldRecord->{Zone} and
				$newRecord->{Type} eq $oldRecord->{Type})
			{
				$newRecord->{Update} = $oldRecord->{Update};
			}
		}
	}


	#
	# Save the updated configuration.
	#
	$config->{Accounts}->{Account}->{Records}->{DnsRecord} = \@newRecords;
	writeConfig();
}


#
# sub chooseHosts()
#
#
sub chooseHosts()
{
	#
	# Display a list of hosts and whether they are set to be updated.
	#
	print "\n";
	print "Dynamic DNS records\n";
	print "\n";
	printRecordList();


	#
	# Prompt for input. Input should either be a hostname to toggle
	# or the word "list" or "done" or "all" or "none".
	#
	print "\n";
	print "To toggle updates, type the full record or group name and press enter.\n";
	print "Type 'all' to set all records to update, or 'none' to set none to update.\n";
	print "Type 'done' when you are finished.\n";

	my $input = '';
	while ($input ne 'done')
	{
		$input = getUserInput('?', '');

		if ($input eq "done")
		{
			last;
		}
		elsif ($input eq "list")
		{
			printRecordList();
			print "\n";
		}


		# Go through each record and set it as appropriate.
		my @records = @{$config->{Accounts}->{Account}->{Records}->{DnsRecord}};
		foreach my $record (@records)
		{
			if ($input eq "all") {
				$record->{Update} = "true";
			}
			elsif ($input eq "none") {
				$record->{Update} = "false";
			}
			elsif (defined($record->{Group}) and $input eq $record->{Group}) {
				$record->{Update} = $record->{Update} eq "true" ? "false" : "true";
			}
			else {
				if ($record->{Host} eq "@") {
					if ($input eq $record->{Zone}) {
						$record->{Update} = $record->{Update} eq "true" ? "false" : "true";
					}
				}
				else {
					if ($input eq $record->{Host} . '.' . $record->{Zone}) {
						$record->{Update} = $record->{Update} eq "true" ? "false" : "true";
					}
				}
			}
		}
	}


	print "\n";
	
	#
	# Write the configuration file with the updated information.
	#
	writeConfig();
}

#
# sub printRecordList()
# Print a list of the records and groups.
#
sub printRecordList()
{
	my @records = @{$config->{Accounts}->{Account}->{Records}->{DnsRecord}};
	my %listedGroups = ();
	
	foreach my $record (@records)
	{
		my $showRecord = 1;

		# If this record is in a group, see if we have already listed the group name.
		# If we haven't, then list it and remember that fact.
		if (defined($record->{Group}))
		{
			if (!defined($listedGroups{$record->{Group}}))
			{
				print $record->{Group} . " (Group)";

				$listedGroups{$record->{Group}} = 1;
			}
			else
			{
				$showRecord = 0;
			}
		}
		else
		{
			my $fullName = "";
			if ($record->{Host} eq "@")
			{
				$fullName = $record->{Zone};
			}
			else
			{
				$fullName = $record->{Host} . "." . $record->{Zone};
			}

			print $fullName;
		}
	
		if ($showRecord == 1)
		{
			if ($record->{Update} eq 'true') 
			{
				print " (Updates on)";
			}
			else
			{
				print " (Updates off)";
			}
			
			print "\n";
		}

	}

	print "\n";
}


#
# sub updateIP()
#
#
sub updateIP()
{
	#
	# Go through the list of hosts and determine which ones
	# need to be updated. If no hosts need to be updated, 
	# then we don't need to do this.
	#
	my $hasRecordToUpdate = 0;
	my %addedGroups = ();
	my @updateIds = ();
	my @updateGroups = ();
	
	if(!exists $config->{Accounts}->{Account}->{Records}) {
		print "No records are known.\n";
		print "You can create records in the management website.\n";
		print "Please use dnsmax.pl --fetchhosts to download your records.\n";
		return;		
	}
	
	foreach my $record (@{$config->{Accounts}->{Account}->{Records}->{DnsRecord}})
	{
		# If this record is marked to be updated
		if ($record->{Update} eq "true")
		{
			# if this is a single record
			if (!defined($record->{Group}))
			{
				$hasRecordToUpdate = 1;
				push(@updateIds, $record->{Id});
			}
			else
			{
				if (!defined($addedGroups{$record->{Group}}))
				{
					$hasRecordToUpdate = 1;
					push(@updateGroups, $record->{Group});
					$addedGroups{$record->{Group}} = 1;
				}
			}
		} # update set to true
	} #foreach record

	# If there are not any records to update, get out of here.
	if ($hasRecordToUpdate != 1)
	{
		print "None of your records are set to be updated.\n";
		print "Please use dnsmax.pl --choosehosts to enable some records.\n";
		return;
	}


	#
	# Determine whether the IP has changed since the last time
	# this was called. If not, we don't need to send an update.
	#
	print "Checking for an IP address change...\n";
	my $ipChanged = 0;
	my $lastIP = $config->{LastIP};
	if(!exists  $config->{LastIP}) {
		$ipChanged = 1;
	}

	my $ipoutput = `$ifconfig`;
	my @iplines = split(/\n/, $ipoutput);

	foreach my $line (@iplines)
	{
		if ($line =~ /addr:\s*(\w+[.:]+\w+[.:]\w+[.:]\w+)/)
		{
			my $ip = $1;
			if ($ip =~/^127./ or 
			    $ip =~ /^10./ or 
				$ip =~ /^192.168./ or 
				$ip =~ /^172./ or
				$ip =~ /^fe80/)
			{
				next;
			}
			
			if (!defined($lastIP) or $lastIP ne $ip)
			{
				$ipChanged = 1;
				$config->{LastIP} = $ip;
				writeConfig();
				last;
			}
		}
	}

	if ($ipChanged != 1)
	{
		print "Your IP address is already up to date.\n";
		return;
	}

	print "Updating records...\n";


	#
	# Build the URI for the update request.
	#
	my $updateServer = $config->{Accounts}->{Account}->{ServerHost};
	my $updatePort = $config->{Accounts}->{Account}->{ServerPort};

	if (!defined($updateServer) or !defined($updatePort))
	{
		print "The update server or port could not be determined.\n";
		print "Please make sure your configuration file is valid and that\n";
		print "you have specified an update server and port.\n";
		print "Please try running dnsmax.pl --configure.\n";
		die();
	}

	my $updateUri = "$protocol://$updateServer:$updatePort/update/";


	#
	# Make the update request.
	#
	my $ua = LWP::UserAgent->new;
	my $updateRequest = POST "$updateUri", 
                 [ 
					'username' => $config->{Accounts}->{Account}->{Username},
					'passwordmd5' => $config->{Accounts}->{Account}->{Md5Password},
					'clientname' => $clientName,
					'clientversion' => $clientVersion,
					'protocolversion' => $protocolVersion,
					'contenttype' => "text/plain",
				 ] ;
	
	# Add the appropriate IDs and Groups to the request.
	foreach my $updateid (@updateIds)
	{
		$updateRequest->add_content("&updateid[]=$updateid");
	}
	foreach my $updategroup (@updateGroups)
	{
		$updateRequest->add_content("&updategroup[]=$updategroup");
	}

	# We need to fix the content length, as add_content apparently
	# doesn't take care of that.
	$updateRequest->header("Content-Length" => length(${$updateRequest->content_ref}));
	my $response = $ua->request($updateRequest);

	
	#
	# Give some output based on the response.
	#
	if (!$response->is_success)
	{
		print "There was a problem updating your hosts.\n";
		print $response->status_line . "\n";
		exit();
	}

	my @lines = split(/\n/, $response->content);
	foreach my $line (@lines)
	{
		my ($key, $val) = split(/:/, $line);

		if ($key eq "serial")
		{
			# Compare this serial number to the one we have recorded.
			# If they are different, instruct the user to update the 
			# records list.
			if ($val ne $config->{Accounts}->{Account}->{Serial})
			{
				print "Your local record list appears to be out of date.\n";
				print "Please use dnsmax.pl --fetchhosts to update your list.\n";
			}
		}
		elsif ($key eq "remoteip")
		{
			print "Your records have been updated to point to $val.\n";

			# Update our last known IP.
			$config->{LastIP} = $val;
			writeConfig();
		}
		elsif($key eq "errorcode")
		{
			print "Error code: $val\n";
		}
		elsif($key eq "errortext")
		{
			print "Error details: $val\n";
		}
		else
		{
			print "Unknown response. $key: $val\n";
		}
	}
}


#
# sub readConfig()
#
#
sub readConfig()
{
	#return XMLin($confFile, KeyAttr => { DNSRecord => "Id" },
	#	                    ForceArray => ["DNSRecord"] );
	return XMLin($confFile, KeyAttr => [],
		                    ForceArray => [qw(DnsRecord )] );	                    
}


#
# sub writeConfig()
#   
#
sub writeConfig()
{
	XMLout($config, RootName => "AppConfiguration",
	                          XMLDecl => "<?xml version=\"1.0\"?>",
	                          NoAttr => 1,
	                          KeyAttr => { DNSRecord => "Id"},
							  OutputFile => $confFile);
}


#
# sub getUserInput
#  $label: text with which to prompt the user.
#  $default: the default value in case the user just presses enter.
#
sub getUserInput($$)
{
	my ($label, $default) = @_;

	my $input = "";
	while ($input eq "")
	{
		print "$label [$default]:  ";
		$input = <STDIN>;

		chop $input;
		if ($input eq "")
		{
			$input = $default;
		}
	}

	return $input;
}