#!/usr/bin/perl -w
######################################################################
# $Header: /home/paul/src/ddclient/RCS/ddclient,v 1.7 2000/04/22 14:32:29 root Exp $
#
# DDCLIENT - a Perl client for updating DynDNS information
#
# Author: Paul Burry (pburry@canada.com)
######################################################################
use strict;
use Getopt::Long;
use IO::Socket;

my $program  = $0;
my $version  = "2.3";
$program =~ s%^.*/%%;
my %cfg;
my %cache;
my %cached = (
	'host'     => 1, 
	'ip'       => 1, 
	'mx'       => 1, 
	'backupmx' => 1, 
	'wildcard' => 1,
	'static'   => 1,
	'time'     => 1,
);
my $read = 0;
my @opt = (
	"usage: ${program} [options]",
	"options are:",
	[ "proxy",    "=s", "",                    "-proxy host      : use 'host' as the HTTP proxy" ],
	[ "server",   "=s", "members.dyndns.org",  "-server host     : update DNS information on 'host'" ],
	[ "file",     "=s", "/etc/ddclient.conf",  "-file path       : load configuration information from 'path'" ],
	[ "cache",    "=s", "/etc/ddclient.cache", "-cache path      : record address used in 'path'" ],
	"",
	[ "login",    "=s", "",                    "-login user      : login as 'user'" ],
	[ "password", "=s", "",                    "-password secret : use password 'secret'" ],
	[ "host",     "=s", "",                    "-host host       : update DNS information for 'host'" ],
	[ "ip",       "=s", undef,                 "-ip address      : set the IP address to 'address'" ],
	[ "mx",       "=s", undef,                 "-mx address      : set the mail exchanger to 'address'" ],
	[ "backupmx", "!",  undef,                 "-{no}backupmx    : enable backup mail exchanger" ],
	[ "wildcard", "!",  undef,                 "-{no}wildcard    : enable wildcard DNS matches" ],
	[ "static",   "!",  undef,                 "-(no)static      : update a static DNS entry, not a dynamic one" ],
	"",
	[ "persist",  "=i", 15,                    "-persist days    : avoid unnecessary updates unless 'days' days have elapsed" ],
	[ "retry",    "!",  0,                     "-{no}retry       : record failed updates so they may be retried with -refresh" ],
	[ "force",    "!",  0,                     "-{no}force       : force an update even if the update may be unnecessary" ],
	[ "timeout",  "=i", 120,                   "-timeout max     : wait at most 'max' seconds for the host to respond" ],
	[ "refresh",  "!",  0,                     "-{no}refresh     : update hosts and addresses listed in the cache file." ],
	[ "debug",    "!",  0,                     "-{no}debug       : print {no} debugging information" ],
	[ "exec",     "!",  1,                     "-{no}exec        : do {not} execute; just show what would be done" ],
	[ "verbose",  "!",  0,                     "-{no}verbose     : print {no} verbose information" ],
	[ "quiet",    "!",  0,                     "-{no}quiet       : print {no} messages for unnecessary updates" ],
  	[ "help",     "",   "",			   "-help            : this message" ],
	"",
	"Examples:",
	"  ${program} -ip 192.168.1.1 -retry",
	"  -- set the ip address of all dyndns hosts listed in the /etc/ddclient.conf to 192.168.1.1",
	"  -- mark failures so they may be retried with -refresh",
	"",
	"  ${program} -ip 192.168.1.1 -host somehost.dyndns.org",
	"  -- set the address of somehost.dyndns.org to 192.168.1.1",
	"  -- use the login and password specified for this host in the configuration file",
	"",
	"  ${program} -ip 192.168.1.1 -host statichost.dyndns.org -static",
	"  -- set the address of statichost.dyndns.org to 192.168.1.1 in the static DNS database",
	"  -- use the login and password specified for this host in the configuration file",
	"",
	"  ${program} -refresh -host somehost.dyndns.org",
	"  ${program} -refresh -host somehost.dyndns.org",
	"  -- refresh only the address of somehost.dyndns.org",
	"  -- use the login and password specified for this host in the configuration file",
	"",
	"  ${program} -refresh -force -retry",
	"  -- refresh all dyndns hosts listed in the /etc/ddclient.conf",
	"  -- force an update even if it may be unneccessary",
	"  -- mark failed updates for retrying later",
	"     (failed updates are those that fail due to connectivity errors)",
	"  -- use the login and password specified for this host in the configuration file",
	"  [this command could be used twice a month to make sure the host does not become stale]",
	"",
	"  ${program} -refresh -retry",
	"  -- refresh all dyndns hosts listed in the /etc/ddclient.conf that could not be updated",
	"     (hosts that do not require update will be skipped)",
	"  -- mark failed updates for retrying later",
	"     (failed updates are those that fail due to connectivity errors)",
	"  -- use the login and password specified for this host in the configuration file",
	"  [this command could be used twice a month to make sure the host does not become stale]",
	"",
	"The configuration file contains like:",
	"  # Host                 login        password",
	"  somehost.dyndns.org    dyndns_login dyndns_password",
	"  anotherhost.dyndns.org dyndns_login dyndns_password",
	"",
	"Comments in the configuration file begin with either a '#' or ';'.",
	"Blank lines are ignored.",
	"",
	"ddclient version $version, written by Paul Burry, pburry\@canada.com",
);

## process args
my ($opt_usage, %opt) = process_args(@opt);
$opt{'verbose'} = 1 if $opt{'debug'};
$opt{'quiet'}   = 1 if $opt{'verbose'};
$opt{'verbose'} = 1 if ! $opt{ 'exec' };
usage() unless $opt{'ip'} || $opt{'refresh'};

## sanity check
$opt{'persist'} *= 24*60*60;
$opt{'persist'}  = 0 if $opt{'persist'} < 0;
$opt{'timeout'}  = 0 if $opt{'timeout'} < 0;

## read configuration
%cfg = read_config($opt{'file'});

## canonify addresses
foreach my $o ('server', 'proxy', 'host') {
    $opt{$o} =~ s%^http://%%i;
    $opt{$o} =~ s%/+$%%;
}

## unbuffer stdout
$| = 1;

## update according to the command-line or configuration file
my $result = 'OK';
my %args;
if ($opt{'host'}) {
    %args   = lookup($opt{host});
    $result = update_cache(%args);
} else {
    my $r;
    my @hosts = keys %cfg;

    foreach my $host (keys %cfg) {
        %args = lookup($host);
    	$r    = update_cache(%args);
	$result = $r if $r ne 'OK';
    }
}
exit ($result ne 'OK');


######################################################################
## lookup - login and password for a host
######################################################################
sub lookup {
    my $host     = shift;
    my $login    = "";
    my $password = "";
    my %args     = %opt;

    if (exists $cfg{$host}) {
	$login    = $cfg{$host}->{'login'};
	$password = $cfg{$host}->{'password'};
    }
    $login    = $opt{'login'}     if $opt{'login'};
    $password = $opt{'password'}  if $opt{'password'};

    $args{'host'}     = $host;
    $args{'login'}    = $login;
    $args{'password'} = $password;

    return %args;
}
######################################################################
## update - a host given a login and password
######################################################################
sub update {
    my ($host, $login, $password) = @_;
    my %args   = @_;
    my $result = 'NOCONNECT';

    if ($args{'host'} eq "") {
	warning("null host name specified.");

    } elsif ($args{'login'} eq "") {
	warning("null login name specified for host $args{host}.");

    } elsif ($args{'password'} eq "") {
	warning("null password specified for host $args{host} login $args{login}");

    } else {
	my $auth = encode_base64("$args{login}:$args{password}");
	my $request;
	$request  = "GET ";
	$request .= "http://$args{server}" if $args{'proxy'};
	$request .= "/nic/" . ($args{'static'} ? "statdns" : "dyndns" );
	$request .= "?action=edit&started=1&hostname=YES&host_id=$args{host}";
	$request .= "&myip=$args{ip}"  if $args{'ip'};
	$request .= "&wildcard=ON"     if $args{'wildcard'};
	if ($args{'mx'}) {
	    $request .= "&mx=$args{'mx'}";
	    $request .= "&backmx=" . ($args{'backupmx'} ? "YES" : "NO");
	}
	$request .= " HTTP/1.0\n";
	$request .= "Host: $args{'server'}\n";
	$request .= "Authorization: Basic $auth";
	$request .= "Content-Type: application/x-www-form-urlencoded\n";
	$request .= "User-Agent: ${program}/${version}\n\n";
	
	## connect the server (or proxy if it was specified)
	my $peer = $args{'proxy'} || $args{'server'};
	my $port = $peer;
	$port =~ s/.*:(\d+)$/$1/;
	$port = 80 unless $port =~ /^\d+$/;
	
	verbose("CONNECT:", "$args{'server'}%s to update $args{host}.", $args{'proxy'} ? " via proxy $args{proxy}" : "");
	if (! $opt{'exec'} ) {
	    verbose("SENDING:", $request);
	    $result = 'OK';
	} else {
	    my $sd;
	    {
		local $^W = 0;
		$sd = IO::Socket::INET->new(
					    PeerAddr => $peer,
					    PeerPort => $port,
					    Proto    => 'tcp')
		    or fatal("cannot connect to $peer: socket: $@");
	    }	
	    ## send the requet to the DynDNS server
	    verbose("SENDING:", $request);
	    
	    ## make sure newlines are <cr><lf> for some pedantic proxy servers
	    my $rq;
	    ($rq = $request) =~ s/\n/\r\n/g;
	    $result = send $sd, $rq, 0;
	    if ($result != length($rq)) {
		warning("cannot send to $host%s ($!).", $args{'proxy'} ? " via proxy $args{proxy}" : "");
		$result = 'NOCONNECT';
	    } else {
		## read the reply back
		my $title       = "";
		my $return_code = "";
		my $error_code  = "";
		my $reply       = "";
		alarm($args{'timeout'}) if $args{'timeout'} > 0;
		while (<$sd>) {
		    debug("read: $_");
		    $reply .= $_;

		    $title       = $1 if m%<TITLE>\s*(.*)\s*</TITLE>%i;
		    $return_code = $1 if m%^return\s+code\s*:\s*(.*)\s*$%i;
		    $error_code  = $1 if m%^error\s+code\s*:\s*(.*)\s*$%i;
		    
		    last if $reply =~ m%</HTML>%i;
		}
		alarm(0) if $args{'timeout'} > 0;
		close($sd) || die "close: $!";

		if ($return_code ne 'NOERROR' || $error_code ne 'NOERROR') {
		    msg("SENT:", $request) unless $opt{'verbose'};
		    msg("REPLIED:", $reply);
		    msg("FAILED:", "updating $args{host}: $title");
		    $result = 'FAILED';
		} else {
		    msg("SUCCESS:", "updating $args{host}: $title");
		    $result = 'OK';
		}
	    }
	}
    }
    return $result;
}

######################################################################
## encode_base64 - from MIME::Base64
######################################################################
sub 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;
}
######################################################################
## msg
## verbose
## debug
## warning
## fatal
######################################################################
sub msg {
    my $prefix = shift;
    my $format = shift;
    my $buffer = sprintf $format, @_;
    chomp($buffer);

    if ($prefix) {
	$buffer = "$prefix $buffer";
    	$buffer =~ s/\n/\n$prefix /g;
    }
    print "$buffer\n";
}
sub verbose { msg(@_)             if $opt{'verbose'};	}
sub debug   { msg("DEBUG:  ", @_) if $opt{'debug'};	}
sub warning { msg("WARNING:", @_);			}
sub fatal   { msg("FATAL:  ", @_); exit(1);		}
######################################################################
## usage
######################################################################
sub usage {
    print $opt_usage;
    exit 1;
}
######################################################################
## process_args - 
######################################################################
sub process_args {
    my @spec  = ();
    my $usage = "";
    my %opts  = ();
    
    foreach (@_) {
	if (ref $_) {
	    my ($key, $specifier, $value, $arg_usage) = @$_;
	    
	    ## add a option specifier
	    push @spec, $key . $specifier;
	    
	    ## define the default value which can be overwritten later
	    $opt{$key} = $value;
	    
	    ## add a line to the usage;
	    $usage .= "  $arg_usage";
	    if (defined($value) && $value ne '') {
		$usage .= " (default: ";
		if ($specifier eq '!') {
		    $usage .= "no" if ($specifier eq '!') && !$value;
		    $usage .= $key;
		} else {
		    $usage .= $value;
		}
		$usage .= ")";
	    }
	    $usage .= ".";
	} else {
	    $usage .= $_;
	}
	$usage .= "\n";
    }
    ## process the arguments
    if (! GetOptions(\%opt, @spec)) {
	$opt{"help"} = 1;
    } elsif (! $opt{'file'}) {
	$opt{"help"} = 1;
    }
    if ($opt{"help"}) {
	print $usage;
	exit 1;
    }
    return ($usage, %opt);
}
######################################################################
## print_args
######################################################################
sub print_args {
    return unless $opt{'debug'};
    
    debug("==== options ====");
    foreach my $key (sort keys %opt) {
	my $value = $opt{$key};
	
	if (ref $value) {
	    $value = join(' ', sort keys %$value);
        } elsif (! defined $value) {
	    $value = "UNDEFINED";
	}
	debug("%20s : %s", "\$opt{$key}", $value);
    }
}
######################################################################
## read_config
######################################################################
sub read_config {
    my $file   = shift;
    my %config = ();
    
    local *FD;
    open(FD, $file) or die "${program}: cannot open configuration file '$file', $!";
    while (<FD>) {
	chomp;
	s/^\s*//;
	s/^\s*$//;
	next if /^[;#]/ || /^$/;
	
	my ($host, $login, $password) = split /\s+/;
	$config{$host} = {
	    'host'     => $host,
	    'login'    => $login,
	    'password' => $password 
	};
    }
    close(FD);
    return %config;
}
######################################################################
## update_cache
######################################################################
sub update_cache {
    my %args   = @_;
    my $host   = $args{'host'};
    my $force  = $opt{'force'};
    my $result = 'OK';

    ## read cache and configuration
    if (!$read) {
	$read  = 1;
	read_cache($opt{'cache'});
    }

    if (exists $cache{$host}) {
	my %values = %{$cache{$host}};
        if ($opt{'refresh'}) {
	    map { $args{$_} = $values{$_} unless defined $args{$_}} keys %values;
        } 
    	$force = 1 if (time - $values{'time'}) >= $opt{'persist'};
	foreach my $c (keys %cached) {
	    next if $c eq 'time';
    	    $force = 1 if defined($args{$c}) && $values{$c} ne $args{$c};
	}
    }
    if (!$force && exists $cache{$host}) {
	msg("SUCCESS:", "host $host was already set to $args{'ip'}") unless $opt{'quiet'};

    } elsif (!defined($args{'ip'}) || !$args{'ip'}) {
	debug("$host has no ip address to set");

    } elsif (($result = update(%args)) eq 'OK') {
	$cache{$host} = { %args, time => time };
	write_cache($opt{'cache'});

    } elsif ($args{'retry'} && ($result eq 'NOCONNECT')) {
        warning("$host was not set to $args{'ip'}, use -refresh to retry later");
    	$cache{$host} = { %args, time => 0 };
        write_cache($opt{'cache'});

    } elsif (exists $cache{$host}) {
        warning("$host was not set to $args{'ip'}, removing entry from cache");
	delete $cache{$host};
	write_cache($opt{'cache'});

    } else {
        debug("$host was not set to $args{'ip'}");
    }
    return $result;
}
######################################################################
## read_cache
######################################################################
sub decode { return                    $_[0] eq 'none' ? ''     : $_[0]; }
sub encode { return !defined($_[0]) || $_[0] eq ''     ? 'none' : $_[0]; }

sub read_cache {
    my $file   = shift;
    my $warned = 0; 

    %cache     = ();
    local *FD;
    if (open(FD, $file)) {
    	while (<FD>) {
	    chomp;
	    s/^\s*//;
	    s/^\s*$//;
	    next if /^[;#]/ || /^$/;
    	
            if (/=/) {
		my $entry = {};
		foreach my $arg (split /\s+/) {
		    my ($k, $v) = split /=/, $arg;
		    $entry->{$k} = decode($v) if exists $cached{$k};
		}
		$cache{ $entry->{'host'} } = $entry;
	    } else {
		warning("read old-style cache $file. Will be rewritten using the new-style.") unless $warned;
		$warned = 1;

	    	my ($host, $ip, $mx, $backupmx, $wildcard, $time) = split /\s+/;
	    	$cache{$host} = {
	        	'host'     => $host,
			'static'   => 0,
	        	'ip'       => decode($ip),
	        	'mx'       => decode($mx),
	        	'backupmx' => decode($backupmx),
	        	'wildcard' => decode($wildcard),
	        	'time'     => $time 
	    	};
	    }
    	}
    	close(FD);
    } elsif ($! =~ /No such file/) {
	debug("cannot read cache file %s: $!", $opt{'cache'});
    } else {
	warning("cannot read cache file %s: $!", $opt{'cache'});
    }
    if ($warned) {
	warning("writing new-style cache $file.");
    	write_cache($file);
    }
    return %cache;
}
######################################################################
## write_cache
######################################################################
sub write_cache {
    my $file = shift;
 
    local *FD;
    if (open(FD, "> $file")) {
	my $now = time;
	printf FD "## last updated at %s ($now)\n", scalar(localtime($now));
	for my $h (sort keys %cache) {
	    print FD "host=$cache{$h}->{host}";
	    for my $k (sort keys %{$cache{$h}}) {
		next if $k eq 'host';
		next unless $cached{$k};
	        print FD " $k=" . encode($cache{$h}->{$k});
	    } 
	    print FD "\n";
	}
    	if (! close(FD)) {
	    warning("cannot write cache file $file");
	}
    }
}
