#!/usr/bin/perl
#
# zyxel-dsl-dyndns-update.pl
#
# This script logs in to a ZyXEL DSL router, fetches its
# current IP addres on the WAN interface and updates a dyndns.org
# account if necessary.
# Usually it is run in a regular interval, e.g. as cron job.
#
# Written by Marc Liyanage <liyanage@access.ch>
#

use strict;
use Net::Telnet;
use IO::Socket;


# ------- Customize this -----------

#use constant STATUSFILE => 'Macintosh HD:System Folder:Preferences:dyndns.txt';
use constant STATUSFILE => '/etc/dyndns.txt';

use constant DYNDNS_HOSTNAME => 'yourhost.dyndns.org';
use constant DYNDNS_USER     => 'yourusername';
use constant DYNDNS_PASS     => 'yourpassword';

use constant ZYXEL_IP        => '192.168.1.1';		# IP address of the ZyXEL's LAN interface
use constant ZYXEL_PASS      => 'verysecret';			# Telnet password of the ZyXEL router

# ------- Should not need to customize below --------


use constant MAX_IDLE_DAYS => 25;


# Check if a status file exists and create one if necessary.
# Fetch the result, which is a hash ref with the data contained in the
# existing status file.
#
my $data = &open_statusfile(STATUSFILE);

die "Unable to open statusfile" unless ref($data);

my $current_ip = &get_ip_address();


# How many days have passed since we last updated the dyndns database?
#
my $idle_days = int((time() - $data->{update_timestamp}) / (60*60*24));

# Did our WAN IP address change since we last updated the dyndns database?
#
my $ip_is_unchanged = defined($data->{last_ip}) && $current_ip eq $data->{last_ip};

# Did the dyndns server instruct us to wait the last time we
# tried to update it?
#
my $wait_until = defined($data->{wait_until}) ? $data->{wait_until} : 0;
my $must_wait = time() < $wait_until;



if ($must_wait) {

	my $delay = $wait_until - time();
	print STDERR "Will not update, instructed to wait for $delay second(s) by server!\n";	
	exit;
}


# Only try to update the dyndns database if either the address changed
# or we haven't "touched" it for a long time. This is the only case
# where we are allowed to update our entry in the DB even if the address
# didn't change
#
unless ($ip_is_unchanged and $idle_days < MAX_IDLE_DAYS) {

	print STDERR "Registering new IP address, current is \"$current_ip\", previous is \"$data->{last_ip}\"\n";
	
	my $result = &update_dyndns($data, DYNDNS_HOSTNAME, $current_ip, DYNDNS_USER, DYNDNS_PASS);

	die "Unable to update dyndns.org database" unless ($result);

	$data->{last_ip} = $current_ip;
	$data->{update_timestamp} = time();
	
	# Update the status file with the new information,
	# which might be the timestamp, a time to wait etc.
	#
	$result = &write_statusfile(STATUSFILE, $data);

} else {
	
	print STDERR "Will not update, IP address is unchanged ($current_ip) and has been\nfor less days than the refresh threshold ($idle_days < " . MAX_IDLE_DAYS . ")\n";
	
}


# End of main program, various subroutines follow here


# Get the ZyXEL router's current WAN interface IP address.
#
# Usage: 
#
# my $ip_address = &get_ip_address();
#
# This uses two global constants, ZYXEL_IP and ZYXEL_PASS
#
sub get_ip_address {

	my $host = ZYXEL_IP;
	my $password = ZYXEL_PASS;
	
	# Open a telnet connection to the router.
	#
	my $t = new Net::Telnet (Timeout => 10, Prompt => '/> /');
	$t->open($host);

	# Login to the router using the given username and password.
	# Note that we append the string "NetMan" to the password.
	# This causes the router to start the session in command-line
	# mode instead of the "graphical" user-friendly version.
	# The former is of course easier to script against.
	#
	$t->waitfor('/Password:/');
	$t->print($password . 'NetMan');
	$t->waitfor('/>/');

	# Issue the command "ip ifconfig wanif0" on the command line.
	# Filter the resulting array of lines, we're only interested
	# in the one that contains the word "inet" because that one contains
	# our IP address.
	#
	my ($line) = grep {$_ =~ /inet/} $t->cmd('ip ifconfig wanif0');

	# Match against the regex to finally get the IP address
	#	
	my ($ip) = $line =~ /inet (\d+\.\d+\.\d+\.\d+)/;

	return $ip;    
    
}



# Update the dyndns database with our current information.
# 
# Usage:
#
#    my $result = &update_dyndns($data, $hostname, $ip, $user, $pass);
#
# where
#
#    $data     = the data hash ref that &open_statusfile() returned previously
#    $hostname = the dyndns hostname to update
#    $ip       = the new IP address
#    $user     = the username of the dyndns account
#    $password = the password of the dyndns account
#
sub update_dyndns {

	my ($data, $hostname, $ip, $user, $pass) = @_;

	# Encode the username/password in base64 and construct
	# the HTTP headers for a GET request to the dyndns
	# web server
	#
	my $auth_string = &old_encode_base64("$user:$pass", '');
	my $request_headers = join("", map {"$_\015\012"} 
		"GET /nic/update?system=dyndns&hostname=$hostname&myip=$ip HTTP/1.1",
		'Host: members.dyndns.org',
		"Authorization: Basic $auth_string",
		'User-Agent: dyndns_update.pl/1.0 liyanage@access.ch',
		'',
	);

	# Open a socket connection to the dyndns web server
	#
	my $sock = IO::Socket::INET->new(
		PeerAddr => 'members.dyndns.org',
		PeerPort => '80',
		Proto    => 'tcp'
	);

	return undef unless($sock);

	# Try to send our GET request to the server, abort upon failure
	#
	my $bytes_written = $sock->syswrite($request_headers, length($request_headers));
	return undef unless($bytes_written == length($request_headers));

	# We were able to send the request, now read the response
	#
	my ($response, $input_buffer);
	while ($sock->sysread($input_buffer, 1000)) {

		$response .= $input_buffer;

	}


	# Split the response at the CRLFCRLF sequence which
	# separates HTTP headers and content
	#
	my ($response_headers, $response_body) = $response =~ /^(.+)\015\012\015\012(.+)$/s;

	# Split both into arrays
	#
	my @response_headers = split(/\015\012/, $response_headers);
	my @response_body = split(/\015\012/, $response_body);

	# Read out the first body line and store it into the $data
	# hash ref
	#
	my $return_code = $response_body[1];
	$data->{last_return_code} = $return_code;

	# Zap wait_until value if there was one
	#
	delete($data->{wait_until});

	# Look at the return code
	#
	if ($return_code =~ /good/i) {
		
		# Return code indicates that the operation was successful, return true
		#
		return 1;

	} elsif ($return_code =~ /^w(\d+)(h|m|s)/) {

		# Return code indicates that we were instructed to wait
		# for a certain time period. Parse the value, store it into 
		# the $data hash ref and return true
		#
		my $delay = $1;
		my $time_unit = $2;
		
		$delay *= 60 if ($time_unit =~ /m/i);
		$delay *= 3600 if ($time_unit =~ /h/i);

		$data->{wait_until} = time() + $delay;
		return 1;

	} elsif ($return_code =~ /^wu(\d\d)(\d\d)/) {

		# Return code indicates that we were instructed to wait
		# until a certain time in the future. Parse the value, store it into 
		# the $data hash ref and return true
		#
		my ($hours, $minutes) = ($1, $2);

		my ($gm_hour, $gm_minute) = (gmtime(time()))[2, 1];

		my $delay += ($hours - $gm_hour) * 3600;
		$delay += ($minutes - $gm_minute) * 60;

		$data->{wait_until} = time() + $delay;
		return 1;
	}
	
	# Return code was something else which we didn't
	# understand, return false to the caller to indicate failure.
	#
	return 0;

}



# Open and read (or create if not yet there) the statusfile
# and return a hash ref with the key/value pairs in the file
# 
# Usage:
#
#    my $data_ref = &open_statusfile($filename);
# 
# returns a hash ref when successful and undef upon failure.
#
sub open_statusfile {

	my ($filename) = @_;
	
	return undef unless ($filename =~ /\w+/);

	# Initialize the hash ref
	#
	my $data = {};
	
	if (-f $filename) {
		
		# Status file exists, try to read it
		#
		unless (open(FILE, $filename)) {
			
			print STDERR "Unable to open Statusfile \"$filename\"\n";
			return undef;

		}
		
		$data = {map {$_ =~ /^(.+)\t(.+)$/; ($1 => $2)} grep {$_ =~ /\S+/} <FILE>};
		
		close(FILE);
		
		return $data;		
		
	} else {

		# Status file does not yet exist, try to create it
		#
		unless (&write_statusfile($filename, $data)) {
			
			print STDERR "Unable to create Statusfile \"$filename\"\n";
			return undef;

		}
		
		return $data;		

	}


}


# Write the contents of our data hash back out
# to the data file
# 
# Usage:
#
#    my $result = &write_statusfile($filename, $data_ref);
#
sub write_statusfile {

	my ($filename, $data) = @_;
	
	return undef unless ($filename =~ /\w+/);
	return undef unless (ref($data) =~ /HASH/);
		
	# Status file exists, try to read it
	#
	unless (open(FILE, ">$filename")) {
		
		print STDERR "Unable to write open Statusfile \"$filename\"\n";
		return undef;

	}
	
	print FILE join("\n", map {"$_\t$data->{$_}"} keys(%$data));

	close(FILE);

	return 1;
}






# This stuff taken straight from MIME::Base64
#
use integer;

sub old_encode_base64 ($;$)
{
    my $res = "";
    my $eol = $_[1];
    $eol = "\n" unless defined $eol;
    pos($_[0]) = 0;                          # ensure start at the beginning
    while ($_[0] =~ /(.{1,45})/gs) {
	$res .= substr(pack('u', $1), 1);
	chop($res);
    }
    $res =~ tr|` -_|AA-Za-z0-9+/|;               # `# help emacs
    # fix padding at the end
    my $padding = (3 - length($_[0]) % 3) % 3;
    $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
    # break encoded string into lines of no more than 76 characters each
    if (length $eol) {
	$res =~ s/(.{1,76})/$1$eol/g;
    }
    $res;
}