Merge branch 'devel'

3 files changed, 538 insertions, 0 deletions

diff --git a/src/mcron/scripts/cron.scm b/src/mcron/scripts/cron.scm
new file mode 100644
index 0000000..d043d79
--- /dev/null
+++ b/src/mcron/scripts/cron.scm
@@ -0,0 +1,177 @@
+;;;; cron -- daemon for running jobs at scheduled times
+;;; Copyright © 2003, 2012 Dale Mellor <dale_mellor@users.sourceforge.net>
+;;; Copyright © 2015, 2016 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 (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 ,(λ (str) (string->number str))))
+    (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-file
+       (λ (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)))))
+       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)
+  ;; XXX: At compile time, this yields a "possibly unbound variable" warning,
+  ;; but this is OK since it is bound in the C wrapper.
+  (c-set-cron-signals)
+  ;; 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 (parse-args 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) ;display jobs schedule
+             => (λ (count)
+                  (display (get-schedule (max 1 (string->number count))))
+                  (exit 0)))
+            (else (case (primitive-fork) ;run the daemon
+                    ((0)
+                     (setsid)
+                     ;; we can now write the PID file.
+                     (with-output-to-file config-pid-file
+                       (λ () (display (getpid)) (newline))))
+                    (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 (cron-file-descriptors)))
+         (while #t
+           (run-job-loop fdes-list)
+           (unless (null? fdes-list)
+             (process-update-request fdes-list)))))))))
diff --git a/src/mcron/scripts/crontab.scm b/src/mcron/scripts/crontab.scm
new file mode 100644
index 0000000..502fec6
--- /dev/null
+++ b/src/mcron/scripts/crontab.scm
@@ -0,0 +1,225 @@
+;;;; crontab -- edit user's cron tabs
+;;; Copyright © 2003, 2004 Dale Mellor <dale_mellor@users.sourceforge.net>
+;;; Copyright © 2016 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 crontab)
+  #:use-module (ice-9 rdelim)
+  #:use-module (mcron config)
+  #:use-module (mcron utils)
+  #:use-module (mcron vixie-specification)
+  #:export (main))
+
+(define* (show-help)
+  (display "Usage: crontab [-u user] file
+       crontab [-u user] { -e | -l | -r }
+               (default operation is replace, per 1003.2)
+       -e      (edit user's crontab)
+       -l      (list user's crontab)
+       -r      (delete user's crontab")
+  (newline)
+  (show-package-information))
+
+(define %options
+  '((user     (single-char #\u) (value #t))
+    (edit     (single-char #\e) (value #f))
+    (list     (single-char #\l) (value #f))
+    (remove   (single-char #\r) (value #f))
+    (version  (single-char #\v) (value #f))
+    (help     (single-char #\h) (value #f))))
+
+
+;;;
+;;; Entry point.
+;;;
+
+(define* (main #:optional (args (command-line)))
+  (let ((opts (parse-args 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 "crontab")
+           (exit 0)))
+    (let ((hit-server
+           (λ (user-name)
+             ;; Procedure to communicate with running cron daemon that a user
+             ;; has modified his crontab. The user name is written to the
+             ;; /var/cron/socket UNIX socket.
+             (catch #t
+               (λ ()
+                 (let ((socket (socket AF_UNIX SOCK_STREAM 0)))
+                   (connect socket AF_UNIX config-socket-file)
+                   (display user-name socket)
+                   (close socket)))
+               (λ (key . args)
+                 (display "Warning: a cron daemon is not running.\n")))))
+
+          ;; Procedure to scan a file containing one user name per line (such
+          ;; as /var/cron/allow and /var/cron/deny), and determine if the
+          ;; given name is in there. The procedure returns #t, #f, or '() if
+          ;; the file does not exist.
+          (in-access-file?
+           (λ (file name)
+             (catch #t
+               (λ ()
+                 (with-input-from-file file
+                   (λ ()
+                     (let loop ((input (read-line)))
+                       (if (eof-object? input)
+                           #f
+                           (if (string=? input name)
+                               #t
+                               (loop (read-line))))))))
+               (λ (key . args) '()))))
+
+          ;; This program should have been installed SUID root. Here we get
+          ;; the passwd entry for the real user who is running this program.
+          (crontab-real-user (passwd:name (getpw (getuid)))))
+
+      ;; If the real user is not allowed to use crontab due to the
+      ;; /var/cron/allow and/or /var/cron/deny files, bomb out now.
+      (if (or (eq? (in-access-file? config-allow-file crontab-real-user) #f)
+              (eq? (in-access-file? config-deny-file crontab-real-user) #t))
+          (mcron-error 6 "Access denied by system operator."))
+
+      ;; Check that no more than one of the mutually exclusive options are
+      ;; being used.
+      (when (> (+ (if (option-ref opts 'edit #f) 1 0)
+                  (if (option-ref opts 'list #f) 1 0)
+                  (if (option-ref opts 'remove #f) 1 0))
+               1)
+        (mcron-error 7 "Only one of options -e, -l or -r can be used."))
+
+      ;; Check that a non-root user is trying to read someone else's files.
+      (when (and (not (zero? (getuid)))
+                 (option-ref opts 'user #f))
+        (mcron-error 8 "Only root can use the -u option."))
+
+      (letrec* (;; Iff the --user option is given, the crontab-user may be
+                ;; different from the real user.
+                (crontab-user (option-ref opts 'user crontab-real-user))
+                ;; So now we know which crontab file we will be manipulating.
+                (crontab-file (string-append config-spool-dir "/" crontab-user))
+                ;; Display the prompt and wait for user to type his
+                ;; choice. Return #t if the answer begins with 'y' or 'Y',
+                ;; return #f if it begins with 'n' or 'N', otherwise ask
+                ;; again.
+                (get-yes-no (λ (prompt . re-prompt)
+                              (if (not (null? re-prompt))
+                                  (display "Please answer y or n.\n"))
+                              (display (string-append prompt " "))
+                              (let ((r (read-line)))
+                                (if (not (string-null? r))
+                                    (case (string-ref r 0)
+                                      ((#\y #\Y) #t)
+                                      ((#\n #\N) #f)
+                                      (else (get-yes-no prompt #t)))
+                                    (get-yes-no prompt #t))))))
+        ;; There are four possible sub-personalities to the crontab
+        ;; personality: list, remove, edit and replace (when the user uses no
+        ;; options but supplies file names on the command line).
+        (cond
+         ;; In the list personality, we simply open the crontab and copy it
+         ;; character-by-character to the standard output. If anything goes
+         ;; wrong, it can only mean that this user does not have a crontab
+         ;; file.
+         ((option-ref opts 'list #f)
+          (catch #t
+            (λ ()
+              (with-input-from-file crontab-file
+                (λ ()
+                  (do ((input (read-char) (read-char)))
+                      ((eof-object? input))
+                    (display input)))))
+            (λ (key . args)
+              (display (string-append "No crontab for "
+                                      crontab-user
+                                      " exists.\n")))))
+
+         ;; In the edit personality, we determine the name of a temporary file
+         ;; and an editor command, copy an existing crontab file (if it is
+         ;; there) to the temporary file, making sure the ownership is set so
+         ;; the real user can edit it; once the editor returns we try to read
+         ;; the file to check that it is parseable (but do nothing more with
+         ;; the configuration), and if it is okay (this program is still
+         ;; running!) we move the temporary file to the real crontab, wake the
+         ;; cron daemon up, and remove the temporary file. If the parse fails,
+         ;; we give user a choice of editing the file again or quitting the
+         ;; program and losing all changes made.
+         ((option-ref opts 'edit #f)
+          (let ((temp-file (string-append config-tmp-dir
+                                          "/crontab."
+                                          (number->string (getpid)))))
+            (catch #t
+              (λ () (copy-file crontab-file temp-file))
+              (λ (key . args) (with-output-to-file temp-file noop)))
+            (chown temp-file (getuid) (getgid))
+            (let retry ()
+              (system (string-append
+                       (or (getenv "VISUAL") (getenv "EDITOR") "vi")
+                       " "
+                       temp-file))
+              (catch 'mcron-error
+                (λ () (read-vixie-file temp-file))
+                (λ (key exit-code . msg)
+                  (apply mcron-error 0 msg)
+                  (if (get-yes-no "Edit again?")
+                      (retry)
+                      (begin
+                        (mcron-error 0 "Crontab not changed")
+                        (primitive-exit 0))))))
+            (copy-file temp-file crontab-file)
+            (delete-file temp-file)
+            (hit-server crontab-user)))
+
+         ;; In the remove personality we simply make an effort to delete the
+         ;; crontab and wake the daemon. No worries if this fails.
+         ((option-ref opts 'remove #f)
+          (catch #t
+            (λ ()
+              (delete-file crontab-file)
+              (hit-server crontab-user))
+            noop))
+
+         ;; XXX: This comment is wrong.
+         ;; In the case of the replace personality we loop over all the
+         ;; arguments on the command line, and for each one parse the file to
+         ;; make sure it is parseable (but subsequently ignore the
+         ;; configuration), and all being well we copy it to the crontab
+         ;; location; we deal with the standard input in the same way but
+         ;; different. :-) In either case the server is woken so that it will
+         ;; read the newly installed crontab.
+         ((not (null? (option-ref opts '() '())))
+          (let ((input-file (car (option-ref opts '() '()))))
+            (catch-mcron-error
+             (if (string=? input-file "-")
+                 (let ((input-string (read-string)))
+                   (read-vixie-port (open-input-string input-string))
+                   (with-output-to-file crontab-file
+                     (λ () (display input-string))))
+                 (begin
+                   (read-vixie-file input-file)
+                   (copy-file input-file crontab-file))))
+            (hit-server crontab-user)))
+
+         ;; The user is being silly. The message here is identical to the one
+         ;; Vixie cron used to put out, for total compatibility.
+         (else (mcron-error 15
+                 "usage error: file name must be specified for replace.")))))))
diff --git a/src/mcron/scripts/mcron.scm b/src/mcron/scripts/mcron.scm
new file mode 100644
index 0000000..b6c7729
--- /dev/null
+++ b/src/mcron/scripts/mcron.scm
@@ -0,0 +1,136 @@
+;;;; mcron -- run jobs at scheduled times
+;;; Copyright © 2003, 2012 Dale Mellor <dale_mellor@users.sourceforge.net>
+;;; Copyright © 2015, 2016 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 (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 (show-help)
+  (display "Usage: mcron [OPTIONS] [FILES]
+Run an mcron process according to the specifications in the FILES (`-' for
+standard input), or use all the files in ~/.config/cron (or the
+deprecated ~/.cron) with .guile or .vixie extensions.
+
+  -v, --version             Display version
+  -h, --help                Display this help message
+  -sN, --schedule[=]N       Display the next N jobs that will be run by mcron
+  -d, --daemon              Immediately detach the program from the terminal
+                              and run as a daemon process
+  -i, --stdin=(guile|vixie) Format of data passed as standard input or
+                              file arguments (default guile)")
+  (newline)
+  (show-package-information))
+
+(define %options
+  `((schedule (single-char #\s) (value #t)
+              (predicate ,(λ (str) (string->number str))))
+    (daemon   (single-char #\d) (value #f))
+    (noetc    (single-char #\n) (value #f))
+    (stdin    (single-char #\i) (value #t)
+              (predicate ,(λ (val)
+                            (or (string=? val "guile")
+                                (string=? val "vixie")))))
+    (version  (single-char #\v) (value #f))
+    (help     (single-char #\h) (value #f))))
+
+(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))))
+            ((or guile-syntax? (regexp-exec guile-regexp file-name))
+             (load file-name))
+            ((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
+                (λ (file)
+                  (process-user-file (string-append dir "/" file)
+                                     #:input input-type))
+                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 #:optional (args (command-line)))
+  (let ((opts (parse-args 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 "mcron")
+           (exit 0))
+          (else
+           (%process-files (option-ref opts '() '())
+                           (option-ref opts 'stdin "guile"))
+           (cond ((option-ref opts 'schedule #f) ;display jobs schedule
+                  => (λ (count)
+                       (display (get-schedule (max 1 (string->number count))))
+                       (exit 0)))
+                 ((option-ref opts 'daemon #f) ;run mcron as a 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)))))))))