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