X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCron.pm;h=94c1cad0450573d6399a08fdc5ab3c4c9c57515b;hb=ca18864d1264fadfe9869b630f05c950876c2169;hp=9e4bde71e9083c5b5c7e9c45a4522c98251ebb3f;hpb=f3adc82a0299652d929b73c718127fa38571eec5;p=spider.git diff --git a/perl/DXCron.pm b/perl/DXCron.pm index 9e4bde71..94c1cad0 100644 --- a/perl/DXCron.pm +++ b/perl/DXCron.pm @@ -20,7 +20,7 @@ use strict; use vars qw{@crontab $mtime $lasttime $lastmin}; @crontab = (); -$mtime = 1; +$mtime = 0; $lasttime = 0; $lastmin = 0; @@ -41,7 +41,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 @@ -165,12 +165,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); } +# 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 = uc shift; + my $dxchan = DXChannel->get($call); + if ($dxchan) { + if ($dxchan->is_ak1a) { + $dxchan->send_now("D", DXProt::pc39($main::mycall, "$main::mycall DXCron")); + } else { + $dxchan->send_now('D', ""); + } + $dxchan->disconnect; + } +} + +# start a connect process off sub start_connect { my $call = uc shift; @@ -184,19 +242,23 @@ sub start_connect if (!$pid) { # in child, unset warnings, disable debugging and general clean up from us $^W = 0; -# do "$main::root/perl/Disable_debug.pl"; 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 $!"); + exec $prog, $call, 'connect' or dbg('cron', "exec '$prog' failed $!"); } dbg('cron', "connect to $call started"); } else { dbg('cron', "can't fork for $prog $!"); } + + # coordinate + sleep(1); } +# spawn any old job off sub spawn { my $line = shift; @@ -206,17 +268,34 @@ sub spawn if (!$pid) { # in child, unset warnings, disable debugging and general clean up from us $^W = 0; -# do "$main::root/perl/Disable_debug.pl"; 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 $!"); + 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($main::mycall, $call, $line); } 1; __END__