#!@PERL@ -w
#
# Copyright (C) 2004, 2005 Philipp Benner
#
# This file is part of UpdateDD - http://updatedd.philipp-benner.de.
#
# UpdateDD 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
# any later version.
#
# UpdateDD 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 UpdateDD; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

use strict;
use Getopt::Std;
use Fcntl qw(:flock);
use Time::Local;
use Time::localtime;

use constant WRAPPER_NAME	=> $0;
use constant UPDATEDD_NAME	=> "updatedd";
use constant CONFIG_FILE_1	=> "/etc/updatedd-wrapper.conf";
use constant CONFIG_FILE_2	=> "/usr/etc/updatedd-wrapper.conf";
use constant CONFIG_FILE_3	=> "/usr/local/etc/updatedd-wrapper.conf";
use constant CACHE_FILE		=> "/tmp/updatedd-wrapper_".$<.".cache";
use constant CACHE_FILE_PERM	=> 0600;
use constant CACHE_EXPIRATION	=> 30 * 60 * 60 * 24; # 30 days
use constant IDLE_TIME		=> 60;
use constant RETRIES		=> 5;

my $num4_rex = qr{
    (?:
     [0-9]{1,2}
|
     1?\d\d
|
     2[0-4]\d
|
     25[0-5]
    )

}x;

my $ipv4_rex = qr{
    (?: ^ | [^\d] )
	( (?: $num4_rex\.){3} $num4_rex)
    (?: $ | [^\d] )
}x;

my $ipv6_rex = qr{

    (?: ^ | [^A-Fa-f0-9] )
    (
    (?: (?: [A-Fa-f0-9]{1,4}:){7}[A-Fa-f0-9]{1,4} )
|   (?: [A-Fa-f0-9]{1,4}::(?: [A-Fa-f0-9]{1,4}:){0,5}[A-Fa-f0-9]{1,4} )
|   (?: (?: [A-Fa-f0-9]{1,4}:){2}:(?: [A-Fa-f0-9]{1,4}:){0,4}[A-Fa-f0-9]{1,4} )
|   (?: (?: [A-Fa-f0-9]{1,4}:){3}:(?: [A-Fa-f0-9]{1,4}:){0,3}[A-Fa-f0-9]{1,4} )
|   (?: (?: [A-Fa-f0-9]{1,4}:){4}:(?: [A-Fa-f0-9]{1,4}:){0,2}[A-Fa-f0-9]{1,4} )
|   (?: (?: [A-Fa-f0-9]{1,4}:){5}:(?: [A-Fa-f0-9]{1,4}:){0,1}[A-Fa-f0-9]{1,4} )
|   (?: (?: [A-Fa-f0-9]{1,4}:){6}:[A-Fa-f0-9]{1,4} )
    )
    (?: $ | [^A-Fa-f0-9] )

}x;

my %options = (c => undef,
	       d => 0,
	       f => 0,
	       i => IDLE_TIME,
	       r => RETRIES,
	       s => 0,
	       t => CACHE_FILE,
	       y => 0, );


sub print_usage($) {

    my $file = shift;

    print($file "\nUsage: ".WRAPPER_NAME." [OPTION]...\n\n");
    print($file "Options:\n");
    print($file "   -c <path>	path to alternative config file\n");
    print($file "   -d		print debug information\n");
    print($file "   -f		force update (do not check ip)\n");
    print($file "   -i <sec>	idle time between failed updates in seconds\n");
    print($file "		(default is ".IDLE_TIME.")\n");
    print($file "   -r <num>	retries on warnings (default is ".RETRIES.")\n");
    print($file "   -s		print update commands to stdout\n");
    print($file "		instead of running updatedd directly\n");
    print($file "   -t <path>	path to cache file\n");
    print($file "		(default is: ".CACHE_FILE.")\n");
    print($file "   -y		print update status to syslog\n");
    print($file "   --help	display this help and exit\n");
    print($file "   --version	print version information and exit\n\n");
    print($file "Report bugs to <updatedd\@philipp-benner.de>.\n\n");

}

sub print_version($) {

    my $file = shift;

    print($file "\nUpdatedd-wrapper version 2.4, Copyright (C) 2005 Philipp Benner.\n");
    print($file "http://updatedd.philipp-benner.de\n\n");

    print($file "This is free software, and you are welcome to redistribute it\n");
    print($file "under certain conditions; see the source for copying conditions.\n");
    print($file "There is NO warranty; not even for MERCHANTABILITY or FITNESS\n");
    print($file "FOR A PARTICULAR PURPOSE.\n\n");

}

foreach my $arg (@ARGV) {
    if($arg eq "--help") {
	print_usage(\*STDOUT);
	exit(0);
    }
    if($arg eq "--version") {
	print_version(\*STDOUT);
	exit(0);
    }
}

getopts("c:dfi:r:st:y", \%options);

sub pdebug($) {

    my $string = shift;

    if($options{d} == 1) {
	print("DEBUG: $string");
    }

}


sub split_line($) {

    my $line = shift;
    my @words;

    push(@words, $+) while $line =~ m{

	  # "some string"
	  (?:
	    [\"]
	    (
	      [^\"\n]*[^\\]
	    )
	    [\"]
	  )
	|
	  # `some string`
	  (
	    [\`]
	      [^\`\n]*[^\\]
	    [\`]
	  )
	|
	  # control characters
	  (
	    (?=
	      ([\=\;\}\{\(\)])
	    )
	  )
	|
	  # words
	  (
	    (?: [\w\d\:\.\-\'\/]+ )
	  )

    }gx;

    return @words;

}

sub read_config($) {

    my $FP	= shift;
    my @buffer;
    my @lines;

    for(my $n = 0; <$FP>; $n++) {
	my @pieces = split /[\#]/, $_;
	chomp $pieces[0];
	$buffer[$n] = $pieces[0];
    }

    for(my $n = 0; $n < @buffer; $n++) {
	$lines[$n] = [ split_line($buffer[$n]) ];
    }

    return @lines;

}

sub list_words_num($$) {

    my ($content, $line_num) = @_;
    my $line = ${ $content }[$line_num];

    return @$line;

}

sub list_next($) {

    my $list = shift;

    my $content = $list->{content};
    my $lines_num = @$content;

    for(;;) {
	if($list->{pos_y}+1 < list_words_num($content, $list->{pos_x})) {
	    ++$list->{pos_y};
	} else {
	    $list->{pos_y} = 0;
	    if($list->{pos_x}+1 < $lines_num) {
		++$list->{pos_x};
	    } else {
		return undef;
	    }
	}
	if(list_words_num($content, $list->{pos_x}) > 0) {
	    last;
	}
    }

    return $content->[$list->{pos_x}]->[$list->{pos_y}];

}

sub list_get_first($) {

    my $list = shift;
    my $content = $list->{content};

    my $max_x = @$content;

    for(my $x = 0; $x < $max_x; $x++) {
	my $max_y = list_words_num($content, $x);
	for(my $y = 0; $y < $max_y; $y++) {
	    if(defined($content->[$x]->[$y])) {
		$list->{pos_x} = $x;
		$list->{pos_y} = $y;
		return $content->[$x]->[$y];
	    }
	}
    }

    return undef;

}


sub parse_error($$) {

    my ($list, $msg) = @_;
    my $line = $list->{pos_x}+1;

    die("parse error at line $line: $msg\n");

}

sub list_next_required($) {

    my $list = shift;
    my $next = list_next($list);

    if(!$list) {
	parse_error($list, "syntax error");
    }

    return $next;

}

sub list_expecting($$) {

    my ($list, $character) = @_;

    my $next = list_next($list);
    if(!$next) {
	parse_error($list, "syntax error");
    }
    if(!($next eq $character)) {
	parse_error($list, "'$character' expected instead of '$next'");
    }

    return $next;

}

sub add_argument($$$) {

    my ($list, $order, $name) = @_;

    if($order->{$name}) {
	parse_error($list, "option '$name' used twice");
    }
    list_expecting($list, "=");
    $order->{$name} = list_next_required($list);
    list_expecting($list, ";");

}

sub get_ip_from_script($$) {

    my ($script, $ip_ver) = @_;
    my $ip;

    my @output = `$script`;
    if($ip_ver == 4) {
	foreach my $line (@output) {
	    if($line =~ /$ipv4_rex/) {
		return $1;
	    }
	}
    } else {
	foreach my $line (@output) {
	    if($line =~ /$ipv6_rex/) {
		return $1;
	    }
	}
    }

    return undef;

}

sub get_ip($) {

    my $list = shift;
    my %ip = ( ver  => undef,
	       addr => undef );

    my $ver = list_next_required($list);
    my $script;

    if( list_next_required($list) =~ /^\`(.*)\`$/ ) {
	$script = $1;
    } else {
	return undef;
    }

    if($ver eq "ipv4:") {
	$ip{ver} = 4;
	$ip{addr} = get_ip_from_script($script, 4);
    } elsif($ver eq "ipv6:") {
	$ip{ver} = 6;
	$ip{addr} = get_ip_from_script($script, 6);
    } else {
	parse_error($list, "invalid option for 'ip-addr'");
    }
    if(!$ip{addr}) {
	print(STDERR "script '$script' returned invalid ip address\n");
	return undef;
    }

    return \%ip;

}

sub add_ip($$) {

    my $list = shift;
    my $order = shift;

    if($order->{ip}) {
	parse_error($list, "option 'ip' used twice");
    }
    list_expecting($list, "=");
    $order->{ip} = get_ip($list);
    list_expecting($list, ";");

    if(defined($order->{ip})) {
	return 1;
    } else {
	return 0;
    }

}

sub add_hostnames($$) {

    my $list = shift;
    my $order = shift;

    if($order->{hostnames}) {
	parse_error($list, "argument 'hostnames' used twice");
    }
    list_expecting($list, "=");
    my $hostnames = list_next_required($list);
    $order->{hostnames} = [split /[, ]/, $hostnames];
    if(!$order->{hostnames}) {
	parse_error($list, "no hostnames specified");
    }
    list_expecting($list, ";");

}

sub get_login($$) {

    my $logins = shift;
    my $alias = shift;

    foreach my $login (@$logins) {
	if($login->{name} eq $alias) {
	    return $login->{login};
	}
    }

    print("no such login alias: $alias\n");
    return undef;

}

sub add_login($$$) {

    my ($list, $logins, $order) = @_;

    if($order->{login}) {
	parse_error($list, "argument 'login' used twice");
    }
    list_expecting($list, "=");

    my $alias = list_next_required($list);
    $order->{login} = get_login($logins, $alias);

    if(!$order->{login}) {
	parse_error($list, "wrong login alias");
    }
    list_expecting($list, ";");

}

sub goto_end_of_block($) {

    my $list = shift;

    for(;;) {
	my $next = list_next_required($list);
	if($next eq "}") {
	    return;
	}
    }

}

sub get_order($$) {

    my $list = shift;
    my $logins = shift;
    my %order = (login		=> undef,
		 hostnames	=> undef,
		 ip		=> undef,
		 use_syslog	=> undef,
		 options	=> undef,
		 force		=> undef );

    list_expecting($list, "{");
    for(;;) {

	my $next = list_next_required($list);
	if($next eq "}") {
	    last;
	}
	if($next eq "login") {
	    add_login($list, $logins, \%order);
	} elsif($next eq "hostnames") {
	    add_hostnames($list, \%order);
	} elsif($next eq "ip-addr") {
	    my $ret = add_ip($list, \%order);
	    if($ret == 0) {
		goto_end_of_block($list);
		return undef;
	    }
	} elsif($next eq "use-syslog") {
	    add_argument($list, \%order, "use_syslog");
	    if(!( ($order{use_syslog} eq "yes")
		  ||    ($order{use_syslog} eq "no" ) )) {
		parse_error($list, "invalid option for 'use-syslog': $order{use_syslog}");
	    }
	} elsif($next eq "options") {
	    add_argument($list, \%order, "options");
	} elsif($next eq "force") {
	    if($order{force}) {
		parse_error($list, "option 'force' used twice");
	    }
	    $order{force} = "yes";
	    list_expecting($list, ";");
	} else {
	    if($next =~ /[^\w\d\-]/) {
		parse_error($list, "unexpected character: '$next'");
	    }
	    parse_error($list, "invalid option: '$next'");
	}

    }

    if(!$order{use_syslog}) {
	$order{use_syslog} = "yes";
    }
    if(!$order{force}) {
	$order{force} = "no";
    }

    return \%order;

}

sub get_block_argument($) {

    my $list = shift;
    my $next = list_next_required($list);

    if($next eq "active") {
	return "active";
    } elsif($next eq "disabled") {
	return "disabled";
    } else {
	parse_error($list, "invalid block argument: $next");
    }

}

sub get_logins($) {

    my $list = shift;
    my @logins;

    list_expecting($list, "{");
    for(;;) {
	my $name = list_next_required($list);

	if($name eq "}") {
	    last;
	} elsif($name =~ /[^\w\d\-\_]/) {
	    parse_error($list, "invalid character: '$name'");
	} else {
	    list_expecting($list, "=");

	    my $next = list_next_required($list);
	    push @logins, { name => $name, login => $next };

	    list_expecting($list, ";");
	}
    }
    list_expecting($list, ";");

    return \@logins;

}

sub goto_matching_bracked($) {

    my $list = shift;

    for(;;) {
	my $next = list_next_required($list);
	if($next eq "}") {
	    last;
	}
	if($next eq "{") {
	    parse_error($list, "nested blocks are not allowed");
	}
    }

    return;

}

sub interpret($) {

    my %list = (content => shift,
		pos_x => 0,
		pos_y => 0, );
    my $logins;
    my @orders;
    my $word = list_get_first(\%list);

    for(;;) {

	if(!defined($word)) {
	    last;
	}

	if($word eq "login") {
	    $logins = get_logins(\%list);
	} elsif($word !~ /[^\w]/) {
	    list_expecting(\%list, "(");
	    my $argument = get_block_argument(\%list);
	    list_expecting(\%list, ")");

	    if($argument eq "active") {
		my $order = get_order(\%list, $logins);
		if(defined($order)) {
		    push @orders, {
			name		=> $word,
			content		=> $order,
			commands	=> undef
			};
		}
	    } else {
		list_expecting(\%list, "{");
		goto_matching_bracked(\%list);
	    }

	} elsif($word eq ";") {
	} else {
	    parse_error(\%list, "invalid block name");
	}

	$word = list_next(\%list);

    }

    return $logins, \@orders;

}

sub cached_ip($) {

    my $hostname = quotemeta(shift);
    my $ret = undef;
    my $cache_fn = $options{t};

    open(CACHE, "<", $cache_fn)
	or return undef;
    flock(CACHE, LOCK_SH);

    while(<CACHE>) {
	($ret) = /$hostname\s*([a-f0-9:\.]+)/i;
	if(defined($ret)) {
	    pdebug("$hostname is cached\n");
	    last;
	}
    }
    close(CACHE)
	or die "could not close ".$cache_fn.": $!";

    return $ret;

}

sub check_cached_ip($$) {

    my ($hostname, $ip_addr) = @_;
    my $cached_ip_addr = cached_ip($hostname);

    if(defined($cached_ip_addr)) {
	if($cached_ip_addr eq $ip_addr) {
	    return 1;
	} else {
	    return 0;
	}
    }

    return 0;

}

sub write_cache($) {

    my $content = shift;
    my $cache_fn = $options{t};

    open(CACHE, ">", $cache_fn)
	or return undef;
    flock(CACHE, LOCK_EX);

    foreach my $entry (@$content) {

	my $tm = localtime($entry->{time});

	if(defined($entry->{ip_addr})) {
	    pdebug("writing cache entry for $entry->{hostname}\n");
	    printf(CACHE "%04d-%02d-%02d %02d:%02d:%02d $entry->{hostname} $entry->{ip_addr}\n",
		   $tm->year+1900, $tm->mon+1, $tm->mday, $tm->hour, $tm->min, $tm->sec);
	}
    }

    close(CACHE)
	or die "could not close ".$cache_fn."$!";

    chmod(CACHE_FILE_PERM, $cache_fn);

}

my $date_rex = qr/\d{4}-\d{2}-\d{2}/imosx;
my $time_rex = qr/\d{2}:\d{2}:\d{2}/imosx;

sub read_cache() {

    my $cache_entry_rex = qr/^\s*($date_rex)\s+($time_rex)\s+([\w\.\-\_]+)\s+([\w\.\:]+)\s*$/imosx;
    my @cached;

    my $cache_fn = $options{t};

    open(CACHE, "<", $cache_fn)
	or return undef;
    flock(CACHE, LOCK_SH);

    while(<CACHE>) {
	if(my ($date, $time , $hostname, $ip_addr) = /$cache_entry_rex/i) {

	    my ($year, $month, $day) = $date =~ /(\d{4})-(\d{2})-(\d{2})/;
	    my ($hour, $min, $sec) = $time =~ /(\d{2}):(\d{2}):(\d{2})/;

	    my $TIME = timelocal($sec, $min, $hour, $day, $month-1, $year-1900);

	    push @cached, { hostname	=> $hostname,
			    ip_addr	=> $ip_addr,
			    time	=> $TIME };

	    pdebug("CACHE ENTRY: $TIME $hostname $ip_addr\n");

	}
    }

    close(CACHE)
	or die "could not close ".$cache_fn.": $!";

    return \@cached;

}

sub date_expired($) {

    my $time = shift;
    my $now  = time();
    my $expiration = CACHE_EXPIRATION;

    if($time + $expiration < $now) {
	return 1;
    } else {
	return 0;
    }

}

sub update_cache($) {

    my $succeeded = shift;
    my $cached = read_cache();
    my @new_cache;

    foreach my $entry (@$succeeded) {
	push @new_cache, { hostname	=> $entry->{hostname},
			   ip_addr	=> $entry->{ip_addr},
			   time		=> time() };
    }

    FIRST: foreach my $entry (@$cached) {
	if(not date_expired($entry->{time})) {
	    foreach my $new_entry (@new_cache) {
		if($entry->{hostname} eq $new_entry->{hostname}) {
		    next FIRST;
		}
	    }
	    push @new_cache, $entry;
	    pdebug("$entry->{hostname} is not expired\n");
	} else {
	    pdebug("$entry->{hostname} is expired\n");
	}
    }

    write_cache(\@new_cache);

}

sub update_required($$) {

    my ($order, $hostname) = @_;

    if($options{f} == 0 &&
       $order->{content}->{force} eq "no") {

	if(check_cached_ip($hostname, $order->{content}->{ip}->{addr})) {
	    pdebug("update for $hostname is not required\n");
	    return 0;
	}
    }

    pdebug("update for $hostname is required\n");
    return 1;

}

sub compose_commands($) {

    my $order = shift;
    my @commands;

    my $command = UPDATEDD_NAME;
    if($options{y} == 1 ||
       $order->{content}->{use_syslog} eq "yes") {
	$command .= " -Y";
    }
    $command .= " $order->{name} -- ";

    # ip addr
    if($order->{content}->{ip}) {
	if($order->{content}->{ip}->{ver} == 4) {
	    $command .= "-4 ";
	} else {
	    $command .= "-6 ";
	}
	$command .= $order->{content}->{ip}->{addr};
    }
    
    # extra options
    if($order->{content}->{options}) {
	$command .= " ".$order->{content}->{options};
    }
    
    # add hostnames and push command to @command
    my $hostnames = $order->{content}->{hostnames};
    foreach my $hostname (@$hostnames) {
	if(update_required($order, $hostname)) {
	    push @commands, { string	=> $command." ".$hostname,
			      succeeded	=> 0,
			      retries	=> $options{r},
			      hostname	=> $hostname,
			      ip_addr	=> $order->{content}->{ip}->{addr} };
	}
    }

    return \@commands;

}

sub exec_command($) {

    my $command = shift;

    my $ret = system($command);
    if($ret == 1) {
	return 0;
    } elsif($ret > 1) {
	return -1;
    } else {
	return 1;
    }

}

sub exec_updatedd($$) {

    my ($commands, $login) = @_;
    my @succeeded;
    my $n = @$commands;

    $ENV{LOGIN} = $login;
    while($n > 0) {
	foreach my $command (@$commands) {
	    if($command->{succeeded} == 0) {
		my $ret = exec_command($command->{string});
		$command->{succeeded} = $ret;
		if($ret == 1) {
		    $n--;
		    push @succeeded, { hostname	=> $command->{hostname},
				       ip_addr	=> $command->{ip_addr} };
		} elsif($ret == -1) {
		    $n--;
		} else {
		    if($command->{retries} > 0) {
			$command->{retries}--;
		    } else {
			$command->{succeeded} = -1;
			$n--;
		    }
		}
	    }
	}
	if($n > 0) {
	    sleep($options{i});
	}
    }

    return \@succeeded;

}

sub run_updatedd($$) {

    my $commands = shift;
    my $login = shift;
    my $succeeded;

    if(@$commands) {
	if($options{s}) {
	    print("export LOGIN=$login\n");
	    foreach my $command (@$commands) {
		print("$command->{string}\n");
	    }
	}  else {
	    $succeeded = exec_updatedd($commands, $login);
	}
    }

    return $succeeded;

}

sub get_config_path() {

    if(defined($options{c})) {
	return $options{c};
    }

    if(-f CONFIG_FILE_1) {
	return CONFIG_FILE_1;
    } elsif(-f CONFIG_FILE_2) {
	return CONFIG_FILE_2;
    } elsif(-f CONFIG_FILE_3) {
	return CONFIG_FILE_3;
    } else {
	die "no config file";
    }

}

sub main() {

    my $config = get_config_path();
    open(FP, "<", $config)
	or die "open() failed: $config: $!\n";
    flock(FP, LOCK_SH);

    my @lines = read_config(\*FP);

    close(FP)
	or die "close() failed: $!\n";

    my ($logins, $orders) = interpret(\@lines);
    my @succeeded;

    foreach my $order (@$orders) {
	my $commands = compose_commands($order);
	my $ret = run_updatedd($commands,
			       $order->{content}->{login});
	foreach (@$ret) {
	    push @succeeded, $_;
	}
    }

    update_cache(\@succeeded);

}

main();