X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCron.pm;h=70c8e6606515015731646ccc4a3e6490cb51c0ef;hb=ab811a0c902225075a9bd69749f65594079433a9;hp=dd78edd4ddeaf146a3c77280aa808099a1c56dfa;hpb=78ed3f6025103ec1c47c90725e37b417647d83c8;p=spider.git diff --git a/perl/DXCron.pm b/perl/DXCron.pm index dd78edd4..70c8e660 100644 --- a/perl/DXCron.pm +++ b/perl/DXCron.pm @@ -3,29 +3,295 @@ # # Copyright (c) 1998 - Dirk Koopman G1TLH # -# $Id$ +# # package DXCron; +use DXVars; use DXUtil; use DXM; use DXDebug; -use Carp; +use IO::File; use strict; +use vars qw{@crontab @lcrontab @scrontab $mtime $lasttime $lastmin}; + +$mtime = 0; +$lasttime = 0; +$lastmin = 0; + + +my $fn = "$main::cmd/crontab"; +my $localfn = "$main::localcmd/crontab"; + # cron initialisation / reading in cronjobs sub init { + if ((-e $localfn && -M $localfn < $mtime) || (-e $fn && -M $fn < $mtime) || $mtime == 0) { + my $t; + + # first read in the standard one + if (-e $fn) { + $t = -M $fn; + + @scrontab = cread($fn); + $mtime = $t if !$mtime || $t <= $mtime; + } + + # then read in any local ones + if (-e $localfn) { + $t = -M $localfn; + + @lcrontab = cread($localfn); + $mtime = $t if $t <= $mtime; + } + @crontab = (@scrontab, @lcrontab); + } +} + +# read in a cron file +sub cread +{ + my $fn = shift; + my $fh = new IO::File; + my $line = 0; + my @out; + + dbg("cron: reading $fn\n") if isdbg('cron'); + open($fh, $fn) or confess("cron: can't open $fn $!"); + while (<$fh>) { + $line++; + chomp; + next if /^\s*#/o or /^\s*$/o; + my ($min, $hour, $mday, $month, $wday, $cmd) = /^\s*(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.+)$/o; + next unless defined $min; + my $ref = bless {}; + my $err; + + $err |= parse($ref, 'min', $min, 0, 60); + $err |= parse($ref, 'hour', $hour, 0, 23); + $err |= parse($ref, 'mday', $mday, 1, 31); + $err |= parse($ref, 'month', $month, 1, 12, "jan", "feb", "mar", "apr", "may", "jun", "jul", "aug", "sep", "oct", "nov", "dec"); + $err |= parse($ref, 'wday', $wday, 0, 6, "sun", "mon", "tue", "wed", "thu", "fri", "sat"); + if (!$err) { + $ref->{cmd} = $cmd; + push @out, $ref; + dbg("cron: adding $_\n") if isdbg('cron'); + } else { + dbg("cron: error on line $line '$_'\n") if isdbg('cron'); + } + } + close($fh); + return @out; +} + +sub parse +{ + my $ref = shift; + my $sort = shift; + my $val = shift; + my $low = shift; + my $high = shift; + my @req; + + # handle '*' values + if ($val eq '*') { + $ref->{$sort} = 0; + return 0; + } + # handle comma delimited values + my @comma = split /,/o, $val; + for (@comma) { + my @minus = split /-/o; + if (@minus == 2) { + return 1 if $minus[0] < $low || $minus[0] > $high; + return 1 if $minus[1] < $low || $minus[1] > $high; + my $i; + for ($i = $minus[0]; $i <= $minus[1]; ++$i) { + push @req, 0 + $i; + } + } else { + return 1 if $_ < $low || $_ > $high; + push @req, 0 + $_; + } + } + $ref->{$sort} = \@req; + + return 0; } # process the cronjobs sub process { + my $now = $main::systime; + return if $now-$lasttime < 1; + + my ($sec, $min, $hour, $mday, $mon, $wday) = (gmtime($now))[0,1,2,3,4,6]; + # are we at a minute boundary? + if ($min != $lastmin) { + + # read in any changes if the modification time has changed + init(); + + $mon += 1; # months otherwise go 0-11 + my $cron; + foreach $cron (@crontab) { + if ((!$cron->{min} || grep $_ eq $min, @{$cron->{min}}) && + (!$cron->{hour} || grep $_ eq $hour, @{$cron->{hour}}) && + (!$cron->{mday} || grep $_ eq $mday, @{$cron->{mday}}) && + (!$cron->{mon} || grep $_ eq $mon, @{$cron->{mon}}) && + (!$cron->{wday} || grep $_ eq $wday, @{$cron->{wday}}) ){ + + if ($cron->{cmd}) { + dbg("cron: $min $hour $mday $mon $wday -> doing '$cron->{cmd}'") if isdbg('cron'); + eval "$cron->{cmd}"; + dbg("cron: cmd error $@") if $@ && isdbg('cron'); + } + } + } + } + + # remember when we are now + $lasttime = $now; + $lastmin = $min; +} + +# +# these are simple stub functions to make connecting easy in DXCron contexts +# + +# is it locally connected? +sub connected +{ + my $call = uc shift; + return DXChannel::get($call); +} + +# is it remotely connected anywhere (with exact callsign)? +sub present +{ + my $call = uc shift; + return Route::get($call); +} + +# is it remotely connected anywhere (ignoring SSIDS)? +sub presentish +{ + my $call = uc shift; + my $c = Route::get($call); + unless ($c) { + for (1..15) { + $c = Route::get("$call-$_"); + last if $c; + } + } + return $c; } +# is it remotely connected anywhere (with exact callsign) and on node? +sub present_on +{ + my $call = uc shift; + my $ncall = uc shift; + my $node = Route::Node::get($ncall); + return ($node) ? grep $call eq $_, $node->users : undef; +} + +# is it remotely connected (ignoring SSIDS) and on node? +sub presentish_on +{ + my $call = uc shift; + my $ncall = uc shift; + my $node = Route::Node::get($ncall); + my $present; + if ($node) { + $present = grep {/^$call/ } $node->users; + } + return $present; +} + +# last time this thing was connected +sub last_connect +{ + my $call = uc shift; + return $main::systime if DXChannel::get($call); + my $user = DXUser::get($call); + return $user ? $user->lastin : 0; +} + +# disconnect a locally connected thing +sub disconnect +{ + my $call = shift; + run_cmd("disconnect $call"); +} + +# start a connect process off +sub start_connect +{ + my $call = shift; + # connecting is now done in one place - Yeah! + run_cmd("connect $call"); +} + +# spawn any old job off +sub spawn +{ + my $line = shift; + + my $pid = fork(); + if (defined $pid) { + if (!$pid) { + # in child, unset warnings, disable debugging and general clean up from us + $^W = 0; + eval "{ package DB; sub DB {} }"; + DXChannel::closeall(); + for (@main::listeners) { + $_->close_server; + } + unless ($main::is_win) { + $SIG{HUP} = 'IGNORE'; + $SIG{CHLD} = $SIG{TERM} = $SIG{INT} = $SIG{__WARN__} = 'DEFAULT'; + alarm(0); + } + exec "$line" or dbg("exec '$line' failed $!") if isdbg('cron'); + } + dbg("spawn of $line started") if isdbg('cron'); + } else { + dbg("can't fork for $line $!") if isdbg('cron'); + } + + # coordinate + sleep(1); +} + +# do an rcmd to another cluster from the crontab +sub rcmd +{ + my $call = uc shift; + my $line = shift; + + # can we see it? Is it a node? + my $noderef = Route::Node::get($call); + return unless $noderef && $noderef->version; + + # send it + DXProt::addrcmd($main::me, $call, $line); +} + +sub run_cmd +{ + my $line = shift; + my @in = DXCommandmode::run_cmd($main::me, $line); + dbg("cmd run: $line") if isdbg('cron'); + for (@in) { + s/\s*$//og; + dbg("cmd out: $_") if isdbg('cron'); + } +} 1; __END__