perl/DXCron.pm

   1 #
   2 # module to timed tasks
   3 #
   4 # Copyright (c) 1998 - Dirk Koopman G1TLH
   5 #
   6 #
   7 #
   8
   9 package DXCron;
  10
  11 use DXVars;
  12 use DXUtil;
  13 use DXM;
  14 use DXDebug;
  15 use IO::File;
  16 use DXLog;
  17 use Time::HiRes qw(gettimeofday tv_interval);
  18 use Mojo::IOLoop::Subprocess;
  19 use DXSubprocess;
  20
  21 use strict;
  22
  23 use vars qw{@crontab @lcrontab @scrontab $mtime $lasttime $lastmin};
  24
  25 $mtime = 0;
  26 $lasttime = 0;
  27 $lastmin = 0;
  28
  29
  30 my $fn = "$main::cmd/crontab";
  31 my $localfn = "$main::localcmd/crontab";
  32
  33 # cron initialisation / reading in cronjobs
  34 sub init
  35 {
  36         if ((-e $localfn && -M $localfn < $mtime) || (-e $fn && -M $fn < $mtime) || $mtime == 0) {
  37                 my $t;
  38
  39                 # first read in the standard one
  40                 if (-e $fn) {
  41                         $t = -M $fn;
  42
  43                         @scrontab = cread($fn);
  44                         $mtime = $t if  !$mtime || $t <= $mtime;
  45                 }
  46
  47                 # then read in any local ones
  48                 if (-e $localfn) {
  49                         $t = -M $localfn;
  50
  51                         @lcrontab = cread($localfn);
  52                         $mtime = $t if $t <= $mtime;
  53                 }
  54                 @crontab = (@scrontab, @lcrontab);
  55         }
  56 }
  57
  58 # read in a cron file
  59 sub cread
  60 {
  61         my $fn = shift;
  62         my $fh = new IO::File;
  63         my $line = 0;
  64         my @out;
  65
  66         dbg("DXCron::cread reading $fn\n") if isdbg('cron');
  67         open($fh, $fn) or confess("cron: can't open $fn $!");
  68         while (<$fh>) {
  69                 $line++;
  70                 chomp;
  71                 next if /^\s*#/o or /^\s*$/o;
  72                 my ($min, $hour, $mday, $month, $wday, $cmd) = /^\s*(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.+)$/o;
  73                 next unless defined $min;
  74                 my $ref = bless {};
  75                 my $err = '';
  76
  77                 if (defined $min && defined $hour && defined $cmd) { # it isn't all of them, but should be enough to tell if this is a real line
  78                         $err .= parse($ref, 'min', $min, 0, 60);
  79                         $err .= parse($ref, 'hour', $hour, 0, 23);
  80                         $err .= parse($ref, 'mday', $mday, 1, 31);
  81                         $err .= parse($ref, 'month', $month, 1, 12, "jan", "feb", "mar", "apr", "may", "jun", "jul", "aug", "sep", "oct", "nov", "dec");
  82                         $err .= parse($ref, 'wday', $wday, 0, 6, "sun", "mon", "tue", "wed", "thu", "fri", "sat");
  83                         if (!$err) {
  84                                 $ref->{cmd} = $cmd;
  85                                 push @out, $ref;
  86                                 dbg("DXCron::cread: adding $_\n") if isdbg('cron');
  87                         } else {
  88                                 $err =~ s/^, //;
  89                                 LogDbg('cron', "DXCron::cread: error $err on line $line '$_'");
  90                         }
  91                 } else {
  92                         LogDbg('cron', "DXCron::cread error on line $line '$_'");
  93                         my @s = ($min, $hour, $mday, $month, $wday, $cmd);
  94                         my $s = "line $line splits as " . join(', ', (map {defined $_ ? qq{$_} : q{'undef'}} @s));
  95                         LogDbg('cron', $s);
  96                 }
  97
  98         }
  99         close($fh);
 100         return @out;
 101 }
 102
 103 sub parse
 104 {
 105         my $ref = shift;
 106         my $sort = shift;
 107         my $val = shift;
 108         my $low = shift;
 109         my $high = shift;
 110         my @req;
 111
 112         # handle '*' values
 113         if ($val eq '*') {
 114                 $ref->{$sort} = 0;
 115                 return;
 116         }
 117
 118         # handle comma delimited values
 119         my @comma = split /,/o, $val;
 120         for (@comma) {
 121                 my @minus = split /-/o;
 122                 if (@minus == 2) {
 123                         return  ", $sort should be $low >= $minus[0] <= $high" if $minus[0] < $low || $minus[0] > $high;
 124                         return  ", $sort should be $low >= $minus[1] <= $high" if $minus[1] < $low || $minus[1] > $high;
 125                         my $i;
 126                         for ($i = $minus[0]; $i <= $minus[1]; ++$i) {
 127                                 push @req, 0 + $i;
 128                         }
 129                 } else {
 130                         return ", $sort should be $low >= $val <= $high" if $_ < $low || $_ > $high;
 131                         push @req, 0 + $_;
 132                 }
 133         }
 134         $ref->{$sort} = \@req;
 135
 136         return;
 137 }
 138
 139 # process the cronjobs
 140 sub process
 141 {
 142         my $now = $main::systime;
 143         return if $now-$lasttime < 1;
 144
 145         my ($sec, $min, $hour, $mday, $mon, $wday) = (gmtime($now))[0,1,2,3,4,6];
 146
 147         # are we at a minute boundary?
 148         if ($min != $lastmin) {
 149
 150                 # read in any changes if the modification time has changed
 151                 init();
 152
 153                 $mon += 1;       # months otherwise go 0-11
 154                 my $cron;
 155                 foreach $cron (@crontab) {
 156                         if ((!$cron->{min} || grep $_ eq $min, @{$cron->{min}}) &&
 157                                 (!$cron->{hour} || grep $_ eq $hour, @{$cron->{hour}}) &&
 158                                 (!$cron->{mday} || grep $_ eq $mday, @{$cron->{mday}}) &&
 159                                 (!$cron->{mon} || grep $_ eq $mon, @{$cron->{mon}}) &&
 160                                 (!$cron->{wday} || grep $_ eq $wday, @{$cron->{wday}})  ){
 161
 162                                 if ($cron->{cmd}) {
 163                                         dbg("cron: $min $hour $mday $mon $wday -> doing '$cron->{cmd}'") if isdbg('cron');
 164                                         eval "$cron->{cmd}";
 165                                         dbg("cron: cmd error $@") if $@ && isdbg('cron');
 166                                 }
 167                         }
 168                 }
 169         }
 170
 171         # remember when we are now
 172         $lasttime = $now;
 173         $lastmin = $min;
 174 }
 175
 176 #
 177 # these are simple stub functions to make connecting easy in DXCron contexts
 178 #
 179
 180 # is it locally connected?
 181 sub connected
 182 {
 183         my $call = uc shift;
 184         return DXChannel::get($call);
 185 }
 186
 187 # is it remotely connected anywhere (with exact callsign)?
 188 sub present
 189 {
 190         my $call = uc shift;
 191         return Route::get($call);
 192 }
 193
 194 # is it remotely connected anywhere (ignoring SSIDS)?
 195 sub presentish
 196 {
 197         my $call = uc shift;
 198         my $c = Route::get($call);
 199         unless ($c) {
 200                 for (1..15) {
 201                         $c = Route::get("$call-$_");
 202                         last if $c;
 203                 }
 204         }
 205         return $c;
 206 }
 207
 208 # is it remotely connected anywhere (with exact callsign) and on node?
 209 sub present_on
 210 {
 211         my $call = uc shift;
 212         my $ncall = uc shift;
 213         my $node = Route::Node::get($ncall);
 214         return ($node) ? grep $call eq $_, $node->users : undef;
 215 }
 216
 217 # is it remotely connected (ignoring SSIDS) and on node?
 218 sub presentish_on
 219 {
 220         my $call = uc shift;
 221         my $ncall = uc shift;
 222         my $node = Route::Node::get($ncall);
 223         my $present;
 224         if ($node) {
 225                 $present = grep {/^$call/ } $node->users;
 226         }
 227         return $present;
 228 }
 229
 230 # last time this thing was connected
 231 sub last_connect
 232 {
 233         my $call = uc shift;
 234         return $main::systime if DXChannel::get($call);
 235         my $user = DXUser::get($call);
 236         return $user ? $user->lastin : 0;
 237 }
 238
 239 # disconnect a locally connected thing
 240 sub disconnect
 241 {
 242         my $call =  shift;
 243         run_cmd("disconnect $call");
 244 }
 245
 246 # start a connect process off
 247 sub start_connect
 248 {
 249         my $call = shift;
 250         # connecting is now done in one place - Yeah!
 251         run_cmd("connect $call");
 252 }
 253
 254 # spawn any old job off
 255 sub spawn
 256 {
 257         my $line = shift;
 258         my $t0 = [gettimeofday];
 259
 260         dbg("DXCron::spawn: $line") if isdbg("cron");
 261         my $fc = DXSubprocess->new();
 262         $fc->run(
 263                          sub {
 264                                  my @res = `$line`;
 265                                  return @res
 266                          },
 267                          sub {
 268                                  my ($fc, $err, @res) = @_;
 269                                  if ($err) {
 270                                          my $s = "DXCron::spawn: error $err";
 271                                          dbg($s);
 272                                          return;
 273                                  }
 274                                  for (@res) {
 275                                          chomp;
 276                                          dbg("DXCron::spawn: $_") if isdbg("cron");
 277                                  }
 278                                  diffms(__PACKAGE__, "::spawn", $line, $t0, scalar @res) if isdbg('progress');
 279                          }
 280                         );
 281 }
 282
 283 sub spawn_cmd
 284 {
 285         my $line = shift;
 286         my $chan = shift || $main::me;
 287         my $pkg = ref $chan || __PACKAGE__;
 288         my $t0 = [gettimeofday];
 289
 290         dbg("$pkg::spawn_cmd run: $line") if isdbg('cron');
 291         my $fc = DXSubprocess->new;
 292         $fc->run(
 293                          sub {
 294                                  $chan->{_nospawn} = 1;
 295                                  my @res = $chan->run_cmd($line);
 296                                  delete $chan->{_nospawn};
 297                                  return @res;
 298                          },
 299                          sub {
 300                                  my ($fc, $err, @res) = @_;
 301                                  if ($err) {
 302                                          chomp $err;
 303                                          my $s = "$pkg::spawn_cmd: error $err";
 304                                          dbg($s);
 305                                  }
 306                                  for (@res) {
 307                                          if (ref $chan) {
 308                                                  $chan->send($_);
 309                                          } elsif (isdbg('cron')) {
 310                                                  dbg("$pkg::spawn_cmd: $_");
 311                                          } else {
 312                                                  last;  # don't care
 313                                          }
 314                                  }
 315                                  diffms($pkg, "::spawn_cmd", $line, $t0, scalar @res) if isdbg('progress');
 316                          }
 317                         );
 318         return ();
 319 }
 320
 321 # do an rcmd to another cluster from the crontab
 322 sub rcmd
 323 {
 324         my $call = uc shift;
 325         my $line = shift;
 326
 327         # can we see it? Is it a node?
 328         my $noderef = Route::Node::get($call);
 329         return  unless $noderef && $noderef->version;
 330
 331         # send it
 332         DXProt::addrcmd($main::me, $call, $line);
 333 }
 334
 335 sub run_cmd
 336 {
 337         my $line = shift;
 338         my @in = $main::me->run_cmd($line);
 339         dbg("DXCron::run_cmd: $line") if isdbg('cron');
 340         for (@in) {
 341                 s/\s*$//og;
 342                 dbg("DXCron::cmd out: $_") if isdbg('cron');
 343         }
 344 }
 345
 346 1;
 347 __END__