Using new Guile command-line-processor.
This commit is contained in:
		
					parent
					
						
							
								f700f299d4
							
						
					
				
			
			
				commit
				
					
						6a9bfcea40
					
				
			
		
					 6 changed files with 195 additions and 178 deletions
				
			
		
							
								
								
									
										47
									
								
								src/cron.in
									
										
									
									
									
								
							
							
						
						
									
										47
									
								
								src/cron.in
									
										
									
									
									
								
							|  | @ -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) | ||||||
|  |  | ||||||
|  | @ -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
									
										
									
									
									
								
							
							
						
						
									
										50
									
								
								src/mcron.in
									
										
									
									
									
								
							|  | @ -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 --!) | ||||||
|  |  | ||||||
|  | @ -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)) | ||||||
|  |  | ||||||
|  | @ -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,60 +78,34 @@ 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 |   (let ((crontab-real-user | ||||||
|       (debug-enable 'backtrace)) |          ;; This program should have been installed SUID root. Here we get | ||||||
|     (cond ((option-ref opts 'help #f) |          ;; the passwd entry for the real user who is running this program. | ||||||
|            (show-help) |          (passwd:name (getpw (getuid))))) | ||||||
|            (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 |     ;; 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. |     ;; /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) |     (if (or (eq? (in-access-file? config-allow-file crontab-real-user) #f) | ||||||
|               (eq? (in-access-file? config-deny-file crontab-real-user) #t)) |             (eq? (in-access-file? config-deny-file crontab-real-user) #t)) | ||||||
|           (mcron-error 6 "Access denied by system operator.")) |         (mcron-error 6 "Access denied by system operator.")) | ||||||
| 
 | 
 | ||||||
|       ;; 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,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 |          ;; 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 |                                     (hit-server crontab-user)) | ||||||
|             (λ () |                           noop)) | ||||||
|               (delete-file crontab-file) |  | ||||||
|               (hit-server crontab-user)) |  | ||||||
|             noop)) |  | ||||||
| 
 | 
 | ||||||
|          ;; XXX: This comment is wrong. |          ;; XXX: This comment is wrong. | ||||||
|          ;; In the case of the replace personality we loop over all the |          ;; 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 |          ;; 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.")))))) | ||||||
|  |  | ||||||
|  | @ -1,6 +1,6 @@ | ||||||
| ;;;; 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,38 +84,17 @@ $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) |                                               (else (exit 0))))) | ||||||
|                      ((0)  (setsid)) |  | ||||||
|                      (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 | ||||||
|     ;; because a message has come in on the socket) we process the socket |     ;; 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, |          ;; 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)))))) | ||||||
|  |  | ||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue
	
	 Dale Mellor
				Dale Mellor