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 DXSubprocess;
  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 (my $l = <$fh>) {
  68                 $line++;
  69                 chomp $l;
  70                 next if $l =~ /^\s*#/o or $l =~ /^\s*$/o;
  71                 my ($min, $hour, $mday, $month, $wday, $cmd) = $l =~ /^\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                 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
  77                         $err .= parse($ref, 'min', $min, 0, 60);
  78                         $err .= parse($ref, 'hour', $hour, 0, 23);
  79                         $err .= parse($ref, 'mday', $mday, 1, 31);
  80                         $err .= parse($ref, 'month', $month, 1, 12, "jan", "feb", "mar", "apr", "may", "jun", "jul", "aug", "sep", "oct", "nov", "dec");
  81                         $err .= parse($ref, 'wday', $wday, 0, 6, "sun", "mon", "tue", "wed", "thu", "fri", "sat");
  82                         if (!$err) {
  83                                 $ref->{cmd} = $cmd;
  84                                 push @out, $ref;
  85                                 dbg("DXCron::cread: adding $l\n") if isdbg('cron');
  86                         } else {
  87                                 $err =~ s/^, //;
  88                                 LogDbg('cron', "DXCron::cread: error $err on line $line '$l'");
  89                         }
  90                 } else {
  91                         LogDbg('cron', "DXCron::cread error on line $line '$l'");
  92                         my @s = ($min, $hour, $mday, $month, $wday, $cmd);
  93                         my $s = "line $line splits as " . join(', ', (map {defined $_ ? qq{$_} : q{'undef'}} @s));
  94                         LogDbg('cron', $s);
  95                 }
  96         }
  97         close($fh);
  98         return @out;
  99 }
 100
 101 sub parse
 102 {
 103         my $ref = shift;
 104         my $sort = shift;
 105         my $val = shift;
 106         my $low = shift;
 107         my $high = shift;
 108         my @req;
 109
 110         # handle '*' values
 111         if ($val eq '*') {
 112                 $ref->{$sort} = 0;
 113                 return;
 114         }
 115
 116         # handle comma delimited values
 117         my @comma = split /,/o, $val;
 118         for (@comma) {
 119                 my @minus = split /-/o;
 120                 if (@minus == 2) {
 121                         return  ", $sort should be $low >= $minus[0] <= $high" if $minus[0] < $low || $minus[0] > $high;
 122                         return  ", $sort should be $low >= $minus[1] <= $high" if $minus[1] < $low || $minus[1] > $high;
 123                         my $i;
 124                         for ($i = $minus[0]; $i <= $minus[1]; ++$i) {
 125                                 push @req, 0 + $i;
 126                         }
 127                 } else {
 128                         return ", $sort should be $low >= $val <= $high" if $_ < $low || $_ > $high;
 129                         push @req, 0 + $_;
 130                 }
 131         }
 132         $ref->{$sort} = \@req;
 133
 134         return;
 135 }
 136
 137 # process the cronjobs
 138 sub process
 139 {
 140         my $now = $main::systime;
 141         return if $now-$lasttime < 1;
 142
 143         my ($sec, $min, $hour, $mday, $mon, $wday) = (gmtime($now))[0,1,2,3,4,6];
 144
 145         # are we at a minute boundary?
 146         if ($min != $lastmin) {
 147
 148                 # read in any changes if the modification time has changed
 149                 init();
 150
 151                 $mon += 1;       # months otherwise go 0-11
 152                 my $cron;
 153                 foreach $cron (@crontab) {
 154                         if ((!$cron->{min} || grep $_ eq $min, @{$cron->{min}}) &&
 155                                 (!$cron->{hour} || grep $_ eq $hour, @{$cron->{hour}}) &&
 156                                 (!$cron->{mday} || grep $_ eq $mday, @{$cron->{mday}}) &&
 157                                 (!$cron->{mon} || grep $_ eq $mon, @{$cron->{mon}}) &&
 158                                 (!$cron->{wday} || grep $_ eq $wday, @{$cron->{wday}})  ){
 159
 160                                 if ($cron->{cmd}) {
 161                                         dbg("cron: $min $hour $mday $mon $wday -> doing '$cron->{cmd}'") if isdbg('cron');
 162                                         eval "$cron->{cmd}";
 163                                         dbg("cron: cmd error $@") if $@ && isdbg('cron');
 164                                 }
 165                         }
 166                 }
 167         }
 168
 169         # remember when we are now
 170         $lasttime = $now;
 171         $lastmin = $min;
 172 }
 173
 174 #
 175 # these are simple stub functions to make connecting easy in DXCron contexts
 176 #
 177
 178 # is it locally connected?
 179 sub connected
 180 {
 181         my $call = uc shift;
 182         return DXChannel::get($call);
 183 }
 184
 185 # is it remotely connected anywhere (with exact callsign)?
 186 sub present
 187 {
 188         my $call = uc shift;
 189         return Route::get($call);
 190 }
 191
 192 # is it remotely connected anywhere (ignoring SSIDS)?
 193 sub presentish
 194 {
 195         my $call = uc shift;
 196         my $c = Route::get($call);
 197         unless ($c) {
 198                 for (1..15) {
 199                         $c = Route::get("$call-$_");
 200                         last if $c;
 201                 }
 202         }
 203         return $c;
 204 }
 205
 206 # is it remotely connected anywhere (with exact callsign) and on node?
 207 sub present_on
 208 {
 209         my $call = uc shift;
 210         my $ncall = uc shift;
 211         my $node = Route::Node::get($ncall);
 212         return ($node) ? grep $call eq $_, $node->users : undef;
 213 }
 214
 215 # is it remotely connected (ignoring SSIDS) and on node?
 216 sub presentish_on
 217 {
 218         my $call = uc shift;
 219         my $ncall = uc shift;
 220         my $node = Route::Node::get($ncall);
 221         my $present;
 222         if ($node) {
 223                 $present = grep {/^$call/ } $node->users;
 224         }
 225         return $present;
 226 }
 227
 228 # last time this thing was connected
 229 sub last_connect
 230 {
 231         my $call = uc shift;
 232         return $main::systime if DXChannel::get($call);
 233         my $user = DXUser::get($call);
 234         return $user ? $user->lastin : 0;
 235 }
 236
 237 # disconnect a locally connected thing
 238 sub disconnect
 239 {
 240         my $call =  shift;
 241         run_cmd("disconnect $call");
 242 }
 243
 244 # start a connect process off
 245 sub start_connect
 246 {
 247         my $call = shift;
 248         # connecting is now done in one place - Yeah!
 249         run_cmd("connect $call");
 250 }
 251
 252 # spawn any old job off
 253 sub spawn
 254 {
 255         my $line = shift;
 256         my $t0 = [gettimeofday];
 257
 258         dbg("DXCron::spawn: $line") if isdbg("cron");
 259         my $fc = DXSubprocess->new();
 260         $fc->run(
 261                          sub {
 262                                  my @res = `$line`;
 263 #                                diffms("DXCron spawn 1", $line, $t0, scalar @res) if isdbg('chan');
 264                                  return @res
 265                          },
 266                          sub {
 267                                  my ($fc, $err, @res) = @_;
 268                                  if ($err) {
 269                                          my $s = "DXCron::spawn: error $err";
 270                                          dbg($s);
 271                                          return;
 272                                  }
 273                                  for (@res) {
 274                                          chomp;
 275                                          dbg("DXCron::spawn: $_") if isdbg("cron");
 276                                  }
 277                                  diffms("by DXCron::spawn", $line, $t0, scalar @res) if isdbg('progress');
 278                          }
 279                         );
 280 }
 281
 282 sub spawn_cmd
 283 {
 284         my $line = shift;
 285         my $t0 = [gettimeofday];
 286
 287         dbg("DXCron::spawn_cmd run: $line") if isdbg('cron');
 288         my $fc = DXSubprocess->new();
 289         $fc->run(
 290                          sub {
 291                                  ++$main::me->{_nospawn};
 292                                  my @res = $main::me->run_cmd($line);
 293 #                                diffms("DXCron spawn_cmd 1", $line, $t0, scalar @res) if isdbg('chan');
 294                                  return @res;
 295                          },
 296                          sub {
 297                                  my ($fc, $err, @res) = @_;
 298                                  --$main::me->{_nospawn};
 299                                  delete $main::me->{_nospawn} if exists $main::me->{_nospawn} && $main::me->{_nospawn} <= 0;
 300                                  if ($err) {
 301                                          my $s = "DXCron::spawn_cmd: error $err";
 302                                          dbg($s);
 303                                  }
 304                                  for (@res) {
 305                                          chomp;
 306                                          dbg("DXCron::spawn_cmd: $_") if isdbg("cron");
 307                                  }
 308                                  diffms("by DXCron::spawn_cmd", $line, $t0, scalar @res) if isdbg('progress');
 309                          }
 310                         );
 311 }
 312
 313 # do an rcmd to another cluster from the crontab
 314 sub rcmd
 315 {
 316         my $call = uc shift;
 317         my $line = shift;
 318
 319         # can we see it? Is it a node?
 320         my $noderef = Route::Node::get($call);
 321         return  unless $noderef && $noderef->version;
 322
 323         # send it
 324         DXProt::addrcmd($main::me, $call, $line);
 325 }
 326
 327 sub run_cmd
 328 {
 329         my $line = shift;
 330         dbg("DXCron::run_cmd: $line") if isdbg('cron');
 331         my @in = $main::me->run_cmd($line);
 332         for (@in) {
 333                 s/\s*$//;
 334                 dbg("DXCron::cmd out: $_") if isdbg('cron');
 335         }
 336 }
 337
 338 1;
 339 __END__