#!/usr/local/bin/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();
syntax highlighted by Code2HTML, v. 0.9.1