AboutSummaryRefsLogTreeCommitDiffStats
path: root/src/mcron
diff options
context:
space:
mode:
Diffstat (limited to 'src/mcron')
-rw-r--r--src/mcron/scripts/cron.scm51
-rw-r--r--src/mcron/scripts/crontab.scm125
-rw-r--r--src/mcron/scripts/mcron.scm66
3 files changed, 67 insertions, 175 deletions
diff --git a/src/mcron/scripts/cron.scm b/src/mcron/scripts/cron.scm
index 25c8a1a..b8463f6 100644
--- a/src/mcron/scripts/cron.scm
+++ b/src/mcron/scripts/cron.scm
@@ -19,7 +19,6 @@
(define-module (mcron scripts cron)
- #:use-module (ice-9 getopt-long)
#:use-module (ice-9 ftw)
#:use-module (mcron base)
#:use-module (mcron config)
@@ -31,29 +30,6 @@
-(define (show-help)
- (display "Usage: cron [OPTIONS]
-Unless an option is specified, run a cron daemon as a detached process,
-reading all the information in the users' crontabs and in /etc/crontab.
-
- -v, --version Display version
- -h, --help Display this help message
- -sN, --schedule[=]N Display the next N jobs that will be run by cron
- -n, --noetc Do not check /etc/crontab for updates (HIGHLY
- RECOMMENDED).")
- (newline)
- (show-package-information))
-
-
-
-(define %options `((schedule (single-char #\s) (value #t)
- (predicate ,string->number))
- (noetc (single-char #\n) (value #f))
- (version (single-char #\v) (value #f))
- (help (single-char #\h) (value #f))))
-
-
-
(define (delete-run-file)
"Remove the /var/run/cron.pid file so that crontab and other invocations of
cron don't get the wrong idea that a daemon is currently running. This
@@ -107,10 +83,7 @@ operation. The permissions on the /var/cron/tabs directory enforce this."
(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))
+(define (%process-files noetc?)
;; Clear MAILTO so that outputs are sent to the various users.
(setenv "MAILTO" #f)
;; Having defined all the necessary procedures for scanning various sets of
@@ -141,17 +114,10 @@ option.\n")
;;; Entry point.
;;;
-(define* (main #:optional (args (command-line)))
- (let ((opts (getopt-long args %options)))
- (when config-debug
- (debug-enable 'backtrace))
- (cond ((option-ref opts 'help #f)
- (show-help)
- (exit 0))
- ((option-ref opts 'version #f)
- (show-version "cron")
- (exit 0))
- ((not (zero? (getuid)))
+(define (main --schedule --noetc)
+ (when config-debug (debug-enable 'backtrace))
+
+ (cond ((not (zero? (getuid)))
(mcron-error 16
"This program must be run by the root user (and should"
" have been installed as such)."))
@@ -161,12 +127,11 @@ option.\n")
" 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)
+ (cond (--schedule
=> (λ (count)
(display-schedule (max 1 (string->number count)))
- (exit 0)))))))
+ (exit 0))))
+ (%process-files --noetc)))
;; Daemonize ourself.
(unless (eq? 0 (primitive-fork)) (exit 0))
diff --git a/src/mcron/scripts/crontab.scm b/src/mcron/scripts/crontab.scm
index 480eadc..0c5c47f 100644
--- a/src/mcron/scripts/crontab.scm
+++ b/src/mcron/scripts/crontab.scm
@@ -1,5 +1,5 @@
;;;; crontab -- edit user's cron tabs
-;;; Copyright © 2003, 2004 Dale Mellor <dale_mellor@users.sourceforge.net>
+;;; Copyright © 2003, 2004 Dale Mellor <>
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
;;;
;;; This file is part of GNU Mcron.
@@ -18,31 +18,12 @@
;;; along with GNU Mcron. If not, see <http://www.gnu.org/licenses/>.
(define-module (mcron scripts crontab)
- #:use-module (ice-9 getopt-long)
#:use-module (ice-9 rdelim)
#:use-module (mcron config)
#:use-module (mcron utils)
#:use-module (mcron vixie-specification)
#:export (main))
-(define (show-help)
- (display "Usage: crontab [-u user] file
- crontab [-u user] { -e | -l | -r }
- (default operation is replace, per 1003.2)
- -e (edit user's crontab)
- -l (list user's crontab)
- -r (delete user's crontab)")
- (newline)
- (show-package-information))
-
-(define %options
- '((user (single-char #\u) (value #t))
- (edit (single-char #\e) (value #f))
- (list (single-char #\l) (value #f))
- (remove (single-char #\r) (value #f))
- (version (single-char #\v) (value #f))
- (help (single-char #\h) (value #f))))
-
(define (hit-server user-name)
"Tell the running cron daemon that the user corresponding to
USER-NAME has modified his crontab. USER-NAME is written to the
@@ -56,6 +37,25 @@ USER-NAME has modified his crontab. USER-NAME is written to the
(lambda (key . args)
(display "Warning: a cron daemon is not running.\n"))))
+
+
+;; 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.
+(define (get-yes-no prompt . re-prompt)
+ (unless (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))))
+
+
+
(define (in-access-file? file name)
"Scan FILE which should contain one user name per line (such as
'/var/cron/allow' and '/var/cron/deny'). Return #t if NAME is in there, and
@@ -78,60 +78,34 @@ USER-NAME has modified his crontab. USER-NAME is written to the
;;; Entry point.
;;;
-(define* (main #:optional (args (command-line)))
- (let ((opts (getopt-long args %options)))
- (when config-debug
- (debug-enable 'backtrace))
- (cond ((option-ref opts 'help #f)
- (show-help)
- (exit 0))
- ((option-ref opts 'version #f)
- (show-version "crontab")
- (exit 0)))
- (let ((crontab-real-user
- ;; This program should have been installed SUID root. Here we get
- ;; the passwd entry for the real user who is running this program.
- (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)
+(define (main --user --edit --list --remove files)
+ (when config-debug (debug-enable 'backtrace))
+ (let ((crontab-real-user
+ ;; This program should have been installed SUID root. Here we get
+ ;; the passwd entry for the real user who is running this program.
+ (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 (< 1 (+ (if --edit 1 0) (if --list 1 0) (if --remove 1 0)))
(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))
+ (when (and (not (zero? (getuid))) --user)
(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))
+ (crontab-user (or --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))))))
+ (crontab-file
+ (string-append config-spool-dir "/" crontab-user)))
;; 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).
@@ -140,7 +114,7 @@ USER-NAME has modified his crontab. USER-NAME is written to the
;; 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)
+ (--list
(catch #t
(λ ()
(with-input-from-file crontab-file
@@ -163,7 +137,7 @@ USER-NAME has modified his crontab. USER-NAME is written to 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)
+ (--edit
(let ((temp-file (string-append config-tmp-dir
"/crontab."
(number->string (getpid)))))
@@ -191,12 +165,9 @@ USER-NAME has modified his crontab. USER-NAME is written to the
;; 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))
+ (--remove (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
@@ -206,8 +177,8 @@ USER-NAME has modified his crontab. USER-NAME is written to the
;; 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 '() '()))))
+ ((not (null? files))
+ (let ((input-file (car files)))
(catch-mcron-error
(if (string=? input-file "-")
(let ((input-string (read-string)))
@@ -222,4 +193,4 @@ USER-NAME has modified his crontab. USER-NAME is written to the
;; 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.")))))))
+ "usage error: file name must be specified for replace."))))))
diff --git a/src/mcron/scripts/mcron.scm b/src/mcron/scripts/mcron.scm
index 0da1cdf..48efae5 100644
--- a/src/mcron/scripts/mcron.scm
+++ b/src/mcron/scripts/mcron.scm
@@ -1,6 +1,6 @@
;;;; mcron -- run jobs at scheduled times
-;;; Copyright © 2003, 2012 Dale Mellor <dale_mellor@users.sourceforge.net>
-;;; Copyright © 2015, 2016, 2018 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2003, 2012, 2020 Dale Mellor <>
+;;; Copyright © 2015, 2016, 2018 Mathieu Lirzin <mthl@gnu.org>
;;;
;;; This file is part of GNU Mcron.
;;;
@@ -19,7 +19,6 @@
(define-module (mcron scripts mcron)
#:use-module (ice-9 ftw)
- #:use-module (ice-9 getopt-long)
#:use-module (ice-9 local-eval)
#:use-module (ice-9 rdelim)
#:use-module (mcron base)
@@ -31,28 +30,6 @@
-(define (show-help)
- (display "Usage: mcron [OPTION...] [FILE...]
-Run an mcron process according to the specifications in the FILE... (`-' for
-standard input), or use all the files in ~/.config/cron (or the deprecated
-~/.cron) with .guile or .vixie extensions.
-
- -d, --daemon Run as a daemon process
- -i, --stdin=(guile|vixie) Format of data passed as standard input or file
- arguments (default guile)
- -s, --schedule[=N] Display the next N (or 8) jobs that will be run
- -?, --help Give this help list
- -V, --version Print program version
-
-Mandatory or optional arguments to long options are also mandatory or optional
-for any corresponding short options.
-
-Report bugs to bug-mcron@gnu.org.
-
-"))
-
-
-
(define process-user-file
(let ((guile-regexp (make-regexp "\\.gui(le)?$"))
(vixie-regexp (make-regexp "\\.vix(ie)?$")))
@@ -107,38 +84,17 @@ $XDG_CONFIG_HOME is not defined uses ~/.config/cron instead)."
;;; Entry point.
;;;
-(define (main)
-
- (let ((options
- (getopt-long
- (command-line)
- `((daemon (single-char #\d) (value #f))
- (stdin (single-char #\i) (value #t)
- (predicate ,(λ (in) (or (string=? in "guile")
- (string=? in "vixie")))))
- (schedule (single-char #\s) (value optional)
- (predicate ,string->number))
- (help (single-char #\?))
- (version (single-char #\V))))))
-
- (cond ((option-ref options 'help #f) (show-help) (exit 0))
- ((option-ref options 'version #f) (show-version "mcron") (exit 0)))
-
- (when config-debug
- (debug-enable 'backtrace))
-
- (%process-files (option-ref options '() '())
- (option-ref options 'stdin "guile"))
+(define (main --daemon --schedule --stdin file-list)
- (cond ((option-ref options 'schedule #f)
+ (when config-debug (debug-enable 'backtrace))
+ (%process-files file-list (or --stdin "guile"))
+ (cond (--schedule
=> (λ (count)
- (let ((c (if (string? count) (string->number count) 8)))
- (display-schedule (if (exact-integer? c) (max 1 c) 8)))
+ (display-schedule
+ (max 1 (inexact->exact (floor (string->number count)))))
(exit 0)))
- ((option-ref options 'daemon #f)
- (case (primitive-fork)
- ((0) (setsid))
- (else (exit 0)))))
+ (--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
@@ -150,4 +106,4 @@ $XDG_CONFIG_HOME is not defined uses ~/.config/cron instead)."
;; 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)))))))
+ (process-update-request fdes-list))))))
generated by cgit v1.2.3 (git 2.46.2) at 2024-11-22 22:17:13 +0000