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