1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
;;;; mcron -- run jobs at scheduled times
;;; Copyright © 2003, 2012, 2020 Dale Mellor <>
;;; Copyright © 2015, 2016, 2018 Mathieu Lirzin <mthl@gnu.org>
;;;
;;; This file is part of GNU Mcron.
;;;
;;; GNU Mcron is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; GNU Mcron is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Mcron. If not, see <http://www.gnu.org/licenses/>.
(define-module (mcron scripts mcron)
#:use-module (ice-9 ftw)
#:use-module (ice-9 local-eval)
#:use-module (ice-9 rdelim)
#:use-module (mcron base)
#:use-module (mcron config)
#:use-module (mcron job-specifier) ; For user/system files.
#:use-module (mcron utils)
#:use-module (mcron vixie-specification)
#:export (main))
(define process-user-file
(let ((guile-regexp (make-regexp "\\.gui(le)?$"))
(vixie-regexp (make-regexp "\\.vix(ie)?$")))
(lambda* (file-name #:optional guile-syntax? #:key (input "guile"))
"Process FILE-NAME according its extension. When GUILE-SYNTAX? is TRUE,
force guile syntax usage. If FILE-NAME format is not recognized, it is
silently ignored."
(cond ((string=? "-" file-name)
(if (string=? input "vixie")
(read-vixie-port (current-input-port))
(eval-string (read-string)
(resolve-module '(mcron job-specifier)))))
((or guile-syntax? (regexp-exec guile-regexp file-name))
(eval-string (read-delimited "" (open-input-file file-name))
(resolve-module '(mcron job-specifier))))
((regexp-exec vixie-regexp file-name)
(read-vixie-file file-name))))))
(define (process-files-in-user-directory input-type)
"Process files in $XDG_CONFIG_HOME/cron and/or ~/.cron directories (if
$XDG_CONFIG_HOME is not defined uses ~/.config/cron instead)."
(let ((errors 0)
(home-directory (passwd:dir (getpw (getuid)))))
(map (λ (dir)
(catch #t
(λ ()
(for-each (λ (file)
(process-user-file (string-append dir "/" file)
#:input input-type))
(scandir dir)))
(λ (key . args)
(set! errors (1+ errors)))))
(list (string-append home-directory "/.cron")
(string-append (or (getenv "XDG_CONFIG_HOME")
(string-append home-directory "/.config"))
"/cron")))
(when (eq? 2 errors)
(mcron-error 13
"Cannot read files in your ~/.config/cron (or ~/.cron) directory."))))
(define (%process-files files input-type)
(if (null? files)
(process-files-in-user-directory input-type)
(for-each (λ (file) (process-user-file file #t)) files)))
;;;
;;; Entry point.
;;;
(define (main --daemon --schedule --stdin file-list)
(when config-debug (debug-enable 'backtrace))
(%process-files file-list (or --stdin "guile"))
(cond (--schedule
=> (λ (count)
(display-schedule
(max 1 (inexact->exact (floor (string->number count)))))
(exit 0)))
(--daemon (case (primitive-fork) ((0) (setsid))
(else (exit 0)))))
;; Forever execute the 'run-job-loop', and when it drops out (can only be
;; because a message has come in on the socket) we process the socket
;; request before restarting the loop again.
(catch-mcron-error
(let ((fdes-list '()))
(while #t
(run-job-loop fdes-list)
;; we can also drop out of run-job-loop because of a SIGCHLD,
;; so must test FDES-LIST.
(unless (null? fdes-list)
(process-update-request fdes-list))))))
|
