From c87c643ca19b731ee6c53fbea72af8312ca6a725 Mon Sep 17 00:00:00 2001 From: Mathieu Lirzin Date: Mon, 9 May 2016 14:50:29 +0200 Subject: all: Separate programs in different executables. 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. --- src/mcron/scripts/mcron.scm | 136 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 136 insertions(+) create mode 100644 src/mcron/scripts/mcron.scm (limited to 'src/mcron/scripts/mcron.scm') diff --git a/src/mcron/scripts/mcron.scm b/src/mcron/scripts/mcron.scm new file mode 100644 index 0000000..30b2d2a --- /dev/null +++ b/src/mcron/scripts/mcron.scm @@ -0,0 +1,136 @@ +;;;; mcron -- run jobs at scheduled times +;;; Copyright © 2003, 2012 Dale Mellor +;;; Copyright © 2015, 2016 Mathieu Lirzin +;;; +;;; This file is part of GNU Mcron. +;;; +;;; GNU Mcron is free software: you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation, either version 3 of the License, or +;;; (at your option) any later version. +;;; +;;; GNU Mcron is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Mcron. If not, see . + +(define-module (mcron scripts mcron) + #:use-module (mcron base) + #:use-module (mcron config) + #:use-module (mcron job-specifier) ;for user/system files + #:use-module (mcron main) + #:use-module (mcron vixie-specification) + #:export (main)) + +(define (show-help) + (display "Usage: mcron [OPTIONS] [FILES] +Run an mcron process according to the specifications in the FILES (`-' for +standard input), or use all the files in ~/.config/cron (or the +deprecated ~/.cron) with .guile or .vixie extensions. + + -v, --version Display version + -h, --help Display this help message + -sN, --schedule[=]N Display the next N jobs that will be run by mcron + -d, --daemon Immediately detach the program from the terminal + and run as a daemon process + -i, --stdin=(guile|vixie) Format of data passed as standard input or + file arguments (default guile)") + (newline) + (show-package-information)) + +(define %options + `((schedule (single-char #\s) (value #t) + (predicate ,(λ (str) (string->number str)))) + (daemon (single-char #\d) (value #f)) + (noetc (single-char #\n) (value #f)) + (stdin (single-char #\i) (value #t) + (predicate ,(λ (val) + (or (string=? val "guile") + (string=? val "vixie"))))) + (version (single-char #\v) (value #f)) + (help (single-char #\h) (value #f)))) + +(define process-user-file + (let ((guile-regexp (make-regexp "\\.gui(le)?$")) + (vixie-regexp (make-regexp "\\.vix(ie)?$"))) + (lambda* (file-name #:optional guile-syntax? #:key (input "guile")) + "Process FILE-NAME according its extension. When GUILE-SYNTAX? is TRUE, +force guile syntax usage. If FILE-NAME format is not recognized, it is +silently ignored." + (cond ((string=? "-" file-name) + (if (string=? input "vixie") + (read-vixie-port (current-input-port)) + (eval-string (stdin->string)))) + ((or guile-syntax? (regexp-exec guile-regexp file-name)) + (load file-name)) + ((regexp-exec vixie-regexp file-name) + (read-vixie-file file-name)))))) + +(define (process-files-in-user-directory input-type) + "Process files in $XDG_CONFIG_HOME/cron and/or ~/.cron directories (if +$XDG_CONFIG_HOME is not defined uses ~/.config/cron instead)." + (let ((errors 0) + (home-directory (passwd:dir (getpw (getuid))))) + (map (λ (dir) + (catch #t + (λ () + (for-each-file + (λ (file) + (process-user-file (string-append dir "/" file) + #:input input-type)) + dir)) + (λ (key . args) + (set! errors (1+ errors))))) + (list (string-append home-directory "/.cron") + (string-append (or (getenv "XDG_CONFIG_HOME") + (string-append home-directory "/.config")) + "/cron"))) + (when (eq? 2 errors) + (mcron-error 13 + "Cannot read files in your ~/.config/cron (or ~/.cron) directory.")))) + +(define (%process-files files input-type) + (if (null? files) + (process-files-in-user-directory input-type) + (for-each (λ (file) (process-user-file file #t)) files))) + + +;;; +;;; Entry point. +;;; + +(define* (main #:optional (args (command-line))) + (let ((opts (parse-args args %options))) + (when config-debug + (debug-enable 'backtrace)) + (cond ((option-ref opts 'help #f) + (show-help) + (exit 0)) + ((option-ref opts 'version #f) + (show-version "mcron") + (exit 0)) + (else + (%process-files (option-ref opts '() '()) + (option-ref opts 'stdin "guile")) + (cond ((option-ref opts 'schedule #f) ;display jobs schedule + => (λ (count) + (display (get-schedule (max 1 (string->number count)))) + (exit 0))) + ((option-ref opts 'daemon #f) ;run mcron as a daemon + (case (primitive-fork) + ((0) (setsid)) + (else (exit 0))))) + ;; Forever execute the 'run-job-loop', and when it drops out (can + ;; only be because a message has come in on the socket) we process + ;; the socket request before restarting the loop again. + (catch-mcron-error + (let ((fdes-list '())) + (while #t + (run-job-loop fdes-list) + ;; we can also drop out of run-job-loop because of a SIGCHLD, + ;; so must test FDES-LIST. + (unless (null? fdes-list) + (process-update-request fdes-list))))))))) -- cgit v1.2.3 From 61f85be19da0e62c899e3b62da403480d881e9f9 Mon Sep 17 00:00:00 2001 From: Mathieu Lirzin Date: Sat, 23 Jul 2016 23:58:06 +0200 Subject: build: Rename (mcron main) to (mcron utils). * src/mcron/main.scm: Rename to ... * src/mcron/utils.scm: ... this. * src/mcron/scripts/cron.scm: Adapt. * src/mcron/scripts/crontab.scm: Likewise. * src/mcron/scripts/mcron.scm: Likewise. * Makefile.am (dist_mcronmodule_DATA): Likewise. --- Makefile.am | 2 +- src/mcron/main.scm | 119 ------------------------------------------ src/mcron/scripts/cron.scm | 2 +- src/mcron/scripts/crontab.scm | 2 +- src/mcron/scripts/mcron.scm | 2 +- src/mcron/utils.scm | 119 ++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 123 insertions(+), 123 deletions(-) delete mode 100644 src/mcron/main.scm create mode 100644 src/mcron/utils.scm (limited to 'src/mcron/scripts/mcron.scm') diff --git a/Makefile.am b/Makefile.am index 77c9b28..109e27a 100644 --- a/Makefile.am +++ b/Makefile.am @@ -40,8 +40,8 @@ dist_mcronmodule_DATA = \ src/mcron/base.scm \ src/mcron/environment.scm \ src/mcron/job-specifier.scm \ - src/mcron/main.scm \ src/mcron/redirect.scm \ + src/mcron/utils.scm \ src/mcron/vixie-specification.scm \ src/mcron/vixie-time.scm diff --git a/src/mcron/main.scm b/src/mcron/main.scm deleted file mode 100644 index 74b49e5..0000000 --- a/src/mcron/main.scm +++ /dev/null @@ -1,119 +0,0 @@ -;;; main.scm -- helper procedures -;;; Copyright © 2003, 2012 Dale Mellor -;;; Copyright © 2015, 2016 Mathieu Lirzin -;;; -;;; This file is part of GNU Mcron. -;;; -;;; GNU Mcron is free software: you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation, either version 3 of the License, or -;;; (at your option) any later version. -;;; -;;; GNU Mcron is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with GNU Mcron. If not, see . - -(define-module (mcron main) - #:use-module (ice-9 getopt-long) - #:use-module (ice-9 rdelim) - #:use-module (mcron config) - #:use-module (mcron base) - #:use-module (mcron job-specifier) - #:use-module (mcron vixie-specification) - #: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 -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 (cons "mcron: " rest)) - (newline))) - (when (and exit-code (not (eq? exit-code 0))) - (primitive-exit exit-code))) - -(define-syntax-rule (catch-mcron-error exp ...) - "Evaluate EXP .... if an 'mcron-error exception occurs, print its diagnostics -and exit with its error code." - (catch 'mcron-error - (lambda () exp ...) - (lambda (key exit-code . msg) - (apply mcron-error exit-code msg)))) - -(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 command) - "Display version information for COMMAND and quit." - (let* ((name config-package-name) - (short-name (cadr (string-split name #\space))) - (version config-package-version)) - (simple-format #t "~a (~a) ~a -Copyright (C) 2015 the ~a authors. -License GPLv3+: GNU GPL version 3 or later -This is free software: you are free to change and redistribute it. -There is NO WARRANTY, to the extent permitted by law.\n" - command name version short-name))) - -(define (show-package-information) - "Display where to get help and send bug reports." - (simple-format #t "\nReport bugs to: ~a. -~a home page: <~a> -General help using GNU software: \n" - config-package-bugreport - config-package-name - config-package-url)) - -(define (stdin->string) - "Return standard input as a string." - (with-output-to-string (lambda () (do ((in (read-char) (read-char))) - ((eof-object? in)) - (display in))))) - -(define (for-each-file proc directory) - "Apply PROC to each file in DIRECTORY. DIRECTORY must be a valid directory name. -PROC must be a procedure that take one file name argument. The return value -is not specified" - (let ((dir (opendir directory))) - (do ((file-name (readdir dir) (readdir dir))) - ((eof-object? file-name) (closedir dir)) - (proc file-name)))) - -(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 -user's updated file. In the special case drop all the system jobs and re-read -the /etc/crontab file. This function should be called whenever a message -comes in on the above socket." - (let* ((sock (car (accept (car fdes-list)))) - (user-name (read-line sock))) - (close sock) - (set-configuration-time (current-time)) - (catch-mcron-error - (if (string=? user-name "/etc/crontab") - (begin - (clear-system-jobs) - (use-system-job-list) - (read-vixie-file "/etc/crontab" parse-system-vixie-line) - (use-user-job-list)) - (let ((user (getpw user-name))) - (remove-user-jobs user) - (set-configuration-user user) - (read-vixie-file (string-append config-spool-dir "/" user-name))))))) diff --git a/src/mcron/scripts/cron.scm b/src/mcron/scripts/cron.scm index dd8f5ad..d043d79 100644 --- a/src/mcron/scripts/cron.scm +++ b/src/mcron/scripts/cron.scm @@ -21,7 +21,7 @@ #:use-module (mcron base) #:use-module (mcron config) #:use-module (mcron job-specifier) - #:use-module (mcron main) + #:use-module (mcron utils) #:use-module (mcron vixie-specification) #:use-module (srfi srfi-2) #:export (main)) diff --git a/src/mcron/scripts/crontab.scm b/src/mcron/scripts/crontab.scm index 43ae8f6..cf6673a 100644 --- a/src/mcron/scripts/crontab.scm +++ b/src/mcron/scripts/crontab.scm @@ -20,7 +20,7 @@ (define-module (mcron scripts crontab) #:use-module (ice-9 rdelim) #:use-module (mcron config) - #:use-module (mcron main) + #:use-module (mcron utils) #:use-module (mcron vixie-specification) #:export (main)) diff --git a/src/mcron/scripts/mcron.scm b/src/mcron/scripts/mcron.scm index 30b2d2a..7b82cf3 100644 --- a/src/mcron/scripts/mcron.scm +++ b/src/mcron/scripts/mcron.scm @@ -21,7 +21,7 @@ #:use-module (mcron base) #:use-module (mcron config) #:use-module (mcron job-specifier) ;for user/system files - #:use-module (mcron main) + #:use-module (mcron utils) #:use-module (mcron vixie-specification) #:export (main)) diff --git a/src/mcron/utils.scm b/src/mcron/utils.scm new file mode 100644 index 0000000..7b29971 --- /dev/null +++ b/src/mcron/utils.scm @@ -0,0 +1,119 @@ +;;;; utils.scm -- helper procedures +;;; Copyright © 2003, 2012 Dale Mellor +;;; Copyright © 2015, 2016 Mathieu Lirzin +;;; +;;; This file is part of GNU Mcron. +;;; +;;; GNU Mcron is free software: you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation, either version 3 of the License, or +;;; (at your option) any later version. +;;; +;;; GNU Mcron is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Mcron. If not, see . + +(define-module (mcron utils) + #:use-module (ice-9 getopt-long) + #:use-module (ice-9 rdelim) + #:use-module (mcron config) + #:use-module (mcron base) + #:use-module (mcron job-specifier) + #:use-module (mcron vixie-specification) + #: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 +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 (cons "mcron: " rest)) + (newline))) + (when (and exit-code (not (eq? exit-code 0))) + (primitive-exit exit-code))) + +(define-syntax-rule (catch-mcron-error exp ...) + "Evaluate EXP .... if an 'mcron-error exception occurs, print its diagnostics +and exit with its error code." + (catch 'mcron-error + (lambda () exp ...) + (lambda (key exit-code . msg) + (apply mcron-error exit-code msg)))) + +(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 command) + "Display version information for COMMAND and quit." + (let* ((name config-package-name) + (short-name (cadr (string-split name #\space))) + (version config-package-version)) + (simple-format #t "~a (~a) ~a +Copyright (C) 2015 the ~a authors. +License GPLv3+: GNU GPL version 3 or later +This is free software: you are free to change and redistribute it. +There is NO WARRANTY, to the extent permitted by law.\n" + command name version short-name))) + +(define (show-package-information) + "Display where to get help and send bug reports." + (simple-format #t "\nReport bugs to: ~a. +~a home page: <~a> +General help using GNU software: \n" + config-package-bugreport + config-package-name + config-package-url)) + +(define (stdin->string) + "Return standard input as a string." + (with-output-to-string (lambda () (do ((in (read-char) (read-char))) + ((eof-object? in)) + (display in))))) + +(define (for-each-file proc directory) + "Apply PROC to each file in DIRECTORY. DIRECTORY must be a valid directory name. +PROC must be a procedure that take one file name argument. The return value +is not specified" + (let ((dir (opendir directory))) + (do ((file-name (readdir dir) (readdir dir))) + ((eof-object? file-name) (closedir dir)) + (proc file-name)))) + +(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 +user's updated file. In the special case drop all the system jobs and re-read +the /etc/crontab file. This function should be called whenever a message +comes in on the above socket." + (let* ((sock (car (accept (car fdes-list)))) + (user-name (read-line sock))) + (close sock) + (set-configuration-time (current-time)) + (catch-mcron-error + (if (string=? user-name "/etc/crontab") + (begin + (clear-system-jobs) + (use-system-job-list) + (read-vixie-file "/etc/crontab" parse-system-vixie-line) + (use-user-job-list)) + (let ((user (getpw user-name))) + (remove-user-jobs user) + (set-configuration-user user) + (read-vixie-file (string-append config-spool-dir "/" user-name))))))) -- cgit v1.2.3 From d4b4ac5708385d500f566267719124c7c62572df Mon Sep 17 00:00:00 2001 From: Mathieu Lirzin Date: Sun, 24 Jul 2016 00:38:21 +0200 Subject: utils: Remove unneeded 'stdin->string' procedure. * src/mcron/utils.scm: Re-export 'read-string'. (stdin->string): Delete. * src/mcron/scripts/crontab.scm (main): Use 'read-string' instead. * src/mcron/scripts/mcron.scm (process-user-file): Likewise. --- src/mcron/scripts/crontab.scm | 2 +- src/mcron/scripts/mcron.scm | 2 +- src/mcron/utils.scm | 10 ++-------- 3 files changed, 4 insertions(+), 10 deletions(-) (limited to 'src/mcron/scripts/mcron.scm') diff --git a/src/mcron/scripts/crontab.scm b/src/mcron/scripts/crontab.scm index cf6673a..502fec6 100644 --- a/src/mcron/scripts/crontab.scm +++ b/src/mcron/scripts/crontab.scm @@ -210,7 +210,7 @@ (let ((input-file (car (option-ref opts '() '())))) (catch-mcron-error (if (string=? input-file "-") - (let ((input-string (stdin->string))) + (let ((input-string (read-string))) (read-vixie-port (open-input-string input-string)) (with-output-to-file crontab-file (λ () (display input-string)))) diff --git a/src/mcron/scripts/mcron.scm b/src/mcron/scripts/mcron.scm index 7b82cf3..b6c7729 100644 --- a/src/mcron/scripts/mcron.scm +++ b/src/mcron/scripts/mcron.scm @@ -63,7 +63,7 @@ silently ignored." (cond ((string=? "-" file-name) (if (string=? input "vixie") (read-vixie-port (current-input-port)) - (eval-string (stdin->string)))) + (eval-string (read-string)))) ((or guile-syntax? (regexp-exec guile-regexp file-name)) (load file-name)) ((regexp-exec vixie-regexp file-name) diff --git a/src/mcron/utils.scm b/src/mcron/utils.scm index ce2610c..062e756 100644 --- a/src/mcron/utils.scm +++ b/src/mcron/utils.scm @@ -29,10 +29,10 @@ parse-args show-version show-package-information - stdin->string for-each-file process-update-request) - #:re-export (option-ref)) + #:re-export (option-ref + read-string)) (define (mcron-error exit-code . rest) "Print an error message (made up from the parts of REST), and if the @@ -81,12 +81,6 @@ General help using GNU software: \n" config-package-name config-package-url)) -(define (stdin->string) - "Return standard input as a string." - (with-output-to-string (lambda () (do ((in (read-char) (read-char))) - ((eof-object? in)) - (display in))))) - (define (for-each-file proc directory) "Apply PROC to each file in DIRECTORY. DIRECTORY must be a valid directory name. PROC must be a procedure that take one file name argument. The return value -- cgit v1.2.3