dmbcs/mcron
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

all: Separate programs in different executables.

Browse source 
This improves readability and complies with the GNU Coding Standards by
making the behavior of the programs independent of the name used to
invoke them.

* src/mcron/scripts/cron.scm: New file.
* src/mcron/scripts/crontab.scm: Likewise.
* src/mcron/scripts/mcron.scm: Likewise.
* Makefile.am (dist_mcronmodule_DATA): Remove 'src/mcron/crontab.scm'.
(bin_PROGRAMS): Add 'crontab'.
(sbin_PROGRAMS): Add 'cron'.
(mcron_CFLAGS, mcron_LDADD): Rename to ...
(AM_CFLAGS, LDADD): ... these.
(cron_SOURCES, cron_CPPFLAGS, cron_DEPENDENCIES)
(crontab_SOURCES, crontab_CPPFLAGS, crontab_DEPENDENCIES)
(mcron_CPPFLAGS, mcronscriptdir, dist_mcronscript_DATA): New variables.
(modules): Redefine it in terms of other '_DATA' variables.
* src/mcron/crontab.scm: Remove file.
* src/mcron/main.scm (parse-args): New procedure.
(command-name, command-type, options): Remove.
(show-version): Adapt.
(show-help, process-files-in-system-directory, cron-file-descriptors)
(main, process-user-file, process-files-in-user-directory): Move
procedures in the new files.
* src/mcron.c (inner_main): Define the current module at compile time.
* TODO: Update.
* .gitignore: Likewise.
This commit is contained in:
Mathieu Lirzin 2016-05-09 14:50:29 +02:00
commit c87c643ca1
No known key found for this signature in database
GPG key ID: 0ADEE10094604D37
9 changed files with 590 additions and 543 deletions
Download patch file Download diff file Expand all files Collapse all files

2
.gitignore vendored
View file

@ -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

41
Makefile.am
View file

@ -16,13 +16,25 @@
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
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

3
TODO
View file

@ -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.
<http://srfi.schemers.org/srfi-64/srfi-64.html>.

2
src/mcron.c
View file

@ -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)");

228
src/mcron/crontab.scm
View file

@ -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.

315
src/mcron/main.scm
View file

@ -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 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))))))
(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* (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))))))

177
src/mcron/scripts/cron.scm Normal file
View file

@ -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)))))))))

225
src/mcron/scripts/crontab.scm Normal file
View file

@ -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.")))))))

136
src/mcron/scripts/mcron.scm Normal file
View file

@ -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)))))))))