X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCron.pm;h=c88ad1d3142d413dd87cb41d2c12f855eecb57dd;hb=23cadfcd0cfe94855905545e2d68c8c0c8981f02;hp=961fa3a60df61c6aab1a096c16ef8412ba8e2806;hpb=cce161221036760959ff1d0b7628a55942bf558a;p=spider.git diff --git a/perl/DXCron.pm b/perl/DXCron.pm index 961fa3a6..c88ad1d3 100644 --- a/perl/DXCron.pm +++ b/perl/DXCron.pm @@ -12,16 +12,16 @@ use DXVars; use DXUtil; use DXM; use DXDebug; -use FileHandle; -use Carp; +use IO::File; use strict; -use vars qw{@crontab $mtime $lasttime}; +use vars qw{@crontab $mtime $lasttime $lastmin}; @crontab = (); $mtime = 0; $lasttime = 0; +$lastmin = 0; my $fn = "$main::cmd/crontab"; @@ -30,18 +30,26 @@ my $localfn = "$main::localcmd/crontab"; # cron initialisation / reading in cronjobs sub init { - my $t; - - if (-e $localfn) { - if (-e $localfn && ($t = -M $localfn) != $mtime) { + if ((-e $localfn && -M $localfn < $mtime) || (-e $fn && -M $fn < $mtime) || $mtime == 0) { + my $t; + + @crontab = (); + + # first read in the standard one + if (-e $fn) { + $t = -M $fn; + + cread($fn); + $mtime = $t if !$mtime || $t <= $mtime; + } + + # then read in any local ones + if (-e $localfn) { + $t = -M $localfn; + cread($localfn); - $mtime = $t; + $mtime = $t if $t <= $mtime; } - return; - } - if (($t = -M $fn) != $mtime) { - cread($fn); - $mtime = $t; } } @@ -49,17 +57,16 @@ sub init sub cread { my $fn = shift; - my $fh = new FileHandle; + my $fh = new IO::File; my $line = 0; - dbg('cron', "reading $fn\n"); - open($fh, $fn) or confess("can't open $fn $!"); - @crontab = (); # clear out the old stuff + dbg('cron', "cron: reading $fn\n"); + 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*(\w+)\s+(\w+)\s+(\w+)\s+(\w+)\s+(\w+)\s+(.+)$/o; + my ($min, $hour, $mday, $month, $wday, $cmd) = /^\s*(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.+)$/o; next if !$min; my $ref = bless {}; my $err; @@ -72,9 +79,9 @@ sub cread if (!$err) { $ref->{cmd} = $cmd; push @crontab, $ref; - dbg('cron', "adding $_\n"); + dbg('cron', "cron: adding $_\n"); } else { - dbg('cron', "error on line $line '$_'\n"); + dbg('cron', "cron: error on line $line '$_'\n"); } } close($fh); @@ -111,6 +118,8 @@ sub parse push @req, 0 + $_; } } + $ref->{$sort} = \@req; + return 0; } @@ -118,13 +127,160 @@ sub parse sub process { my $now = $main::systime; + return if $now-$lasttime < 1; - if ($now - $lasttime >= 60) { - my ($sec, $min, $hour, $mday, $mon, $wday) = (gmtime($main::systime))[0-4,6]; + my ($sec, $min, $hour, $mday, $mon, $wday) = (gmtime($now))[0,1,2,3,4,6]; + + # are we at a minute boundary? + if ($min != $lastmin) { - $lasttime = $now; + # 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', "cron: $min $hour $mday $mon $wday -> doing '$cron->{cmd}'"); + eval "$cron->{cmd}"; + dbg('cron', "cron: cmd error $@") if $@; + } + } + } + } + + # 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 DXCluster->get_exact($call); +} + +# is it remotely connected anywhere (ignoring SSIDS)? +sub presentish +{ + my $call = uc shift; + return DXCluster->get($call); +} + +# is it remotely connected anywhere (with exact callsign) and on node? +sub present_on +{ + my $call = uc shift; + my $node = uc shift; + my $ref = DXCluster->get_exact($call); + return ($ref && $ref->mynode) ? $ref->mynode->call eq $node : undef; +} + +# is it remotely connected anywhere (ignoring SSIDS) and on node? +sub presentish_on +{ + my $call = uc shift; + my $node = uc shift; + my $ref = DXCluster->get($call); + return ($ref && $ref->mynode) ? $ref->mynode->call eq $node : undef; +} + +# 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('cron', "exec '$line' failed $!"); + } + dbg('cron', "spawn of $line started"); + } else { + dbg('cron', "can't fork for $line $!"); } + + # 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 = DXCluster->get_exact($call); + return if !$noderef || !$noderef->pcversion; + + # send it + DXProt::addrcmd($DXProt::me, $call, $line); } +sub run_cmd +{ + my $line = shift; + my @in = DXCommandmode::run_cmd($DXProt::me, $line); + dbg('cron', "cmd run: $line"); + for (@in) { + s/\s*$//og; + dbg('cron', "cmd out: $_"); + } +} 1; __END__