X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCron.pm;h=c88ad1d3142d413dd87cb41d2c12f855eecb57dd;hb=23cadfcd0cfe94855905545e2d68c8c0c8981f02;hp=3c9c04fb8bb015a7fb37a5c2cc541c55832fdfc5;hpb=5d197c9f7aa2ea796d86aa5473f93956b24cf1b7;p=spider.git diff --git a/perl/DXCron.pm b/perl/DXCron.pm index 3c9c04fb..c88ad1d3 100644 --- a/perl/DXCron.pm +++ b/perl/DXCron.pm @@ -12,15 +12,14 @@ use DXVars; use DXUtil; use DXM; use DXDebug; -use FileHandle; -use Carp; +use IO::File; use strict; use vars qw{@crontab $mtime $lasttime $lastmin}; @crontab = (); -$mtime = 1; +$mtime = 0; $lasttime = 0; $lastmin = 0; @@ -41,7 +40,7 @@ sub init $t = -M $fn; cread($fn); - $mtime = $t if $t <= $mtime; + $mtime = $t if !$mtime || $t <= $mtime; } # then read in any local ones @@ -58,7 +57,7 @@ sub init sub cread { my $fn = shift; - my $fh = new FileHandle; + my $fh = new IO::File; my $line = 0; dbg('cron', "cron: reading $fn\n"); @@ -165,42 +164,70 @@ sub process # 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); } -sub start_connect +# is it remotely connected anywhere (with exact callsign)? +sub present { my $call = uc shift; - my $lccall = lc $call; + return DXCluster->get_exact($call); +} - my $prog = "$main::root/local/client.pl"; - $prog = "$main::root/perl/client.pl" if ! -e $prog; - - 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 {} }"; - $SIG{HUP} = 'IGNORE'; - alarm(0); - DXChannel::closeall(); - $SIG{CHLD} = $SIG{TERM} = $SIG{INT} = $SIG{__WARN__} = 'DEFAULT'; - exec $prog, $call, 'connect'; - dbg('cron', "exec '$prog' failed $!"); - } - dbg('cron', "connect to $call started"); - } else { - dbg('cron', "can't fork for $prog $!"); - } +# is it remotely connected anywhere (ignoring SSIDS)? +sub presentish +{ + my $call = uc shift; + return DXCluster->get($call); +} - # coordinate - sleep(1); +# 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; @@ -211,12 +238,16 @@ sub spawn # in child, unset warnings, disable debugging and general clean up from us $^W = 0; eval "{ package DB; sub DB {} }"; - $SIG{HUP} = 'IGNORE'; - alarm(0); DXChannel::closeall(); - $SIG{CHLD} = $SIG{TERM} = $SIG{INT} = $SIG{__WARN__} = 'DEFAULT'; - exec "$line"; - dbg('cron', "exec '$line' failed $!"); + 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 { @@ -226,5 +257,30 @@ sub spawn # 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__