SummaryRefsLogTreeCommitDiffStats
path: root/src/mcron/scripts/cron.scm
blob: 25c8a1a56618e1cd5433a43a6455c21b9402a626 (about) (plain) (blame)
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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
;;;; cron -- daemon for running jobs at scheduled times
;;; Copyright © 2003, 2012 Dale Mellor <dale_mellor@users.sourceforge.net>
;;; 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 cron)
  #:use-module (ice-9 getopt-long)
  #:use-module (ice-9 ftw)
  #:use-module (mcron base)
  #:use-module (mcron config)
  #:use-module (mcron job-specifier)
  #:use-module (mcron utils)
  #:use-module (mcron vixie-specification)
  #:use-module (srfi srfi-2)
  #:export (main))



(define (show-help)
  (display "Usage: cron [OPTIONS]
Unless an option is specified, run a cron daemon as a detached process,
reading all the information in the users' crontabs and in /etc/crontab.

  -v, --version             Display version
  -h, --help                Display this help message
  -sN, --schedule[=]N       Display the next N jobs that will be run by cron
  -n, --noetc               Do not check /etc/crontab for updates (HIGHLY
                              RECOMMENDED).")
  (newline)
  (show-package-information))



(define  %options  `((schedule (single-char #\s) (value #t)
                               (predicate ,string->number))
                     (noetc    (single-char #\n) (value #f))
                     (version  (single-char #\v) (value #f))
                     (help     (single-char #\h) (value #f))))



(define (delete-run-file)
  "Remove the /var/run/cron.pid file so that crontab and other invocations of
cron don't get the wrong idea that a daemon is currently running.  This
procedure is called from the C front-end whenever a terminal signal is
received."
  (catch #t
    (λ ()
      (delete-file config-pid-file)
      (delete-file config-socket-file))
    noop)
  (quit))



(define (cron-file-descriptors)
  "Establish a socket to listen for updates from a crontab program, and return
a list containing the file descriptors correponding to the files read by
crontab.  This requires that command-type is 'cron."
  (catch #t
    (λ ()
      (let ((sock (socket AF_UNIX SOCK_STREAM 0)))
        (bind sock AF_UNIX config-socket-file)
        (listen sock 5)
        (list sock)))
    (λ (key . args)
      (delete-file config-pid-file)
      (mcron-error 1 "Cannot bind to UNIX socket " config-socket-file))))



(define (process-files-in-system-directory)
  "Process all the files in the crontab directory.  When the job procedure is
run on behalf of the configuration files, the jobs are registered on the
system with the appropriate user.  Only root should be able to perform this
operation.  The permissions on the /var/cron/tabs directory enforce this."

  (define (user-entry name)
    ;; Return the user database entry if NAME is valid, otherwise #f.
    (false-if-exception (getpwnam name)))

  (catch #t
    (λ ()
      (for-each
       (λ (user)
         (and-let* ((entry (user-entry user))) ;crontab without user?
           (set-configuration-user entry)
           (catch-mcron-error
            (read-vixie-file (string-append config-spool-dir "/" user)))))
       (scandir config-spool-dir)))
    (λ (key . args)
      (mcron-error 4
        "You do not have permission to access the system crontabs."))))

(define (%process-files schedule? noetc?)
  ;; XXX: What is this supposed to do?
  (when schedule?
    (with-output-to-file config-pid-file noop))
  ;; Clear MAILTO so that outputs are sent to the various users.
  (setenv "MAILTO" #f)
  ;; Having defined all the necessary procedures for scanning various sets of
  ;; files, we perform the actual configuration of the program depending on
  ;; the personality we are running as. If it is mcron, we either scan the
  ;; files passed on the command line, or else all the ones in the user's
  ;; .config/cron (or .cron) directory. If we are running under the cron
  ;; personality, we read the /var/cron/tabs directory and also the
  ;; /etc/crontab file.
  (process-files-in-system-directory)
  (use-system-job-list)
  (catch-mcron-error
   (read-vixie-file "/etc/crontab" parse-system-vixie-line))
  (use-user-job-list)
  (unless noetc?
    (display "\
WARNING: cron will check for updates to /etc/crontab EVERY MINUTE. If you do
not use this file, or you are prepared to manually restart cron whenever you
make a change, then it is HIGHLY RECOMMENDED that you use the --noetc
option.\n")
    (set-configuration-user "root")
    (job '(- (next-minute-from (next-minute)) 6)
         check-system-crontab
         "/etc/crontab update checker.")))


;;;
;;; Entry point.
;;;

(define* (main #:optional (args (command-line)))
  (let ((opts (getopt-long args %options)))
    (when config-debug
      (debug-enable 'backtrace))
    (cond  ((option-ref opts 'help #f)
               (show-help)
               (exit 0))
           ((option-ref opts 'version #f)
               (show-version "cron")
               (exit 0))
           ((not (zero? (getuid)))
               (mcron-error 16
                   "This program must be run by the root user (and should"
                   " have been installed as such)."))
           ((access? config-pid-file F_OK)
               (mcron-error 1
                   "A cron daemon is already running.\n  (If you are sure"
                   " this is not true, remove the file\n   "
                   config-pid-file ".)"))
           (else
               (%process-files (option-ref opts 'schedule #f)
                               (option-ref opts 'noetc #f))
               (cond ((option-ref opts 'schedule #f)
                      => (λ (count)
                           (display-schedule (max 1 (string->number count)))
                           (exit 0)))))))

  ;; Daemonize ourself.
  (unless  (eq? 0 (primitive-fork))  (exit 0))
  (setsid)

  ;; Set up process signal handlers, as signals are the only way to terminate
  ;; the daemon and we MUST be graceful in defeat.
  (for-each   (λ (x)  (sigaction  x
                          (λ (sig)  (catch #t
                                           (λ ()
                                             (delete-file config-pid-file)
                                             (delete-file config-socket-file))
                                           noop)
                             (exit EXIT_FAILURE))))
                '(SIGTERM SIGINT SIGQUIT SIGHUP))

  ;; We can now write the PID file.
  (with-output-to-file  config-pid-file
                        (λ () (display (getpid)) (newline)))

  ;; 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 (cron-file-descriptors)))
     (while #t
       (run-job-loop fdes-list)
       (unless (null? fdes-list) (process-update-request fdes-list))))))