diff options
Diffstat (limited to 'src/mcron')
| -rw-r--r-- | src/mcron/crontab.scm | 228 | ||||
| -rw-r--r-- | src/mcron/main.scm | 319 | ||||
| -rw-r--r-- | src/mcron/scripts/cron.scm | 177 | ||||
| -rw-r--r-- | src/mcron/scripts/crontab.scm | 225 | ||||
| -rw-r--r-- | src/mcron/scripts/mcron.scm | 136 |
5 files changed, 556 insertions, 529 deletions
diff --git a/src/mcron/crontab.scm b/src/mcron/crontab.scm deleted file mode 100644 index 6be5c61..0000000 --- a/src/mcron/crontab.scm +++ /dev/null @@ -1,228 +0,0 @@ -;; Copyright (C) 2003, 2014 Dale Mellor -;; -;; 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/>. - - -;; Apart from the collecting of options and the handling of --help and --version -;; (which are done in the main.scm file), this file provides all the -;; functionality of the crontab personality. It is designed to be loaded and run -;; once, and then the calling program can exit and the crontab program will have -;; completed its function. - - - -;; 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. - -(let ((hit-server - (lambda (user-name) - (catch #t (lambda () - (let ((socket (socket AF_UNIX SOCK_STREAM 0))) - (connect socket AF_UNIX config-socket-file) - (display user-name socket) - (close socket))) - (lambda (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? - (lambda (file name) - (catch #t (lambda () - (with-input-from-file - file - (lambda () - (let loop ((input (read-line))) - (if (eof-object? input) - #f - (if (string=? input name) - #t - (loop (read-line)))))))) - (lambda (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. - - (if (> (+ (if (option-ref options 'edit #f) 1 0) - (if (option-ref options 'list #f) 1 0) - (if (option-ref options '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. - - (if (and (not (eqv? (getuid) 0)) - (option-ref options 'user #f)) - (mcron-error 8 "Only root can use the -u option.")) - - - - (let ( - - - ;; Iff the --user option is given, the crontab-user may be different - ;; from the real user. - - (crontab-user (option-ref options '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 (lambda (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 options 'list #f) - (catch #t (lambda () - (with-input-from-file crontab-file (lambda () - (do ((input (read-char) (read-char))) - ((eof-object? input)) - (display input))))) - (lambda (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 options 'edit #f) - (let ((temp-file (string-append config-tmp-dir - "/crontab." - (number->string (getpid))))) - (catch #t (lambda () (copy-file crontab-file temp-file)) - (lambda (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 - (lambda () (read-vixie-file temp-file)) - (lambda (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 options 'remove #f) - (catch #t (lambda () (delete-file crontab-file) - (hit-server crontab-user)) - noop)) - - - ;; !!!! 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 options '() '()))) - (let ((input-file (car (option-ref options '() '())))) - (catch-mcron-error - (if (string=? input-file "-") - (let ((input-string (stdin->string))) - (read-vixie-port (open-input-string input-string)) - (with-output-to-file crontab-file (lambda () - (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."))) - - -)) ;; End of file-level let-scopes. diff --git a/src/mcron/main.scm b/src/mcron/main.scm index db7dfd6..1faa1ae 100644 --- a/src/mcron/main.scm +++ b/src/mcron/main.scm @@ -16,30 +16,22 @@ ;; You should have received a copy of the GNU General Public License along ;; with GNU mcron. If not, see <http://www.gnu.org/licenses/>. -;;; This is the 'main' routine for the whole system; this module is the global -;;; entry point (after the minimal C wrapper); to all intents and purposes the -;;; program is pure Guile and starts here. - (define-module (mcron main) #:use-module (ice-9 getopt-long) #:use-module (ice-9 rdelim) - #:use-module (ice-9 regex) #:use-module (mcron config) #:use-module (mcron base) #:use-module (mcron job-specifier) #:use-module (mcron vixie-specification) - #:use-module (srfi srfi-2) - #:use-module (srfi srfi-26) - #:export (delete-run-file - main)) - -(define* (command-name #:optional (command (car (command-line)))) - "Extract the actual command name from COMMAND. This returns the last part -of COMMAND without any non-alphabetic characters. For example \"in.cron\" and -\"./mcron\" will return respectively \"cron\" and \"mcron\". - -When COMMAND is not specified this uses the first element of (command-line)." - (match:substring (regexp-exec (make-regexp "[[:alpha:]]*$") command))) + #:export (catch-mcron-error + mcron-error + parse-args + show-version + show-package-information + stdin->string + for-each-file + process-update-request) + #:re-export (option-ref)) (define (mcron-error exit-code . rest) "Print an error message (made up from the parts of REST), and if the @@ -47,7 +39,7 @@ EXIT-CODE error is fatal (present and non-zero) then exit to the system with EXIT-CODE." (with-output-to-port (current-error-port) (lambda () - (for-each display (append (list (command-name) ": ") rest)) + (for-each display (cons "mcron: " rest)) (newline))) (when (and exit-code (not (eq? exit-code 0))) (primitive-exit exit-code))) @@ -60,48 +52,14 @@ and exit with its error code." (lambda (key exit-code . msg) (apply mcron-error exit-code msg)))) -(define command-type - ;; We will be doing a lot of testing of the command name, so it makes sense - ;; to perform the string comparisons once and for all here. - (let* ((command (command-name)) - (command=? (cut string=? command <>))) - (cond ((command=? "mcron") 'mcron) - ((or (command=? "cron") (command=? "crond")) 'cron) - ((command=? "crontab") 'crontab) - (else (mcron-error 12 "The command name is invalid."))))) +(define (parse-args args option-desc-list) + "Parse ARGS with OPTION-DESC-LIST specification." + (catch 'misc-error + (lambda () (getopt-long args option-desc-list)) + (lambda (key func fmt args . rest) + (mcron-error 1 (apply format (append (list #f fmt) args)))))) -(define options - ;; There are a different set of options for the crontab personality compared - ;; to all the others, with the --help and --version options common to all - ;; the personalities. - (catch - 'misc-error - (lambda () - (getopt-long (command-line) - (append - (case command-type - ((crontab) - '((user (single-char #\u) (value #t)) - (edit (single-char #\e) (value #f)) - (list (single-char #\l) (value #f)) - (remove (single-char #\r) (value #f)))) - (else `((schedule (single-char #\s) (value #t) - (predicate - ,(lambda (value) - (string->number value)))) - (daemon (single-char #\d) (value #f)) - (noetc (single-char #\n) (value #f)) - (stdin (single-char #\i) (value #t) - (predicate - ,(lambda (value) - (or (string=? "vixie" value) - (string=? "guile" value)))))))) - '((version (single-char #\v) (value #f)) - (help (single-char #\h) (value #f)))))) - (lambda (key func fmt args . rest) - (mcron-error 1 (apply format (append (list #f fmt) args)))))) - -(define* (show-version #:optional (command (command-name))) +(define (show-version command) "Display version information for COMMAND and quit." (let* ((name config-package-name) (short-name (cadr (string-split name #\space))) @@ -111,8 +69,7 @@ Copyright (C) 2015 the ~a authors. License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html> This is free software: you are free to change and redistribute it. There is NO WARRANTY, to the extent permitted by law.\n" - command name version short-name) - (quit))) + command name version short-name))) (define (show-package-information) "Display where to get help and send bug reports." @@ -123,56 +80,6 @@ General help using GNU software: <http://www.gnu.org/gethelp/>\n" config-package-name config-package-url)) -(define* (show-help #:optional (command (command-name))) - "Display informations of usage for COMMAND and quit." - (simple-format #t "Usage: ~a" command) - (display - (case command-type - ((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)") - ((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).") - ((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") - (else "\nrubbish"))) - (newline) - (show-package-information) - (quit)) - -(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 (lambda () (delete-file config-pid-file) - (delete-file config-socket-file)) - noop) - (quit)) - (define (stdin->string) "Return standard input as a string." (with-output-to-string (lambda () (do ((in (read-char) (read-char))) @@ -188,83 +95,6 @@ is not specified" ((eof-object? file-name) (closedir dir)) (proc file-name)))) -(define process-user-file - (let ((guile-regexp (make-regexp "\\.gui(le)?$")) - (vixie-regexp (make-regexp "\\.vix(ie)?$"))) - (lambda* (file-name #:optional guile-syntax?) - "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=? (option-ref options 'stdin "guile") "vixie") - (read-vixie-port (current-input-port)) - (eval-string (stdin->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) - "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 (lambda (dir) - (catch #t - (lambda () - (for-each-file - (lambda (file) - (process-user-file (string-append dir "/" file))) - dir)) - (lambda (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-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 - (lambda () - (for-each-file - (lambda (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)) - (lambda (key . args) - (mcron-error 4 - "You do not have permission to access the system crontabs.")))) - -(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." - (if (eq? command-type 'cron) - (catch #t - (lambda () - (let ((sock (socket AF_UNIX SOCK_STREAM 0))) - (bind sock AF_UNIX config-socket-file) - (listen sock 5) - (list sock))) - (lambda (key . args) - (delete-file config-pid-file) - (mcron-error 1 "Cannot bind to UNIX socket " config-socket-file))) - '())) - (define (process-update-request fdes-list) "Read a user name from the socket, dealing with the /etc/crontab special case, remove all the user's jobs from the job list, and then re-read the @@ -286,116 +116,3 @@ comes in on the above socket." (remove-user-jobs user) (set-configuration-user user) (read-vixie-file (string-append config-spool-dir "/" user-name))))))) - - -;;; -;;; Entry point. -;;; - -(define (main . args) - ;; Turn debugging on if indicated. - (when config-debug - (debug-enable 'backtrace)) - (when (option-ref options 'version #f) - (show-version)) - (when (option-ref options 'help #f) - (show-help)) - - ;; Setup the cron process, if appropriate. If there is already a - ;; /var/run/cron.pid file, then we must assume a cron daemon is already - ;; running and refuse to start another one. - ;; - ;; Otherwise, clear the MAILTO environment variable so that output from cron - ;; jobs is sent to the various users (this may still be overridden in the - ;; configuration files), and call the function in the C wrapper to set up - ;; terminal signal responses to vector to the procedure above. The PID file - ;; will be filled in properly later when we have forked our daemon process - ;; (but not done if we are only viewing the schedules). - (when (eq? command-type 'cron) - (unless (eqv? (getuid) 0) - (mcron-error 16 - "This program must be run by the root user (and should have been " - "installed as such).")) - (when (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 ".)")) - (unless (option-ref options 'schedule #f) - (with-output-to-file config-pid-file noop)) - (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)) - - ;; Now we have the procedures in place for dealing with the contents of - ;; configuration files, the crontab personality is able to validate such - ;; files. If the user requested the crontab personality, we load and run the - ;; code here and then get out. - (when (eq? command-type 'crontab) - (load "crontab.scm") - (quit)) - - ;; 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. - (case command-type - ((mcron) - (if (null? (option-ref options '() '())) - (process-files-in-user-directory) - (for-each (lambda (file-path) (process-user-file file-path #t)) - (option-ref options '() '())))) - ((cron) - (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 (option-ref options 'noetc #f) - (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.")))) - - ;; If the user has requested a schedule of jobs that will run, we provide - ;; the information here and then get out. Start by determining the number - ;; of time points in the future that output is required for. This may be - ;; provided on the command line as a parameter to the --schedule option, or - ;; else we assume a default of 8. Finally, ensure that the count is some - ;; positive integer. - (and-let* ((count (option-ref options 'schedule #f))) - (set! count (string->number count)) - (display (get-schedule (if (<= count 0) 1 count))) - (quit)) - - ;; If we are supposed to run as a daemon process (either a --daemon option - ;; has been explicitly used, or we are running as cron or crond), detach - ;; from the terminal now. If we are running as cron, we can now write the - ;; PID file. - (when (option-ref options 'daemon (eq? command-type 'cron)) - (unless (eqv? (primitive-fork) 0) - (quit)) - (setsid) - (when (eq? command-type 'cron) - (with-output-to-file config-pid-file - (lambda () (display (getpid)) (newline))))) - - ;; Now the main loop. Forever execute the run-job-loop procedure in the - ;; mcron base, 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. Sergey Poznyakoff: we can also drop out of run-job-loop - ;; because of a SIGCHLD, so must test FDES-LIST. - (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/cron.scm b/src/mcron/scripts/cron.scm new file mode 100644 index 0000000..dd8f5ad --- /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 main) + #: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..43ae8f6 --- /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 main) + #: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 (stdin->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..30b2d2a --- /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 main) + #: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 (stdin->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))))))))) |