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

Using new Guile command-line-processor.

Browse source
This commit is contained in:
Dale Mellor 2020-05-08 20:43:50 +01:00
commit 6a9bfcea40
6 changed files with 195 additions and 178 deletions
Download patch file Download diff file Expand all files Collapse all files

47
src/cron.in
View file

@ -2,9 +2,52 @@
-*- scheme -*- -*- scheme -*-
!# !#
;;;; cron -- run jobs at scheduled times
;;; Copyright © 2003, 2012, 2020 Dale Mellor <mcron-lsfnyl@rdmp.org>
;;; Copyright © 2015, 2016, 2018 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/>.
(unless (getenv "MCRON_UNINSTALLED") (unless (getenv "MCRON_UNINSTALLED")
(set! %load-path (cons "%modsrcdir%" %load-path)) (set! %load-path (cons "%modsrcdir%" %load-path))
(set! %load-compiled-path (cons "%modbuilddir%" %load-compiled-path))) (set! %load-compiled-path (cons "%modbuilddir%" %load-compiled-path)))
(use-modules (mcron scripts cron)) (use-modules (mcron scripts cron)
(main) (ice-9 command-line-processor))
(process-command-line (command-line)
application "cron"
version "%VERSION%"
usage "[OPTIONS]"
help-preamble
"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."
option (--schedule=8 -s string->number
"display the next N (or 8) jobs that will be"
"run, and exit")
option (--noetc -n "do not check /etc/crontab for updates (use"
"of this option is HIGHLY RECOMMENDED)")
help-postamble
"Mandatory or optional arguments to long options are also mandatory or "
"optional for any corresponding short options."
bug-address "%PACKAGE_BUGREPORT%"
copyright
"2003, 2012, 2015, 2016, 2018, 2020 Free Software Foundation, Inc."
license GPLv3)
(main --schedule --noetc)

38
src/crontab.in
View file

@ -2,8 +2,44 @@
-*- scheme -*- -*- scheme -*-
!# !#
;;;; crontab -- run jobs at scheduled times
;;; Copyright © 2003, 2020 Dale Mellor <mcron-lsfnyl@rdmp.org>
;;; Copyright © 2015, 2016, 2018 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/>.
(unless (getenv "MCRON_UNINSTALLED") (unless (getenv "MCRON_UNINSTALLED")
(set! %load-path (cons "%modsrcdir%" %load-path)) (set! %load-path (cons "%modsrcdir%" %load-path))
(set! %load-compiled-path (cons "%modbuilddir%" %load-compiled-path))) (set! %load-compiled-path (cons "%modbuilddir%" %load-compiled-path)))
((@ (mcron scripts crontab) main)) (use-modules (mcron scripts crontab)
(ice-9 command-line-processor))
(process-command-line (command-line)
application "crontab"
version "%VERSION%"
usage "[-u user] { -e | -l | -r }"
help-preamble "the default operation is to replace, per 1003.2"
option (--user= -u "the user whose files are to be manipulated")
option (--edit -e "edit this userʼs crontab")
option (--list -l "list this userʼs crontab")
option (--remove -r "delete the userʼs crontab")
bug-address "%PACKAGE_BUGREPORT%"
copyright "2003, 2016, 2020 Free Software Foundation, Inc."
license GPLv3)
((@ (mcron scripts crontab) main) --user --edit --list --remove --!)

50
src/mcron.in
View file

@ -2,9 +2,55 @@
-*- scheme -*- -*- scheme -*-
!# !#
;;;; mcron -- run jobs at scheduled times
;;; Copyright © 2003, 2012, 2020 Dale Mellor <mcron-lsfnyl@rdmp.org>
;;; Copyright © 2015, 2016, 2018 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/>.
(unless (getenv "MCRON_UNINSTALLED") (unless (getenv "MCRON_UNINSTALLED")
(set! %load-path (cons "%modsrcdir%" %load-path)) (set! %load-path (cons "%modsrcdir%" %load-path))
(set! %load-compiled-path (cons "%modbuilddir%" %load-compiled-path))) (set! %load-compiled-path (cons "%modbuilddir%" %load-compiled-path)))
(use-modules (mcron scripts mcron)) (use-modules (mcron scripts mcron)
(main) (ice-9 command-line-processor))
(process-command-line (command-line)
application "mcron"
version "%VERSION%"
usage "[OPTIONS ...] [FILES ...]"
help-preamble
"Run unattended jobs according to instructions in the FILES... "
"(`-' for standard input), or use all the files in ~/.config/cron "
"(or the deprecated ~/.cron) with .guile or .vixie extensions.\n"
"Note that --daemon and --schedule are mutually exclusive."
option (--daemon -d "run as a daemon process")
option (--schedule=8 -s string->number
"display the next N (or 8) jobs that will be run,"
"and then exit")
option (--stdin=guile short-i (λ (in) (or (string=? in "guile")
(string=? in "vixie")))
"format of data passed as standard input or file "
"arguments, 'guile' or 'vixie' (default guile)")
help-postamble
"Mandatory or optional arguments to long options are also mandatory or "
"optional for any corresponding short options."
bug-address "%PACKAGE_BUGREPORT%"
copyright "2003, 2006, 2014, 2020 Free Software Foundation, Inc."
license GPLv3)
(main --daemon --schedule --stdin --!)

51
src/mcron/scripts/cron.scm
View file

@ -19,7 +19,6 @@
(define-module (mcron scripts cron) (define-module (mcron scripts cron)
#:use-module (ice-9 getopt-long)
#:use-module (ice-9 ftw) #:use-module (ice-9 ftw)
#:use-module (mcron base) #:use-module (mcron base)
#:use-module (mcron config) #: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) (define (delete-run-file)
"Remove the /var/run/cron.pid file so that crontab and other invocations of "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 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 (mcron-error 4
"You do not have permission to access the system crontabs.")))) "You do not have permission to access the system crontabs."))))
(define (%process-files schedule? noetc?) (define (%process-files 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. ;; Clear MAILTO so that outputs are sent to the various users.
(setenv "MAILTO" #f) (setenv "MAILTO" #f)
;; Having defined all the necessary procedures for scanning various sets of ;; Having defined all the necessary procedures for scanning various sets of
@ -141,17 +114,10 @@ option.\n")
;;; Entry point. ;;; Entry point.
;;; ;;;
(define* (main #:optional (args (command-line))) (define (main --schedule --noetc)
(let ((opts (getopt-long args %options))) (when config-debug (debug-enable 'backtrace))
(when config-debug
(debug-enable 'backtrace)) (cond ((not (zero? (getuid)))
(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 (mcron-error 16
"This program must be run by the root user (and should" "This program must be run by the root user (and should"
" have been installed as such).")) " have been installed as such)."))
@ -161,12 +127,11 @@ option.\n")
" this is not true, remove the file\n " " this is not true, remove the file\n "
config-pid-file ".)")) config-pid-file ".)"))
(else (else
(%process-files (option-ref opts 'schedule #f) (cond (--schedule
(option-ref opts 'noetc #f))
(cond ((option-ref opts 'schedule #f)
=> (λ (count) => (λ (count)
(display-schedule (max 1 (string->number count))) (display-schedule (max 1 (string->number count)))
(exit 0))))))) (exit 0))))
(%process-files --noetc)))
;; Daemonize ourself. ;; Daemonize ourself.
(unless (eq? 0 (primitive-fork)) (exit 0)) (unless (eq? 0 (primitive-fork)) (exit 0))

95
src/mcron/scripts/crontab.scm
View file

@ -1,5 +1,5 @@
;;;; crontab -- edit user's cron tabs ;;;; 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> ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
;;; ;;;
;;; This file is part of GNU Mcron. ;;; This file is part of GNU Mcron.
@ -18,31 +18,12 @@
;;; along with GNU Mcron. If not, see <http://www.gnu.org/licenses/>. ;;; along with GNU Mcron. If not, see <http://www.gnu.org/licenses/>.
(define-module (mcron scripts crontab) (define-module (mcron scripts crontab)
#:use-module (ice-9 getopt-long)
#:use-module (ice-9 rdelim) #:use-module (ice-9 rdelim)
#:use-module (mcron config) #:use-module (mcron config)
#:use-module (mcron utils) #:use-module (mcron utils)
#:use-module (mcron vixie-specification) #:use-module (mcron vixie-specification)
#:export (main)) #: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) (define (hit-server user-name)
"Tell the running cron daemon that the user corresponding to "Tell the running cron daemon that the user corresponding to
USER-NAME has modified his crontab. USER-NAME is written to the 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) (lambda (key . args)
(display "Warning: a cron daemon is not running.\n")))) (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) (define (in-access-file? file name)
"Scan FILE which should contain one user name per line (such as "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 '/var/cron/allow' and '/var/cron/deny'). Return #t if NAME is in there, and
@ -78,16 +78,8 @@ USER-NAME has modified his crontab. USER-NAME is written to the
;;; Entry point. ;;; Entry point.
;;; ;;;
(define* (main #:optional (args (command-line))) (define (main --user --edit --list --remove files)
(let ((opts (getopt-long args %options))) (when config-debug (debug-enable 'backtrace))
(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 (let ((crontab-real-user
;; This program should have been installed SUID root. Here we get ;; This program should have been installed SUID root. Here we get
;; the passwd entry for the real user who is running this program. ;; the passwd entry for the real user who is running this program.
@ -101,37 +93,19 @@ USER-NAME has modified his crontab. USER-NAME is written to the
;; Check that no more than one of the mutually exclusive options are ;; Check that no more than one of the mutually exclusive options are
;; being used. ;; being used.
(when (> (+ (if (option-ref opts 'edit #f) 1 0) (when (< 1 (+ (if --edit 1 0) (if --list 1 0) (if --remove 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.")) (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. ;; Check that a non-root user is trying to read someone else's files.
(when (and (not (zero? (getuid))) (when (and (not (zero? (getuid))) --user)
(option-ref opts 'user #f))
(mcron-error 8 "Only root can use the -u option.")) (mcron-error 8 "Only root can use the -u option."))
(letrec* (;; Iff the --user option is given, the crontab-user may be (letrec* (;; Iff the --user option is given, the crontab-user may be
;; different from the real user. ;; 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. ;; So now we know which crontab file we will be manipulating.
(crontab-file (string-append config-spool-dir "/" crontab-user)) (crontab-file
;; Display the prompt and wait for user to type his (string-append config-spool-dir "/" crontab-user)))
;; 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 ;; There are four possible sub-personalities to the crontab
;; personality: list, remove, edit and replace (when the user uses no ;; personality: list, remove, edit and replace (when the user uses no
;; options but supplies file names on the command line). ;; 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 ;; character-by-character to the standard output. If anything goes
;; wrong, it can only mean that this user does not have a crontab ;; wrong, it can only mean that this user does not have a crontab
;; file. ;; file.
((option-ref opts 'list #f) (--list
(catch #t (catch #t
(λ () (λ ()
(with-input-from-file crontab-file (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, ;; 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 ;; we give user a choice of editing the file again or quitting the
;; program and losing all changes made. ;; program and losing all changes made.
((option-ref opts 'edit #f) (--edit
(let ((temp-file (string-append config-tmp-dir (let ((temp-file (string-append config-tmp-dir
"/crontab." "/crontab."
(number->string (getpid))))) (number->string (getpid)))))
@ -191,10 +165,7 @@ USER-NAME has modified his crontab. USER-NAME is written to the
;; In the remove personality we simply make an effort to delete the ;; In the remove personality we simply make an effort to delete the
;; crontab and wake the daemon. No worries if this fails. ;; crontab and wake the daemon. No worries if this fails.
((option-ref opts 'remove #f) (--remove (catch #t (λ () (delete-file crontab-file)
(catch #t
(λ ()
(delete-file crontab-file)
(hit-server crontab-user)) (hit-server crontab-user))
noop)) noop))
@ -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 ;; location; we deal with the standard input in the same way but
;; different. :-) In either case the server is woken so that it will ;; different. :-) In either case the server is woken so that it will
;; read the newly installed crontab. ;; read the newly installed crontab.
((not (null? (option-ref opts '() '()))) ((not (null? files))
(let ((input-file (car (option-ref opts '() '())))) (let ((input-file (car files)))
(catch-mcron-error (catch-mcron-error
(if (string=? input-file "-") (if (string=? input-file "-")
(let ((input-string (read-string))) (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 ;; The user is being silly. The message here is identical to the one
;; Vixie cron used to put out, for total compatibility. ;; Vixie cron used to put out, for total compatibility.
(else (mcron-error 15 (else (mcron-error 15
"usage error: file name must be specified for replace."))))))) "usage error: file name must be specified for replace."))))))

62
src/mcron/scripts/mcron.scm
View file

@ -1,5 +1,5 @@
;;;; mcron -- run jobs at scheduled times ;;;; mcron -- run jobs at scheduled times
;;; Copyright © 2003, 2012 Dale Mellor <dale_mellor@users.sourceforge.net> ;;; Copyright © 2003, 2012, 2020 Dale Mellor <>
;;; Copyright © 2015, 2016, 2018 Mathieu Lirzin <mthl@gnu.org> ;;; Copyright © 2015, 2016, 2018 Mathieu Lirzin <mthl@gnu.org>
;;; ;;;
;;; This file is part of GNU Mcron. ;;; This file is part of GNU Mcron.
@ -19,7 +19,6 @@
(define-module (mcron scripts mcron) (define-module (mcron scripts mcron)
#:use-module (ice-9 ftw) #:use-module (ice-9 ftw)
#:use-module (ice-9 getopt-long)
#:use-module (ice-9 local-eval) #:use-module (ice-9 local-eval)
#:use-module (ice-9 rdelim) #:use-module (ice-9 rdelim)
#:use-module (mcron base) #: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 (define process-user-file
(let ((guile-regexp (make-regexp "\\.gui(le)?$")) (let ((guile-regexp (make-regexp "\\.gui(le)?$"))
(vixie-regexp (make-regexp "\\.vix(ie)?$"))) (vixie-regexp (make-regexp "\\.vix(ie)?$")))
@ -107,37 +84,16 @@ $XDG_CONFIG_HOME is not defined uses ~/.config/cron instead)."
;;; Entry point. ;;; Entry point.
;;; ;;;
(define (main) (define (main --daemon --schedule --stdin file-list)
(let ((options (when config-debug (debug-enable 'backtrace))
(getopt-long (%process-files file-list (or --stdin "guile"))
(command-line) (cond (--schedule
`((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"))
(cond ((option-ref options 'schedule #f)
=> (λ (count) => (λ (count)
(let ((c (if (string? count) (string->number count) 8))) (display-schedule
(display-schedule (if (exact-integer? c) (max 1 c) 8))) (max 1 (inexact->exact (floor (string->number count)))))
(exit 0))) (exit 0)))
((option-ref options 'daemon #f) (--daemon (case (primitive-fork) ((0) (setsid))
(case (primitive-fork)
((0) (setsid))
(else (exit 0))))) (else (exit 0)))))
;; Forever execute the 'run-job-loop', and when it drops out (can only be ;; Forever execute the 'run-job-loop', and when it drops out (can only be
@ -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, ;; we can also drop out of run-job-loop because of a SIGCHLD,
;; so must test FDES-LIST. ;; so must test FDES-LIST.
(unless (null? fdes-list) (unless (null? fdes-list)
(process-update-request fdes-list))))))) (process-update-request fdes-list))))))