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 +++++++++++++++++++++++++++++++++ src/mcron/scripts/crontab.scm | 225 ++++++++++++++++++++++++++++++++++++++++++ src/mcron/scripts/mcron.scm | 136 +++++++++++++++++++++++++ 3 files changed, 538 insertions(+) create mode 100644 src/mcron/scripts/cron.scm create mode 100644 src/mcron/scripts/crontab.scm create mode 100644 src/mcron/scripts/mcron.scm (limited to 'src/mcron/scripts') 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))))))))) diff --git a/src/mcron/scripts/crontab.scm b/src/mcron/scripts/crontab.scm new file mode 100644 index 0000000..43ae8f6 --- /dev/null +++ b/src/mcron/scripts/crontab.scm @@ -0,0 +1,225 @@ +;;;; crontab -- edit user's cron tabs +;;; Copyright © 2003, 2004 Dale Mellor +;;; Copyright © 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 crontab) + #:use-module (ice-9 rdelim) + #:use-module (mcron config) + #:use-module (mcron main) + #:use-module (mcron vixie-specification) + #:export (main)) + +(define* (show-help) + (display "Usage: crontab [-u user] file + crontab [-u user] { -e | -l | -r } + (default operation is replace, per 1003.2) + -e (edit user's crontab) + -l (list user's crontab) + -r (delete user's crontab") + (newline) + (show-package-information)) + +(define %options + '((user (single-char #\u) (value #t)) + (edit (single-char #\e) (value #f)) + (list (single-char #\l) (value #f)) + (remove (single-char #\r) (value #f)) + (version (single-char #\v) (value #f)) + (help (single-char #\h) (value #f)))) + + +;;; +;;; 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 "crontab") + (exit 0))) + (let ((hit-server + (λ (user-name) + ;; Procedure to communicate with running cron daemon that a user + ;; has modified his crontab. The user name is written to the + ;; /var/cron/socket UNIX socket. + (catch #t + (λ () + (let ((socket (socket AF_UNIX SOCK_STREAM 0))) + (connect socket AF_UNIX config-socket-file) + (display user-name socket) + (close socket))) + (λ (key . args) + (display "Warning: a cron daemon is not running.\n"))))) + + ;; Procedure to scan a file containing one user name per line (such + ;; as /var/cron/allow and /var/cron/deny), and determine if the + ;; given name is in there. The procedure returns #t, #f, or '() if + ;; the file does not exist. + (in-access-file? + (λ (file name) + (catch #t + (λ () + (with-input-from-file file + (λ () + (let loop ((input (read-line))) + (if (eof-object? input) + #f + (if (string=? input name) + #t + (loop (read-line)))))))) + (λ (key . args) '())))) + + ;; This program should have been installed SUID root. Here we get + ;; the passwd entry for the real user who is running this program. + (crontab-real-user (passwd:name (getpw (getuid))))) + + ;; If the real user is not allowed to use crontab due to the + ;; /var/cron/allow and/or /var/cron/deny files, bomb out now. + (if (or (eq? (in-access-file? config-allow-file crontab-real-user) #f) + (eq? (in-access-file? config-deny-file crontab-real-user) #t)) + (mcron-error 6 "Access denied by system operator.")) + + ;; Check that no more than one of the mutually exclusive options are + ;; being used. + (when (> (+ (if (option-ref opts 'edit #f) 1 0) + (if (option-ref opts 'list #f) 1 0) + (if (option-ref opts 'remove #f) 1 0)) + 1) + (mcron-error 7 "Only one of options -e, -l or -r can be used.")) + + ;; Check that a non-root user is trying to read someone else's files. + (when (and (not (zero? (getuid))) + (option-ref opts 'user #f)) + (mcron-error 8 "Only root can use the -u option.")) + + (letrec* (;; Iff the --user option is given, the crontab-user may be + ;; different from the real user. + (crontab-user (option-ref opts 'user crontab-real-user)) + ;; So now we know which crontab file we will be manipulating. + (crontab-file (string-append config-spool-dir "/" crontab-user)) + ;; Display the prompt and wait for user to type his + ;; choice. Return #t if the answer begins with 'y' or 'Y', + ;; return #f if it begins with 'n' or 'N', otherwise ask + ;; again. + (get-yes-no (λ (prompt . re-prompt) + (if (not (null? re-prompt)) + (display "Please answer y or n.\n")) + (display (string-append prompt " ")) + (let ((r (read-line))) + (if (not (string-null? r)) + (case (string-ref r 0) + ((#\y #\Y) #t) + ((#\n #\N) #f) + (else (get-yes-no prompt #t))) + (get-yes-no prompt #t)))))) + ;; There are four possible sub-personalities to the crontab + ;; personality: list, remove, edit and replace (when the user uses no + ;; options but supplies file names on the command line). + (cond + ;; In the list personality, we simply open the crontab and copy it + ;; character-by-character to the standard output. If anything goes + ;; wrong, it can only mean that this user does not have a crontab + ;; file. + ((option-ref opts 'list #f) + (catch #t + (λ () + (with-input-from-file crontab-file + (λ () + (do ((input (read-char) (read-char))) + ((eof-object? input)) + (display input))))) + (λ (key . args) + (display (string-append "No crontab for " + crontab-user + " exists.\n"))))) + + ;; In the edit personality, we determine the name of a temporary file + ;; and an editor command, copy an existing crontab file (if it is + ;; there) to the temporary file, making sure the ownership is set so + ;; the real user can edit it; once the editor returns we try to read + ;; the file to check that it is parseable (but do nothing more with + ;; the configuration), and if it is okay (this program is still + ;; running!) we move the temporary file to the real crontab, wake the + ;; cron daemon up, and remove the temporary file. If the parse fails, + ;; we give user a choice of editing the file again or quitting the + ;; program and losing all changes made. + ((option-ref opts 'edit #f) + (let ((temp-file (string-append config-tmp-dir + "/crontab." + (number->string (getpid))))) + (catch #t + (λ () (copy-file crontab-file temp-file)) + (λ (key . args) (with-output-to-file temp-file noop))) + (chown temp-file (getuid) (getgid)) + (let retry () + (system (string-append + (or (getenv "VISUAL") (getenv "EDITOR") "vi") + " " + temp-file)) + (catch 'mcron-error + (λ () (read-vixie-file temp-file)) + (λ (key exit-code . msg) + (apply mcron-error 0 msg) + (if (get-yes-no "Edit again?") + (retry) + (begin + (mcron-error 0 "Crontab not changed") + (primitive-exit 0)))))) + (copy-file temp-file crontab-file) + (delete-file temp-file) + (hit-server crontab-user))) + + ;; In the remove personality we simply make an effort to delete the + ;; crontab and wake the daemon. No worries if this fails. + ((option-ref opts 'remove #f) + (catch #t + (λ () + (delete-file crontab-file) + (hit-server crontab-user)) + noop)) + + ;; XXX: This comment is wrong. + ;; In the case of the replace personality we loop over all the + ;; arguments on the command line, and for each one parse the file to + ;; make sure it is parseable (but subsequently ignore the + ;; configuration), and all being well we copy it to the crontab + ;; location; we deal with the standard input in the same way but + ;; different. :-) In either case the server is woken so that it will + ;; read the newly installed crontab. + ((not (null? (option-ref opts '() '()))) + (let ((input-file (car (option-ref opts '() '())))) + (catch-mcron-error + (if (string=? input-file "-") + (let ((input-string (stdin->string))) + (read-vixie-port (open-input-string input-string)) + (with-output-to-file crontab-file + (λ () (display input-string)))) + (begin + (read-vixie-file input-file) + (copy-file input-file crontab-file)))) + (hit-server crontab-user))) + + ;; The user is being silly. The message here is identical to the one + ;; Vixie cron used to put out, for total compatibility. + (else (mcron-error 15 + "usage error: file name must be specified for replace."))))))) 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') 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') 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