]> gb7djk.dxcluster.net Git - spider.git/blob - perl/DXCron.pm
ccbb78d4773a6a7466e81a6625e968cd15ffca92
[spider.git] / 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                          undef,
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                                  dbg($_) for @res;
259                          }
260                         );
261 }
262
263 # do an rcmd to another cluster from the crontab
264 sub rcmd
265 {
266         my $call = uc shift;
267         my $line = shift;
268
269         # can we see it? Is it a node?
270         my $noderef = Route::Node::get($call);
271         return  unless $noderef && $noderef->version;
272
273         # send it 
274         DXProt::addrcmd($main::me, $call, $line);
275 }
276
277 sub run_cmd
278 {
279         my $line = shift;
280         my @in = DXCommandmode::run_cmd($main::me, $line);
281         dbg("cmd run: $line") if isdbg('cron');
282         for (@in) {
283                 s/\s*$//og;
284                 dbg("cmd out: $_") if isdbg('cron');
285         }
286 }
287 1;
288 __END__