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/cron.scm | 177 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 177 insertions(+) create mode 100644 src/mcron/scripts/cron.scm (limited to 'src/mcron/scripts/cron.scm') diff --git a/src/mcron/scripts/cron.scm b/src/mcron/scripts/cron.scm new file mode 100644 index 0000000..dd8f5ad --- /dev/null +++ b/src/mcron/scripts/cron.scm @@ -0,0 +1,177 @@ +;;;; cron -- daemon for running 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 cron) + #:use-module (mcron base) + #:use-module (mcron config) + #:use-module (mcron job-specifier) + #:use-module (mcron main) + #:use-module (mcron vixie-specification) + #:use-module (srfi srfi-2) + #:export (main)) + +(define (show-help) + (display "Usage: cron [OPTIONS] +Unless an option is specified, run a cron daemon as a detached process, +reading all the information in the users' crontabs and in /etc/crontab. + + -v, --version Display version + -h, --help Display this help message + -sN, --schedule[=]N Display the next N jobs that will be run by cron + -n, --noetc Do not check /etc/crontab for updates (HIGHLY + RECOMMENDED).") + (newline) + (show-package-information)) + +(define %options + `((schedule (single-char #\s) (value #t) + (predicate ,(λ (str) (string->number str)))) + (noetc (single-char #\n) (value #f)) + (version (single-char #\v) (value #f)) + (help (single-char #\h) (value #f)))) + +(define (delete-run-file) + "Remove the /var/run/cron.pid file so that crontab and other invocations of +cron don't get the wrong idea that a daemon is currently running. This +procedure is called from the C front-end whenever a terminal signal is +received." + (catch #t + (λ () + (delete-file config-pid-file) + (delete-file config-socket-file)) + noop) + (quit)) + +(define (cron-file-descriptors) + "Establish a socket to listen for updates from a crontab program, and return +a list containing the file descriptors correponding to the files read by +crontab. This requires that command-type is 'cron." + (catch #t + (λ () + (let ((sock (socket AF_UNIX SOCK_STREAM 0))) + (bind sock AF_UNIX config-socket-file) + (listen sock 5) + (list sock))) + (λ (key . args) + (delete-file config-pid-file) + (mcron-error 1 "Cannot bind to UNIX socket " config-socket-file)))) + +(define (process-files-in-system-directory) + "Process all the files in the crontab directory. When the job procedure is +run on behalf of the configuration files, the jobs are registered on the +system with the appropriate user. Only root should be able to perform this +operation. The permissions on the /var/cron/tabs directory enforce this." + + (define (user-entry name) + ;; Return the user database entry if NAME is valid, otherwise #f. + (false-if-exception (getpwnam name))) + + (catch #t + (λ () + (for-each-file + (λ (user) + (and-let* ((entry (user-entry user))) ;crontab without user? + (set-configuration-user entry) + (catch-mcron-error + (read-vixie-file (string-append config-spool-dir "/" user))))) + config-spool-dir)) + (λ (key . args) + (mcron-error 4 + "You do not have permission to access the system crontabs.")))) + +(define (%process-files schedule? noetc?) + ;; XXX: What is this supposed to do? + (when schedule? + (with-output-to-file config-pid-file noop)) + ;; Clear MAILTO so that outputs are sent to the various users. + (setenv "MAILTO" #f) + ;; XXX: At compile time, this yields a "possibly unbound variable" warning, + ;; but this is OK since it is bound in the C wrapper. + (c-set-cron-signals) + ;; Having defined all the necessary procedures for scanning various sets of + ;; files, we perform the actual configuration of the program depending on + ;; the personality we are running as. If it is mcron, we either scan the + ;; files passed on the command line, or else all the ones in the user's + ;; .config/cron (or .cron) directory. If we are running under the cron + ;; personality, we read the /var/cron/tabs directory and also the + ;; /etc/crontab file. + (process-files-in-system-directory) + (use-system-job-list) + (catch-mcron-error + (read-vixie-file "/etc/crontab" parse-system-vixie-line)) + (use-user-job-list) + (unless noetc? + (display "\ +WARNING: cron will check for updates to /etc/crontab EVERY MINUTE. If you do +not use this file, or you are prepared to manually restart cron whenever you +make a change, then it is HIGHLY RECOMMENDED that you use the --noetc +option.\n") + (set-configuration-user "root") + (job '(- (next-minute-from (next-minute)) 6) + check-system-crontab + "/etc/crontab update checker."))) + + +;;; +;;; Entry point. +;;; + +(define* (main #:optional (args (command-line))) + (let ((opts (parse-args args %options))) + (when config-debug + (debug-enable 'backtrace)) + (cond + ((option-ref opts 'help #f) + (show-help) + (exit 0)) + ((option-ref opts 'version #f) + (show-version "cron") + (exit 0)) + ((not (zero? (getuid))) + (mcron-error 16 + "This program must be run by the root user (and should" + " have been installed as such).")) + ((access? config-pid-file F_OK) + (mcron-error 1 + "A cron daemon is already running.\n (If you are sure" + " this is not true, remove the file\n " + config-pid-file ".)")) + (else + (%process-files (option-ref opts 'schedule #f) + (option-ref opts 'noetc #f)) + (cond ((option-ref opts 'schedule #f) ;display jobs schedule + => (λ (count) + (display (get-schedule (max 1 (string->number count)))) + (exit 0))) + (else (case (primitive-fork) ;run the daemon + ((0) + (setsid) + ;; we can now write the PID file. + (with-output-to-file config-pid-file + (λ () (display (getpid)) (newline)))) + (else (exit 0))))) + ;; Forever execute the 'run-job-loop', and when it drops out (can + ;; only be because a message has come in on the socket) we + ;; process the socket request before restarting the loop again. + (catch-mcron-error + (let ((fdes-list (cron-file-descriptors))) + (while #t + (run-job-loop fdes-list) + (unless (null? fdes-list) + (process-update-request fdes-list))))))))) -- 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/cron.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