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