diff --git a/.gitignore b/.gitignore
index c064be1..d4fc72a 100644
--- a/.gitignore
+++ b/.gitignore
@@ -11,6 +11,8 @@
/build-aux/mdate-sh
/build-aux/missing
/build-aux/texinfo.tex
+/cron
+/crontab
/doc/config.texi
/doc/mcron.1
/doc/mcron.info
diff --git a/Makefile.am b/Makefile.am
index 8c105e9..dc47945 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -16,13 +16,25 @@
# You should have received a copy of the GNU General Public License
# along with this program. If not, see .
-bin_PROGRAMS = mcron
-mcron_SOURCES = src/mcron.c
-mcron_CFLAGS = @GUILE_CFLAGS@
-mcron_DEPENDENCIES = $(mcronmodule_DATA)
-mcron_LDADD = @GUILE_LIBS@
+bin_PROGRAMS = mcron crontab
+sbin_PROGRAMS = cron
-modules = \
+AM_CFLAGS = @GUILE_CFLAGS@
+LDADD = @GUILE_LIBS@
+
+mcron_SOURCES = src/mcron.c
+mcron_CPPFLAGS = -DPROGRAM="\"mcron\""
+mcron_DEPENDENCIES = $(modules:%.scm=%.go)
+
+cron_SOURCES = src/mcron.c
+cron_CPPFLAGS = -DPROGRAM="\"cron\""
+cron_DEPENDENCIES = $(modules:%.scm=%.go)
+
+crontab_SOURCES = src/mcron.c
+crontab_CPPFLAGS = -DPROGRAM="\"crontab\""
+crontab_DEPENDENCIES = $(modules:%.scm=%.go)
+
+dist_mcronmodule_DATA = \
src/mcron/base.scm \
src/mcron/environment.scm \
src/mcron/job-specifier.scm \
@@ -32,13 +44,22 @@ modules = \
src/mcron/vixie-time.scm
mcronmodule_DATA = \
- $(modules:%.scm=%.go) \
+ $(dist_mcronmodule_DATA:%.scm=%.go) \
src/mcron/config.scm \
src/mcron/config.go
-dist_mcronmodule_DATA = \
- $(modules) \
- src/mcron/crontab.scm
+mcronscriptdir = $(mcronmoduledir)/scripts
+dist_mcronscript_DATA = \
+ src/mcron/scripts/cron.scm \
+ src/mcron/scripts/crontab.scm \
+ src/mcron/scripts/mcron.scm
+
+mcronscript_DATA = $(dist_mcronscript_DATA:%.scm=%.go)
+
+modules = \
+ $(dist_mcronmodule_DATA) \
+ $(dist_mcronscript_DATA) \
+ src/mcron/config.scm
# Unset 'GUILE_LOAD_COMPILED_PATH' altogether while compiling. Otherwise, if
# $GUILE_LOAD_COMPILED_PATH contains $(mcronmoduledir), we may find .go files
diff --git a/TODO b/TODO
index b43f233..2b7329f 100644
--- a/TODO
+++ b/TODO
@@ -20,9 +20,6 @@ Maybe in the near future...
core or other users' files up. Then allow scheme code in the system
crontabs.
- * Make mcron behavior not depend on the name used to invoke it, to conform
- to GNU Coding Standards.
-
* Provide a test suite using SRFI-64 API.
.
diff --git a/src/mcron.c b/src/mcron.c
index 92e1a37..026b077 100644
--- a/src/mcron.c
+++ b/src/mcron.c
@@ -53,7 +53,7 @@ inner_main (void *closure, int argc, char **argv)
scm_c_eval_string ("(set! %load-compiled-path (cons \""
PACKAGE_LOAD_PATH "\" %load-compiled-path))");
}
- scm_set_current_module (scm_c_resolve_module ("mcron main"));
+ scm_set_current_module (scm_c_resolve_module ("mcron scripts " PROGRAM));
/* Register set_cron_signals to be called from Guile. */
scm_c_define_gsubr ("c-set-cron-signals", 0, 0, 0, set_cron_signals);
scm_c_eval_string ("(main)");
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 .
-
-
-;; 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 .
-;;; 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
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: \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
+;;; Copyright © 2015, 2016 Mathieu Lirzin
+;;;
+;;; 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 .
+
+(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
+;;; Copyright © 2016 Mathieu Lirzin
+;;;
+;;; 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 .
+
+(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
+;;; Copyright © 2015, 2016 Mathieu Lirzin
+;;;
+;;; 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 .
+
+(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)))))))))