From 8f430594f4452c378de08177be187d1cb5de1cd0 Mon Sep 17 00:00:00 2001 From: Mathieu Lirzin Date: Fri, 26 Jun 2015 23:17:01 +0200 Subject: build: Fix build of the manual. * mcron.texinfo.in: Rename to ... * doc/mcron.texi: ... this. * doc/config.texi.in: New file. * configure.ac: Adapt to it. * makefile.am: Likewise. * .gitignore: Likewise. * README--git: Likewise. --- configure.ac | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'configure.ac') diff --git a/configure.ac b/configure.ac index 764ea03..fee17fc 100644 --- a/configure.ac +++ b/configure.ac @@ -3,6 +3,7 @@ # Copyright (C) 2003, 2005, 2012, 2014 Dale Mellor +# Copyright (C) 2015, 2016 Mathieu Lirzin # # This file is part of GNU mcron. # @@ -174,6 +175,8 @@ AC_SUBST(CONFIG_TMP_DIR) real_program_prefix=`echo $program_prefix | sed s/NONE//` AC_SUBST(real_program_prefix) - -AC_CONFIG_FILES(mcron.texinfo makefile scm/mcron/makefile scm/mcron/config.scm) +AC_CONFIG_FILES([doc/config.texi + makefile + scm/mcron/makefile + scm/mcron/config.scm]) AC_OUTPUT -- cgit v1.2.3 From c43a9173e6e70cf12f3f47a845cc91688877a781 Mon Sep 17 00:00:00 2001 From: Mathieu Lirzin Date: Wed, 20 Apr 2016 01:21:43 +0200 Subject: maint: Use 'build-aux' directory for auxiliary build tools. * configure.ac (AC_CONFIG_AUX_DIR): Set it to 'build-aux'. * .gitignore: Adapt to it. --- .gitignore | 7 +++++++ configure.ac | 1 + 2 files changed, 8 insertions(+) (limited to 'configure.ac') diff --git a/.gitignore b/.gitignore index 2bedd6e..6aaa315 100644 --- a/.gitignore +++ b/.gitignore @@ -3,7 +3,14 @@ INSTALL aclocal.m4 autom4te.cache +/build-aux/compile +/build-aux/depcomp +/build-aux/install-sh +/build-aux/mdate-sh +/build-aux/missing +/build-aux/texinfo.tex compile +config.cache config.log config.scm config.status diff --git a/configure.ac b/configure.ac index fee17fc..6b0fc4c 100644 --- a/configure.ac +++ b/configure.ac @@ -23,6 +23,7 @@ AC_PREREQ(2.61) AC_INIT([mcron], [1.0.8], [dale_mellor@users.sourceforge.net]) +AC_CONFIG_AUX_DIR([build-aux]) AM_INIT_AUTOMAKE -- cgit v1.2.3 From 754d1d01761922b0c609058607fd854049d7b737 Mon Sep 17 00:00:00 2001 From: Mathieu Lirzin Date: Wed, 1 Jul 2015 01:05:34 +0200 Subject: maint: Fix package name and bug reports email address. * configure.ac (AC_INIT): Fix package name and bug reports email address. --- configure.ac | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'configure.ac') diff --git a/configure.ac b/configure.ac index 6b0fc4c..3826bad 100644 --- a/configure.ac +++ b/configure.ac @@ -22,7 +22,7 @@ AC_PREREQ(2.61) -AC_INIT([mcron], [1.0.8], [dale_mellor@users.sourceforge.net]) +AC_INIT([GNU Mcron], [1.0.8], [bug-mcron@gnu.org]) AC_CONFIG_AUX_DIR([build-aux]) AM_INIT_AUTOMAKE -- cgit v1.2.3 From 3c903bfc808b6fed0c3fff6e78689cfe280d25b3 Mon Sep 17 00:00:00 2001 From: Mathieu Lirzin Date: Sun, 16 Aug 2015 10:33:37 +0200 Subject: main: Add (mcron main) module. Remove 'ed' hack to eval content of scm/mcron/main.scm in the C wrapper. Use proper libguile functions instead. * scm/mcron/main.scm (mcron main): New module. (show-version, show-package-information, show-help, main): Remove extra newline characters in strings. * mcron.c.template: Rename to ... * mcron.c: ... this. (inner_main): Set current module to (mcron main). * makefile.ed: Delete file. * configure.ac: Remove check for 'ed'. * makefile.am: Adjust accordingly. * .gitignore: Likewise. --- .gitignore | 1 - configure.ac | 4 -- makefile.am | 11 +---- makefile.ed | 34 --------------- mcron.c | 102 +++++++++++++++++++++++++++++++++++++++++++++ mcron.c.template | 120 ----------------------------------------------------- scm/mcron/main.scm | 108 ++++++++++++++++++++++------------------------- 7 files changed, 153 insertions(+), 227 deletions(-) delete mode 100644 makefile.ed create mode 100644 mcron.c delete mode 100644 mcron.c.template (limited to 'configure.ac') diff --git a/.gitignore b/.gitignore index 6aaa315..4505cc5 100644 --- a/.gitignore +++ b/.gitignore @@ -27,7 +27,6 @@ install-sh makefile makefile.in /mcron -mcron.c /mdate-sh *.o missing diff --git a/configure.ac b/configure.ac index 3826bad..ed6971f 100644 --- a/configure.ac +++ b/configure.ac @@ -64,10 +64,6 @@ AC_CHECK_PROGS(HEAD, head) if test "x$ac_cv_prog_HEAD" = "x"; then AC_MSG_ERROR(head not found) fi -AC_CHECK_PROGS(ED, ed) -if test "x$ac_cv_prog_ED" = "x"; then - AC_MSG_ERROR(ed not found) -fi AC_CHECK_PROGS(WHICH, which) if test "x$ac_cv_prog_WHICH" = "x"; then AC_MSG_ERROR(which not found) diff --git a/makefile.am b/makefile.am index 61fbe56..aa0b24b 100644 --- a/makefile.am +++ b/makefile.am @@ -21,12 +21,9 @@ SUBDIRS = scm/mcron . -ED = @ED@ # !!!! Are these needed? CP = @CP@ -CLEANFILES = mcron.c - -EXTRA_DIST = makefile.ed mcron.c.template BUGS ChangeLog.old +EXTRA_DIST = BUGS ChangeLog.old info_TEXINFOS = doc/mcron.texi doc_mcron_TEXINFOS = doc/fdl.texi @@ -40,12 +37,6 @@ mcron_LDADD = @GUILE_LIBS@ # in turn so that we can do mcron --help during the build process. mcron_CFLAGS = @GUILE_CFLAGS@ -DGUILE_LOAD_PATH=\"$(datadir):./scm:...\" - -mcron.c : scm/mcron/main.scm scm/mcron/crontab.scm makefile.ed mcron.c.template - @echo 'Building mcron.c...' - @$(ED) < makefile.ed > /dev/null 2>&1 - @rm -f mcron.escaped.scm > /dev/null 2>&1 - dist-hook: gen-ChangeLog gen_start_date = 2015-06-26 diff --git a/makefile.ed b/makefile.ed deleted file mode 100644 index 7047ec7..0000000 --- a/makefile.ed +++ /dev/null @@ -1,34 +0,0 @@ -# Copyright (C) 2003 Dale Mellor -# -# 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 . -# -# -# -e scm/mcron/main.scm -/\(load "crontab.scm"\)/d --1r scm/mcron/crontab.scm -%s/\\/\\\\/g -%s/"/\\"/g -%s/ *;;.*$/ /g -g/^ *$/d -%s/^/\"/ -%s/$/\"/ -w mcron.escaped.scm -e mcron.c.template -/GUILE_PROGRAM_GOES_HERE/d --1r mcron.escaped.scm -w mcron.c -q diff --git a/mcron.c b/mcron.c new file mode 100644 index 0000000..6c9efa4 --- /dev/null +++ b/mcron.c @@ -0,0 +1,102 @@ +/* mcron - run jobs at scheduled times + + Copyright (C) 2015, 2016 Mathieu Lirzin + Copyright (C) 2003, 2014 Dale Mellor + + 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 . */ + +/* This C code represents the thinnest possible wrapper around the Guile code + which constitutes all the functionality of the mcron program. There are + two plus one reasons why we need to do this, and one very unfortunate + consequence. + + * Firstly, SUID does not work on an executable script. In the end, it is + the execution of the translator, in our case guile, which determines the + effective user, and it is not wise to make the system guile installation + SUID root! + + * Secondly, executable scripts show up in ugly ways in listings of the + system process table. Guile in particular, with its multi-line + #! ...\ \n -s ...!# + idiosyncracies shows up in process listings in a way that is difficult + to determine what program is actually running. + + * A third reason for the C wrapper which might be mentioned is that a + security-conscious system administrator can choose to only install a + binary, thus removing the possibility of a user studying a guile script + and working out ways of hacking it to his own ends, or worse still + finding a way to modify it to his own ends. + + * Unfortunately, running the guile script from inside a C program means + that the sigaction function does not work. Instead, it is necessary to + perform the signal processing in C. */ + +#include +#include +#include + +/* This is a function designed to be installed as a signal handler, for + signals which are supposed to initiate shutdown of this program. It calls + the scheme procedure (see mcron.scm for details) to do all the work, and + then exits. */ + +void +react_to_terminal_signal (int sig) +{ + scm_c_eval_string ("(delete-run-file)"); + exit (1); +} + +/* This is a function designed to be callable from scheme, and sets up all the + signal handlers required by the cron personality. */ + +SCM +set_cron_signals () +{ + static struct sigaction sa; + + memset (&sa, 0, sizeof (sa)); + sa.sa_handler = react_to_terminal_signal; + sigaction (SIGTERM, &sa, 0); + sigaction (SIGINT, &sa, 0); + sigaction (SIGQUIT, &sa, 0); + sigaction (SIGHUP, &sa, 0); + + return SCM_BOOL_T; +} + +/* The effective main function (i.e. the one that actually does some work). + We register the function above with the guile system, and then execute the + mcron guile program. */ + +void +inner_main (void *closure, int argc, char **argv) +{ + scm_set_current_module (scm_c_resolve_module ("mcron main")); + scm_c_define_gsubr ("c-set-cron-signals", 0, 0, 0, set_cron_signals); + scm_c_eval_string ("(main)"); +} + +/* The real main function. Does nothing but start up the guile subsystem. */ + +int +main (int argc, char **argv) +{ + setenv ("GUILE_LOAD_PATH", GUILE_LOAD_PATH, 1); + scm_boot_guile (argc, argv, inner_main, 0); + + return 0; +} diff --git a/mcron.c.template b/mcron.c.template deleted file mode 100644 index e9a755d..0000000 --- a/mcron.c.template +++ /dev/null @@ -1,120 +0,0 @@ -/* -*-c-*- */ -/* - * Copyright (C) 2003, 2014 Dale Mellor - * - * 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 . - */ - - -/* - This C code represents the thinnest possible wrapper around the Guile code - which constitutes all the functionality of the mcron program. There are two - plus one reasons why we need to do this, and one very unfortunate - consequence. - - Firstly, SUID does not work on an executable script. In the end, it is - the execution of the translator, in our case guile, which determines the - effective user, and it is not wise to make the system guile installation - SUID root! - - Secondly, executable scripts show up in ugly ways in listings of the - system process table. Guile in particular, with its multi-line - #! ...\ \n -s ...!# - idiosyncracies shows up in process listings in a way that is difficult - to determine what program is actually running. - - A third reason for the C wrapper which might be mentioned is that a - security-conscious system administrator can choose to only install a - binary, thus removing the possibility of a user studying a guile script - and working out ways of hacking it to his own ends, or worse still - finding a way to modify it to his own ends. - - Unfortunately, running the guile script from inside a C program means - that the sigaction function does not work. Instead, it is necessary to - perform the signal processing in C. - - The guile code itself is substituted for the GU1LE_PROGRAM_GOES_HERE (sic) - token by the makefile, which processes the scheme to make it look like one - big string. -*/ - - - -#include -#include -#include - - - -/* This is a function designed to be installed as a signal handler, for signals - which are supposed to initiate shutdown of this program. It calls the scheme - procedure (see mcron.scm for details) to do all the work, and then exits. */ - -void -react_to_terminal_signal (int sig) -{ - scm_c_eval_string ("(delete-run-file)"); - exit (1); -} - - - -/* This is a function designed to be callable from scheme, and sets up all the - signal handlers required by the cron personality. */ - -SCM -set_cron_signals () -{ - static struct sigaction sa; - memset (&sa, 0, sizeof (sa)); - sa.sa_handler = react_to_terminal_signal; - sigaction (SIGTERM, &sa, 0); - sigaction (SIGINT, &sa, 0); - sigaction (SIGQUIT, &sa, 0); - sigaction (SIGHUP, &sa, 0); - - return SCM_BOOL_T; -} - - - -/* The effective main function (i.e. the one that actually does some work). We - register the function above with the guile system, and then execute the mcron - guile program. */ - -void -inner_main () -{ - scm_c_define_gsubr ("c-set-cron-signals", 0, 0, 0, set_cron_signals); - - scm_c_eval_string ( - GUILE_PROGRAM_GOES_HERE - ); -} - - - -/* The real main function. Does nothing but start up the guile subsystem. */ - -int -main (int argc, char **argv) -{ - setenv ("GUILE_LOAD_PATH", GUILE_LOAD_PATH, 1); - - scm_boot_guile (argc, argv, inner_main, 0); - - return 0; -} diff --git a/scm/mcron/main.scm b/scm/mcron/main.scm index a964795..1d8c87b 100644 --- a/scm/mcron/main.scm +++ b/scm/mcron/main.scm @@ -16,28 +16,22 @@ ;; You should have received a copy of the GNU General Public License along ;; with GNU mcron. If not, see . - - -;; This is the 'main' routine for the whole system; the top of this file is the -;; global entry point (after the minimal C wrapper, mcron.c.template); to all -;; intents and purposes the program is pure Guile and starts here. -;; -;; This file is built into mcron.c.template by the makefile, which stringifies -;; the whole lot, and escapes quotation marks and escape characters -;; accordingly. Bear this in mind when considering literal multi-line strings. -;; -;; (l0ad "crontab.scm") (sic) is inlined by the makefile. All other -;; functionality comes through modules in .../share/guile/site/mcron/*.scm. - -(use-modules (ice-9 getopt-long) - (ice-9 rdelim) - (ice-9 regex) - (mcron config) - (mcron core) - (mcron job-specifier) - (mcron vixie-specification) - (srfi srfi-2) - (srfi srfi-26)) +;;; This is the 'main' routine for the whole system; this module is the global +;;; entry point (after the minimal C wrapper); to all intents and purposes the +;;; program is pure Guile and starts here. + +(define-module (mcron main) + #:use-module (ice-9 getopt-long) + #:use-module (ice-9 rdelim) + #:use-module (ice-9 regex) + #:use-module (mcron config) + #:use-module (mcron core) + #:use-module (mcron job-specifier) + #:use-module (mcron vixie-specification) + #:use-module (srfi srfi-2) + #:use-module (srfi srfi-26) + #:export (delete-run-file + main)) (define* (command-name #:optional (command (car (command-line)))) "Extract the actual command name from COMMAND. This returns the last part @@ -112,18 +106,18 @@ and exit with its error code." (let* ((name config-package-name) (short-name (cadr (string-split name #\space))) (version config-package-version)) - (simple-format #t "~a (~a) ~a\n -Copyright (C) 2015 the ~a authors.\n -License GPLv3+: GNU GPL version 3 or later \n -This is free software: you are free to change and redistribute it.\n + (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) (quit))) (define (show-package-information) "Display where to get help and send bug reports." - (simple-format #t "\nReport bugs to: ~a.\n -~a home page: <~a>\n + (simple-format #t "\nReport bugs to: ~a. +~a home page: <~a> General help using GNU software: \n" config-package-bugreport config-package-name @@ -135,34 +129,34 @@ General help using GNU software: \n" (display (case command-type ((mcron) - " [OPTIONS] [FILES]\n -Run an mcron process according to the specifications in the FILES (`-' for\n -standard input), or use all the files in ~/.config/cron (or the \n -deprecated ~/.cron) with .guile or .vixie extensions.\n -\n - -v, --version Display version\n - -h, --help Display this help message\n - -sN, --schedule[=]N Display the next N jobs that will be run by mcron\n - -d, --daemon Immediately detach the program from the terminal\n - and run as a daemon process\n - -i, --stdin=(guile|vixie) Format of data passed as standard input or\n + " [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)") ((cron) - " [OPTIONS]\n -Unless an option is specified, run a cron daemon as a detached process, \n -reading all the information in the users' crontabs and in /etc/crontab.\n -\n - -v, --version Display version\n - -h, --help Display this help message\n - -sN, --schedule[=]N Display the next N jobs that will be run by cron\n - -n, --noetc Do not check /etc/crontab for updates (HIGHLY\n + " [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).") ((crontab) - " [-u user] file\n - crontab [-u user] { -e | -l | -r }\n - (default operation is replace, per 1003.2)\n - -e (edit user's crontab)\n - -l (list user's crontab)\n + " [-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") (else "\nrubbish"))) (newline) @@ -379,10 +373,10 @@ comes in on the above socket." parse-system-vixie-line)) (use-user-job-list) (unless (option-ref options 'noetc #f) - (display "WARNING: -cron will check for updates to /etc/crontab EVERY MINUTE. If you do\n -not use this file, or you are prepared to manually restart cron whenever you\n -make a change, then it is HIGHLY RECOMMENDED that you use the --noetc\n + (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) @@ -423,5 +417,3 @@ option.\n") (run-job-loop fdes-list) (unless (null? fdes-list) (process-update-request fdes-list)))))) - -(main) -- cgit v1.2.3 From 3221c057206ca22c2da599c8c76bbcbb0f36e794 Mon Sep 17 00:00:00 2001 From: Mathieu Lirzin Date: Sun, 16 Aug 2015 15:55:35 +0200 Subject: build: Compile and install '.go' files. * configure.ac: Set and substitute 'mcronmoduledir'. Check for 'guild' which requires Guile >= 2.0.7. Use 'AC_CANONICAL_HOST'. * scm/mcron/makefile.am (.scm.go): New target. (MODULES, GEN_MODULES, GOBJECTS, CLEANFILES, SUFFIXES) (dist_mcronmodule_DATA, mcronmodule_DATA): New variables. (pkgdata_DATA, EXTRA_DIST): Remove variables. * .gitignore: Adjust accordingly. --- .gitignore | 3 +++ configure.ac | 12 ++++++++++-- scm/mcron/main.scm | 2 ++ scm/mcron/makefile.am | 48 +++++++++++++++++++++++++++++++++++++++++++----- 4 files changed, 58 insertions(+), 7 deletions(-) (limited to 'configure.ac') diff --git a/.gitignore b/.gitignore index 4505cc5..9748b8a 100644 --- a/.gitignore +++ b/.gitignore @@ -1,9 +1,12 @@ *~ +*.go .deps INSTALL aclocal.m4 autom4te.cache /build-aux/compile +/build-aux/config.guess +/build-aux/config.sub /build-aux/depcomp /build-aux/install-sh /build-aux/mdate-sh diff --git a/configure.ac b/configure.ac index ed6971f..42dfa6e 100644 --- a/configure.ac +++ b/configure.ac @@ -26,6 +26,8 @@ AC_INIT([GNU Mcron], [1.0.8], [bug-mcron@gnu.org]) AC_CONFIG_AUX_DIR([build-aux]) AM_INIT_AUTOMAKE +mcronmoduledir="${datarootdir}/guile/site/2.0/mcron" +AC_SUBST([mcronmoduledir]) AC_MSG_CHECKING([whether debugging is requested]) AC_ARG_ENABLE(debug, @@ -45,12 +47,18 @@ AC_SUBST(CONFIG_DEBUG) # We have no interest (hence a no-op), but Debian wants this. AC_ARG_ENABLE(maintainer-mode) - +AC_CANONICAL_HOST AC_PROG_AWK AC_PROG_EGREP AM_PROG_CC_C_O -PKG_CHECK_MODULES(GUILE, guile-2.0) +PKG_CHECK_MODULES([GUILE], [guile-2.0 >= 2.0.7]) +AC_PATH_PROG([GUILE], [guile]) + +# search guild +AC_PATH_PROG([GUILD], [guild]) +AS_IF([test -z "$ac_cv_path_GUILD"], + [AC_MSG_ERROR(['guild' program cannot be found.])]) # Checks for programs. diff --git a/scm/mcron/main.scm b/scm/mcron/main.scm index 1d8c87b..6ac2116 100644 --- a/scm/mcron/main.scm +++ b/scm/mcron/main.scm @@ -343,6 +343,8 @@ comes in on the above socket." (unless (option-ref options 'schedule #f) (with-output-to-file config-pid-file noop)) (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)) ;; Now we have the procedures in place for dealing with the contents of diff --git a/scm/mcron/makefile.am b/scm/mcron/makefile.am index 931b03b..ab6cae2 100644 --- a/scm/mcron/makefile.am +++ b/scm/mcron/makefile.am @@ -1,10 +1,48 @@ -EXTRA_DIST = main.scm mcron-core.scm vixie-specification.scm \ - crontab.scm environment.scm job-specifier.scm redirect.scm \ - vixie-time.scm +MODULES = \ + environment.scm \ + job-specifier.scm \ + main.scm \ + redirect.scm \ + vixie-specification.scm \ + vixie-time.scm -pkgdata_DATA = core.scm environment.scm job-specifier.scm redirect.scm \ - vixie-time.scm vixie-specification.scm config.scm +GEN_MODULES = \ + config.scm \ + core.scm +GOBJECTS = \ + $(GEN_MODULES:%.scm=%.go) \ + $(MODULES:%.scm=%.go) + +mcronmodule_DATA = \ + $(GOBJECTS) \ + $(GEN_MODULES) + +dist_mcronmodule_DATA = \ + $(MODULES) \ + crontab.scm \ + mcron-core.scm + +# Unset 'GUILE_LOAD_COMPILED_PATH' altogether while compiling. Otherwise, if +# $GUILE_LOAD_COMPILED_PATH contains $(mcronmoduledir), we may find .go files +# in there that are newer than the local .scm files (for instance because the +# user ran 'make install' recently). When that happens, we end up loading +# those previously-installed .go files, which may be stale, thereby breaking +# the whole thing. +# +# XXX: Use the C locale for when Guile lacks +# . +.scm.go: + unset GUILE_LOAD_COMPILED_PATH ; \ + LC_ALL=C \ + $(GUILD) compile \ + --load-path="$(top_builddir)/scm" \ + --load-path="$(top_srcdir)/scm" \ + --warn=format --warn=unbound-variable --warn=arity-mismatch \ + --target="$(host)" --output="$@" "$<" + +SUFFIXES = .go +CLEANFILES = $(GOBJECTS) # If you're wondering, the configure script keeps deleting all files with a name # like core.*, so we have to keep re-making it (I lost a good day's work because -- cgit v1.2.3 From 1712722a7b50e2f449ee94fb5d039757f2426f36 Mon Sep 17 00:00:00 2001 From: Mathieu Lirzin Date: Tue, 18 Aug 2015 17:25:21 +0200 Subject: build: Enable silent rules by default. * configure.ac (AM_SILENT_RULES): Use macro. * makefile.am (doc/mcron.1): Use $(AM_V_HELP2MAN). (AM_V_HELP2MAN, AM_V_HELP2MAN_, AM_V_HELP2MAN_): New variables. * scm/mcron/makefile.am (.scm.go): Use $(AM_V_GUILEC). (AM_V_GUILEC, AM_V_GUILEC_, AM_V_GUILEC_): New variables. --- configure.ac | 1 + makefile.am | 10 ++++++++-- scm/mcron/makefile.am | 6 ++++++ 3 files changed, 15 insertions(+), 2 deletions(-) (limited to 'configure.ac') diff --git a/configure.ac b/configure.ac index 42dfa6e..54481dd 100644 --- a/configure.ac +++ b/configure.ac @@ -25,6 +25,7 @@ AC_PREREQ(2.61) AC_INIT([GNU Mcron], [1.0.8], [bug-mcron@gnu.org]) AC_CONFIG_AUX_DIR([build-aux]) AM_INIT_AUTOMAKE +AM_SILENT_RULES([yes]) # enables silent rules by default mcronmoduledir="${datarootdir}/guile/site/2.0/mcron" AC_SUBST([mcronmoduledir]) diff --git a/makefile.am b/makefile.am index aa0b24b..1fcf32e 100644 --- a/makefile.am +++ b/makefile.am @@ -79,9 +79,15 @@ uninstall-hook: rm -f $(fpp){cron,crontab}$(EXEEXT); \ fi +# Extend silent rules to help2man. +AM_V_HELP2MAN = $(AM_V_HELP2MAN_$(V)) +AM_V_HELP2MAN_ = $(AM_V_HELP2MAN_$(AM_DEFAULT_VERBOSITY)) +AM_V_HELP2MAN_0 = @echo " HELP2MAN" $@; # Not part of formal package building, but a rule for manual use to get the # elemental man page. Will only work once the mcron program is installed. doc/mcron.1: mcron.c - -$(HELP2MAN) -n 'a program to run tasks at regular (or not) intervals' \ - ./mcron > $@ + -$(AM_V_HELP2MAN)$(MKDIR_P) `dirname "$@"` ; \ + $(HELP2MAN) \ + -n 'a program to run tasks at regular (or not) intervals' \ + ./mcron > $@ diff --git a/scm/mcron/makefile.am b/scm/mcron/makefile.am index ab6cae2..cb7a6bb 100644 --- a/scm/mcron/makefile.am +++ b/scm/mcron/makefile.am @@ -23,6 +23,11 @@ dist_mcronmodule_DATA = \ crontab.scm \ mcron-core.scm +# Extend silent rules to Guile compilation. +AM_V_GUILEC = $(AM_V_GUILEC_$(V)) +AM_V_GUILEC_ = $(AM_V_GUILEC_$(AM_DEFAULT_VERBOSITY)) +AM_V_GUILEC_0 = @echo " GUILEC " $@; + # Unset 'GUILE_LOAD_COMPILED_PATH' altogether while compiling. Otherwise, if # $GUILE_LOAD_COMPILED_PATH contains $(mcronmoduledir), we may find .go files # in there that are newer than the local .scm files (for instance because the @@ -33,6 +38,7 @@ dist_mcronmodule_DATA = \ # XXX: Use the C locale for when Guile lacks # . .scm.go: + $(AM_V_GUILEC)$(MKDIR_P) `dirname "$@"` ; \ unset GUILE_LOAD_COMPILED_PATH ; \ LC_ALL=C \ $(GUILD) compile \ -- cgit v1.2.3 From b59f2f5ea6f99681ca61f9342206c11f3a165b2c Mon Sep 17 00:00:00 2001 From: Mathieu Lirzin Date: Sat, 17 Oct 2015 19:56:03 +0200 Subject: build: Use a non-recursive makefile. * configure.ac (AM_INIT_AUTOMAKE): Use 'subdir-objects' option. (AC_CONFIG_FILES): Remove 'scm/mcron/makefile' and 'makefile'. Add 'Makefile'. * makefile.am: Delete file. Move its content into ... * scm/mcron/makefile.am: Likewise. * Makefile.am: ... this. New file. * .gitignore: Update. --- .gitignore | 30 +++++------ Makefile.am | 145 ++++++++++++++++++++++++++++++++++++++++++++++++++ configure.ac | 5 +- makefile.am | 93 -------------------------------- scm/mcron/makefile.am | 59 -------------------- 5 files changed, 162 insertions(+), 170 deletions(-) create mode 100644 Makefile.am delete mode 100644 makefile.am delete mode 100644 scm/mcron/makefile.am (limited to 'configure.ac') diff --git a/.gitignore b/.gitignore index 9748b8a..3aa3599 100644 --- a/.gitignore +++ b/.gitignore @@ -1,9 +1,7 @@ -*~ *.go +*.o +*~ .deps -INSTALL -aclocal.m4 -autom4te.cache /build-aux/compile /build-aux/config.guess /build-aux/config.sub @@ -12,6 +10,19 @@ autom4te.cache /build-aux/mdate-sh /build-aux/missing /build-aux/texinfo.tex +/doc/.dirstamp +/doc/config.texi +/doc/mcron.1 +/doc/mcron.info +/doc/stamp-vti +/doc/version.texi +/mcron +/mdate-sh +INSTALL +Makefile +Makefile.in +aclocal.m4 +autom4te.cache compile config.cache config.log @@ -20,17 +31,6 @@ config.status configure core.scm depcomp -/doc/.dirstamp -/doc/config.texi -/doc/mcron.info -/doc/mcron.1 -/doc/stamp-vti -/doc/version.texi install-sh -makefile -makefile.in -/mcron -/mdate-sh -*.o missing texinfo.tex diff --git a/Makefile.am b/Makefile.am new file mode 100644 index 0000000..8c7b4d0 --- /dev/null +++ b/Makefile.am @@ -0,0 +1,145 @@ +## Process this file with automake to produce Makefile.in. + +# Copyright (C) 2003 Dale Mellor +# Copyright (C) 2015, 2016 Mathieu Lirzin +# +# This program 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. +# +# This program 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 this program. If not, see . + +bin_PROGRAMS = mcron +mcron_SOURCES = mcron.c +mcron_CFLAGS = @GUILE_CFLAGS@ -DGUILE_LOAD_PATH=\"$(datadir):./scm:...\" +mcron_DEPENDENCIES = $(GOBJECTS) # Build Guile modules before linking. +mcron_LDADD = @GUILE_LIBS@ + +MODULES = \ + scm/mcron/environment.scm \ + scm/mcron/job-specifier.scm \ + scm/mcron/main.scm \ + scm/mcron/redirect.scm \ + scm/mcron/vixie-specification.scm \ + scm/mcron/vixie-time.scm + +GEN_MODULES = \ + scm/mcron/config.scm \ + scm/mcron/core.scm + +CP = @CP@ +# XXX: Prevent the 'configure' script to delete the 'core.*' files. +scm/mcron/core.scm: scm/mcron/mcron-core.scm + $(CP) $< $@ + +GOBJECTS = \ + $(GEN_MODULES:%.scm=%.go) \ + $(MODULES:%.scm=%.go) + +mcronmodule_DATA = \ + $(GOBJECTS) \ + $(GEN_MODULES) + +dist_mcronmodule_DATA = \ + $(MODULES) \ + scm/mcron/crontab.scm \ + scm/mcron/mcron-core.scm + +# Unset 'GUILE_LOAD_COMPILED_PATH' altogether while compiling. Otherwise, if +# $GUILE_LOAD_COMPILED_PATH contains $(mcronmoduledir), we may find .go files +# in there that are newer than the local .scm files (for instance because the +# user ran 'make install' recently). When that happens, we end up loading +# those previously-installed .go files, which may be stale, thereby breaking +# the whole thing. +# +# XXX: Use the C locale for when Guile lacks +# . +.scm.go: + $(AM_V_GUILEC)$(MKDIR_P) `dirname "$@"` ; \ + unset GUILE_LOAD_COMPILED_PATH ; \ + LC_ALL=C \ + $(GUILD) compile \ + --load-path="$(top_builddir)/scm" \ + --load-path="$(top_srcdir)/scm" \ + --warn=format --warn=unbound-variable --warn=arity-mismatch \ + --target="$(host)" --output="$@" "$<" + +SUFFIXES = .go + +dist-hook: gen-ChangeLog + +gen_start_date = 2015-06-26 +.PHONY: gen-ChangeLog +gen-ChangeLog: + $(AM_V_GEN)if test -d $(srcdir)/.git; then \ + log_fix="$(srcdir)/build-aux/git-log-fix"; \ + test -e "$$log_fix" \ + && amend_git_log="--amend=$$log_fix" \ + || amend_git_log=; \ + $(top_srcdir)/build-aux/gitlog-to-changelog \ + $$amend_git_log --since=$(gen_start_date) > $(distdir)/cl-t && \ + { rm -f $(distdir)/ChangeLog && \ + mv $(distdir)/cl-t $(distdir)/ChangeLog; } \ + fi + +#full program prefix +fpp = $(DESTDIR)$(bindir)/@real_program_prefix@ + +install-exec-hook: + @if [ "x@NO_VIXIE_CLOBBER@" != "xyes" -a "`id -u`" -eq "0" ]; then \ + rm -f $(fpp)cron$(EXEEXT) > /dev/null 2>&1; \ + $(INSTALL) --mode='u=rwx' mcron$(EXEEXT) $(fpp)cron$(EXEEXT); \ + rm -f $(fpp)crontab$(EXEEXT) > /dev/null 2>&1; \ + $(INSTALL) --mode='u=rwxs,og=rx' mcron$(EXEEXT) $(fpp)crontab$(EXEEXT); \ + $(INSTALL) -d --mode='u=rwx' $(DESTDIR)/var/cron; \ + $(INSTALL) -d --mode='u=rwx,og=rx' $(DESTDIR)/var/run; \ + $(INSTALL) -d --mode='u=rwx,og=rx' $(DESTDIR)@GUILE_SITE@; \ + $(INSTALL) -d --mode='u=rwx,og=rx' $(DESTDIR)@GUILE_SITE@/mcron; \ + elif [ "x@NO_VIXIE_CLOBBER@" = "xyes" ]; then \ + echo "Not installing Vixie-style programs"; \ + else \ + echo "+++ WARNING: NON-ROOT INSTALL: ONLY mcron WILL BE INSTALLED, NOT ANY OF THE VIXIE REPLACEMENT PROGRAMS"; \ + fi + +uninstall-hook: + if [ "`id -u`" -eq "0" ]; then \ + rm -f $(fpp){cron,crontab}$(EXEEXT); \ + fi + +EXTRA_DIST = BUGS +CLEANFILES = $(GOBJECTS) + +## --------------- ## +## Documentation. ## +## --------------- ## + +info_TEXINFOS = doc/mcron.texi +doc_mcron_TEXINFOS = doc/fdl.texi +dist_man_MANS = doc/mcron.1 + +# Not part of formal package building, but a rule for manual use to get the +# elemental man page. Will only work once the mcron program is installed. +doc/mcron.1: mcron.c + -$(AM_V_HELP2MAN)$(MKDIR_P) `dirname "$@"` ; \ + $(HELP2MAN) \ + -n 'a program to run tasks at regular (or not) intervals' \ + ./mcron > $@ + +## -------------- ## +## Silent rules. ## +## -------------- ## + +AM_V_GUILEC = $(AM_V_GUILEC_$(V)) +AM_V_GUILEC_ = $(AM_V_GUILEC_$(AM_DEFAULT_VERBOSITY)) +AM_V_GUILEC_0 = @echo " GUILEC " $@; + +AM_V_HELP2MAN = $(AM_V_HELP2MAN_$(V)) +AM_V_HELP2MAN_ = $(AM_V_HELP2MAN_$(AM_DEFAULT_VERBOSITY)) +AM_V_HELP2MAN_0 = @echo " HELP2MAN" $@; diff --git a/configure.ac b/configure.ac index 54481dd..9972ad5 100644 --- a/configure.ac +++ b/configure.ac @@ -24,7 +24,7 @@ AC_PREREQ(2.61) AC_INIT([GNU Mcron], [1.0.8], [bug-mcron@gnu.org]) AC_CONFIG_AUX_DIR([build-aux]) -AM_INIT_AUTOMAKE +AM_INIT_AUTOMAKE([subdir-objects]) AM_SILENT_RULES([yes]) # enables silent rules by default mcronmoduledir="${datarootdir}/guile/site/2.0/mcron" @@ -182,7 +182,6 @@ real_program_prefix=`echo $program_prefix | sed s/NONE//` AC_SUBST(real_program_prefix) AC_CONFIG_FILES([doc/config.texi - makefile - scm/mcron/makefile + Makefile scm/mcron/config.scm]) AC_OUTPUT diff --git a/makefile.am b/makefile.am deleted file mode 100644 index 1fcf32e..0000000 --- a/makefile.am +++ /dev/null @@ -1,93 +0,0 @@ -## Makefile for the toplevel directory of mcron. -## Copyright (C) 2003 Dale Mellor -## Copyright (C) 2015 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 . - -## Process this file with automake to produce Makefile.in - -SUBDIRS = scm/mcron . - -CP = @CP@ - -EXTRA_DIST = BUGS ChangeLog.old - -info_TEXINFOS = doc/mcron.texi -doc_mcron_TEXINFOS = doc/fdl.texi -dist_man_MANS = doc/mcron.1 - -bin_PROGRAMS = mcron -mcron_SOURCES = mcron.c -mcron_LDADD = @GUILE_LIBS@ - -# The second option is so that we can execute the binary in the local directory, -# in turn so that we can do mcron --help during the build process. -mcron_CFLAGS = @GUILE_CFLAGS@ -DGUILE_LOAD_PATH=\"$(datadir):./scm:...\" - -dist-hook: gen-ChangeLog - -gen_start_date = 2015-06-26 -.PHONY: gen-ChangeLog -gen-ChangeLog: - $(AM_V_GEN)if test -d $(srcdir)/.git; then \ - log_fix="$(srcdir)/build-aux/git-log-fix"; \ - test -e "$$log_fix" \ - && amend_git_log="--amend=$$log_fix" \ - || amend_git_log=; \ - $(top_srcdir)/build-aux/gitlog-to-changelog \ - $$amend_git_log --since=$(gen_start_date) > $(distdir)/cl-t && \ - { rm -f $(distdir)/ChangeLog && \ - mv $(distdir)/cl-t $(distdir)/ChangeLog; } \ - fi - -#full program prefix -fpp = $(DESTDIR)$(bindir)/@real_program_prefix@ - - -install-exec-hook: - @if [ "x@NO_VIXIE_CLOBBER@" != "xyes" -a "`id -u`" -eq "0" ]; then \ - rm -f $(fpp)cron$(EXEEXT) > /dev/null 2>&1; \ - $(INSTALL) --mode='u=rwx' mcron$(EXEEXT) $(fpp)cron$(EXEEXT); \ - rm -f $(fpp)crontab$(EXEEXT) > /dev/null 2>&1; \ - $(INSTALL) --mode='u=rwxs,og=rx' mcron$(EXEEXT) $(fpp)crontab$(EXEEXT); \ - $(INSTALL) -d --mode='u=rwx' $(DESTDIR)/var/cron; \ - $(INSTALL) -d --mode='u=rwx,og=rx' $(DESTDIR)/var/run; \ - $(INSTALL) -d --mode='u=rwx,og=rx' $(DESTDIR)@GUILE_SITE@; \ - $(INSTALL) -d --mode='u=rwx,og=rx' $(DESTDIR)@GUILE_SITE@/mcron; \ - elif [ "x@NO_VIXIE_CLOBBER@" = "xyes" ]; then \ - echo "Not installing Vixie-style programs"; \ - else \ - echo "+++ WARNING: NON-ROOT INSTALL: ONLY mcron WILL BE INSTALLED, NOT ANY OF THE VIXIE REPLACEMENT PROGRAMS"; \ - fi - - -uninstall-hook: - if [ "`id -u`" -eq "0" ]; then \ - rm -f $(fpp){cron,crontab}$(EXEEXT); \ - fi - -# Extend silent rules to help2man. -AM_V_HELP2MAN = $(AM_V_HELP2MAN_$(V)) -AM_V_HELP2MAN_ = $(AM_V_HELP2MAN_$(AM_DEFAULT_VERBOSITY)) -AM_V_HELP2MAN_0 = @echo " HELP2MAN" $@; - -# Not part of formal package building, but a rule for manual use to get the -# elemental man page. Will only work once the mcron program is installed. -doc/mcron.1: mcron.c - -$(AM_V_HELP2MAN)$(MKDIR_P) `dirname "$@"` ; \ - $(HELP2MAN) \ - -n 'a program to run tasks at regular (or not) intervals' \ - ./mcron > $@ diff --git a/scm/mcron/makefile.am b/scm/mcron/makefile.am deleted file mode 100644 index cb7a6bb..0000000 --- a/scm/mcron/makefile.am +++ /dev/null @@ -1,59 +0,0 @@ -MODULES = \ - environment.scm \ - job-specifier.scm \ - main.scm \ - redirect.scm \ - vixie-specification.scm \ - vixie-time.scm - -GEN_MODULES = \ - config.scm \ - core.scm - -GOBJECTS = \ - $(GEN_MODULES:%.scm=%.go) \ - $(MODULES:%.scm=%.go) - -mcronmodule_DATA = \ - $(GOBJECTS) \ - $(GEN_MODULES) - -dist_mcronmodule_DATA = \ - $(MODULES) \ - crontab.scm \ - mcron-core.scm - -# Extend silent rules to Guile compilation. -AM_V_GUILEC = $(AM_V_GUILEC_$(V)) -AM_V_GUILEC_ = $(AM_V_GUILEC_$(AM_DEFAULT_VERBOSITY)) -AM_V_GUILEC_0 = @echo " GUILEC " $@; - -# Unset 'GUILE_LOAD_COMPILED_PATH' altogether while compiling. Otherwise, if -# $GUILE_LOAD_COMPILED_PATH contains $(mcronmoduledir), we may find .go files -# in there that are newer than the local .scm files (for instance because the -# user ran 'make install' recently). When that happens, we end up loading -# those previously-installed .go files, which may be stale, thereby breaking -# the whole thing. -# -# XXX: Use the C locale for when Guile lacks -# . -.scm.go: - $(AM_V_GUILEC)$(MKDIR_P) `dirname "$@"` ; \ - unset GUILE_LOAD_COMPILED_PATH ; \ - LC_ALL=C \ - $(GUILD) compile \ - --load-path="$(top_builddir)/scm" \ - --load-path="$(top_srcdir)/scm" \ - --warn=format --warn=unbound-variable --warn=arity-mismatch \ - --target="$(host)" --output="$@" "$<" - -SUFFIXES = .go -CLEANFILES = $(GOBJECTS) - -# If you're wondering, the configure script keeps deleting all files with a name -# like core.*, so we have to keep re-making it (I lost a good day's work because -# of this). - -core.scm : mcron-core.scm - $(CP) mcron-core.scm core.scm - -- cgit v1.2.3 From 8952d2dc442913f0ecf1fa896d97c882a5daa664 Mon Sep 17 00:00:00 2001 From: Mathieu Lirzin Date: Sat, 17 Oct 2015 20:05:08 +0200 Subject: build: Support VPATH builds. This allows using 'mcron' before it is installed without hardcoding the local build environment in the executable. * build-aux/pre-inst-env.in: New script. * configure.ac (AC_CONFIG_FILES): Create it. (AC_CONFIG_HEADER): Add 'config.h'. (moduledir): New variable. (PACKAGE_LOAD_PATH): new C preprocessor macro. * mcron.c: Include "config.h". (main): Don't overwrite Guile load paths. (inner_main): Prepend Mcron modules load paths. * Makefile.am (.scm.go, doc/mcron.1): Use 'pre-inst-env'. (mcron_CFLAGS): Remove GUILE_LOAD_PATH macro. (noinst_SCRIPTS): New variable. * .gitignore: Update. --- .gitignore | 4 ++++ Makefile.am | 7 ++++--- build-aux/pre-inst-env.in | 35 +++++++++++++++++++++++++++++++++++ configure.ac | 10 +++++++--- mcron.c | 10 +++++++++- 5 files changed, 59 insertions(+), 7 deletions(-) create mode 100644 build-aux/pre-inst-env.in (limited to 'configure.ac') diff --git a/.gitignore b/.gitignore index 3aa3599..17829a7 100644 --- a/.gitignore +++ b/.gitignore @@ -25,6 +25,8 @@ aclocal.m4 autom4te.cache compile config.cache +config.h +config.h.in config.log config.scm config.status @@ -33,4 +35,6 @@ core.scm depcomp install-sh missing +pre-inst-env +stamp-h1 texinfo.tex diff --git a/Makefile.am b/Makefile.am index 8c7b4d0..c2d42b4 100644 --- a/Makefile.am +++ b/Makefile.am @@ -18,7 +18,7 @@ bin_PROGRAMS = mcron mcron_SOURCES = mcron.c -mcron_CFLAGS = @GUILE_CFLAGS@ -DGUILE_LOAD_PATH=\"$(datadir):./scm:...\" +mcron_CFLAGS = @GUILE_CFLAGS@ mcron_DEPENDENCIES = $(GOBJECTS) # Build Guile modules before linking. mcron_LDADD = @GUILE_LIBS@ @@ -65,13 +65,14 @@ dist_mcronmodule_DATA = \ $(AM_V_GUILEC)$(MKDIR_P) `dirname "$@"` ; \ unset GUILE_LOAD_COMPILED_PATH ; \ LC_ALL=C \ - $(GUILD) compile \ + $(top_builddir)/pre-inst-env $(GUILD) compile \ --load-path="$(top_builddir)/scm" \ --load-path="$(top_srcdir)/scm" \ --warn=format --warn=unbound-variable --warn=arity-mismatch \ --target="$(host)" --output="$@" "$<" SUFFIXES = .go +noinst_SCRIPTS = pre-inst-env dist-hook: gen-ChangeLog @@ -128,7 +129,7 @@ dist_man_MANS = doc/mcron.1 # elemental man page. Will only work once the mcron program is installed. doc/mcron.1: mcron.c -$(AM_V_HELP2MAN)$(MKDIR_P) `dirname "$@"` ; \ - $(HELP2MAN) \ + $(top_builddir)/pre-inst-env $(HELP2MAN) \ -n 'a program to run tasks at regular (or not) intervals' \ ./mcron > $@ diff --git a/build-aux/pre-inst-env.in b/build-aux/pre-inst-env.in new file mode 100644 index 0000000..7e69b44 --- /dev/null +++ b/build-aux/pre-inst-env.in @@ -0,0 +1,35 @@ +#!/bin/sh + +# 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 . + +abs_top_srcdir="`cd "@abs_top_srcdir@" > /dev/null; pwd`" +abs_top_builddir="`cd "@abs_top_builddir@" > /dev/null; pwd`" + +GUILE_LOAD_COMPILED_PATH="$abs_top_builddir/scm${GUILE_LOAD_COMPILED_PATH:+:}$GUILE_LOAD_COMPILED_PATH" +GUILE_LOAD_PATH="$abs_top_builddir/scm:$abs_top_srcdir/scm${GUILE_LOAD_PATH:+:}:$GUILE_LOAD_PATH" +export GUILE_LOAD_COMPILED_PATH GUILE_LOAD_PATH + +PATH="$abs_top_builddir:$PATH" +export PATH + +# Define $MCRON_UNINSTALLED to prevent 'mcron' from prepending @moduledir@ to +# the Guile load paths. +MCRON_UNINSTALLED=1 +export MCRON_UNINSTALLED + +exec "$@" diff --git a/configure.ac b/configure.ac index 9972ad5..d6262f2 100644 --- a/configure.ac +++ b/configure.ac @@ -23,13 +23,15 @@ AC_PREREQ(2.61) AC_INIT([GNU Mcron], [1.0.8], [bug-mcron@gnu.org]) +AC_CONFIG_HEADER([config.h]) AC_CONFIG_AUX_DIR([build-aux]) AM_INIT_AUTOMAKE([subdir-objects]) AM_SILENT_RULES([yes]) # enables silent rules by default -mcronmoduledir="${datarootdir}/guile/site/2.0/mcron" -AC_SUBST([mcronmoduledir]) - +moduledir="${datarootdir}/guile/site/2.0" +AC_SUBST([mcronmoduledir], ["${moduledir}/mcron"]) +AC_DEFINE_UNQUOTED([PACKAGE_LOAD_PATH], ["${moduledir}"], + [Define to the guile modules location of this package.]) AC_MSG_CHECKING([whether debugging is requested]) AC_ARG_ENABLE(debug, AC_HELP_STRING([--enable-debug], @@ -181,6 +183,8 @@ AC_SUBST(CONFIG_TMP_DIR) real_program_prefix=`echo $program_prefix | sed s/NONE//` AC_SUBST(real_program_prefix) +AC_CONFIG_FILES([pre-inst-env:build-aux/pre-inst-env.in], + [chmod +x pre-inst-env]) AC_CONFIG_FILES([doc/config.texi Makefile scm/mcron/config.scm]) diff --git a/mcron.c b/mcron.c index 0c62ec8..92e1a37 100644 --- a/mcron.c +++ b/mcron.c @@ -22,6 +22,7 @@ is needed because the crontab personality requires SUID which is not permitted for executable scripts. */ +#include "config.h" #include #include #include @@ -35,7 +36,6 @@ static SCM set_cron_signals (void); int main (int argc, char **argv) { - setenv ("GUILE_LOAD_PATH", GUILE_LOAD_PATH, 1); scm_boot_guile (argc, argv, inner_main, 0); return EXIT_SUCCESS; @@ -45,6 +45,14 @@ main (int argc, char **argv) static void inner_main (void *closure, int argc, char **argv) { + /* Set Guile load paths to ensure that Mcron modules will be found. */ + if (getenv ("MCRON_UNINSTALLED") == NULL) + { + scm_c_eval_string ("(set! %load-path (cons \"" + PACKAGE_LOAD_PATH "\" %load-path))"); + scm_c_eval_string ("(set! %load-compiled-path (cons \"" + PACKAGE_LOAD_PATH "\" %load-compiled-path))"); + } scm_set_current_module (scm_c_resolve_module ("mcron main")); /* Register set_cron_signals to be called from Guile. */ scm_c_define_gsubr ("c-set-cron-signals", 0, 0, 0, set_cron_signals); -- cgit v1.2.3 From 995bc9ca6ebf6880d7e7e6f3d1baa2941758fc47 Mon Sep 17 00:00:00 2001 From: Mathieu Lirzin Date: Sat, 7 May 2016 11:09:44 +0200 Subject: all: Rename 'scm' directory to 'src'. * scm/mcron/config.scm.in: Rename to ... * src/mcron/config.scm.in: ... this. * scm/mcron/crontab.scm: Rename to ... * src/mcron/crontab.scm: ... this. * scm/mcron/environment.scm: Rename to ... * src/mcron/environment.scm: ... this. * scm/mcron/job-specifier.scm: Rename to ... * src/mcron/job-specifier.scm: ... this. * scm/mcron/main.scm: Rename to ... * src/mcron/main.scm: ... this. * scm/mcron/mcron-core.scm: Rename to ... * src/mcron/mcron-core.scm: ... this. * scm/mcron/redirect.scm: Rename to ... * src/mcron/redirect.scm: ... this. * scm/mcron/vixie-specification.scm: Rename to ... * src/mcron/vixie-specification.scm: ... this. * scm/mcron/vixie-time.scm: Rename to ... * src/mcron/vixie-time.scm: ... this. * mcron.c: Rename to ... * src/mcron.c: ... this. * Makefile.am: Adapt to them. * build-aux/pre-inst-env.in: Likewise. * configure.ac (AC_CONFIG_FILES): Likewise. (AC_CONFIG_HEADER): Set to 'src/config.h'. * .gitignore: Update. --- .gitignore | 2 +- Makefile.am | 30 +-- build-aux/pre-inst-env.in | 4 +- configure.ac | 4 +- mcron.c | 87 --------- scm/mcron/config.scm.in | 39 ---- scm/mcron/crontab.scm | 228 ---------------------- scm/mcron/environment.scm | 97 --------- scm/mcron/job-specifier.scm | 253 ------------------------ scm/mcron/main.scm | 401 -------------------------------------- scm/mcron/mcron-core.scm | 270 ------------------------- scm/mcron/redirect.scm | 190 ------------------ scm/mcron/vixie-specification.scm | 207 -------------------- scm/mcron/vixie-time.scm | 384 ------------------------------------ src/mcron.c | 87 +++++++++ src/mcron/config.scm.in | 39 ++++ src/mcron/crontab.scm | 228 ++++++++++++++++++++++ src/mcron/environment.scm | 97 +++++++++ src/mcron/job-specifier.scm | 253 ++++++++++++++++++++++++ src/mcron/main.scm | 401 ++++++++++++++++++++++++++++++++++++++ src/mcron/mcron-core.scm | 270 +++++++++++++++++++++++++ src/mcron/redirect.scm | 190 ++++++++++++++++++ src/mcron/vixie-specification.scm | 207 ++++++++++++++++++++ src/mcron/vixie-time.scm | 384 ++++++++++++++++++++++++++++++++++++ 24 files changed, 2176 insertions(+), 2176 deletions(-) delete mode 100644 mcron.c delete mode 100644 scm/mcron/config.scm.in delete mode 100644 scm/mcron/crontab.scm delete mode 100644 scm/mcron/environment.scm delete mode 100644 scm/mcron/job-specifier.scm delete mode 100644 scm/mcron/main.scm delete mode 100644 scm/mcron/mcron-core.scm delete mode 100644 scm/mcron/redirect.scm delete mode 100644 scm/mcron/vixie-specification.scm delete mode 100644 scm/mcron/vixie-time.scm create mode 100644 src/mcron.c create mode 100644 src/mcron/config.scm.in create mode 100644 src/mcron/crontab.scm create mode 100644 src/mcron/environment.scm create mode 100644 src/mcron/job-specifier.scm create mode 100644 src/mcron/main.scm create mode 100644 src/mcron/mcron-core.scm create mode 100644 src/mcron/redirect.scm create mode 100644 src/mcron/vixie-specification.scm create mode 100644 src/mcron/vixie-time.scm (limited to 'configure.ac') diff --git a/.gitignore b/.gitignore index 17829a7..8bffc85 100644 --- a/.gitignore +++ b/.gitignore @@ -2,6 +2,7 @@ *.o *~ .deps +.dirstamp /build-aux/compile /build-aux/config.guess /build-aux/config.sub @@ -10,7 +11,6 @@ /build-aux/mdate-sh /build-aux/missing /build-aux/texinfo.tex -/doc/.dirstamp /doc/config.texi /doc/mcron.1 /doc/mcron.info diff --git a/Makefile.am b/Makefile.am index 4f11c0f..1b5317c 100644 --- a/Makefile.am +++ b/Makefile.am @@ -17,26 +17,26 @@ # along with this program. If not, see . bin_PROGRAMS = mcron -mcron_SOURCES = mcron.c +mcron_SOURCES = src/mcron.c mcron_CFLAGS = @GUILE_CFLAGS@ mcron_DEPENDENCIES = $(GOBJECTS) # Build Guile modules before linking. mcron_LDADD = @GUILE_LIBS@ MODULES = \ - scm/mcron/environment.scm \ - scm/mcron/job-specifier.scm \ - scm/mcron/main.scm \ - scm/mcron/redirect.scm \ - scm/mcron/vixie-specification.scm \ - scm/mcron/vixie-time.scm + src/mcron/environment.scm \ + src/mcron/job-specifier.scm \ + src/mcron/main.scm \ + src/mcron/redirect.scm \ + src/mcron/vixie-specification.scm \ + src/mcron/vixie-time.scm GEN_MODULES = \ - scm/mcron/config.scm \ - scm/mcron/core.scm + src/mcron/config.scm \ + src/mcron/core.scm CP = @CP@ # XXX: Prevent the 'configure' script to delete the 'core.*' files. -scm/mcron/core.scm: scm/mcron/mcron-core.scm +src/mcron/core.scm: src/mcron/mcron-core.scm $(CP) $< $@ GOBJECTS = \ @@ -49,8 +49,8 @@ mcronmodule_DATA = \ dist_mcronmodule_DATA = \ $(MODULES) \ - scm/mcron/crontab.scm \ - scm/mcron/mcron-core.scm + src/mcron/crontab.scm \ + src/mcron/mcron-core.scm # Unset 'GUILE_LOAD_COMPILED_PATH' altogether while compiling. Otherwise, if # $GUILE_LOAD_COMPILED_PATH contains $(mcronmoduledir), we may find .go files @@ -67,8 +67,8 @@ dist_mcronmodule_DATA = \ export GUILE_AUTO_COMPILE=0 ; unset GUILE_LOAD_COMPILED_PATH ; \ LC_ALL=C \ $(top_builddir)/pre-inst-env $(GUILD) compile \ - --load-path="$(top_builddir)/scm" \ - --load-path="$(top_srcdir)/scm" \ + --load-path="$(top_builddir)/src" \ + --load-path="$(top_srcdir)/src" \ --warn=format --warn=unbound-variable --warn=arity-mismatch \ --target="$(host)" --output="$@" "$<" @@ -134,7 +134,7 @@ TEXI2DVI = texi2dvi -I doc # Not part of formal package building, but a rule for manual use to get the # elemental man page. Will only work once the mcron program is installed. -doc/mcron.1: mcron.c +doc/mcron.1: src/mcron.c -$(AM_V_HELP2MAN)$(MKDIR_P) `dirname "$@"` ; \ $(top_builddir)/pre-inst-env $(HELP2MAN) \ -n 'a program to run tasks at regular (or not) intervals' \ diff --git a/build-aux/pre-inst-env.in b/build-aux/pre-inst-env.in index 7e69b44..ea866ee 100644 --- a/build-aux/pre-inst-env.in +++ b/build-aux/pre-inst-env.in @@ -20,8 +20,8 @@ abs_top_srcdir="`cd "@abs_top_srcdir@" > /dev/null; pwd`" abs_top_builddir="`cd "@abs_top_builddir@" > /dev/null; pwd`" -GUILE_LOAD_COMPILED_PATH="$abs_top_builddir/scm${GUILE_LOAD_COMPILED_PATH:+:}$GUILE_LOAD_COMPILED_PATH" -GUILE_LOAD_PATH="$abs_top_builddir/scm:$abs_top_srcdir/scm${GUILE_LOAD_PATH:+:}:$GUILE_LOAD_PATH" +GUILE_LOAD_COMPILED_PATH="$abs_top_builddir/src${GUILE_LOAD_COMPILED_PATH:+:}$GUILE_LOAD_COMPILED_PATH" +GUILE_LOAD_PATH="$abs_top_builddir/src:$abs_top_srcdir/src${GUILE_LOAD_PATH:+:}:$GUILE_LOAD_PATH" export GUILE_LOAD_COMPILED_PATH GUILE_LOAD_PATH PATH="$abs_top_builddir:$PATH" diff --git a/configure.ac b/configure.ac index d6262f2..175ba16 100644 --- a/configure.ac +++ b/configure.ac @@ -23,7 +23,7 @@ AC_PREREQ(2.61) AC_INIT([GNU Mcron], [1.0.8], [bug-mcron@gnu.org]) -AC_CONFIG_HEADER([config.h]) +AC_CONFIG_HEADER([src/config.h]) AC_CONFIG_AUX_DIR([build-aux]) AM_INIT_AUTOMAKE([subdir-objects]) AM_SILENT_RULES([yes]) # enables silent rules by default @@ -187,5 +187,5 @@ AC_CONFIG_FILES([pre-inst-env:build-aux/pre-inst-env.in], [chmod +x pre-inst-env]) AC_CONFIG_FILES([doc/config.texi Makefile - scm/mcron/config.scm]) + src/mcron/config.scm]) AC_OUTPUT diff --git a/mcron.c b/mcron.c deleted file mode 100644 index 92e1a37..0000000 --- a/mcron.c +++ /dev/null @@ -1,87 +0,0 @@ -/* mcron - run jobs at scheduled times - - Copyright (C) 2015, 2016 Mathieu Lirzin - Copyright (C) 2003, 2014 Dale Mellor - - 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 . */ - -/* This C code represents a thin wrapper around the Guile code of Mcron. It - is needed because the crontab personality requires SUID which is not - permitted for executable scripts. */ - -#include "config.h" -#include -#include -#include -#include - -/* Forward declarations. */ -static void inner_main (void *closure, int argc, char **argv); -static void react_to_terminal_signal (int sig); -static SCM set_cron_signals (void); - -int -main (int argc, char **argv) -{ - scm_boot_guile (argc, argv, inner_main, 0); - - return EXIT_SUCCESS; -} - -/* Launch the Mcron Guile main program. */ -static void -inner_main (void *closure, int argc, char **argv) -{ - /* Set Guile load paths to ensure that Mcron modules will be found. */ - if (getenv ("MCRON_UNINSTALLED") == NULL) - { - scm_c_eval_string ("(set! %load-path (cons \"" - PACKAGE_LOAD_PATH "\" %load-path))"); - scm_c_eval_string ("(set! %load-compiled-path (cons \"" - PACKAGE_LOAD_PATH "\" %load-compiled-path))"); - } - scm_set_current_module (scm_c_resolve_module ("mcron main")); - /* Register set_cron_signals to be called from Guile. */ - scm_c_define_gsubr ("c-set-cron-signals", 0, 0, 0, set_cron_signals); - scm_c_eval_string ("(main)"); -} - -/* Set up all the signal handlers as required by the cron personality. This - is necessary to perform the signal processing in C because the sigaction - function won't work when called from Guile. */ -static SCM -set_cron_signals () -{ - static struct sigaction sa; - - memset (&sa, 0, sizeof (sa)); - sa.sa_handler = react_to_terminal_signal; - sigaction (SIGTERM, &sa, 0); - sigaction (SIGINT, &sa, 0); - sigaction (SIGQUIT, &sa, 0); - sigaction (SIGHUP, &sa, 0); - - return SCM_BOOL_T; -} - -/* Handle signal SIG and exit. All signals that mcron handles will produce - the same behavior so we don't need to use SIG in the implementation. */ -static void -react_to_terminal_signal (int sig) -{ - scm_c_eval_string ("(delete-run-file)"); - exit (EXIT_FAILURE); -} diff --git a/scm/mcron/config.scm.in b/scm/mcron/config.scm.in deleted file mode 100644 index db2bc32..0000000 --- a/scm/mcron/config.scm.in +++ /dev/null @@ -1,39 +0,0 @@ -;; -*-scheme-*- - -;; Copyright (C) 2015 Mathieu Lirzin -;; Copyright (C) 2003 Dale Mellor -;; -;; 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 . - - -;; Some constants set by the configuration process. - -(define-module (mcron config)) - -(define-public config-debug @CONFIG_DEBUG@) -(define-public config-package-name "@PACKAGE_NAME@") -(define-public config-package-version "@PACKAGE_VERSION@") -(define-public config-package-string "@PACKAGE_STRING@") -(define-public config-package-bugreport "@PACKAGE_BUGREPORT@") -(define-public config-package-url "@PACKAGE_URL@") -(define-public config-sendmail "@SENDMAIL@") - -(define-public config-spool-dir "@CONFIG_SPOOL_DIR@") -(define-public config-socket-file "@CONFIG_SOCKET_FILE@") -(define-public config-allow-file "@CONFIG_ALLOW_FILE@") -(define-public config-deny-file "@CONFIG_DENY_FILE@") -(define-public config-pid-file "@CONFIG_PID_FILE@") -(define-public config-tmp-dir "@CONFIG_TMP_DIR@") diff --git a/scm/mcron/crontab.scm b/scm/mcron/crontab.scm deleted file mode 100644 index 6be5c61..0000000 --- a/scm/mcron/crontab.scm +++ /dev/null @@ -1,228 +0,0 @@ -;; Copyright (C) 2003, 2014 Dale Mellor -;; -;; 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 . - - -;; Apart from the collecting of options and the handling of --help and --version -;; (which are done in the main.scm file), this file provides all the -;; functionality of the crontab personality. It is designed to be loaded and run -;; once, and then the calling program can exit and the crontab program will have -;; completed its function. - - - -;; 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. - -(let ((hit-server - (lambda (user-name) - (catch #t (lambda () - (let ((socket (socket AF_UNIX SOCK_STREAM 0))) - (connect socket AF_UNIX config-socket-file) - (display user-name socket) - (close socket))) - (lambda (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? - (lambda (file name) - (catch #t (lambda () - (with-input-from-file - file - (lambda () - (let loop ((input (read-line))) - (if (eof-object? input) - #f - (if (string=? input name) - #t - (loop (read-line)))))))) - (lambda (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. - - (if (> (+ (if (option-ref options 'edit #f) 1 0) - (if (option-ref options 'list #f) 1 0) - (if (option-ref options '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. - - (if (and (not (eqv? (getuid) 0)) - (option-ref options 'user #f)) - (mcron-error 8 "Only root can use the -u option.")) - - - - (let ( - - - ;; Iff the --user option is given, the crontab-user may be different - ;; from the real user. - - (crontab-user (option-ref options '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 (lambda (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 options 'list #f) - (catch #t (lambda () - (with-input-from-file crontab-file (lambda () - (do ((input (read-char) (read-char))) - ((eof-object? input)) - (display input))))) - (lambda (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 options 'edit #f) - (let ((temp-file (string-append config-tmp-dir - "/crontab." - (number->string (getpid))))) - (catch #t (lambda () (copy-file crontab-file temp-file)) - (lambda (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 - (lambda () (read-vixie-file temp-file)) - (lambda (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 options 'remove #f) - (catch #t (lambda () (delete-file crontab-file) - (hit-server crontab-user)) - noop)) - - - ;; !!!! 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 options '() '()))) - (let ((input-file (car (option-ref options '() '())))) - (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 (lambda () - (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."))) - - -)) ;; End of file-level let-scopes. diff --git a/scm/mcron/environment.scm b/scm/mcron/environment.scm deleted file mode 100644 index b563d55..0000000 --- a/scm/mcron/environment.scm +++ /dev/null @@ -1,97 +0,0 @@ -;; Copyright (C) 2015, 2016 Mathieu Lirzin -;; Copyright (C) 2003 Dale Mellor -;; -;; 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 . - - - -;; This file defines the variable current-environment-mods, and the procedures -;; append-environment-mods (which is available to user configuration files), -;; clear-environment-mods and modify-environment. The idea is that the -;; current-environment-mods is a list of pairs of environment names and values, -;; and represents the cumulated environment settings in a configuration -;; file. When a job definition is seen in a configuration file, the -;; current-environment-mods are copied into the internal job description, and -;; when the job actually runs these environment modifications are applied to -;; the UNIX environment in which the job runs. - - - - -(define-module (mcron environment) - #:export (modify-environment - clear-environment-mods - append-environment-mods - get-current-environment-mods-copy)) - - - -;; As we parse configuration files, we build up an alist of environment -;; variables here. - -(define current-environment-mods '()) - - - -;; Each time a job is added to the system, we take a snapshot of the current -;; set of environment modifiers. - -(define (get-current-environment-mods-copy) - (list-copy current-environment-mods)) - - - -;; When we start to parse a new configuration file, we want to start with a -;; fresh environment (actually an umodified version of the pervading mcron -;; environment). - -(define (clear-environment-mods) - (set! current-environment-mods '())) - - - -;; Procedure to add another environment setting to the alist above. This is -;; used both implicitly by the Vixie parser, and can be used directly by users -;; in scheme configuration files. The return value is purely for the -;; convenience of the parse-vixie-environment in the vixie-specification module -;; (yuk). - -(define (append-environment-mods name value) - (set! current-environment-mods (append current-environment-mods - (list (cons name value)))) - #t) - -(define (modify-environment env passwd-entry) - "Modify the environment (in the UNIX sense) by setting the variables from -ENV and some default ones which are modulated by PASSWD-ENTRY. \"LOGNAME\" -and \"USER\" environment variables can't be overided by ENV. ENV must be an -alist which associate environment variables to their value. PASSWD-ENTRY must -be an object representing user information which corresponds to a valid entry -in /etc/passwd. The return value is not specified." - (for-each (lambda (pair) (setenv (car pair) (cdr pair))) - (let ((home-dir (passwd:dir passwd-entry)) - (user-name (passwd:name passwd-entry))) - (append - ;; Default environment variables which can be overided by ENV. - `(("HOME" . ,home-dir) - ("CWD" . ,home-dir) - ("SHELL" . ,(passwd:shell passwd-entry)) - ("TERM" . #f) - ("TERMCAP" . #f)) - env - ;; Environment variables with imposed values. - `(("LOGNAME" . ,user-name) - ("USER" . ,user-name)))))) diff --git a/scm/mcron/job-specifier.scm b/scm/mcron/job-specifier.scm deleted file mode 100644 index 1c2f9d9..0000000 --- a/scm/mcron/job-specifier.scm +++ /dev/null @@ -1,253 +0,0 @@ -;; Copyright (C) 2003 Dale Mellor -;; Copyright (C) 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 . - - - -;; This module defines all the functions that can be used by scheme mcron -;; configuration files, namely the procedures for working out next times, the -;; job procedure for registering new jobs (actually a wrapper around the core -;; add-job function), and the procedure for declaring environment modifications. - -(define-module (mcron job-specifier) - #:use-module (ice-9 match) - #:use-module (mcron core) - #:use-module (mcron environment) - #:use-module (mcron vixie-time) - #:use-module (srfi srfi-1) - #:use-module (srfi srfi-26) - #:re-export (append-environment-mods) - #:export (range - next-year-from next-year - next-month-from next-month - next-day-from next-day - next-hour-from next-hour - next-minute-from next-minute - next-second-from next-second - set-configuration-user - set-configuration-time - job)) - -(define* (range start end #:optional (step 1)) - "Produces a list of values from START up to (but not including) END. An -optional STEP may be supplied, and (if positive) only every step'th value will -go into the list. For example, (range 1 6 2) returns '(1 3 5)." - (unfold (cut >= <> end) identity (cute + <> (max step 1)) start)) - -(define (%find-best-next current next-list) - ;; Takes a value and a list of possible next values (all assumed less than - ;; 9999). It returns a pair consisting of the smallest element of the - ;; NEXT-LIST, and the smallest element larger than the CURRENT value. If an - ;; example of the latter cannot be found, 9999 will be returned. - (let loop ((smallest 9999) (closest+ 9999) (lst next-list)) - (match lst - (() (cons smallest closest+)) - ((time . rest) - (loop (min time smallest) - (if (> time current) (min time closest+) closest+) - rest))))) - -;; Internal function to return the time corresponding to some near future -;; hour. If hour-list is not supplied, the time returned corresponds to the -;; start of the next hour of the day. -;; -;; If the hour-list is supplied the time returned corresponds to the first hour -;; of the day in the future which is contained in the list. If all the values in -;; the list are less than the current hour, then the time returned will -;; correspond to the first hour in the list *on the following day*. -;; -;; ... except that the function is actually generalized to deal with seconds, -;; minutes, etc., in an obvious way :-) -;; -;; Note that value-list always comes from an optional argument to a procedure, -;; so is wrapped up as the first element of a list (i.e. it is a list inside a -;; list). - -(define (bump-time time value-list component higher-component - set-component! set-higher-component!) - (if (null? value-list) - (set-component! time (+ (component time) 1)) - (let ((best-next (%find-best-next (component time) (car value-list)))) - (if (eqv? 9999 (cdr best-next)) - (begin - (set-higher-component! time (+ (higher-component time) 1)) - (set-component! time (car best-next))) - (set-component! time (cdr best-next))))) - (car (mktime time))) - - - - -;; Set of configuration methods which use the above general function to bump -;; specific components of time to the next legitimate value. In each case, all -;; the components smaller than that of interest are taken to zero, so that for -;; example the time of the next year will be the time at which the next year -;; actually starts. - -(define (next-year-from current-time . year-list) - (let ((time (localtime current-time))) - (set-tm:mon time 0) - (set-tm:mday time 1) - (set-tm:hour time 0) - (set-tm:min time 0) - (set-tm:sec time 0) - (bump-time time year-list tm:year tm:year set-tm:year set-tm:year))) - -(define (next-month-from current-time . month-list) - (let ((time (localtime current-time))) - (set-tm:mday time 1) - (set-tm:hour time 0) - (set-tm:min time 0) - (set-tm:sec time 0) - (bump-time time month-list tm:mon tm:year set-tm:mon set-tm:year))) - -(define (next-day-from current-time . day-list) - (let ((time (localtime current-time))) - (set-tm:hour time 0) - (set-tm:min time 0) - (set-tm:sec time 0) - (bump-time time day-list tm:mday tm:mon set-tm:mday set-tm:mon))) - -(define (next-hour-from current-time . hour-list) - (let ((time (localtime current-time))) - (set-tm:min time 0) - (set-tm:sec time 0) - (bump-time time hour-list tm:hour tm:mday set-tm:hour set-tm:mday))) - -(define (next-minute-from current-time . minute-list) - (let ((time (localtime current-time))) - (set-tm:sec time 0) - (bump-time time minute-list tm:min tm:hour set-tm:min set-tm:hour))) - -(define (next-second-from current-time . second-list) - (let ((time (localtime current-time))) - (bump-time time second-list tm:sec tm:min set-tm:sec set-tm:min))) - - - -;; The current-action-time is the time a job was last run, the time from which -;; the next time to run a job must be computed. (When the program is first run, -;; this time is set to the configuration time so that jobs run from that moment -;; forwards.) Once we have this, we supply versions of the time computation -;; commands above which implicitly assume this value. - -(define current-action-time 0) - - - -;; We want to provide functions which take a single optional argument (as well -;; as implicitly the current action time), but unlike usual scheme behaviour if -;; the argument is missing we want to act like it is really missing, and if it -;; is there we want to act like it is a genuine argument, not a list of -;; optionals. - -(define (maybe-args function args) - (if (null? args) - (function current-action-time) - (function current-action-time (car args)))) - - - -;; These are the convenience functions we were striving to define for the -;; configuration files. They are wrappers for the next-X-from functions above, -;; but implicitly use the current-action-time for the time argument. - -(define (next-year . args) (maybe-args next-year-from args)) -(define (next-month . args) (maybe-args next-month-from args)) -(define (next-day . args) (maybe-args next-day-from args)) -(define (next-hour . args) (maybe-args next-hour-from args)) -(define (next-minute . args) (maybe-args next-minute-from args)) -(define (next-second . args) (maybe-args next-second-from args)) - - - -;; The default user for running jobs is the current one (who invoked this -;; program). There are exceptions: when cron parses /etc/crontab the user is -;; specified on each individual line; when cron parses /var/cron/tabs/* the user -;; is derived from the filename of the crontab. These cases are dealt with by -;; mutating this variable. Note that the variable is only used at configuration -;; time; a UID is stored with each job and it is that which takes effect when -;; the job actually runs. - -(define configuration-user (getpw (getuid))) -(define configuration-time (current-time)) - -(define (set-configuration-user user) - (set! configuration-user (if (or (string? user) - (integer? user)) - (getpw user) - user))) -(define (set-configuration-time time) (set! configuration-time time)) - - - -;; The job function, available to configuration files for adding a job rule to -;; the system. -;; -;; Here we must 'normalize' the next-time-function so that it is always a lambda -;; function which takes one argument (the last time the job ran) and returns a -;; single value (the next time the job should run). If the input value is a -;; string this is parsed as a Vixie-style time specification, and if it is a -;; list then we arrange to eval it (but note that such lists are expected to -;; ignore the function parameter - the last run time is always read from the -;; current-action-time global variable). A similar normalization is applied to -;; the action. -;; -;; Here we also compute the first time that the job is supposed to run, by -;; finding the next legitimate time from the current configuration time (set -;; right at the top of this program). - -(define (job time-proc action . displayable) - (let ((action (cond ((procedure? action) action) - ((list? action) (lambda () (primitive-eval action))) - ((string? action) (lambda () (system action))) - (else - (throw 'mcron-error 2 - "job: invalid second argument (action; should be lambda " - "function, string or list)")))) - - (time-proc - (cond ((procedure? time-proc) time-proc) - ((string? time-proc) (parse-vixie-time time-proc)) - ((list? time-proc) (lambda (current-time) - (primitive-eval time-proc))) - (else - (throw 'mcron-error 3 - "job: invalid first argument (next-time-function; " - "should be function, string or list)")))) - (displayable - (cond ((not (null? displayable)) (car displayable)) - ((procedure? action) "Lambda function") - ((string? action) action) - ((list? action) (with-output-to-string - (lambda () (display action))))))) - (add-job (lambda (current-time) - (set! current-action-time current-time) ;; ?? !!!! Code - - ;; Contributed by Sergey Poznyakoff to allow for daylight savings - ;; time changes. - (let* ((next (time-proc current-time)) - (gmtoff (tm:gmtoff (localtime next))) - (d (+ next (- gmtoff - (tm:gmtoff (localtime current-time)))))) - (if (eqv? (tm:gmtoff (localtime d)) gmtoff) - d - next))) - action - displayable - configuration-time - configuration-user))) diff --git a/scm/mcron/main.scm b/scm/mcron/main.scm deleted file mode 100644 index 1f2b068..0000000 --- a/scm/mcron/main.scm +++ /dev/null @@ -1,401 +0,0 @@ -;; Copyright (C) 2015, 2016 Mathieu Lirzin -;; Copyright (C) 2003, 2012 Dale Mellor -;; -;; 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 . - -;;; This is the 'main' routine for the whole system; this module is the global -;;; entry point (after the minimal C wrapper); to all intents and purposes the -;;; program is pure Guile and starts here. - -(define-module (mcron main) - #:use-module (ice-9 getopt-long) - #:use-module (ice-9 rdelim) - #:use-module (ice-9 regex) - #:use-module (mcron config) - #:use-module (mcron core) - #:use-module (mcron job-specifier) - #:use-module (mcron vixie-specification) - #:use-module (srfi srfi-2) - #:use-module (srfi srfi-26) - #:export (delete-run-file - main)) - -(define* (command-name #:optional (command (car (command-line)))) - "Extract the actual command name from COMMAND. This returns the last part -of COMMAND without any non-alphabetic characters. For example \"in.cron\" and -\"./mcron\" will return respectively \"cron\" and \"mcron\". - -When COMMAND is not specified this uses the first element of (command-line)." - (match:substring (regexp-exec (make-regexp "[[:alpha:]]*$") command))) - -(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 (append (list (command-name) ": ") 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 command-type - ;; We will be doing a lot of testing of the command name, so it makes sense - ;; to perform the string comparisons once and for all here. - (let* ((command (command-name)) - (command=? (cut string=? command <>))) - (cond ((command=? "mcron") 'mcron) - ((or (command=? "cron") (command=? "crond")) 'cron) - ((command=? "crontab") 'crontab) - (else (mcron-error 12 "The command name is invalid."))))) - -(define options - ;; There are a different set of options for the crontab personality compared - ;; to all the others, with the --help and --version options common to all - ;; the personalities. - (catch - 'misc-error - (lambda () - (getopt-long (command-line) - (append - (case command-type - ((crontab) - '((user (single-char #\u) (value #t)) - (edit (single-char #\e) (value #f)) - (list (single-char #\l) (value #f)) - (remove (single-char #\r) (value #f)))) - (else `((schedule (single-char #\s) (value #t) - (predicate - ,(lambda (value) - (string->number value)))) - (daemon (single-char #\d) (value #f)) - (noetc (single-char #\n) (value #f)) - (stdin (single-char #\i) (value #t) - (predicate - ,(lambda (value) - (or (string=? "vixie" value) - (string=? "guile" value)))))))) - '((version (single-char #\v) (value #f)) - (help (single-char #\h) (value #f)))))) - (lambda (key func fmt args . rest) - (mcron-error 1 (apply format (append (list #f fmt) args)))))) - -(define* (show-version #:optional (command (command-name))) - "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) - (quit))) - -(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* (show-help #:optional (command (command-name))) - "Display informations of usage for COMMAND and quit." - (simple-format #t "Usage: ~a" command) - (display - (case command-type - ((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)") - ((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).") - ((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") - (else "\nrubbish"))) - (newline) - (show-package-information) - (quit)) - -(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 (lambda () (delete-file config-pid-file) - (delete-file config-socket-file)) - noop) - (quit)) - -(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-user-file - (let ((guile-regexp (make-regexp "\\.gui(le)?$")) - (vixie-regexp (make-regexp "\\.vix(ie)?$"))) - (lambda* (file-name #:optional guile-syntax?) - "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=? (option-ref options 'stdin "guile") "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) - "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 (lambda (dir) - (catch #t - (lambda () - (for-each-file - (lambda (file) - (process-user-file (string-append dir "/" file))) - dir)) - (lambda (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-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 - (lambda () - (for-each-file - (lambda (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)) - (lambda (key . args) - (mcron-error 4 - "You do not have permission to access the system crontabs.")))) - -(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." - (if (eq? command-type 'cron) - (catch #t - (lambda () - (let ((sock (socket AF_UNIX SOCK_STREAM 0))) - (bind sock AF_UNIX config-socket-file) - (listen sock 5) - (list sock))) - (lambda (key . args) - (delete-file config-pid-file) - (mcron-error 1 "Cannot bind to UNIX socket " config-socket-file))) - '())) - -(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))))))) - - -;;; -;;; Entry point. -;;; - -(define (main . args) - ;; Turn debugging on if indicated. - (when config-debug - (debug-enable 'backtrace)) - (when (option-ref options 'version #f) - (show-version)) - (when (option-ref options 'help #f) - (show-help)) - - ;; Setup the cron process, if appropriate. If there is already a - ;; /var/run/cron.pid file, then we must assume a cron daemon is already - ;; running and refuse to start another one. - ;; - ;; Otherwise, clear the MAILTO environment variable so that output from cron - ;; jobs is sent to the various users (this may still be overridden in the - ;; configuration files), and call the function in the C wrapper to set up - ;; terminal signal responses to vector to the procedure above. The PID file - ;; will be filled in properly later when we have forked our daemon process - ;; (but not done if we are only viewing the schedules). - (when (eq? command-type 'cron) - (unless (eqv? (getuid) 0) - (mcron-error 16 - "This program must be run by the root user (and should have been " - "installed as such).")) - (when (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 ".)")) - (unless (option-ref options 'schedule #f) - (with-output-to-file config-pid-file noop)) - (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)) - - ;; Now we have the procedures in place for dealing with the contents of - ;; configuration files, the crontab personality is able to validate such - ;; files. If the user requested the crontab personality, we load and run the - ;; code here and then get out. - (when (eq? command-type 'crontab) - (load "crontab.scm") - (quit)) - - ;; 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. - (case command-type - ((mcron) - (if (null? (option-ref options '() '())) - (process-files-in-user-directory) - (for-each (lambda (file-path) (process-user-file file-path #t)) - (option-ref options '() '())))) - ((cron) - (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 (option-ref options 'noetc #f) - (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.")))) - - ;; If the user has requested a schedule of jobs that will run, we provide - ;; the information here and then get out. Start by determining the number - ;; of time points in the future that output is required for. This may be - ;; provided on the command line as a parameter to the --schedule option, or - ;; else we assume a default of 8. Finally, ensure that the count is some - ;; positive integer. - (and-let* ((count (option-ref options 'schedule #f))) - (set! count (string->number count)) - (display (get-schedule (if (<= count 0) 1 count))) - (quit)) - - ;; If we are supposed to run as a daemon process (either a --daemon option - ;; has been explicitly used, or we are running as cron or crond), detach - ;; from the terminal now. If we are running as cron, we can now write the - ;; PID file. - (when (option-ref options 'daemon (eq? command-type 'cron)) - (unless (eqv? (primitive-fork) 0) - (quit)) - (setsid) - (when (eq? command-type 'cron) - (with-output-to-file config-pid-file - (lambda () (display (getpid)) (newline))))) - - ;; Now the main loop. Forever execute the run-job-loop procedure in the - ;; mcron core, 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. Sergey Poznyakoff: we can also drop out of run-job-loop - ;; because of a SIGCHLD, so must test FDES-LIST. - (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/scm/mcron/mcron-core.scm b/scm/mcron/mcron-core.scm deleted file mode 100644 index 13781c9..0000000 --- a/scm/mcron/mcron-core.scm +++ /dev/null @@ -1,270 +0,0 @@ -;; Copyright (C) 2015, 2016 Mathieu Lirzin -;; Copyright (C) 2003 Dale Mellor -;; -;; 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 core) - #:use-module (mcron environment) - #:use-module (srfi srfi-9) - #:export (add-job - remove-user-jobs - get-schedule - run-job-loop - ;; These three are deprecated and not documented. - use-system-job-list - use-user-job-list - clear-system-jobs) - #:re-export (clear-environment-mods - append-environment-mods)) - - -(use-modules (srfi srfi-1) ;; For remove. - (srfi srfi-2)) ;; For and-let*. - - - -;; The list of all jobs known to the system. Each element of the list is -;; -;; (make-job user next-time-function action environment displayable next-time) -;; -;; where action must be a procedure, and the environment is an alist of -;; modifications that need making to the UNIX environment before the action is -;; run. The next-time element is the only one that is modified during the -;; running of a cron process (i.e. all the others are set once and for all at -;; configuration time). -;; -;; The reason we maintain two lists is that jobs in /etc/crontab may be placed -;; in one, and all other jobs go in the other. This makes it possible to remove -;; all the jobs in the first list in one go, and separately we can remove all -;; jobs from the second list which belong to a particular user. This behaviour -;; is required for full vixie compatibility. - -(define system-job-list '()) -(define user-job-list '()) - -(define configuration-source 'user) - -(define (use-system-job-list) (set! configuration-source 'system)) -(define (use-user-job-list) (set! configuration-source 'user)) - -;; A cron job. -(define-record-type - (make-job user time-proc action environment displayable next-time) - job? - (user job:user) ;object : passwd entry - (time-proc job:next-time-function) ;proc : with one 'time' parameter - (action job:action) ;thunk : user's code - (environment job:environment) ;alist : environment variables - (displayable job:displayable) ;string : visible in schedule - (next-time job:next-time ;number : time in UNIX format - job:next-time-set!)) - -;; Remove jobs from the user-job-list belonging to this user. - -(define (remove-user-jobs user) - (if (or (string? user) - (integer? user)) - (set! user (getpw user))) - (set! user-job-list - (remove (lambda (job) (eqv? (passwd:uid user) - (passwd:uid (job:user job)))) - user-job-list))) - - - -;; Remove all the jobs on the system job list. - -(define (clear-system-jobs) (set! system-job-list '())) - - - -;; Add a new job with the given specifications to the head of the appropriate -;; jobs list. - -(define (add-job time-proc action displayable configuration-time - configuration-user) - (let ((entry (make-job configuration-user - time-proc - action - (get-current-environment-mods-copy) - displayable - (time-proc configuration-time)))) - (if (eq? configuration-source 'user) - (set! user-job-list (cons entry user-job-list)) - (set! system-job-list (cons entry system-job-list))))) - - - -;; Procedure to locate the jobs in the global job-list with the lowest -;; (soonest) next-times. These are the jobs for which we must schedule the mcron -;; program (under any personality) to next wake up. The return value is a cons -;; cell consisting of the next time (maintained in the next-time variable) and a -;; list of the job entries that are to run at this time (maintained in the -;; next-jobs-list variable). -;; -;; The procedure works by first obtaining the time of the first job on the list, -;; and setting this job in the next-jobs-list. Then for each other entry on the -;; job-list, either the job runs earlier than any other that have been scanned, -;; in which case the next-time and next-jobs-list are re-initialized to -;; accomodate, or the job runs at the same time as the next job, in which case -;; the next-jobs-list is simply augmented with the new job, or else the job runs -;; later than others noted in which case we ignore it for now and continue to -;; recurse the list. - -(define (find-next-jobs) - (let ((job-list (append system-job-list user-job-list))) - - (if (null? job-list) - - '(#f . '()) - - (let ((next-time 2000000000) - (next-jobs-list '())) - - (for-each - (lambda (job) - (let ((this-time (job:next-time job))) - (cond ((< this-time next-time) - (set! next-time this-time) - (set! next-jobs-list (list job))) - ((eqv? this-time next-time) - (set! next-jobs-list (cons job next-jobs-list)))))) - job-list) - - (cons next-time next-jobs-list))))) - - - -;; Create a string containing a textual list of the next count jobs to run. -;; -;; Enter a loop of displaying the next set of jobs to run, artificially -;; forwarding the time to the next time point (instead of waiting for it to -;; occur as we would do in a normal run of mcron), and recurse around the loop -;; count times. -;; -;; Note that this has the effect of mutating the job timings. Thus the program -;; must exit after calling this function; the internal data state will be left -;; unusable. - -(define (get-schedule count) - (with-output-to-string - (lambda () - (do ((count count (- count 1))) - ((eqv? count 0)) - (and-let* - ((next-jobs (find-next-jobs)) - (time (car next-jobs)) - (date-string (strftime "%c %z\n" (localtime time)))) - (for-each (lambda (job) - (display date-string) - (display (job:displayable job)) - (newline)(newline) - (job:next-time-set! job ((job:next-time-function job) - (job:next-time job)))) - (cdr next-jobs))))))) - - - -;; For proper housekeeping, it is necessary to keep a record of the number of -;; child processes we fork off to run the jobs. - -(define number-children 0) - - - -;; For every job on the list, fork a process to run it (noting the fact by -;; increasing the number-children counter), and in the new process set up the -;; run-time environment exactly as it should be before running the job proper. -;; -;; In the parent, update the job entry by computing the next time the job needs -;; to run. - -(define (run-jobs jobs-list) - (for-each - (lambda (job) - (if (eqv? (primitive-fork) 0) - (begin - (setgid (passwd:gid (job:user job))) - (setuid (passwd:uid (job:user job))) - (chdir (passwd:dir (job:user job))) - (modify-environment (job:environment job) (job:user job)) - ((job:action job)) - (primitive-exit 0)) - (begin - (set! number-children (+ number-children 1)) - (job:next-time-set! job ((job:next-time-function job) - (current-time)))))) - jobs-list)) - - - -;; Give any zombie children a chance to die, and decrease the number known to -;; exist. - -(define (child-cleanup) - (do () ((or (<= number-children 0) - (eqv? (car (waitpid WAIT_ANY WNOHANG)) 0))) - (set! number-children (- number-children 1)))) - - - -;; Now the main loop. Loop over all job specifications, get a list of the next -;; ones to run (may be more than one). Set an alarm and go to sleep. When we -;; wake, run the jobs and reap any children (old jobs) that have -;; completed. Repeat ad infinitum. -;; -;; Note that, if we wake ahead of time, it can only mean that a signal has been -;; sent by a crontab job to tell us to re-read a crontab file. In this case we -;; break out of the loop here, and let the main procedure deal with the -;; situation (it will eventually re-call this function, thus maintaining the -;; loop). - -(define (run-job-loop . fd-list) - - (call-with-current-continuation - (lambda (break) - - (let ((fd-list (if (null? fd-list) '() (car fd-list)))) - - (let loop () - - (let* ((next-jobs (find-next-jobs)) - (next-time (car next-jobs)) - (next-jobs-list (cdr next-jobs)) - (sleep-time (if next-time (- next-time (current-time)) - 2000000000))) - - (and (> sleep-time 0) - (if (not (null? - (catch 'system-error - (lambda () - (car (select fd-list '() '() sleep-time))) - (lambda (key . args) ;; Exception add by Sergey - ;; Poznyakoff. - (if (member (car (last args)) - (list EINTR EAGAIN)) - (begin - (child-cleanup) '()) - (apply throw key args)))))) - (break))) - - (run-jobs next-jobs-list) - - (child-cleanup) - - (loop))))))) diff --git a/scm/mcron/redirect.scm b/scm/mcron/redirect.scm deleted file mode 100644 index af763cb..0000000 --- a/scm/mcron/redirect.scm +++ /dev/null @@ -1,190 +0,0 @@ -;; Copyright (C) 2003 Dale Mellor -;; -;; 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 . - - - -;; This module provides the (with-mail-out action . user) procedure. This -;; procedure runs the action in a child process, allowing the user control over -;; the input and output (including standard error). The input is governed (only -;; in the case of a string action) by the placing of percentage signs in the -;; string; the first delimits the true action from the standard input, and -;; subsequent ones denote newlines to be placed into the input. The output (if -;; there actually is any) is controlled by the MAILTO environment variable. If -;; this is not defined, output is e-mailed to the user passed as argument, if -;; any, or else the owner of the action; if defined but empty then any output is -;; sunk to /dev/null; otherwise output is e-mailed to the address held in the -;; MAILTO variable. - -(define-module (mcron redirect) - #:export (with-mail-out) - #:use-module (ice-9 regex) - #:use-module ((mcron config) :select (config-sendmail)) - #:use-module (mcron vixie-time)) - - - -;; An action string consists of a sequence of characters forming a command -;; executable by the shell, possibly followed by an non-escaped percentage -;; sign. The text after the percentage sign is to be fed to the command's -;; standard input, with further unescaped percents being substituted with -;; newlines. The escape character can itself be escaped. -;; -;; This regexp separates the two halves of the string, and indeed determines if -;; the second part is present. - -(define action-string-regexp (make-regexp "((\\\\%|[^%])*)%(.*)$")) - - - -;; This regexp identifies an escaped percentage sign. - -(define e-percent (make-regexp "\\\\%")) - - -;; Function to execute some action (this may be a shell command, lamdba function -;; or list of scheme procedures) in a forked process, with the input coming from -;; the string, and output (including the error output) being sent to a pipe -;; opened on a mail transport. - -(use-modules (ice-9 popen)) - -(define (with-mail-out action . user) - - ;; Determine the name of the user who is to recieve the mail, looking for a - ;; name in the optional user argument, then in the MAILTO environment - ;; variable, and finally in the LOGNAME environment variable. (The case - ;; MAILTO="" is dealt with specially below.) - - (let* ((mailto (getenv "MAILTO")) - (user (cond (mailto mailto) - ((not (null? user)) (car user)) - (else (getenv "LOGNAME")))) - (parent->child (pipe)) - (child->parent (pipe)) - (child-pid (primitive-fork))) - - - ;; The child process. Close redundant ends of pipes, remap the standard - ;; streams, and run the action, taking care to chop off the input part of an - ;; action string. - - (if (eqv? child-pid 0) - (begin - (close (cdr parent->child)) - (close (car child->parent)) - - (dup2 (port->fdes (car parent->child)) 0) - (close (car parent->child)) - (dup2 (port->fdes (cdr child->parent)) 1) - (close (cdr child->parent)) - (dup2 1 2) - - (cond ((string? action) - (let ((match (regexp-exec action-string-regexp action))) - (system (if match - (let ((action (match:substring match 1))) - (do ((match (regexp-exec e-percent action) - (regexp-exec e-percent action))) - ((not match)) - (set! action (string-append - (match:prefix match) - "%" - (match:suffix match)))) - action) - action)))) - - ((procedure? action) (action)) - ((list? action) (primitive-eval action))) - - (primitive-exit 0))) - - - ;; The parent process. Get rid of redundant pipe ends. - - (close (car parent->child)) - (close (cdr child->parent)) - - - ;; Put stuff to child from after '%' in command line, replacing - ;; other %'s with newlines. Ugly or what? - - (if (string? action) - (let ((port (cdr parent->child)) - (match (regexp-exec action-string-regexp action))) - (if (and match - (match:substring match 3)) - (with-input-from-string (match:substring match 3) - (lambda () - (let loop () - (let ((next-char (read-char))) - (if (not (eof-object? next-char)) - (cond - ((char=? next-char #\%) - (newline port) - (loop)) - ((char=? next-char #\\) - (let ((escape (read-char))) - (if (eof-object? escape) - (display #\\ port) - (if (char=? escape #\%) - (begin - (display #\% port) - (loop)) - (begin - (display #\\ port) - (display escape port) - (loop)))))) - (else - (display next-char port) - (loop))))))))))) - - - ;; So the child process doesn't hang on to its input expecting more stuff. - - (close (cdr parent->child)) - - - ;; That's got streaming into the child's input out of the way, now we stream - ;; the child's output to a mail sink, but only if there is something there - ;; in the first place. - - (if (eof-object? (peek-char (car child->parent))) - - (read-char (car child->parent)) - - (begin - (set-current-output-port (if (and (string? mailto) - (string=? mailto "")) - (open-output-file "/dev/null") - (open-output-pipe - (string-append config-sendmail - " " - user)))) - (set-current-input-port (car child->parent)) - (display "To: ") (display user) (newline) - (display "From: mcron") (newline) - (display (string-append "Subject: " user "@" (gethostname))) - (newline) - (newline) - - (do ((next-char (read-char) (read-char))) - ((eof-object? next-char)) - (display next-char)))) - - (close (car child->parent)) - - (waitpid child-pid))) diff --git a/scm/mcron/vixie-specification.scm b/scm/mcron/vixie-specification.scm deleted file mode 100644 index 5cd1528..0000000 --- a/scm/mcron/vixie-specification.scm +++ /dev/null @@ -1,207 +0,0 @@ -;; Copyright (C) 2003 Dale Mellor -;; -;; 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 . - - - -;; This file provides methods for reading a complete Vixie-style configuration -;; file, either from a real file or an already opened port. It also exposes the -;; method for parsing the time-specification part of a Vixie string, so that -;; these can be used to form the next-time-function of a job in a Guile -;; configuration file. - -(define-module (mcron vixie-specification) - #:export (parse-user-vixie-line - parse-system-vixie-line - read-vixie-port - read-vixie-file - check-system-crontab) - #:use-module ((mcron config) :select (config-socket-file)) - #:use-module (mcron core) - #:use-module (mcron job-specifier) - #:use-module (mcron redirect) - #:use-module (mcron vixie-time)) - - -(use-modules (ice-9 regex) (ice-9 rdelim) - (srfi srfi-1) (srfi srfi-2) (srfi srfi-13) (srfi srfi-14)) - - - -;; A line in a Vixie-style crontab file which gives a command specification -;; carries two pieces of information: a time specification consisting of five -;; space-separated items, and a command which is also separated from the time -;; specification by a space. The line is broken into the two components, and the -;; job procedure run to add the two pieces of information to the job list (this -;; will in turn use the above function to turn the time specification into a -;; function for computing future run times of the command). - -(define parse-user-vixie-line-regexp - (make-regexp "^[[:space:]]*(([^[:space:]]+[[:space:]]+){5})(.*)$")) - -(define (parse-user-vixie-line line) - (let ((match (regexp-exec parse-user-vixie-line-regexp line))) - (if (not match) - (throw 'mcron-error 10 "Bad job line in Vixie file.")) - (job (match:substring match 1) - (lambda () (with-mail-out (match:substring match 3))) - (match:substring match 3)))) - - - -;; The case of reading a line from /etc/crontab is similar to above but the user -;; ID appears in the sixth field, before the action. - -(define parse-system-vixie-line-regexp - (make-regexp (string-append "^[[:space:]]*(([^[:space:]]+[[:space:]]+){5})" - "([[:alpha:]][[:alnum:]_]*)[[:space:]]+(.*)$"))) - -(define (parse-system-vixie-line line) - (let ((match (regexp-exec parse-system-vixie-line-regexp line))) - (if (not match) - (throw 'mcron-error 11 "Bad job line in /etc/crontab.")) - (let ((user (match:substring match 3))) - (set-configuration-user user) - (job (match:substring match 1) - (lambda () (with-mail-out (match:substring match 4) - user)) - (match:substring match 4))))) - - - -;; Procedure to act on an environment variable specification in a Vixie-style -;; configuration file, by adding an entry to the alist above. Returns #t if the -;; operation was successful, #f if the line could not be interpreted as an -;; environment specification. - -(define parse-vixie-environment-regexp1 - (make-regexp - "^[ \t]*([[:alpha:]_][[:alnum:]_]*)[ \t]*=[ \t]*\"(.*)\"[ \t]*$")) -(define parse-vixie-environment-regexp2 - (make-regexp - "^[ \t]*([[:alpha:]_][[:alnum:]_]*)[ \t]*=[ \t]*'(.*)'[ \t]*$")) -(define parse-vixie-environment-regexp3 - (make-regexp - "^[ \t]*([[:alpha:]_][[:alnum:]_]*)[ \t]*=[ \t]*(.*[^ \t])[ \t]*$")) -(define parse-vixie-environment-regexp4 - (make-regexp - "^[ \t]*([[:alpha:]_][[:alnum:]_]*)[ \t]*=[ \t]*$")) - - -(define (parse-vixie-environment string) - (let ((match (or (regexp-exec parse-vixie-environment-regexp1 string) - (regexp-exec parse-vixie-environment-regexp2 string) - (regexp-exec parse-vixie-environment-regexp3 string)))) - (if match - (append-environment-mods (match:substring match 1) - (match:substring match 2)) - (and-let* ((match (regexp-exec parse-vixie-environment-regexp4 string))) - (append-environment-mods (match:substring match 1) #f))))) - - - - -;; The next procedure reads an entire Vixie-style file. For each line in the -;; file there are three possibilities (after continuation lines have been -;; appended): the line is blank or contains only a comment, the line contains an -;; environment modifier which will be handled in the mcron environment module, -;; or the line contains a command specification in which case we use the -;; procedure above to add an entry to the internal job list. -;; -;; Note that the environment modifications are cleared, so that there is no -;; interference between crontab files (this might lead to unpredictable -;; behaviour because the order in which crontab files are processed, if there is -;; more than one, is generally undefined). - -(define read-vixie-file-comment-regexp - (make-regexp "^[[:space:]]*(#.*)?$")) - - -(define (read-vixie-port port . parse-vixie-line) - (clear-environment-mods) - (if port - (let ((parse-vixie-line - (if (null? parse-vixie-line) parse-user-vixie-line - (car parse-vixie-line)))) - (do ((line (read-line port) (read-line port)) - (line-number 1 (1+ line-number))) - ((eof-object? line)) - - (let ((report-line line-number)) - ;; If the line ends with \, append the next line. - (while (and (>= (string-length line) 1) - (char=? (string-ref line - (- (string-length line) 1)) - #\\)) - (let ((next-line (read-line port))) - (if (eof-object? next-line) - (set! next-line "")) - (set! line-number (1+ line-number)) - (set! line - (string-append - (substring line 0 (- (string-length line) 1)) - next-line)))) - - (catch 'mcron-error - (lambda () - ;; Consider the three cases mentioned in the description. - (or (regexp-exec read-vixie-file-comment-regexp line) - (parse-vixie-environment line) - (parse-vixie-line line))) - (lambda (key exit-code . msg) - (throw 'mcron-error exit-code - (apply string-append - (number->string report-line) - ": " - msg))))))))) - - - -;; If a file cannot be opened, we must silently ignore it because it may have -;; been removed by crontab. However, if the file is there it must be parseable, -;; otherwise the error must be propagated to the caller. - -(define (read-vixie-file file-path . parse-vixie-line) - (let ((port #f)) - (catch #t (lambda () (set! port (open-input-file file-path))) - (lambda (key . args) (set! port #f))) - (if port - (catch 'mcron-error - (lambda () - (if (null? parse-vixie-line) - (read-vixie-port port) - (read-vixie-port port (car parse-vixie-line))) - (close port)) - (lambda (key exit-code . msg) - (close port) - (throw 'mcron-error exit-code - (apply string-append file-path ":" msg))))))) - - -;; A procedure which determines if the /etc/crontab file has been recently -;; modified, and, if so, signals the main routine to re-read the file. We run -;; under the with-mail-to command so that the process runs as a child, -;; preventing lockup. If cron is supposed to check for updates to /etc/crontab, -;; then this procedure will be called about 5 seconds before every minute. - -(define (check-system-crontab) - (with-mail-out (lambda () - (let ((mtime (stat:mtime (stat "/etc/crontab")))) - (if (> mtime (- (current-time) 60)) - (let ((socket (socket AF_UNIX SOCK_STREAM 0))) - (connect socket AF_UNIX config-socket-file) - (display "/etc/crontab" socket) - (close socket))))))) diff --git a/scm/mcron/vixie-time.scm b/scm/mcron/vixie-time.scm deleted file mode 100644 index a91fa89..0000000 --- a/scm/mcron/vixie-time.scm +++ /dev/null @@ -1,384 +0,0 @@ -;; Copyright (C) 2003 Dale Mellor -;; -;; 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 vixie-time) - #:use-module (ice-9 regex) - #:use-module (mcron job-specifier) - #:use-module (srfi srfi-1) - #:use-module (srfi srfi-13) - #:use-module (srfi srfi-14) - #:export (parse-vixie-time)) - -;; In Vixie-style time specifications three-letter symbols are allowed to stand -;; for the numbers corresponding to months and days of the week. We deal with -;; this by making a textual substitution early on in the processing of the -;; strings. -;; -;; We start by defining, once and for all, a list of cons cells consisting of -;; regexps which will match the symbols - which allow an arbitrary number of -;; other letters to appear after them (so that the user can optionally complete -;; the month and day names; this is an extension of Vixie) - and the value which -;; is to replace the symbol. -;; -;; The procedure then takes a string, and then for each symbol in the -;; parse-symbols list attempts to locate an instance and replace it with an -;; ASCII representation of the value it stands for. The procedure returns the -;; modified string. (Note that each symbol can appear only once, which meets the -;; Vixie specifications technically but still allows silly users to mess things -;; up). - -(define parse-symbols - (map (lambda (symbol-cell) - (cons (make-regexp (string-append (car symbol-cell) "[[:alpha:]]*") - regexp/icase) - (cdr symbol-cell))) - '(("jan" . "0") ("feb" . "1") ("mar" . "2") ("apr" . "3") - ("may" . "4") ("jun" . "5") ("jul" . "6") ("aug" . "7") - ("sep" . "8") ("oct" . "9") ("nov" . "10") ("dec" . "11") - - ("sun" . "0") ("mon" . "1") ("tue" . "2") ("wed" . "3") - ("thu" . "4") ("fri" . "5") ("sat" . "6") ))) - -(define (vixie-substitute-parse-symbols string) - (for-each (lambda (symbol-cell) - (let ((match (regexp-exec (car symbol-cell) string))) - (if match - (set! string (string-append (match:prefix match) - (cdr symbol-cell) - (match:suffix match)))))) - parse-symbols) - string) - - - -;; A Vixie time specification is made up of a space-separated list of elements, -;; and the elements consist of a comma-separated list of subelements. The -;; procedure below takes a string holding a subelement, which should have no -;; spaces or symbols (see above) in it, and returns a list of all values which -;; that subelement indicates. There are five distinct cases which must be dealt -;; with: [1] a single '*' which returns a list of all values; [2] a '*' followed -;; by a step specifier; [3] a range and step specifier; [4] a range; and [5] a -;; single number. -;; -;; To perform the computation required for the '*' cases, we need to pass the -;; limit of the allowable range for this subelement as the third argument. As -;; days of the month start at 1 while all the other time components start at 0, -;; we must pass the base of the range to deal with this case also. - -(define parse-vixie-subelement-regexp - (make-regexp "^([[:digit:]]+)(-([[:digit:]]+)(/([[:digit:]]+))?)?$")) - -(define (parse-vixie-subelement string base limit) - (if (char=? (string-ref string 0) #\*) - (range base limit (if (> (string-length string) 1) - (string->number (substring string 2)) ;; [2] - 1)) ;; [1] - (let ((match (regexp-exec parse-vixie-subelement-regexp string))) - (cond ((not match) - (throw 'mcron-error 9 - "Bad Vixie-style time specification.")) - ((match:substring match 5) - (range (string->number (match:substring match 1)) - (+ 1 (string->number (match:substring match 3))) - (string->number (match:substring match 5)))) ;; [3] - ((match:substring match 3) - (range (string->number (match:substring match 1)) - (+ 1 (string->number (match:substring match 3))))) ;; [4] - (else - (list (string->number (match:substring match 1)))))))) ;; [5] - - - -;; A Vixie element contains the entire specification, without spaces or symbols, -;; of the acceptable values for one of the time components (minutes, hours, -;; days, months, week days). Here we break the comma-separated list into -;; subelements, and process each with the procedure above. The return value is a -;; list of all the valid values of all the subcomponents. -;; -;; The second and third arguments are the base and upper limit on the values -;; that can be accepted for this time element. -;; -;; The effect of the 'apply append' is to merge a list of lists into a single -;; list. - -(define (parse-vixie-element string base limit) - (apply append - (map (lambda (sub-element) - (parse-vixie-subelement sub-element base limit)) - (string-tokenize string (char-set-complement (char-set #\,)))))) - - - -;; Consider there are two lists, one of days in the month, the other of days in -;; the week. This procedure returns an augmented list of days in the month with -;; weekdays accounted for. - -(define (interpolate-weekdays mday-list wday-list month year) - (let ((t (localtime 0))) - (set-tm:mday t 1) - (set-tm:mon t month) - (set-tm:year t year) - (let ((first-day (tm:wday (cdr (mktime t))))) - (apply append - mday-list - (map (lambda (wday) - (let ((first (- wday first-day))) - (if (< first 0) (set! first (+ first 7))) - (range (+ 1 first) 32 7))) - wday-list))))) - - - -;; Return the number of days in a month. Fix up a tm object for the zero'th day -;; of the next month, rationalize the object and extract the day. - -(define (days-in-month month year) - (let ((t (localtime 0))) (set-tm:mday t 0) - (set-tm:mon t (+ month 1)) - (set-tm:year t year) - (tm:mday (cdr (mktime t))))) - - - -;; We will be working with a list of time-spec's, one for each element of a time -;; specification (minute, hour, ...). Each time-spec holds three pieces of -;; information: a list of acceptable values for this time component, a procedure -;; to get the component from a tm object, and a procedure to set the component -;; in a tm object. - -(define (time-spec:list time-spec) (vector-ref time-spec 0)) -(define (time-spec:getter time-spec) (vector-ref time-spec 1)) -(define (time-spec:setter time-spec) (vector-ref time-spec 2)) - - - -;; This procedure modifies the time tm object by setting the component referred -;; to by the time-spec object to its next acceptable value. If this value is not -;; greater than the original (because we have wrapped around the top of the -;; acceptable values list), then the function returns #t, otherwise it returns -;; #f. Thus, if the return value is true then it will be necessary for the -;; caller to increment the next coarser time component as well. -;; -;; The first part of the let block is a concession to humanity; the procedure is -;; simply unreadable without all of these aliases. - -(define (increment-time-component time time-spec) - (let* ((time-list (time-spec:list time-spec)) - (getter (time-spec:getter time-spec)) - (setter (time-spec:setter time-spec)) - (find-best-next (@@ (mcron job-specifier) %find-best-next)) - (next-best (find-best-next (getter time) time-list)) - (wrap-around (eqv? (cdr next-best) 9999))) - (setter time ((if wrap-around car cdr) next-best)) - wrap-around)) - - - -;; There now follows a set of procedures for adjusting an element of time, -;; i.e. taking it to the next acceptable value. In each case, the head of the -;; time-spec-list is expected to correspond to the component of time in -;; question. If the adjusted value wraps around its allowed range, then the next -;; biggest element of time must be adjusted, and so on. - -;; There is no specification allowed for the year component of -;; time. Therefore, if we have to make an adjustment (presumably because a -;; monthly adjustment has wrapped around the top of its range) we can simply -;; go to the next year. - -(define (nudge-year! time) - (set-tm:year time (+ (tm:year time) 1))) - - -;; We nudge the month by finding the next allowable value, and if it wraps -;; around we also nudge the year. The time-spec-list will have time-spec -;; objects for month and weekday. - -(define (nudge-month! time time-spec-list) - (and (increment-time-component time (car time-spec-list)) - (nudge-year! time))) - - -;; Try to increment the day component of the time according to the combination -;; of the mday-list and the wday-list. If this wraps around the range, or if -;; this falls outside the current month (31st February, for example), then -;; bump the month, set the day to zero, and recurse on this procedure to find -;; the next day in the new month. -;; -;; The time-spec-list will have time-spec entries for mday, month, and -;; weekday. - -(define (nudge-day! time time-spec-list) - (if (or (increment-time-component - time - (vector - (interpolate-weekdays (time-spec:list (car time-spec-list)) - (time-spec:list (caddr time-spec-list)) - (tm:mon time) - (tm:year time)) - tm:mday - set-tm:mday)) - (> (tm:mday time) (days-in-month (tm:mon time) (tm:year time)))) - (begin - (nudge-month! time (cdr time-spec-list)) - (set-tm:mday time 0) - (nudge-day! time time-spec-list)))) - - - -;; The hour is bumped to the next accceptable value, and the day is bumped if -;; the hour wraps around. -;; -;; The time-spec-list holds specifications for hour, mday, month and weekday. - -(define (nudge-hour! time time-spec-list) - (and (increment-time-component time (car time-spec-list)) - (nudge-day! time (cdr time-spec-list)))) - - - -;; The minute is bumped to the next accceptable value, and the hour is bumped -;; if the minute wraps around. -;; -;; The time-spec-list holds specifications for minute, hour, day-date, month -;; and weekday. - -(define (nudge-min! time time-spec-list) - (and (increment-time-component time (car time-spec-list)) - (nudge-hour! time (cdr time-spec-list)))) - - - - -;; This is a procedure which returns a procedure which computes the next time a -;; command should run after the current time, based on the information in the -;; Vixie-style time specification. -;; -;; We start by computing a list of time-spec objects (described above) for the -;; minute, hour, date, month, year and weekday components of the overall time -;; specification [1]. Special care is taken to produce proper values for -;; fields 2 and 4: according to Vixie specification "If both fields are -;; restricted (ie, aren't *), the command will be run when _either_ field -;; matches the current time." This implies that if one of these fields is *, -;; while the other is not, its value should be '() [0], otherwise -;; interpolate-weekdays below will produce incorrect results. - -;; When we create the return procedure, it is this list to -;; which references to a time-spec-list will be bound. It will be used by the -;; returned procedure [3] to compute the next time a function should run. Any -;; 7's in the weekday component of the list (the last one) are folded into 0's -;; (both values represent sunday) [2]. Any 0's in the month-day component of the -;; list are removed (this allows a solitary zero to be used to indicate that -;; jobs should only run on certain days of the _week_) [2.1]. -;; -;; The returned procedure itself:- -;; -;; Starts by obtaining the current broken-down time [4], and fixing it to -;; ensure that it is an acceptable value, as follows. Each component from the -;; biggest down is checked for acceptability, and if it is not acceptable it -;; is bumped to the next acceptable value (this may cause higher components to -;; also be bumped if there is range wrap-around) and all the lower components -;; are set to -1 so that it can successfully be bumped up to zero if this is -;; an allowed value. The -1 value will be bumped up subsequently to an allowed -;; value [5]. -;; -;; Once it has been asserted that the current time is acceptable, or has been -;; adjusted to one minute before the next acceptable time, the minute -;; component is then bumped to the next acceptable time, which may ripple -;; through the higher components if necessary [6]. We now have the next time -;; the command needs to run. -;; -;; The new time is then converted back into a UNIX time and returned [7]. - -(define (parse-vixie-time string) - (let ((tokens (string-tokenize (vixie-substitute-parse-symbols string)))) - (cond - ((> (length tokens) 5) - (throw 'mcron-error 9 - "Too many fields in Vixie-style time specification")) - ((< (length tokens) 5) - (throw 'mcron-error 9 - "Not enough fields in Vixie-style time specification"))) - (let ((time-spec-list - (map-in-order (lambda (x) (vector - (let* ((n (vector-ref x 0)) - (tok (list-ref tokens n))) - (cond - ((and (= n 4) - (string=? tok "*") - (not (string=? - (list-ref tokens 2) "*"))) - '()) - ((and (= n 2) - (string=? tok "*") - (not (string=? - (list-ref tokens 4) "*"))) - '()) - (else - (parse-vixie-element - tok - (vector-ref x 1) - (vector-ref x 2))))) ; [0] - (vector-ref x 3) - (vector-ref x 4))) - ;; token range-top+1 getter setter - `( #( 0 0 60 ,tm:min ,set-tm:min ) - #( 1 0 24 ,tm:hour ,set-tm:hour ) - #( 2 1 32 ,tm:mday ,set-tm:mday ) - #( 3 0 12 ,tm:mon ,set-tm:mon ) - #( 4 0 7 ,tm:wday ,set-tm:wday ))))) ;; [1] - - (vector-set! (car (last-pair time-spec-list)) - 0 - (map (lambda (time-spec) - (if (eqv? time-spec 7) 0 time-spec)) - (vector-ref (car (last-pair time-spec-list)) 0))) ;; [2] - - (vector-set! (caddr time-spec-list) - 0 - (remove (lambda (day) (eqv? day 0)) - (vector-ref (caddr time-spec-list) 0))) ;; [2.1] - - - (lambda (current-time) ;; [3] - (let ((time (localtime current-time))) ;; [4] - - (if (not (member (tm:mon time) - (time-spec:list (cadddr time-spec-list)))) - (begin - (nudge-month! time (cdddr time-spec-list)) - (set-tm:mday time 0))) - (if (or (eqv? (tm:mday time) 0) - (not (member (tm:mday time) - (interpolate-weekdays - (time-spec:list (caddr time-spec-list)) - (time-spec:list (caddr (cddr time-spec-list))) - (tm:mon time) - (tm:year time))))) - (begin - (nudge-day! time (cddr time-spec-list)) - (set-tm:hour time -1))) - (if (not (member (tm:hour time) - (time-spec:list (cadr time-spec-list)))) - (begin - (nudge-hour! time (cdr time-spec-list)) - (set-tm:min time -1))) ;; [5] - - (set-tm:sec time 0) - (nudge-min! time time-spec-list) ;; [6] - (car (mktime time))))))) ;; [7] - - diff --git a/src/mcron.c b/src/mcron.c new file mode 100644 index 0000000..92e1a37 --- /dev/null +++ b/src/mcron.c @@ -0,0 +1,87 @@ +/* mcron - run jobs at scheduled times + + Copyright (C) 2015, 2016 Mathieu Lirzin + Copyright (C) 2003, 2014 Dale Mellor + + 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 . */ + +/* This C code represents a thin wrapper around the Guile code of Mcron. It + is needed because the crontab personality requires SUID which is not + permitted for executable scripts. */ + +#include "config.h" +#include +#include +#include +#include + +/* Forward declarations. */ +static void inner_main (void *closure, int argc, char **argv); +static void react_to_terminal_signal (int sig); +static SCM set_cron_signals (void); + +int +main (int argc, char **argv) +{ + scm_boot_guile (argc, argv, inner_main, 0); + + return EXIT_SUCCESS; +} + +/* Launch the Mcron Guile main program. */ +static void +inner_main (void *closure, int argc, char **argv) +{ + /* Set Guile load paths to ensure that Mcron modules will be found. */ + if (getenv ("MCRON_UNINSTALLED") == NULL) + { + scm_c_eval_string ("(set! %load-path (cons \"" + PACKAGE_LOAD_PATH "\" %load-path))"); + scm_c_eval_string ("(set! %load-compiled-path (cons \"" + PACKAGE_LOAD_PATH "\" %load-compiled-path))"); + } + scm_set_current_module (scm_c_resolve_module ("mcron main")); + /* Register set_cron_signals to be called from Guile. */ + scm_c_define_gsubr ("c-set-cron-signals", 0, 0, 0, set_cron_signals); + scm_c_eval_string ("(main)"); +} + +/* Set up all the signal handlers as required by the cron personality. This + is necessary to perform the signal processing in C because the sigaction + function won't work when called from Guile. */ +static SCM +set_cron_signals () +{ + static struct sigaction sa; + + memset (&sa, 0, sizeof (sa)); + sa.sa_handler = react_to_terminal_signal; + sigaction (SIGTERM, &sa, 0); + sigaction (SIGINT, &sa, 0); + sigaction (SIGQUIT, &sa, 0); + sigaction (SIGHUP, &sa, 0); + + return SCM_BOOL_T; +} + +/* Handle signal SIG and exit. All signals that mcron handles will produce + the same behavior so we don't need to use SIG in the implementation. */ +static void +react_to_terminal_signal (int sig) +{ + scm_c_eval_string ("(delete-run-file)"); + exit (EXIT_FAILURE); +} diff --git a/src/mcron/config.scm.in b/src/mcron/config.scm.in new file mode 100644 index 0000000..db2bc32 --- /dev/null +++ b/src/mcron/config.scm.in @@ -0,0 +1,39 @@ +;; -*-scheme-*- + +;; Copyright (C) 2015 Mathieu Lirzin +;; Copyright (C) 2003 Dale Mellor +;; +;; 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 . + + +;; Some constants set by the configuration process. + +(define-module (mcron config)) + +(define-public config-debug @CONFIG_DEBUG@) +(define-public config-package-name "@PACKAGE_NAME@") +(define-public config-package-version "@PACKAGE_VERSION@") +(define-public config-package-string "@PACKAGE_STRING@") +(define-public config-package-bugreport "@PACKAGE_BUGREPORT@") +(define-public config-package-url "@PACKAGE_URL@") +(define-public config-sendmail "@SENDMAIL@") + +(define-public config-spool-dir "@CONFIG_SPOOL_DIR@") +(define-public config-socket-file "@CONFIG_SOCKET_FILE@") +(define-public config-allow-file "@CONFIG_ALLOW_FILE@") +(define-public config-deny-file "@CONFIG_DENY_FILE@") +(define-public config-pid-file "@CONFIG_PID_FILE@") +(define-public config-tmp-dir "@CONFIG_TMP_DIR@") diff --git a/src/mcron/crontab.scm b/src/mcron/crontab.scm new file mode 100644 index 0000000..6be5c61 --- /dev/null +++ b/src/mcron/crontab.scm @@ -0,0 +1,228 @@ +;; Copyright (C) 2003, 2014 Dale Mellor +;; +;; 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 . + + +;; Apart from the collecting of options and the handling of --help and --version +;; (which are done in the main.scm file), this file provides all the +;; functionality of the crontab personality. It is designed to be loaded and run +;; once, and then the calling program can exit and the crontab program will have +;; completed its function. + + + +;; 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. + +(let ((hit-server + (lambda (user-name) + (catch #t (lambda () + (let ((socket (socket AF_UNIX SOCK_STREAM 0))) + (connect socket AF_UNIX config-socket-file) + (display user-name socket) + (close socket))) + (lambda (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? + (lambda (file name) + (catch #t (lambda () + (with-input-from-file + file + (lambda () + (let loop ((input (read-line))) + (if (eof-object? input) + #f + (if (string=? input name) + #t + (loop (read-line)))))))) + (lambda (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. + + (if (> (+ (if (option-ref options 'edit #f) 1 0) + (if (option-ref options 'list #f) 1 0) + (if (option-ref options '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. + + (if (and (not (eqv? (getuid) 0)) + (option-ref options 'user #f)) + (mcron-error 8 "Only root can use the -u option.")) + + + + (let ( + + + ;; Iff the --user option is given, the crontab-user may be different + ;; from the real user. + + (crontab-user (option-ref options '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 (lambda (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 options 'list #f) + (catch #t (lambda () + (with-input-from-file crontab-file (lambda () + (do ((input (read-char) (read-char))) + ((eof-object? input)) + (display input))))) + (lambda (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 options 'edit #f) + (let ((temp-file (string-append config-tmp-dir + "/crontab." + (number->string (getpid))))) + (catch #t (lambda () (copy-file crontab-file temp-file)) + (lambda (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 + (lambda () (read-vixie-file temp-file)) + (lambda (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 options 'remove #f) + (catch #t (lambda () (delete-file crontab-file) + (hit-server crontab-user)) + noop)) + + + ;; !!!! 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 options '() '()))) + (let ((input-file (car (option-ref options '() '())))) + (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 (lambda () + (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."))) + + +)) ;; End of file-level let-scopes. diff --git a/src/mcron/environment.scm b/src/mcron/environment.scm new file mode 100644 index 0000000..b563d55 --- /dev/null +++ b/src/mcron/environment.scm @@ -0,0 +1,97 @@ +;; Copyright (C) 2015, 2016 Mathieu Lirzin +;; Copyright (C) 2003 Dale Mellor +;; +;; 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 . + + + +;; This file defines the variable current-environment-mods, and the procedures +;; append-environment-mods (which is available to user configuration files), +;; clear-environment-mods and modify-environment. The idea is that the +;; current-environment-mods is a list of pairs of environment names and values, +;; and represents the cumulated environment settings in a configuration +;; file. When a job definition is seen in a configuration file, the +;; current-environment-mods are copied into the internal job description, and +;; when the job actually runs these environment modifications are applied to +;; the UNIX environment in which the job runs. + + + + +(define-module (mcron environment) + #:export (modify-environment + clear-environment-mods + append-environment-mods + get-current-environment-mods-copy)) + + + +;; As we parse configuration files, we build up an alist of environment +;; variables here. + +(define current-environment-mods '()) + + + +;; Each time a job is added to the system, we take a snapshot of the current +;; set of environment modifiers. + +(define (get-current-environment-mods-copy) + (list-copy current-environment-mods)) + + + +;; When we start to parse a new configuration file, we want to start with a +;; fresh environment (actually an umodified version of the pervading mcron +;; environment). + +(define (clear-environment-mods) + (set! current-environment-mods '())) + + + +;; Procedure to add another environment setting to the alist above. This is +;; used both implicitly by the Vixie parser, and can be used directly by users +;; in scheme configuration files. The return value is purely for the +;; convenience of the parse-vixie-environment in the vixie-specification module +;; (yuk). + +(define (append-environment-mods name value) + (set! current-environment-mods (append current-environment-mods + (list (cons name value)))) + #t) + +(define (modify-environment env passwd-entry) + "Modify the environment (in the UNIX sense) by setting the variables from +ENV and some default ones which are modulated by PASSWD-ENTRY. \"LOGNAME\" +and \"USER\" environment variables can't be overided by ENV. ENV must be an +alist which associate environment variables to their value. PASSWD-ENTRY must +be an object representing user information which corresponds to a valid entry +in /etc/passwd. The return value is not specified." + (for-each (lambda (pair) (setenv (car pair) (cdr pair))) + (let ((home-dir (passwd:dir passwd-entry)) + (user-name (passwd:name passwd-entry))) + (append + ;; Default environment variables which can be overided by ENV. + `(("HOME" . ,home-dir) + ("CWD" . ,home-dir) + ("SHELL" . ,(passwd:shell passwd-entry)) + ("TERM" . #f) + ("TERMCAP" . #f)) + env + ;; Environment variables with imposed values. + `(("LOGNAME" . ,user-name) + ("USER" . ,user-name)))))) diff --git a/src/mcron/job-specifier.scm b/src/mcron/job-specifier.scm new file mode 100644 index 0000000..1c2f9d9 --- /dev/null +++ b/src/mcron/job-specifier.scm @@ -0,0 +1,253 @@ +;; Copyright (C) 2003 Dale Mellor +;; Copyright (C) 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 . + + + +;; This module defines all the functions that can be used by scheme mcron +;; configuration files, namely the procedures for working out next times, the +;; job procedure for registering new jobs (actually a wrapper around the core +;; add-job function), and the procedure for declaring environment modifications. + +(define-module (mcron job-specifier) + #:use-module (ice-9 match) + #:use-module (mcron core) + #:use-module (mcron environment) + #:use-module (mcron vixie-time) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:re-export (append-environment-mods) + #:export (range + next-year-from next-year + next-month-from next-month + next-day-from next-day + next-hour-from next-hour + next-minute-from next-minute + next-second-from next-second + set-configuration-user + set-configuration-time + job)) + +(define* (range start end #:optional (step 1)) + "Produces a list of values from START up to (but not including) END. An +optional STEP may be supplied, and (if positive) only every step'th value will +go into the list. For example, (range 1 6 2) returns '(1 3 5)." + (unfold (cut >= <> end) identity (cute + <> (max step 1)) start)) + +(define (%find-best-next current next-list) + ;; Takes a value and a list of possible next values (all assumed less than + ;; 9999). It returns a pair consisting of the smallest element of the + ;; NEXT-LIST, and the smallest element larger than the CURRENT value. If an + ;; example of the latter cannot be found, 9999 will be returned. + (let loop ((smallest 9999) (closest+ 9999) (lst next-list)) + (match lst + (() (cons smallest closest+)) + ((time . rest) + (loop (min time smallest) + (if (> time current) (min time closest+) closest+) + rest))))) + +;; Internal function to return the time corresponding to some near future +;; hour. If hour-list is not supplied, the time returned corresponds to the +;; start of the next hour of the day. +;; +;; If the hour-list is supplied the time returned corresponds to the first hour +;; of the day in the future which is contained in the list. If all the values in +;; the list are less than the current hour, then the time returned will +;; correspond to the first hour in the list *on the following day*. +;; +;; ... except that the function is actually generalized to deal with seconds, +;; minutes, etc., in an obvious way :-) +;; +;; Note that value-list always comes from an optional argument to a procedure, +;; so is wrapped up as the first element of a list (i.e. it is a list inside a +;; list). + +(define (bump-time time value-list component higher-component + set-component! set-higher-component!) + (if (null? value-list) + (set-component! time (+ (component time) 1)) + (let ((best-next (%find-best-next (component time) (car value-list)))) + (if (eqv? 9999 (cdr best-next)) + (begin + (set-higher-component! time (+ (higher-component time) 1)) + (set-component! time (car best-next))) + (set-component! time (cdr best-next))))) + (car (mktime time))) + + + + +;; Set of configuration methods which use the above general function to bump +;; specific components of time to the next legitimate value. In each case, all +;; the components smaller than that of interest are taken to zero, so that for +;; example the time of the next year will be the time at which the next year +;; actually starts. + +(define (next-year-from current-time . year-list) + (let ((time (localtime current-time))) + (set-tm:mon time 0) + (set-tm:mday time 1) + (set-tm:hour time 0) + (set-tm:min time 0) + (set-tm:sec time 0) + (bump-time time year-list tm:year tm:year set-tm:year set-tm:year))) + +(define (next-month-from current-time . month-list) + (let ((time (localtime current-time))) + (set-tm:mday time 1) + (set-tm:hour time 0) + (set-tm:min time 0) + (set-tm:sec time 0) + (bump-time time month-list tm:mon tm:year set-tm:mon set-tm:year))) + +(define (next-day-from current-time . day-list) + (let ((time (localtime current-time))) + (set-tm:hour time 0) + (set-tm:min time 0) + (set-tm:sec time 0) + (bump-time time day-list tm:mday tm:mon set-tm:mday set-tm:mon))) + +(define (next-hour-from current-time . hour-list) + (let ((time (localtime current-time))) + (set-tm:min time 0) + (set-tm:sec time 0) + (bump-time time hour-list tm:hour tm:mday set-tm:hour set-tm:mday))) + +(define (next-minute-from current-time . minute-list) + (let ((time (localtime current-time))) + (set-tm:sec time 0) + (bump-time time minute-list tm:min tm:hour set-tm:min set-tm:hour))) + +(define (next-second-from current-time . second-list) + (let ((time (localtime current-time))) + (bump-time time second-list tm:sec tm:min set-tm:sec set-tm:min))) + + + +;; The current-action-time is the time a job was last run, the time from which +;; the next time to run a job must be computed. (When the program is first run, +;; this time is set to the configuration time so that jobs run from that moment +;; forwards.) Once we have this, we supply versions of the time computation +;; commands above which implicitly assume this value. + +(define current-action-time 0) + + + +;; We want to provide functions which take a single optional argument (as well +;; as implicitly the current action time), but unlike usual scheme behaviour if +;; the argument is missing we want to act like it is really missing, and if it +;; is there we want to act like it is a genuine argument, not a list of +;; optionals. + +(define (maybe-args function args) + (if (null? args) + (function current-action-time) + (function current-action-time (car args)))) + + + +;; These are the convenience functions we were striving to define for the +;; configuration files. They are wrappers for the next-X-from functions above, +;; but implicitly use the current-action-time for the time argument. + +(define (next-year . args) (maybe-args next-year-from args)) +(define (next-month . args) (maybe-args next-month-from args)) +(define (next-day . args) (maybe-args next-day-from args)) +(define (next-hour . args) (maybe-args next-hour-from args)) +(define (next-minute . args) (maybe-args next-minute-from args)) +(define (next-second . args) (maybe-args next-second-from args)) + + + +;; The default user for running jobs is the current one (who invoked this +;; program). There are exceptions: when cron parses /etc/crontab the user is +;; specified on each individual line; when cron parses /var/cron/tabs/* the user +;; is derived from the filename of the crontab. These cases are dealt with by +;; mutating this variable. Note that the variable is only used at configuration +;; time; a UID is stored with each job and it is that which takes effect when +;; the job actually runs. + +(define configuration-user (getpw (getuid))) +(define configuration-time (current-time)) + +(define (set-configuration-user user) + (set! configuration-user (if (or (string? user) + (integer? user)) + (getpw user) + user))) +(define (set-configuration-time time) (set! configuration-time time)) + + + +;; The job function, available to configuration files for adding a job rule to +;; the system. +;; +;; Here we must 'normalize' the next-time-function so that it is always a lambda +;; function which takes one argument (the last time the job ran) and returns a +;; single value (the next time the job should run). If the input value is a +;; string this is parsed as a Vixie-style time specification, and if it is a +;; list then we arrange to eval it (but note that such lists are expected to +;; ignore the function parameter - the last run time is always read from the +;; current-action-time global variable). A similar normalization is applied to +;; the action. +;; +;; Here we also compute the first time that the job is supposed to run, by +;; finding the next legitimate time from the current configuration time (set +;; right at the top of this program). + +(define (job time-proc action . displayable) + (let ((action (cond ((procedure? action) action) + ((list? action) (lambda () (primitive-eval action))) + ((string? action) (lambda () (system action))) + (else + (throw 'mcron-error 2 + "job: invalid second argument (action; should be lambda " + "function, string or list)")))) + + (time-proc + (cond ((procedure? time-proc) time-proc) + ((string? time-proc) (parse-vixie-time time-proc)) + ((list? time-proc) (lambda (current-time) + (primitive-eval time-proc))) + (else + (throw 'mcron-error 3 + "job: invalid first argument (next-time-function; " + "should be function, string or list)")))) + (displayable + (cond ((not (null? displayable)) (car displayable)) + ((procedure? action) "Lambda function") + ((string? action) action) + ((list? action) (with-output-to-string + (lambda () (display action))))))) + (add-job (lambda (current-time) + (set! current-action-time current-time) ;; ?? !!!! Code + + ;; Contributed by Sergey Poznyakoff to allow for daylight savings + ;; time changes. + (let* ((next (time-proc current-time)) + (gmtoff (tm:gmtoff (localtime next))) + (d (+ next (- gmtoff + (tm:gmtoff (localtime current-time)))))) + (if (eqv? (tm:gmtoff (localtime d)) gmtoff) + d + next))) + action + displayable + configuration-time + configuration-user))) diff --git a/src/mcron/main.scm b/src/mcron/main.scm new file mode 100644 index 0000000..1f2b068 --- /dev/null +++ b/src/mcron/main.scm @@ -0,0 +1,401 @@ +;; Copyright (C) 2015, 2016 Mathieu Lirzin +;; Copyright (C) 2003, 2012 Dale Mellor +;; +;; 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 . + +;;; This is the 'main' routine for the whole system; this module is the global +;;; entry point (after the minimal C wrapper); to all intents and purposes the +;;; program is pure Guile and starts here. + +(define-module (mcron main) + #:use-module (ice-9 getopt-long) + #:use-module (ice-9 rdelim) + #:use-module (ice-9 regex) + #:use-module (mcron config) + #:use-module (mcron core) + #:use-module (mcron job-specifier) + #:use-module (mcron vixie-specification) + #:use-module (srfi srfi-2) + #:use-module (srfi srfi-26) + #:export (delete-run-file + main)) + +(define* (command-name #:optional (command (car (command-line)))) + "Extract the actual command name from COMMAND. This returns the last part +of COMMAND without any non-alphabetic characters. For example \"in.cron\" and +\"./mcron\" will return respectively \"cron\" and \"mcron\". + +When COMMAND is not specified this uses the first element of (command-line)." + (match:substring (regexp-exec (make-regexp "[[:alpha:]]*$") command))) + +(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 (append (list (command-name) ": ") 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 command-type + ;; We will be doing a lot of testing of the command name, so it makes sense + ;; to perform the string comparisons once and for all here. + (let* ((command (command-name)) + (command=? (cut string=? command <>))) + (cond ((command=? "mcron") 'mcron) + ((or (command=? "cron") (command=? "crond")) 'cron) + ((command=? "crontab") 'crontab) + (else (mcron-error 12 "The command name is invalid."))))) + +(define options + ;; There are a different set of options for the crontab personality compared + ;; to all the others, with the --help and --version options common to all + ;; the personalities. + (catch + 'misc-error + (lambda () + (getopt-long (command-line) + (append + (case command-type + ((crontab) + '((user (single-char #\u) (value #t)) + (edit (single-char #\e) (value #f)) + (list (single-char #\l) (value #f)) + (remove (single-char #\r) (value #f)))) + (else `((schedule (single-char #\s) (value #t) + (predicate + ,(lambda (value) + (string->number value)))) + (daemon (single-char #\d) (value #f)) + (noetc (single-char #\n) (value #f)) + (stdin (single-char #\i) (value #t) + (predicate + ,(lambda (value) + (or (string=? "vixie" value) + (string=? "guile" value)))))))) + '((version (single-char #\v) (value #f)) + (help (single-char #\h) (value #f)))))) + (lambda (key func fmt args . rest) + (mcron-error 1 (apply format (append (list #f fmt) args)))))) + +(define* (show-version #:optional (command (command-name))) + "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) + (quit))) + +(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* (show-help #:optional (command (command-name))) + "Display informations of usage for COMMAND and quit." + (simple-format #t "Usage: ~a" command) + (display + (case command-type + ((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)") + ((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).") + ((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") + (else "\nrubbish"))) + (newline) + (show-package-information) + (quit)) + +(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 (lambda () (delete-file config-pid-file) + (delete-file config-socket-file)) + noop) + (quit)) + +(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-user-file + (let ((guile-regexp (make-regexp "\\.gui(le)?$")) + (vixie-regexp (make-regexp "\\.vix(ie)?$"))) + (lambda* (file-name #:optional guile-syntax?) + "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=? (option-ref options 'stdin "guile") "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) + "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 (lambda (dir) + (catch #t + (lambda () + (for-each-file + (lambda (file) + (process-user-file (string-append dir "/" file))) + dir)) + (lambda (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-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 + (lambda () + (for-each-file + (lambda (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)) + (lambda (key . args) + (mcron-error 4 + "You do not have permission to access the system crontabs.")))) + +(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." + (if (eq? command-type 'cron) + (catch #t + (lambda () + (let ((sock (socket AF_UNIX SOCK_STREAM 0))) + (bind sock AF_UNIX config-socket-file) + (listen sock 5) + (list sock))) + (lambda (key . args) + (delete-file config-pid-file) + (mcron-error 1 "Cannot bind to UNIX socket " config-socket-file))) + '())) + +(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))))))) + + +;;; +;;; Entry point. +;;; + +(define (main . args) + ;; Turn debugging on if indicated. + (when config-debug + (debug-enable 'backtrace)) + (when (option-ref options 'version #f) + (show-version)) + (when (option-ref options 'help #f) + (show-help)) + + ;; Setup the cron process, if appropriate. If there is already a + ;; /var/run/cron.pid file, then we must assume a cron daemon is already + ;; running and refuse to start another one. + ;; + ;; Otherwise, clear the MAILTO environment variable so that output from cron + ;; jobs is sent to the various users (this may still be overridden in the + ;; configuration files), and call the function in the C wrapper to set up + ;; terminal signal responses to vector to the procedure above. The PID file + ;; will be filled in properly later when we have forked our daemon process + ;; (but not done if we are only viewing the schedules). + (when (eq? command-type 'cron) + (unless (eqv? (getuid) 0) + (mcron-error 16 + "This program must be run by the root user (and should have been " + "installed as such).")) + (when (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 ".)")) + (unless (option-ref options 'schedule #f) + (with-output-to-file config-pid-file noop)) + (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)) + + ;; Now we have the procedures in place for dealing with the contents of + ;; configuration files, the crontab personality is able to validate such + ;; files. If the user requested the crontab personality, we load and run the + ;; code here and then get out. + (when (eq? command-type 'crontab) + (load "crontab.scm") + (quit)) + + ;; 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. + (case command-type + ((mcron) + (if (null? (option-ref options '() '())) + (process-files-in-user-directory) + (for-each (lambda (file-path) (process-user-file file-path #t)) + (option-ref options '() '())))) + ((cron) + (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 (option-ref options 'noetc #f) + (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.")))) + + ;; If the user has requested a schedule of jobs that will run, we provide + ;; the information here and then get out. Start by determining the number + ;; of time points in the future that output is required for. This may be + ;; provided on the command line as a parameter to the --schedule option, or + ;; else we assume a default of 8. Finally, ensure that the count is some + ;; positive integer. + (and-let* ((count (option-ref options 'schedule #f))) + (set! count (string->number count)) + (display (get-schedule (if (<= count 0) 1 count))) + (quit)) + + ;; If we are supposed to run as a daemon process (either a --daemon option + ;; has been explicitly used, or we are running as cron or crond), detach + ;; from the terminal now. If we are running as cron, we can now write the + ;; PID file. + (when (option-ref options 'daemon (eq? command-type 'cron)) + (unless (eqv? (primitive-fork) 0) + (quit)) + (setsid) + (when (eq? command-type 'cron) + (with-output-to-file config-pid-file + (lambda () (display (getpid)) (newline))))) + + ;; Now the main loop. Forever execute the run-job-loop procedure in the + ;; mcron core, 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. Sergey Poznyakoff: we can also drop out of run-job-loop + ;; because of a SIGCHLD, so must test FDES-LIST. + (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/mcron-core.scm b/src/mcron/mcron-core.scm new file mode 100644 index 0000000..13781c9 --- /dev/null +++ b/src/mcron/mcron-core.scm @@ -0,0 +1,270 @@ +;; Copyright (C) 2015, 2016 Mathieu Lirzin +;; Copyright (C) 2003 Dale Mellor +;; +;; 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 core) + #:use-module (mcron environment) + #:use-module (srfi srfi-9) + #:export (add-job + remove-user-jobs + get-schedule + run-job-loop + ;; These three are deprecated and not documented. + use-system-job-list + use-user-job-list + clear-system-jobs) + #:re-export (clear-environment-mods + append-environment-mods)) + + +(use-modules (srfi srfi-1) ;; For remove. + (srfi srfi-2)) ;; For and-let*. + + + +;; The list of all jobs known to the system. Each element of the list is +;; +;; (make-job user next-time-function action environment displayable next-time) +;; +;; where action must be a procedure, and the environment is an alist of +;; modifications that need making to the UNIX environment before the action is +;; run. The next-time element is the only one that is modified during the +;; running of a cron process (i.e. all the others are set once and for all at +;; configuration time). +;; +;; The reason we maintain two lists is that jobs in /etc/crontab may be placed +;; in one, and all other jobs go in the other. This makes it possible to remove +;; all the jobs in the first list in one go, and separately we can remove all +;; jobs from the second list which belong to a particular user. This behaviour +;; is required for full vixie compatibility. + +(define system-job-list '()) +(define user-job-list '()) + +(define configuration-source 'user) + +(define (use-system-job-list) (set! configuration-source 'system)) +(define (use-user-job-list) (set! configuration-source 'user)) + +;; A cron job. +(define-record-type + (make-job user time-proc action environment displayable next-time) + job? + (user job:user) ;object : passwd entry + (time-proc job:next-time-function) ;proc : with one 'time' parameter + (action job:action) ;thunk : user's code + (environment job:environment) ;alist : environment variables + (displayable job:displayable) ;string : visible in schedule + (next-time job:next-time ;number : time in UNIX format + job:next-time-set!)) + +;; Remove jobs from the user-job-list belonging to this user. + +(define (remove-user-jobs user) + (if (or (string? user) + (integer? user)) + (set! user (getpw user))) + (set! user-job-list + (remove (lambda (job) (eqv? (passwd:uid user) + (passwd:uid (job:user job)))) + user-job-list))) + + + +;; Remove all the jobs on the system job list. + +(define (clear-system-jobs) (set! system-job-list '())) + + + +;; Add a new job with the given specifications to the head of the appropriate +;; jobs list. + +(define (add-job time-proc action displayable configuration-time + configuration-user) + (let ((entry (make-job configuration-user + time-proc + action + (get-current-environment-mods-copy) + displayable + (time-proc configuration-time)))) + (if (eq? configuration-source 'user) + (set! user-job-list (cons entry user-job-list)) + (set! system-job-list (cons entry system-job-list))))) + + + +;; Procedure to locate the jobs in the global job-list with the lowest +;; (soonest) next-times. These are the jobs for which we must schedule the mcron +;; program (under any personality) to next wake up. The return value is a cons +;; cell consisting of the next time (maintained in the next-time variable) and a +;; list of the job entries that are to run at this time (maintained in the +;; next-jobs-list variable). +;; +;; The procedure works by first obtaining the time of the first job on the list, +;; and setting this job in the next-jobs-list. Then for each other entry on the +;; job-list, either the job runs earlier than any other that have been scanned, +;; in which case the next-time and next-jobs-list are re-initialized to +;; accomodate, or the job runs at the same time as the next job, in which case +;; the next-jobs-list is simply augmented with the new job, or else the job runs +;; later than others noted in which case we ignore it for now and continue to +;; recurse the list. + +(define (find-next-jobs) + (let ((job-list (append system-job-list user-job-list))) + + (if (null? job-list) + + '(#f . '()) + + (let ((next-time 2000000000) + (next-jobs-list '())) + + (for-each + (lambda (job) + (let ((this-time (job:next-time job))) + (cond ((< this-time next-time) + (set! next-time this-time) + (set! next-jobs-list (list job))) + ((eqv? this-time next-time) + (set! next-jobs-list (cons job next-jobs-list)))))) + job-list) + + (cons next-time next-jobs-list))))) + + + +;; Create a string containing a textual list of the next count jobs to run. +;; +;; Enter a loop of displaying the next set of jobs to run, artificially +;; forwarding the time to the next time point (instead of waiting for it to +;; occur as we would do in a normal run of mcron), and recurse around the loop +;; count times. +;; +;; Note that this has the effect of mutating the job timings. Thus the program +;; must exit after calling this function; the internal data state will be left +;; unusable. + +(define (get-schedule count) + (with-output-to-string + (lambda () + (do ((count count (- count 1))) + ((eqv? count 0)) + (and-let* + ((next-jobs (find-next-jobs)) + (time (car next-jobs)) + (date-string (strftime "%c %z\n" (localtime time)))) + (for-each (lambda (job) + (display date-string) + (display (job:displayable job)) + (newline)(newline) + (job:next-time-set! job ((job:next-time-function job) + (job:next-time job)))) + (cdr next-jobs))))))) + + + +;; For proper housekeeping, it is necessary to keep a record of the number of +;; child processes we fork off to run the jobs. + +(define number-children 0) + + + +;; For every job on the list, fork a process to run it (noting the fact by +;; increasing the number-children counter), and in the new process set up the +;; run-time environment exactly as it should be before running the job proper. +;; +;; In the parent, update the job entry by computing the next time the job needs +;; to run. + +(define (run-jobs jobs-list) + (for-each + (lambda (job) + (if (eqv? (primitive-fork) 0) + (begin + (setgid (passwd:gid (job:user job))) + (setuid (passwd:uid (job:user job))) + (chdir (passwd:dir (job:user job))) + (modify-environment (job:environment job) (job:user job)) + ((job:action job)) + (primitive-exit 0)) + (begin + (set! number-children (+ number-children 1)) + (job:next-time-set! job ((job:next-time-function job) + (current-time)))))) + jobs-list)) + + + +;; Give any zombie children a chance to die, and decrease the number known to +;; exist. + +(define (child-cleanup) + (do () ((or (<= number-children 0) + (eqv? (car (waitpid WAIT_ANY WNOHANG)) 0))) + (set! number-children (- number-children 1)))) + + + +;; Now the main loop. Loop over all job specifications, get a list of the next +;; ones to run (may be more than one). Set an alarm and go to sleep. When we +;; wake, run the jobs and reap any children (old jobs) that have +;; completed. Repeat ad infinitum. +;; +;; Note that, if we wake ahead of time, it can only mean that a signal has been +;; sent by a crontab job to tell us to re-read a crontab file. In this case we +;; break out of the loop here, and let the main procedure deal with the +;; situation (it will eventually re-call this function, thus maintaining the +;; loop). + +(define (run-job-loop . fd-list) + + (call-with-current-continuation + (lambda (break) + + (let ((fd-list (if (null? fd-list) '() (car fd-list)))) + + (let loop () + + (let* ((next-jobs (find-next-jobs)) + (next-time (car next-jobs)) + (next-jobs-list (cdr next-jobs)) + (sleep-time (if next-time (- next-time (current-time)) + 2000000000))) + + (and (> sleep-time 0) + (if (not (null? + (catch 'system-error + (lambda () + (car (select fd-list '() '() sleep-time))) + (lambda (key . args) ;; Exception add by Sergey + ;; Poznyakoff. + (if (member (car (last args)) + (list EINTR EAGAIN)) + (begin + (child-cleanup) '()) + (apply throw key args)))))) + (break))) + + (run-jobs next-jobs-list) + + (child-cleanup) + + (loop))))))) diff --git a/src/mcron/redirect.scm b/src/mcron/redirect.scm new file mode 100644 index 0000000..af763cb --- /dev/null +++ b/src/mcron/redirect.scm @@ -0,0 +1,190 @@ +;; Copyright (C) 2003 Dale Mellor +;; +;; 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 . + + + +;; This module provides the (with-mail-out action . user) procedure. This +;; procedure runs the action in a child process, allowing the user control over +;; the input and output (including standard error). The input is governed (only +;; in the case of a string action) by the placing of percentage signs in the +;; string; the first delimits the true action from the standard input, and +;; subsequent ones denote newlines to be placed into the input. The output (if +;; there actually is any) is controlled by the MAILTO environment variable. If +;; this is not defined, output is e-mailed to the user passed as argument, if +;; any, or else the owner of the action; if defined but empty then any output is +;; sunk to /dev/null; otherwise output is e-mailed to the address held in the +;; MAILTO variable. + +(define-module (mcron redirect) + #:export (with-mail-out) + #:use-module (ice-9 regex) + #:use-module ((mcron config) :select (config-sendmail)) + #:use-module (mcron vixie-time)) + + + +;; An action string consists of a sequence of characters forming a command +;; executable by the shell, possibly followed by an non-escaped percentage +;; sign. The text after the percentage sign is to be fed to the command's +;; standard input, with further unescaped percents being substituted with +;; newlines. The escape character can itself be escaped. +;; +;; This regexp separates the two halves of the string, and indeed determines if +;; the second part is present. + +(define action-string-regexp (make-regexp "((\\\\%|[^%])*)%(.*)$")) + + + +;; This regexp identifies an escaped percentage sign. + +(define e-percent (make-regexp "\\\\%")) + + +;; Function to execute some action (this may be a shell command, lamdba function +;; or list of scheme procedures) in a forked process, with the input coming from +;; the string, and output (including the error output) being sent to a pipe +;; opened on a mail transport. + +(use-modules (ice-9 popen)) + +(define (with-mail-out action . user) + + ;; Determine the name of the user who is to recieve the mail, looking for a + ;; name in the optional user argument, then in the MAILTO environment + ;; variable, and finally in the LOGNAME environment variable. (The case + ;; MAILTO="" is dealt with specially below.) + + (let* ((mailto (getenv "MAILTO")) + (user (cond (mailto mailto) + ((not (null? user)) (car user)) + (else (getenv "LOGNAME")))) + (parent->child (pipe)) + (child->parent (pipe)) + (child-pid (primitive-fork))) + + + ;; The child process. Close redundant ends of pipes, remap the standard + ;; streams, and run the action, taking care to chop off the input part of an + ;; action string. + + (if (eqv? child-pid 0) + (begin + (close (cdr parent->child)) + (close (car child->parent)) + + (dup2 (port->fdes (car parent->child)) 0) + (close (car parent->child)) + (dup2 (port->fdes (cdr child->parent)) 1) + (close (cdr child->parent)) + (dup2 1 2) + + (cond ((string? action) + (let ((match (regexp-exec action-string-regexp action))) + (system (if match + (let ((action (match:substring match 1))) + (do ((match (regexp-exec e-percent action) + (regexp-exec e-percent action))) + ((not match)) + (set! action (string-append + (match:prefix match) + "%" + (match:suffix match)))) + action) + action)))) + + ((procedure? action) (action)) + ((list? action) (primitive-eval action))) + + (primitive-exit 0))) + + + ;; The parent process. Get rid of redundant pipe ends. + + (close (car parent->child)) + (close (cdr child->parent)) + + + ;; Put stuff to child from after '%' in command line, replacing + ;; other %'s with newlines. Ugly or what? + + (if (string? action) + (let ((port (cdr parent->child)) + (match (regexp-exec action-string-regexp action))) + (if (and match + (match:substring match 3)) + (with-input-from-string (match:substring match 3) + (lambda () + (let loop () + (let ((next-char (read-char))) + (if (not (eof-object? next-char)) + (cond + ((char=? next-char #\%) + (newline port) + (loop)) + ((char=? next-char #\\) + (let ((escape (read-char))) + (if (eof-object? escape) + (display #\\ port) + (if (char=? escape #\%) + (begin + (display #\% port) + (loop)) + (begin + (display #\\ port) + (display escape port) + (loop)))))) + (else + (display next-char port) + (loop))))))))))) + + + ;; So the child process doesn't hang on to its input expecting more stuff. + + (close (cdr parent->child)) + + + ;; That's got streaming into the child's input out of the way, now we stream + ;; the child's output to a mail sink, but only if there is something there + ;; in the first place. + + (if (eof-object? (peek-char (car child->parent))) + + (read-char (car child->parent)) + + (begin + (set-current-output-port (if (and (string? mailto) + (string=? mailto "")) + (open-output-file "/dev/null") + (open-output-pipe + (string-append config-sendmail + " " + user)))) + (set-current-input-port (car child->parent)) + (display "To: ") (display user) (newline) + (display "From: mcron") (newline) + (display (string-append "Subject: " user "@" (gethostname))) + (newline) + (newline) + + (do ((next-char (read-char) (read-char))) + ((eof-object? next-char)) + (display next-char)))) + + (close (car child->parent)) + + (waitpid child-pid))) diff --git a/src/mcron/vixie-specification.scm b/src/mcron/vixie-specification.scm new file mode 100644 index 0000000..5cd1528 --- /dev/null +++ b/src/mcron/vixie-specification.scm @@ -0,0 +1,207 @@ +;; Copyright (C) 2003 Dale Mellor +;; +;; 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 . + + + +;; This file provides methods for reading a complete Vixie-style configuration +;; file, either from a real file or an already opened port. It also exposes the +;; method for parsing the time-specification part of a Vixie string, so that +;; these can be used to form the next-time-function of a job in a Guile +;; configuration file. + +(define-module (mcron vixie-specification) + #:export (parse-user-vixie-line + parse-system-vixie-line + read-vixie-port + read-vixie-file + check-system-crontab) + #:use-module ((mcron config) :select (config-socket-file)) + #:use-module (mcron core) + #:use-module (mcron job-specifier) + #:use-module (mcron redirect) + #:use-module (mcron vixie-time)) + + +(use-modules (ice-9 regex) (ice-9 rdelim) + (srfi srfi-1) (srfi srfi-2) (srfi srfi-13) (srfi srfi-14)) + + + +;; A line in a Vixie-style crontab file which gives a command specification +;; carries two pieces of information: a time specification consisting of five +;; space-separated items, and a command which is also separated from the time +;; specification by a space. The line is broken into the two components, and the +;; job procedure run to add the two pieces of information to the job list (this +;; will in turn use the above function to turn the time specification into a +;; function for computing future run times of the command). + +(define parse-user-vixie-line-regexp + (make-regexp "^[[:space:]]*(([^[:space:]]+[[:space:]]+){5})(.*)$")) + +(define (parse-user-vixie-line line) + (let ((match (regexp-exec parse-user-vixie-line-regexp line))) + (if (not match) + (throw 'mcron-error 10 "Bad job line in Vixie file.")) + (job (match:substring match 1) + (lambda () (with-mail-out (match:substring match 3))) + (match:substring match 3)))) + + + +;; The case of reading a line from /etc/crontab is similar to above but the user +;; ID appears in the sixth field, before the action. + +(define parse-system-vixie-line-regexp + (make-regexp (string-append "^[[:space:]]*(([^[:space:]]+[[:space:]]+){5})" + "([[:alpha:]][[:alnum:]_]*)[[:space:]]+(.*)$"))) + +(define (parse-system-vixie-line line) + (let ((match (regexp-exec parse-system-vixie-line-regexp line))) + (if (not match) + (throw 'mcron-error 11 "Bad job line in /etc/crontab.")) + (let ((user (match:substring match 3))) + (set-configuration-user user) + (job (match:substring match 1) + (lambda () (with-mail-out (match:substring match 4) + user)) + (match:substring match 4))))) + + + +;; Procedure to act on an environment variable specification in a Vixie-style +;; configuration file, by adding an entry to the alist above. Returns #t if the +;; operation was successful, #f if the line could not be interpreted as an +;; environment specification. + +(define parse-vixie-environment-regexp1 + (make-regexp + "^[ \t]*([[:alpha:]_][[:alnum:]_]*)[ \t]*=[ \t]*\"(.*)\"[ \t]*$")) +(define parse-vixie-environment-regexp2 + (make-regexp + "^[ \t]*([[:alpha:]_][[:alnum:]_]*)[ \t]*=[ \t]*'(.*)'[ \t]*$")) +(define parse-vixie-environment-regexp3 + (make-regexp + "^[ \t]*([[:alpha:]_][[:alnum:]_]*)[ \t]*=[ \t]*(.*[^ \t])[ \t]*$")) +(define parse-vixie-environment-regexp4 + (make-regexp + "^[ \t]*([[:alpha:]_][[:alnum:]_]*)[ \t]*=[ \t]*$")) + + +(define (parse-vixie-environment string) + (let ((match (or (regexp-exec parse-vixie-environment-regexp1 string) + (regexp-exec parse-vixie-environment-regexp2 string) + (regexp-exec parse-vixie-environment-regexp3 string)))) + (if match + (append-environment-mods (match:substring match 1) + (match:substring match 2)) + (and-let* ((match (regexp-exec parse-vixie-environment-regexp4 string))) + (append-environment-mods (match:substring match 1) #f))))) + + + + +;; The next procedure reads an entire Vixie-style file. For each line in the +;; file there are three possibilities (after continuation lines have been +;; appended): the line is blank or contains only a comment, the line contains an +;; environment modifier which will be handled in the mcron environment module, +;; or the line contains a command specification in which case we use the +;; procedure above to add an entry to the internal job list. +;; +;; Note that the environment modifications are cleared, so that there is no +;; interference between crontab files (this might lead to unpredictable +;; behaviour because the order in which crontab files are processed, if there is +;; more than one, is generally undefined). + +(define read-vixie-file-comment-regexp + (make-regexp "^[[:space:]]*(#.*)?$")) + + +(define (read-vixie-port port . parse-vixie-line) + (clear-environment-mods) + (if port + (let ((parse-vixie-line + (if (null? parse-vixie-line) parse-user-vixie-line + (car parse-vixie-line)))) + (do ((line (read-line port) (read-line port)) + (line-number 1 (1+ line-number))) + ((eof-object? line)) + + (let ((report-line line-number)) + ;; If the line ends with \, append the next line. + (while (and (>= (string-length line) 1) + (char=? (string-ref line + (- (string-length line) 1)) + #\\)) + (let ((next-line (read-line port))) + (if (eof-object? next-line) + (set! next-line "")) + (set! line-number (1+ line-number)) + (set! line + (string-append + (substring line 0 (- (string-length line) 1)) + next-line)))) + + (catch 'mcron-error + (lambda () + ;; Consider the three cases mentioned in the description. + (or (regexp-exec read-vixie-file-comment-regexp line) + (parse-vixie-environment line) + (parse-vixie-line line))) + (lambda (key exit-code . msg) + (throw 'mcron-error exit-code + (apply string-append + (number->string report-line) + ": " + msg))))))))) + + + +;; If a file cannot be opened, we must silently ignore it because it may have +;; been removed by crontab. However, if the file is there it must be parseable, +;; otherwise the error must be propagated to the caller. + +(define (read-vixie-file file-path . parse-vixie-line) + (let ((port #f)) + (catch #t (lambda () (set! port (open-input-file file-path))) + (lambda (key . args) (set! port #f))) + (if port + (catch 'mcron-error + (lambda () + (if (null? parse-vixie-line) + (read-vixie-port port) + (read-vixie-port port (car parse-vixie-line))) + (close port)) + (lambda (key exit-code . msg) + (close port) + (throw 'mcron-error exit-code + (apply string-append file-path ":" msg))))))) + + +;; A procedure which determines if the /etc/crontab file has been recently +;; modified, and, if so, signals the main routine to re-read the file. We run +;; under the with-mail-to command so that the process runs as a child, +;; preventing lockup. If cron is supposed to check for updates to /etc/crontab, +;; then this procedure will be called about 5 seconds before every minute. + +(define (check-system-crontab) + (with-mail-out (lambda () + (let ((mtime (stat:mtime (stat "/etc/crontab")))) + (if (> mtime (- (current-time) 60)) + (let ((socket (socket AF_UNIX SOCK_STREAM 0))) + (connect socket AF_UNIX config-socket-file) + (display "/etc/crontab" socket) + (close socket))))))) diff --git a/src/mcron/vixie-time.scm b/src/mcron/vixie-time.scm new file mode 100644 index 0000000..a91fa89 --- /dev/null +++ b/src/mcron/vixie-time.scm @@ -0,0 +1,384 @@ +;; Copyright (C) 2003 Dale Mellor +;; +;; 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 vixie-time) + #:use-module (ice-9 regex) + #:use-module (mcron job-specifier) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-13) + #:use-module (srfi srfi-14) + #:export (parse-vixie-time)) + +;; In Vixie-style time specifications three-letter symbols are allowed to stand +;; for the numbers corresponding to months and days of the week. We deal with +;; this by making a textual substitution early on in the processing of the +;; strings. +;; +;; We start by defining, once and for all, a list of cons cells consisting of +;; regexps which will match the symbols - which allow an arbitrary number of +;; other letters to appear after them (so that the user can optionally complete +;; the month and day names; this is an extension of Vixie) - and the value which +;; is to replace the symbol. +;; +;; The procedure then takes a string, and then for each symbol in the +;; parse-symbols list attempts to locate an instance and replace it with an +;; ASCII representation of the value it stands for. The procedure returns the +;; modified string. (Note that each symbol can appear only once, which meets the +;; Vixie specifications technically but still allows silly users to mess things +;; up). + +(define parse-symbols + (map (lambda (symbol-cell) + (cons (make-regexp (string-append (car symbol-cell) "[[:alpha:]]*") + regexp/icase) + (cdr symbol-cell))) + '(("jan" . "0") ("feb" . "1") ("mar" . "2") ("apr" . "3") + ("may" . "4") ("jun" . "5") ("jul" . "6") ("aug" . "7") + ("sep" . "8") ("oct" . "9") ("nov" . "10") ("dec" . "11") + + ("sun" . "0") ("mon" . "1") ("tue" . "2") ("wed" . "3") + ("thu" . "4") ("fri" . "5") ("sat" . "6") ))) + +(define (vixie-substitute-parse-symbols string) + (for-each (lambda (symbol-cell) + (let ((match (regexp-exec (car symbol-cell) string))) + (if match + (set! string (string-append (match:prefix match) + (cdr symbol-cell) + (match:suffix match)))))) + parse-symbols) + string) + + + +;; A Vixie time specification is made up of a space-separated list of elements, +;; and the elements consist of a comma-separated list of subelements. The +;; procedure below takes a string holding a subelement, which should have no +;; spaces or symbols (see above) in it, and returns a list of all values which +;; that subelement indicates. There are five distinct cases which must be dealt +;; with: [1] a single '*' which returns a list of all values; [2] a '*' followed +;; by a step specifier; [3] a range and step specifier; [4] a range; and [5] a +;; single number. +;; +;; To perform the computation required for the '*' cases, we need to pass the +;; limit of the allowable range for this subelement as the third argument. As +;; days of the month start at 1 while all the other time components start at 0, +;; we must pass the base of the range to deal with this case also. + +(define parse-vixie-subelement-regexp + (make-regexp "^([[:digit:]]+)(-([[:digit:]]+)(/([[:digit:]]+))?)?$")) + +(define (parse-vixie-subelement string base limit) + (if (char=? (string-ref string 0) #\*) + (range base limit (if (> (string-length string) 1) + (string->number (substring string 2)) ;; [2] + 1)) ;; [1] + (let ((match (regexp-exec parse-vixie-subelement-regexp string))) + (cond ((not match) + (throw 'mcron-error 9 + "Bad Vixie-style time specification.")) + ((match:substring match 5) + (range (string->number (match:substring match 1)) + (+ 1 (string->number (match:substring match 3))) + (string->number (match:substring match 5)))) ;; [3] + ((match:substring match 3) + (range (string->number (match:substring match 1)) + (+ 1 (string->number (match:substring match 3))))) ;; [4] + (else + (list (string->number (match:substring match 1)))))))) ;; [5] + + + +;; A Vixie element contains the entire specification, without spaces or symbols, +;; of the acceptable values for one of the time components (minutes, hours, +;; days, months, week days). Here we break the comma-separated list into +;; subelements, and process each with the procedure above. The return value is a +;; list of all the valid values of all the subcomponents. +;; +;; The second and third arguments are the base and upper limit on the values +;; that can be accepted for this time element. +;; +;; The effect of the 'apply append' is to merge a list of lists into a single +;; list. + +(define (parse-vixie-element string base limit) + (apply append + (map (lambda (sub-element) + (parse-vixie-subelement sub-element base limit)) + (string-tokenize string (char-set-complement (char-set #\,)))))) + + + +;; Consider there are two lists, one of days in the month, the other of days in +;; the week. This procedure returns an augmented list of days in the month with +;; weekdays accounted for. + +(define (interpolate-weekdays mday-list wday-list month year) + (let ((t (localtime 0))) + (set-tm:mday t 1) + (set-tm:mon t month) + (set-tm:year t year) + (let ((first-day (tm:wday (cdr (mktime t))))) + (apply append + mday-list + (map (lambda (wday) + (let ((first (- wday first-day))) + (if (< first 0) (set! first (+ first 7))) + (range (+ 1 first) 32 7))) + wday-list))))) + + + +;; Return the number of days in a month. Fix up a tm object for the zero'th day +;; of the next month, rationalize the object and extract the day. + +(define (days-in-month month year) + (let ((t (localtime 0))) (set-tm:mday t 0) + (set-tm:mon t (+ month 1)) + (set-tm:year t year) + (tm:mday (cdr (mktime t))))) + + + +;; We will be working with a list of time-spec's, one for each element of a time +;; specification (minute, hour, ...). Each time-spec holds three pieces of +;; information: a list of acceptable values for this time component, a procedure +;; to get the component from a tm object, and a procedure to set the component +;; in a tm object. + +(define (time-spec:list time-spec) (vector-ref time-spec 0)) +(define (time-spec:getter time-spec) (vector-ref time-spec 1)) +(define (time-spec:setter time-spec) (vector-ref time-spec 2)) + + + +;; This procedure modifies the time tm object by setting the component referred +;; to by the time-spec object to its next acceptable value. If this value is not +;; greater than the original (because we have wrapped around the top of the +;; acceptable values list), then the function returns #t, otherwise it returns +;; #f. Thus, if the return value is true then it will be necessary for the +;; caller to increment the next coarser time component as well. +;; +;; The first part of the let block is a concession to humanity; the procedure is +;; simply unreadable without all of these aliases. + +(define (increment-time-component time time-spec) + (let* ((time-list (time-spec:list time-spec)) + (getter (time-spec:getter time-spec)) + (setter (time-spec:setter time-spec)) + (find-best-next (@@ (mcron job-specifier) %find-best-next)) + (next-best (find-best-next (getter time) time-list)) + (wrap-around (eqv? (cdr next-best) 9999))) + (setter time ((if wrap-around car cdr) next-best)) + wrap-around)) + + + +;; There now follows a set of procedures for adjusting an element of time, +;; i.e. taking it to the next acceptable value. In each case, the head of the +;; time-spec-list is expected to correspond to the component of time in +;; question. If the adjusted value wraps around its allowed range, then the next +;; biggest element of time must be adjusted, and so on. + +;; There is no specification allowed for the year component of +;; time. Therefore, if we have to make an adjustment (presumably because a +;; monthly adjustment has wrapped around the top of its range) we can simply +;; go to the next year. + +(define (nudge-year! time) + (set-tm:year time (+ (tm:year time) 1))) + + +;; We nudge the month by finding the next allowable value, and if it wraps +;; around we also nudge the year. The time-spec-list will have time-spec +;; objects for month and weekday. + +(define (nudge-month! time time-spec-list) + (and (increment-time-component time (car time-spec-list)) + (nudge-year! time))) + + +;; Try to increment the day component of the time according to the combination +;; of the mday-list and the wday-list. If this wraps around the range, or if +;; this falls outside the current month (31st February, for example), then +;; bump the month, set the day to zero, and recurse on this procedure to find +;; the next day in the new month. +;; +;; The time-spec-list will have time-spec entries for mday, month, and +;; weekday. + +(define (nudge-day! time time-spec-list) + (if (or (increment-time-component + time + (vector + (interpolate-weekdays (time-spec:list (car time-spec-list)) + (time-spec:list (caddr time-spec-list)) + (tm:mon time) + (tm:year time)) + tm:mday + set-tm:mday)) + (> (tm:mday time) (days-in-month (tm:mon time) (tm:year time)))) + (begin + (nudge-month! time (cdr time-spec-list)) + (set-tm:mday time 0) + (nudge-day! time time-spec-list)))) + + + +;; The hour is bumped to the next accceptable value, and the day is bumped if +;; the hour wraps around. +;; +;; The time-spec-list holds specifications for hour, mday, month and weekday. + +(define (nudge-hour! time time-spec-list) + (and (increment-time-component time (car time-spec-list)) + (nudge-day! time (cdr time-spec-list)))) + + + +;; The minute is bumped to the next accceptable value, and the hour is bumped +;; if the minute wraps around. +;; +;; The time-spec-list holds specifications for minute, hour, day-date, month +;; and weekday. + +(define (nudge-min! time time-spec-list) + (and (increment-time-component time (car time-spec-list)) + (nudge-hour! time (cdr time-spec-list)))) + + + + +;; This is a procedure which returns a procedure which computes the next time a +;; command should run after the current time, based on the information in the +;; Vixie-style time specification. +;; +;; We start by computing a list of time-spec objects (described above) for the +;; minute, hour, date, month, year and weekday components of the overall time +;; specification [1]. Special care is taken to produce proper values for +;; fields 2 and 4: according to Vixie specification "If both fields are +;; restricted (ie, aren't *), the command will be run when _either_ field +;; matches the current time." This implies that if one of these fields is *, +;; while the other is not, its value should be '() [0], otherwise +;; interpolate-weekdays below will produce incorrect results. + +;; When we create the return procedure, it is this list to +;; which references to a time-spec-list will be bound. It will be used by the +;; returned procedure [3] to compute the next time a function should run. Any +;; 7's in the weekday component of the list (the last one) are folded into 0's +;; (both values represent sunday) [2]. Any 0's in the month-day component of the +;; list are removed (this allows a solitary zero to be used to indicate that +;; jobs should only run on certain days of the _week_) [2.1]. +;; +;; The returned procedure itself:- +;; +;; Starts by obtaining the current broken-down time [4], and fixing it to +;; ensure that it is an acceptable value, as follows. Each component from the +;; biggest down is checked for acceptability, and if it is not acceptable it +;; is bumped to the next acceptable value (this may cause higher components to +;; also be bumped if there is range wrap-around) and all the lower components +;; are set to -1 so that it can successfully be bumped up to zero if this is +;; an allowed value. The -1 value will be bumped up subsequently to an allowed +;; value [5]. +;; +;; Once it has been asserted that the current time is acceptable, or has been +;; adjusted to one minute before the next acceptable time, the minute +;; component is then bumped to the next acceptable time, which may ripple +;; through the higher components if necessary [6]. We now have the next time +;; the command needs to run. +;; +;; The new time is then converted back into a UNIX time and returned [7]. + +(define (parse-vixie-time string) + (let ((tokens (string-tokenize (vixie-substitute-parse-symbols string)))) + (cond + ((> (length tokens) 5) + (throw 'mcron-error 9 + "Too many fields in Vixie-style time specification")) + ((< (length tokens) 5) + (throw 'mcron-error 9 + "Not enough fields in Vixie-style time specification"))) + (let ((time-spec-list + (map-in-order (lambda (x) (vector + (let* ((n (vector-ref x 0)) + (tok (list-ref tokens n))) + (cond + ((and (= n 4) + (string=? tok "*") + (not (string=? + (list-ref tokens 2) "*"))) + '()) + ((and (= n 2) + (string=? tok "*") + (not (string=? + (list-ref tokens 4) "*"))) + '()) + (else + (parse-vixie-element + tok + (vector-ref x 1) + (vector-ref x 2))))) ; [0] + (vector-ref x 3) + (vector-ref x 4))) + ;; token range-top+1 getter setter + `( #( 0 0 60 ,tm:min ,set-tm:min ) + #( 1 0 24 ,tm:hour ,set-tm:hour ) + #( 2 1 32 ,tm:mday ,set-tm:mday ) + #( 3 0 12 ,tm:mon ,set-tm:mon ) + #( 4 0 7 ,tm:wday ,set-tm:wday ))))) ;; [1] + + (vector-set! (car (last-pair time-spec-list)) + 0 + (map (lambda (time-spec) + (if (eqv? time-spec 7) 0 time-spec)) + (vector-ref (car (last-pair time-spec-list)) 0))) ;; [2] + + (vector-set! (caddr time-spec-list) + 0 + (remove (lambda (day) (eqv? day 0)) + (vector-ref (caddr time-spec-list) 0))) ;; [2.1] + + + (lambda (current-time) ;; [3] + (let ((time (localtime current-time))) ;; [4] + + (if (not (member (tm:mon time) + (time-spec:list (cadddr time-spec-list)))) + (begin + (nudge-month! time (cdddr time-spec-list)) + (set-tm:mday time 0))) + (if (or (eqv? (tm:mday time) 0) + (not (member (tm:mday time) + (interpolate-weekdays + (time-spec:list (caddr time-spec-list)) + (time-spec:list (caddr (cddr time-spec-list))) + (tm:mon time) + (tm:year time))))) + (begin + (nudge-day! time (cddr time-spec-list)) + (set-tm:hour time -1))) + (if (not (member (tm:hour time) + (time-spec:list (cadr time-spec-list)))) + (begin + (nudge-hour! time (cdr time-spec-list)) + (set-tm:min time -1))) ;; [5] + + (set-tm:sec time 0) + (nudge-min! time time-spec-list) ;; [6] + (car (mktime time))))))) ;; [7] + + -- cgit v1.2.3 From 52364699ed36e53ef5f913f1511f6a8e182e80ed Mon Sep 17 00:00:00 2001 From: Mathieu Lirzin Date: Sat, 7 May 2016 11:44:13 +0200 Subject: build: Use AC_CONFIG_SRCDIR safety check. * configure.ac (AC_CONFIG_SCRDIR): Set it to 'src/mcron.c'. --- configure.ac | 1 + 1 file changed, 1 insertion(+) (limited to 'configure.ac') diff --git a/configure.ac b/configure.ac index 175ba16..c6c77d9 100644 --- a/configure.ac +++ b/configure.ac @@ -24,6 +24,7 @@ AC_PREREQ(2.61) AC_INIT([GNU Mcron], [1.0.8], [bug-mcron@gnu.org]) AC_CONFIG_HEADER([src/config.h]) +AC_CONFIG_SRCDIR([src/mcron.c]) AC_CONFIG_AUX_DIR([build-aux]) AM_INIT_AUTOMAKE([subdir-objects]) AM_SILENT_RULES([yes]) # enables silent rules by default -- cgit v1.2.3 From 9d173e23bc0bf39c1114f2ac6fc6e5c1e56dd55f Mon Sep 17 00:00:00 2001 From: Mathieu Lirzin Date: Tue, 10 May 2016 01:06:10 +0200 Subject: job-specifier: range: Add tests. * build-aux/test-driver.scm: New script. * configure.ac (AC_REQUIRE_AUX_FILE): Add it. * tests/job-specifier.scm: New test. * Makefile.am (TEST_EXTENSIONS, AM_TESTS_ENVIRONMENT, SCM_LOG_DRIVER) (TESTS): New variables. (EXTRA_DIST): Update. * .gitignore: Likewise. --- .gitignore | 2 + Makefile.am | 11 ++- build-aux/test-driver.scm | 193 ++++++++++++++++++++++++++++++++++++++++++++++ configure.ac | 1 + tests/job-specifier.scm | 43 +++++++++++ 5 files changed, 249 insertions(+), 1 deletion(-) create mode 100644 build-aux/test-driver.scm create mode 100644 tests/job-specifier.scm (limited to 'configure.ac') diff --git a/.gitignore b/.gitignore index d4fc72a..b998b13 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,7 @@ *.go +*.log *.o +*.trs *~ .deps .dirstamp diff --git a/Makefile.am b/Makefile.am index ec98ef3..020aac6 100644 --- a/Makefile.am +++ b/Makefile.am @@ -61,6 +61,15 @@ modules = \ $(dist_mcronscript_DATA) \ src/mcron/config.scm +TEST_EXTENSIONS = .scm +AM_TESTS_ENVIRONMENT = env GUILE_AUTO_COMPILE='0' + +SCM_LOG_DRIVER = \ + $(builddir)/pre-inst-env $(GUILE) \ + $(srcdir)/build-aux/test-driver.scm + +TESTS = tests/job-specifier.scm + # Unset 'GUILE_LOAD_COMPILED_PATH' altogether while compiling. Otherwise, if # $GUILE_LOAD_COMPILED_PATH contains $(mcronmoduledir), we may find .go files # in there that are newer than the local .scm files (for instance because the @@ -124,7 +133,7 @@ uninstall-hook: rm -f $(fpp){cron,crontab}$(EXEEXT); \ fi -EXTRA_DIST = BUGS +EXTRA_DIST = BUGS $(TESTS) DISTCLEANFILES = src/config.scm CLEANFILES = \ $(modules:%.scm=%.go) \ diff --git a/build-aux/test-driver.scm b/build-aux/test-driver.scm new file mode 100644 index 0000000..01edf93 --- /dev/null +++ b/build-aux/test-driver.scm @@ -0,0 +1,193 @@ +;;;; test-driver.scm - Guile test driver for Automake testsuite harness + +(define script-version "2016-05-09.22") ;UTC + +;;; Copyright (C) 2015, 2016 Mathieu Lirzin +;;; +;;; This program 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. +;;; +;;; This program 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 this program. If not, see . +;;; +;;; As a special exception to the GNU General Public License, if you +;;; distribute this file as part of a program that contains a configuration +;;; script generated by Autoconf, you may include it under the same +;;; distribution terms that you use for the rest of that program. + +;;;; Commentary: +;;; +;;; This script provides a Guile test driver using the SRFI-64 Scheme API for +;;; test suites. SRFI-64 is distributed with Guile since version 2.0.9. +;;; +;;;; Code: + +(use-modules (ice-9 getopt-long) + (ice-9 pretty-print) + (srfi srfi-26) + (srfi srfi-64)) + +(define (show-help) + (display "Usage: + test-driver --test-name=NAME --log-file=PATH --trs-file=PATH + [--expect-failure={yes|no}] [--color-tests={yes|no}] + [--enable-hard-errors={yes|no}] [--brief={yes|no}}] [--] + TEST-SCRIPT [TEST-SCRIPT-ARGUMENTS] +The '--test-name', '--log-file' and '--trs-file' options are mandatory.\n")) + +(define %options + '((test-name (value #t)) + (log-file (value #t)) + (trs-file (value #t)) + (color-tests (value #t)) + (expect-failure (value #t)) ;XXX: not implemented yet + (enable-hard-errors (value #t)) ;not implemented in SRFI-64 + (brief (value #t)) + (help (single-char #\h) (value #f)) + (version (single-char #\V) (value #f)))) + +(define (option->boolean options key) + "Return #t if the value associated with KEY in OPTIONS is \"yes\"." + (and=> (option-ref options key #f) (cut string=? <> "yes"))) + +(define* (test-display field value #:optional (port (current-output-port)) + #:key pretty?) + "Display \"FIELD: VALUE\\n\" on PORT." + (if pretty? + (begin + (format port "~A:~%" field) + (pretty-print value port #:per-line-prefix "+ ")) + (format port "~A: ~A~%" field value))) + +(define* (result->string symbol #:key colorize?) + "Return SYMBOL as an upper case string. Use colors when COLORIZE is #t." + (let ((result (string-upcase (symbol->string symbol)))) + (if colorize? + (string-append (case symbol + ((pass) "") ;green + ((xfail) "") ;light green + ((skip) "") ;blue + ((fail xpass) "") ;red + ((error) "")) ;magenta + result + "") ;no color + result))) + +(define* (test-runner-gnu test-name #:key color? brief? out-port trs-port) + "Return an custom SRFI-64 test runner. TEST-NAME is a string specifying the +file name of the current the test. COLOR? specifies whether to use colors, +and BRIEF?, well, you know. OUT-PORT and TRS-PORT must be output ports. The +current output port is supposed to be redirected to a '.log' file." + + (define (test-on-test-begin-gnu runner) + ;; Procedure called at the start of an individual test case, before the + ;; test expression (and expected value) are evaluated. + (let ((result (cute assq-ref (test-result-alist runner) <>))) + (test-display "test-name" (result 'test-name)) + (test-display "location" + (string-append (result 'source-file) ":" + (number->string (result 'source-line)))) + (test-display "source" (result 'source-form) #:pretty? #t))) + + (define (test-on-test-end-gnu runner) + ;; Procedure called at the end of an individual test case, when the result + ;; of the test is available. + (let* ((results (test-result-alist runner)) + (result? (cut assq <> results)) + (result (cut assq-ref results <>))) + (unless brief? + ;; Display the result of each test case on the console. + (test-display + (result->string (test-result-kind runner) #:colorize? color?) + (string-append test-name " - " (test-runner-test-name runner)) + out-port)) + (when (result? 'expected-value) + (test-display "expected-value" (result 'expected-value))) + (when (result? 'expected-error) + (test-display "expected-error" (result 'expected-error) #:pretty? #t)) + (when (result? 'actual-value) + (test-display "actual-value" (result 'actual-value))) + (when (result? 'actual-error) + (test-display "actual-error" (result 'actual-error) #:pretty? #t)) + (test-display "result" (result->string (result 'result-kind))) + (newline) + (test-display ":test-result" + (string-append (result->string (test-result-kind runner)) + " " (test-runner-test-name runner)) + trs-port))) + + (define (test-on-group-end-gnu runner) + ;; Procedure called by a 'test-end', including at the end of a test-group. + (let ((fail (or (positive? (test-runner-fail-count runner)) + (positive? (test-runner-xpass-count runner)))) + (skip (or (positive? (test-runner-skip-count runner)) + (positive? (test-runner-xfail-count runner))))) + ;; XXX: The global results need some refinements for XPASS. + (test-display ":global-test-result" + (if fail "FAIL" (if skip "SKIP" "PASS")) + trs-port) + (test-display ":recheck" + (if fail "yes" "no") + trs-port) + (test-display ":copy-in-global-log" + (if (or fail skip) "yes" "no") + trs-port) + (when brief? + ;; Display the global test group result on the console. + (test-display (result->string (if fail 'fail (if skip 'skip 'pass)) + #:colorize? color?) + test-name + out-port)) + #f)) + + (let ((runner (test-runner-null))) + (test-runner-on-test-begin! runner test-on-test-begin-gnu) + (test-runner-on-test-end! runner test-on-test-end-gnu) + (test-runner-on-group-end! runner test-on-group-end-gnu) + (test-runner-on-bad-end-name! runner test-on-bad-end-name-simple) + runner)) + + +;;; +;;; Entry point. +;;; + +(let* ((opts (getopt-long (command-line) %options)) + (option (cut option-ref opts <> <>))) + (cond + ((option 'help #f) (show-help)) + ((option 'version #f) (format #t "test-driver.scm ~A~%" script-version)) + (else + (let ((log (open-file (option 'log-file "") "w0")) + (trs (open-file (option 'trs-file "") "wl")) + (out (duplicate-port (current-output-port) "wl"))) + (redirect-port log (current-output-port)) + (redirect-port log (current-warning-port)) + (redirect-port log (current-error-port)) + (test-with-runner + (test-runner-gnu (option 'test-name #f) + #:color? (option->boolean opts 'color-tests) + #:brief? (option->boolean opts 'brief) + #:out-port out #:trs-port trs) + (load (string-append (getcwd) "/" (car (option '() '("")))))) + (close-port log) + (close-port trs) + (close-port out)))) + (exit 0)) + +;;; Local Variables: +;;; eval: (add-hook 'write-file-functions 'time-stamp) +;;; time-stamp-start: "(define script-version \"" +;;; time-stamp-format: "%:y-%02m-%02d.%02H" +;;; time-stamp-time-zone: "UTC" +;;; time-stamp-end: "\") ;UTC" +;;; End: + +;;;; test-driver.scm ends here. diff --git a/configure.ac b/configure.ac index c6c77d9..892eb19 100644 --- a/configure.ac +++ b/configure.ac @@ -26,6 +26,7 @@ AC_INIT([GNU Mcron], [1.0.8], [bug-mcron@gnu.org]) AC_CONFIG_HEADER([src/config.h]) AC_CONFIG_SRCDIR([src/mcron.c]) AC_CONFIG_AUX_DIR([build-aux]) +AC_REQUIRE_AUX_FILE([test-driver.scm]) AM_INIT_AUTOMAKE([subdir-objects]) AM_SILENT_RULES([yes]) # enables silent rules by default diff --git a/tests/job-specifier.scm b/tests/job-specifier.scm new file mode 100644 index 0000000..889530b --- /dev/null +++ b/tests/job-specifier.scm @@ -0,0 +1,43 @@ +;;;; job-specifier.scm -- tests for (mcron job-specifier) module +;;; 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 . + +(use-modules (srfi srfi-64) + (mcron job-specifier)) + +(test-begin "job-specifier") + +(test-equal "range: basic" + '(0 1 2 3 4 5 6 7 8 9) + (range 0 10)) + +(test-equal "range: positive step" + '(0 2 4 6 8) + (range 0 10 2)) + +(test-assert "range: zero step" + ;; Since this behavior is undefined, only check if range doesn't crash. + (range 0 5 0)) + +(test-assert "range: negative step" + ;; Since this behavior is undefined, only check if range doesn't crash. + (range 0 5 -2)) + +(test-assert "range: reverse boundaries" + (range 10 3)) + +(test-end) -- cgit v1.2.3 From 10c9f31c6c6dee962e114a0ea494088d8fdb3502 Mon Sep 17 00:00:00 2001 From: Mathieu Lirzin Date: Tue, 10 May 2016 21:00:59 +0200 Subject: build: Use Automake warnings. * configure.ac (AM_INIT_AUTOMAKE): Add more warnings. * Makefile.am (AM_V_GUILEC, AM_V_GUILEC_, AM_V_GUILEC_0): Rename to ... (guilec_verbose, guilec_verbose_, guilec_verbose_0): ... these. Make them more portable. This follows an example from Automake manual. --- Makefile.am | 8 ++++---- configure.ac | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) (limited to 'configure.ac') diff --git a/Makefile.am b/Makefile.am index 305421d..0504a2c 100644 --- a/Makefile.am +++ b/Makefile.am @@ -83,7 +83,7 @@ TESTS = \ # XXX: Use the C locale for when Guile lacks # . .scm.go: - $(AM_V_GUILEC)$(MKDIR_P) `dirname "$@"` ; \ + $(guilec_verbose)$(MKDIR_P) `dirname "$@"` ; \ export GUILE_AUTO_COMPILE=0 ; unset GUILE_LOAD_COMPILED_PATH ; \ LC_ALL=C \ $(top_builddir)/pre-inst-env $(GUILD) compile \ @@ -183,6 +183,6 @@ $(srcdir)/doc/cron.8: src/mcron/scripts/cron.scm cron ## Silent rules. ## ## -------------- ## -AM_V_GUILEC = $(AM_V_GUILEC_$(V)) -AM_V_GUILEC_ = $(AM_V_GUILEC_$(AM_DEFAULT_VERBOSITY)) -AM_V_GUILEC_0 = @echo " GUILEC " $@; +guilec_verbose = $(guilec_verbose_@AM_V@) +guilec_verbose_ = $(guilec_verbose_@AM_DEFAULT_V@) +guilec_verbose_0 = @echo " GUILEC " $@; diff --git a/configure.ac b/configure.ac index 892eb19..da860f9 100644 --- a/configure.ac +++ b/configure.ac @@ -27,7 +27,7 @@ AC_CONFIG_HEADER([src/config.h]) AC_CONFIG_SRCDIR([src/mcron.c]) AC_CONFIG_AUX_DIR([build-aux]) AC_REQUIRE_AUX_FILE([test-driver.scm]) -AM_INIT_AUTOMAKE([subdir-objects]) +AM_INIT_AUTOMAKE([subdir-objects -Wall -Wno-override]) AM_SILENT_RULES([yes]) # enables silent rules by default moduledir="${datarootdir}/guile/site/2.0" -- cgit v1.2.3 From 245413041c1ddee4bb7d752f6f1044750b887df8 Mon Sep 17 00:00:00 2001 From: Mathieu Lirzin Date: Sun, 17 Jul 2016 00:10:35 +0200 Subject: build: Define PACKAGE_LOAD_PATH in Makefile. Previously PACKAGE_LOAD_PATH was set in config header which wasn't correctly expanded due to the presence of ${prefix} in ${moduledir}. Let 'make' handle the expansion. * Makefile.am (AM_CPPFLAGS): New variable. (cron_CPPFLAGS, crontab_CPPFLAGS, mcron_CPPFLAGS): Use it. * configure.ac (PACKAGE_LOAD_PATH): Undefine it. (AC_CONFIG_HEADER): Remove macro. * src/mcron.c: Adapt to it. --- Makefile.am | 7 ++++--- configure.ac | 4 +--- src/mcron.c | 1 - 3 files changed, 5 insertions(+), 7 deletions(-) (limited to 'configure.ac') diff --git a/Makefile.am b/Makefile.am index ddb1c26..d01e730 100644 --- a/Makefile.am +++ b/Makefile.am @@ -19,19 +19,20 @@ bin_PROGRAMS = mcron crontab sbin_PROGRAMS = cron +AM_CPPFLAGS = -DPACKAGE_LOAD_PATH=\"$(moduledir)\" AM_CFLAGS = @GUILE_CFLAGS@ LDADD = @GUILE_LIBS@ mcron_SOURCES = src/mcron.c -mcron_CPPFLAGS = -DPROGRAM="\"mcron\"" +mcron_CPPFLAGS = $(AM_CPPFLAGS) -DPROGRAM="\"mcron\"" mcron_DEPENDENCIES = $(modules:%.scm=%.go) cron_SOURCES = src/mcron.c -cron_CPPFLAGS = -DPROGRAM="\"cron\"" +cron_CPPFLAGS = $(AM_CPPFLAGS) -DPROGRAM="\"cron\"" cron_DEPENDENCIES = $(modules:%.scm=%.go) crontab_SOURCES = src/mcron.c -crontab_CPPFLAGS = -DPROGRAM="\"crontab\"" +crontab_CPPFLAGS = $(AM_CPPFLAGS) -DPROGRAM="\"crontab\"" crontab_DEPENDENCIES = $(modules:%.scm=%.go) dist_mcronmodule_DATA = \ diff --git a/configure.ac b/configure.ac index da860f9..5ec29aa 100644 --- a/configure.ac +++ b/configure.ac @@ -23,7 +23,6 @@ AC_PREREQ(2.61) AC_INIT([GNU Mcron], [1.0.8], [bug-mcron@gnu.org]) -AC_CONFIG_HEADER([src/config.h]) AC_CONFIG_SRCDIR([src/mcron.c]) AC_CONFIG_AUX_DIR([build-aux]) AC_REQUIRE_AUX_FILE([test-driver.scm]) @@ -31,9 +30,8 @@ AM_INIT_AUTOMAKE([subdir-objects -Wall -Wno-override]) AM_SILENT_RULES([yes]) # enables silent rules by default moduledir="${datarootdir}/guile/site/2.0" +AC_SUBST([moduledir]) AC_SUBST([mcronmoduledir], ["${moduledir}/mcron"]) -AC_DEFINE_UNQUOTED([PACKAGE_LOAD_PATH], ["${moduledir}"], - [Define to the guile modules location of this package.]) AC_MSG_CHECKING([whether debugging is requested]) AC_ARG_ENABLE(debug, AC_HELP_STRING([--enable-debug], diff --git a/src/mcron.c b/src/mcron.c index 026b077..a52c073 100644 --- a/src/mcron.c +++ b/src/mcron.c @@ -22,7 +22,6 @@ is needed because the crontab personality requires SUID which is not permitted for executable scripts. */ -#include "config.h" #include #include #include -- cgit v1.2.3 From 19d68f7dd67dea1e5e11d5014766157d45e5ebf4 Mon Sep 17 00:00:00 2001 From: Mathieu Lirzin Date: Mon, 18 Jul 2016 16:30:11 +0200 Subject: build: Rename 'mcron.c' to 'wrapper.c'. * src/mcron.c: Rename to ... * src/wrapper.c: ... this. * Makefile.am (mcron_SOURCES, cron_SOURCES, crontab_SOURCES): Adapt to it. * configure.ac (AC_CONFIG_SRCDIR): Likewise. --- Makefile.am | 6 ++--- configure.ac | 2 +- src/mcron.c | 86 ----------------------------------------------------------- src/wrapper.c | 85 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 89 insertions(+), 90 deletions(-) delete mode 100644 src/mcron.c create mode 100644 src/wrapper.c (limited to 'configure.ac') diff --git a/Makefile.am b/Makefile.am index d01e730..61f1c7b 100644 --- a/Makefile.am +++ b/Makefile.am @@ -23,15 +23,15 @@ AM_CPPFLAGS = -DPACKAGE_LOAD_PATH=\"$(moduledir)\" AM_CFLAGS = @GUILE_CFLAGS@ LDADD = @GUILE_LIBS@ -mcron_SOURCES = src/mcron.c +mcron_SOURCES = src/wrapper.c mcron_CPPFLAGS = $(AM_CPPFLAGS) -DPROGRAM="\"mcron\"" mcron_DEPENDENCIES = $(modules:%.scm=%.go) -cron_SOURCES = src/mcron.c +cron_SOURCES = src/wrapper.c cron_CPPFLAGS = $(AM_CPPFLAGS) -DPROGRAM="\"cron\"" cron_DEPENDENCIES = $(modules:%.scm=%.go) -crontab_SOURCES = src/mcron.c +crontab_SOURCES = src/wrapper.c crontab_CPPFLAGS = $(AM_CPPFLAGS) -DPROGRAM="\"crontab\"" crontab_DEPENDENCIES = $(modules:%.scm=%.go) diff --git a/configure.ac b/configure.ac index 5ec29aa..5b2fcf6 100644 --- a/configure.ac +++ b/configure.ac @@ -23,7 +23,7 @@ AC_PREREQ(2.61) AC_INIT([GNU Mcron], [1.0.8], [bug-mcron@gnu.org]) -AC_CONFIG_SRCDIR([src/mcron.c]) +AC_CONFIG_SRCDIR([src/wrapper.c]) AC_CONFIG_AUX_DIR([build-aux]) AC_REQUIRE_AUX_FILE([test-driver.scm]) AM_INIT_AUTOMAKE([subdir-objects -Wall -Wno-override]) diff --git a/src/mcron.c b/src/mcron.c deleted file mode 100644 index a52c073..0000000 --- a/src/mcron.c +++ /dev/null @@ -1,86 +0,0 @@ -/* mcron - run jobs at scheduled times - - Copyright (C) 2015, 2016 Mathieu Lirzin - Copyright (C) 2003, 2014 Dale Mellor - - 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 . */ - -/* This C code represents a thin wrapper around the Guile code of Mcron. It - is needed because the crontab personality requires SUID which is not - permitted for executable scripts. */ - -#include -#include -#include -#include - -/* Forward declarations. */ -static void inner_main (void *closure, int argc, char **argv); -static void react_to_terminal_signal (int sig); -static SCM set_cron_signals (void); - -int -main (int argc, char **argv) -{ - scm_boot_guile (argc, argv, inner_main, 0); - - return EXIT_SUCCESS; -} - -/* Launch the Mcron Guile main program. */ -static void -inner_main (void *closure, int argc, char **argv) -{ - /* Set Guile load paths to ensure that Mcron modules will be found. */ - if (getenv ("MCRON_UNINSTALLED") == NULL) - { - scm_c_eval_string ("(set! %load-path (cons \"" - PACKAGE_LOAD_PATH "\" %load-path))"); - scm_c_eval_string ("(set! %load-compiled-path (cons \"" - PACKAGE_LOAD_PATH "\" %load-compiled-path))"); - } - scm_set_current_module (scm_c_resolve_module ("mcron scripts " PROGRAM)); - /* Register set_cron_signals to be called from Guile. */ - scm_c_define_gsubr ("c-set-cron-signals", 0, 0, 0, set_cron_signals); - scm_c_eval_string ("(main)"); -} - -/* Set up all the signal handlers as required by the cron personality. This - is necessary to perform the signal processing in C because the sigaction - function won't work when called from Guile. */ -static SCM -set_cron_signals () -{ - static struct sigaction sa; - - memset (&sa, 0, sizeof (sa)); - sa.sa_handler = react_to_terminal_signal; - sigaction (SIGTERM, &sa, 0); - sigaction (SIGINT, &sa, 0); - sigaction (SIGQUIT, &sa, 0); - sigaction (SIGHUP, &sa, 0); - - return SCM_BOOL_T; -} - -/* Handle signal SIG and exit. All signals that mcron handles will produce - the same behavior so we don't need to use SIG in the implementation. */ -static void -react_to_terminal_signal (int sig) -{ - scm_c_eval_string ("(delete-run-file)"); - exit (EXIT_FAILURE); -} diff --git a/src/wrapper.c b/src/wrapper.c new file mode 100644 index 0000000..a5b46db --- /dev/null +++ b/src/wrapper.c @@ -0,0 +1,85 @@ +/* wrapper.c -- C code booting Guile + Copyright (C) 2003, 2014 Dale Mellor + Copyright (C) 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 . */ + +/* This C code represents a thin wrapper around the Guile code of Mcron. It + is needed because the crontab personality requires SUID which is not + permitted for executable scripts. */ + +#include +#include +#include +#include + +/* Forward declarations. */ +static void inner_main (void *closure, int argc, char **argv); +static void react_to_terminal_signal (int sig); +static SCM set_cron_signals (void); + +int +main (int argc, char **argv) +{ + scm_boot_guile (argc, argv, inner_main, 0); + + return EXIT_SUCCESS; +} + +/* Launch the Mcron Guile main program. */ +static void +inner_main (void *closure, int argc, char **argv) +{ + /* Set Guile load paths to ensure that Mcron modules will be found. */ + if (getenv ("MCRON_UNINSTALLED") == NULL) + { + scm_c_eval_string ("(set! %load-path (cons \"" + PACKAGE_LOAD_PATH "\" %load-path))"); + scm_c_eval_string ("(set! %load-compiled-path (cons \"" + PACKAGE_LOAD_PATH "\" %load-compiled-path))"); + } + scm_set_current_module (scm_c_resolve_module ("mcron scripts " PROGRAM)); + /* Register set_cron_signals to be called from Guile. */ + scm_c_define_gsubr ("c-set-cron-signals", 0, 0, 0, set_cron_signals); + scm_c_eval_string ("(main)"); +} + +/* Set up all the signal handlers as required by the cron personality. This + is necessary to perform the signal processing in C because the sigaction + function won't work when called from Guile. */ +static SCM +set_cron_signals () +{ + static struct sigaction sa; + + memset (&sa, 0, sizeof (sa)); + sa.sa_handler = react_to_terminal_signal; + sigaction (SIGTERM, &sa, 0); + sigaction (SIGINT, &sa, 0); + sigaction (SIGQUIT, &sa, 0); + sigaction (SIGHUP, &sa, 0); + + return SCM_BOOL_T; +} + +/* Handle signal SIG and exit. All signals that mcron handles will produce + the same behavior so we don't need to use SIG in the implementation. */ +static void +react_to_terminal_signal (int sig) +{ + scm_c_eval_string ("(delete-run-file)"); + exit (EXIT_FAILURE); +} -- cgit v1.2.3 From 2cdd544a56e4b340f1744cfe2ab6439aa815045c Mon Sep 17 00:00:00 2001 From: Mathieu Lirzin Date: Mon, 18 Jul 2016 17:25:27 +0200 Subject: maint: Reformat copyright notices and copying permission statements. --- Makefile.am | 13 ++++---- configure.ac | 41 ++++++++++++------------- src/mcron/base.scm | 39 ++++++++++++------------ src/mcron/config.scm.in | 40 +++++++++++------------- src/mcron/environment.scm | 64 +++++++++++++++++++-------------------- src/mcron/job-specifier.scm | 50 +++++++++++++++--------------- src/mcron/main.scm | 35 ++++++++++----------- src/mcron/redirect.scm | 63 ++++++++++++++++++++------------------ src/mcron/vixie-specification.scm | 51 ++++++++++++++++--------------- src/mcron/vixie-time.scm | 33 ++++++++++---------- src/wrapper.c | 4 +-- 11 files changed, 218 insertions(+), 215 deletions(-) (limited to 'configure.ac') diff --git a/Makefile.am b/Makefile.am index 61f1c7b..52a8499 100644 --- a/Makefile.am +++ b/Makefile.am @@ -1,20 +1,21 @@ ## Process this file with automake to produce Makefile.in. - -# Copyright (C) 2003 Dale Mellor -# Copyright (C) 2015, 2016 Mathieu Lirzin +# Copyright © 2003 Dale Mellor +# Copyright © 2015, 2016 Mathieu Lirzin +# +# This file is part of GNU Mcron. # -# This program is free software: you can redistribute it and/or modify +# 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. # -# This program is distributed in the hope that it will be useful, +# 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 this program. If not, see . +# along with GNU Mcron. If not, see . bin_PROGRAMS = mcron crontab sbin_PROGRAMS = cron diff --git a/configure.ac b/configure.ac index 5b2fcf6..97c900b 100644 --- a/configure.ac +++ b/configure.ac @@ -1,25 +1,22 @@ -# -*- Autoconf -*- -# Process this file with autoconf to produce a configure script. - - -# Copyright (C) 2003, 2005, 2012, 2014 Dale Mellor -# Copyright (C) 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 . - +## Process this file with autoconf to produce a configure script. +# Copyright © 2003, 2005, 2012, 2014 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 . AC_PREREQ(2.61) AC_INIT([GNU Mcron], [1.0.8], [bug-mcron@gnu.org]) diff --git a/src/mcron/base.scm b/src/mcron/base.scm index b779c8a..b607c05 100644 --- a/src/mcron/base.scm +++ b/src/mcron/base.scm @@ -1,23 +1,22 @@ -;; Copyright (C) 2016 Ludovic Courtès -;; Copyright (C) 2015, 2016 Mathieu Lirzin -;; Copyright (C) 2003 Dale Mellor -;; -;; 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 . - - +;;;; base.scm -- core procedures +;;; Copyright © 2003 Dale Mellor +;;; Copyright © 2015, 2016 Mathieu Lirzin +;;; Copyright © 2016 Ludovic Courtès +;;; +;;; 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 base) #:use-module (ice-9 match) diff --git a/src/mcron/config.scm.in b/src/mcron/config.scm.in index db2bc32..2b0bc7f 100644 --- a/src/mcron/config.scm.in +++ b/src/mcron/config.scm.in @@ -1,25 +1,21 @@ -;; -*-scheme-*- - -;; Copyright (C) 2015 Mathieu Lirzin -;; Copyright (C) 2003 Dale Mellor -;; -;; 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 . - - -;; Some constants set by the configuration process. +;;;; config.scm -- variables defined at configure time +;;; Copyright © 2003 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 config)) diff --git a/src/mcron/environment.scm b/src/mcron/environment.scm index b563d55..f6b9637 100644 --- a/src/mcron/environment.scm +++ b/src/mcron/environment.scm @@ -1,35 +1,35 @@ -;; Copyright (C) 2015, 2016 Mathieu Lirzin -;; Copyright (C) 2003 Dale Mellor -;; -;; 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 . - - - -;; This file defines the variable current-environment-mods, and the procedures -;; append-environment-mods (which is available to user configuration files), -;; clear-environment-mods and modify-environment. The idea is that the -;; current-environment-mods is a list of pairs of environment names and values, -;; and represents the cumulated environment settings in a configuration -;; file. When a job definition is seen in a configuration file, the -;; current-environment-mods are copied into the internal job description, and -;; when the job actually runs these environment modifications are applied to -;; the UNIX environment in which the job runs. - - - +;;;; environment.scm -- interact with the job process environment +;;; Copyright © 2003 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 . + +;;;; Commentary: +;;; +;;; Define the variable current-environment-mods, and the procedures +;;; append-environment-mods (which is available to user configuration files), +;;; clear-environment-mods and modify-environment. The idea is that the +;;; current-environment-mods is a list of pairs of environment names and +;;; values, and represents the cumulated environment settings in a +;;; configuration file. When a job definition is seen in a configuration file, +;;; the current-environment-mods are copied into the internal job description, +;;; and when the job actually runs these environment modifications are applied +;;; to the UNIX environment in which the job runs. +;;; +;;;; Code: (define-module (mcron environment) #:export (modify-environment diff --git a/src/mcron/job-specifier.scm b/src/mcron/job-specifier.scm index 5d60484..d4c05bd 100644 --- a/src/mcron/job-specifier.scm +++ b/src/mcron/job-specifier.scm @@ -1,28 +1,30 @@ -;; Copyright (C) 2003 Dale Mellor -;; Copyright (C) 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 . - - +;;;; job-specifier.scm -- public interface for defining jobs +;;; Copyright © 2003 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 . -;; This module defines all the functions that can be used by scheme mcron -;; configuration files, namely the procedures for working out next times, the -;; job procedure for registering new jobs (actually a wrapper around the -;; base add-job function), and the procedure for declaring environment -;; modifications. +;;;; Commentary: +;;; +;;; Define all the functions that can be used by scheme Mcron configuration +;;; files, namely the procedures for working out next times, the job procedure +;;; for registering new jobs (actually a wrapper around the base add-job +;;; function), and the procedure for declaring environment modifications. +;;; +;;;; Code: (define-module (mcron job-specifier) #:use-module (ice-9 match) diff --git a/src/mcron/main.scm b/src/mcron/main.scm index 1faa1ae..74b49e5 100644 --- a/src/mcron/main.scm +++ b/src/mcron/main.scm @@ -1,20 +1,21 @@ -;; Copyright (C) 2015, 2016 Mathieu Lirzin -;; Copyright (C) 2003, 2012 Dale Mellor -;; -;; 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 . +;;; 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) diff --git a/src/mcron/redirect.scm b/src/mcron/redirect.scm index af763cb..7474c4a 100644 --- a/src/mcron/redirect.scm +++ b/src/mcron/redirect.scm @@ -1,33 +1,36 @@ -;; Copyright (C) 2003 Dale Mellor -;; -;; 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 . - - - -;; This module provides the (with-mail-out action . user) procedure. This -;; procedure runs the action in a child process, allowing the user control over -;; the input and output (including standard error). The input is governed (only -;; in the case of a string action) by the placing of percentage signs in the -;; string; the first delimits the true action from the standard input, and -;; subsequent ones denote newlines to be placed into the input. The output (if -;; there actually is any) is controlled by the MAILTO environment variable. If -;; this is not defined, output is e-mailed to the user passed as argument, if -;; any, or else the owner of the action; if defined but empty then any output is -;; sunk to /dev/null; otherwise output is e-mailed to the address held in the -;; MAILTO variable. +;;;; redirect.scm -- modify job outputs +;;; Copyright © 2003 Dale Mellor +;;; +;;; 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 . + +;;;; Commentary: +;;; +;;; Provide the (with-mail-out action . user) procedure. This procedure runs +;;; the action in a child process, allowing the user control over the input +;;; and output (including standard error). The input is governed (only in the +;;; case of a string action) by the placing of percentage signs in the string; +;;; the first delimits the true action from the standard input, and subsequent +;;; ones denote newlines to be placed into the input. The output (if there +;;; actually is any) is controlled by the MAILTO environment variable. If +;;; this is not defined, output is e-mailed to the user passed as argument, if +;;; any, or else the owner of the action; if defined but empty then any output +;;; is sunk to /dev/null; otherwise output is e-mailed to the address held in +;;; the MAILTO variable. +;;; +;;;; Code: (define-module (mcron redirect) #:export (with-mail-out) diff --git a/src/mcron/vixie-specification.scm b/src/mcron/vixie-specification.scm index f055383..4356db7 100644 --- a/src/mcron/vixie-specification.scm +++ b/src/mcron/vixie-specification.scm @@ -1,27 +1,30 @@ -;; Copyright (C) 2003 Dale Mellor -;; -;; 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 . - - - -;; This file provides methods for reading a complete Vixie-style configuration -;; file, either from a real file or an already opened port. It also exposes the -;; method for parsing the time-specification part of a Vixie string, so that -;; these can be used to form the next-time-function of a job in a Guile -;; configuration file. +;;;; vixie-specification.scm -- read Vixie-sytle configuration file +;;; Copyright © 2003 Dale Mellor +;;; +;;; 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 . + +;;;; Commentary: +;;; +;;; Methods for reading a complete Vixie-style configuration file, either from +;;; a real file or an already opened port. It also exposes the method for +;;; parsing the time-specification part of a Vixie string, so that these can +;;; be used to form the next-time-function of a job in a Guile configuration +;;; file. +;;; +;;;; Code: (define-module (mcron vixie-specification) #:export (parse-user-vixie-line diff --git a/src/mcron/vixie-time.scm b/src/mcron/vixie-time.scm index a91fa89..f734600 100644 --- a/src/mcron/vixie-time.scm +++ b/src/mcron/vixie-time.scm @@ -1,19 +1,20 @@ -;; Copyright (C) 2003 Dale Mellor -;; -;; 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 . +;;;; vixie-time.scm -- parse Vixie-style times +;;; Copyright © 2003 Dale Mellor +;;; +;;; 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 vixie-time) #:use-module (ice-9 regex) diff --git a/src/wrapper.c b/src/wrapper.c index a5b46db..bb7932e 100644 --- a/src/wrapper.c +++ b/src/wrapper.c @@ -1,6 +1,6 @@ /* wrapper.c -- C code booting Guile - Copyright (C) 2003, 2014 Dale Mellor - Copyright (C) 2015, 2016 Mathieu Lirzin + Copyright © 2003, 2014 Dale Mellor + Copyright © 2015, 2016 Mathieu Lirzin This file is part of GNU Mcron. -- cgit v1.2.3 From a3051133c0370abcbff266441e177ce81920457a Mon Sep 17 00:00:00 2001 From: Mathieu Lirzin Date: Wed, 28 Dec 2016 23:06:03 +0100 Subject: maint: Generate version number. * build-aux/git-version-gen: New script. * configure.ac (AC_INIT): Use it. (AC_REQUIRE_AUX_FILE): Distribute it. * Makefile.am (.version): New target. (BUILT_SOURCES, EXTRA_DIST): Add it. (dist-hook): Generate ".tarball-version". * .gitignore: Update. --- .gitignore | 1 + Makefile.am | 10 +- build-aux/git-version-gen | 226 ++++++++++++++++++++++++++++++++++++++++++++++ configure.ac | 5 +- 4 files changed, 240 insertions(+), 2 deletions(-) create mode 100755 build-aux/git-version-gen (limited to 'configure.ac') diff --git a/.gitignore b/.gitignore index cc8e31d..09579ee 100644 --- a/.gitignore +++ b/.gitignore @@ -24,6 +24,7 @@ /doc/version.texi /mcron /mdate-sh +/.version INSTALL Makefile Makefile.in diff --git a/Makefile.am b/Makefile.am index 109e27a..a1d6be4 100644 --- a/Makefile.am +++ b/Makefile.am @@ -97,7 +97,12 @@ TESTS = \ SUFFIXES = .go noinst_SCRIPTS = pre-inst-env +BUILT_SOURCES= .version +.version: + $(AM_V_GEN)echo $(VERSION) > $@-t && mv $@-t $@ + dist-hook: gen-ChangeLog + $(AM_V_GEN)echo $(VERSION) > $(distdir)/.tarball-version gen_start_date = 2015-06-26 .PHONY: gen-ChangeLog @@ -137,7 +142,10 @@ uninstall-hook: rm -f $(fpp){cron,crontab}$(EXEEXT); \ fi -EXTRA_DIST = $(TESTS) +EXTRA_DIST = \ + .version \ + $(TESTS) + MAINTAINERCLEANFILES = $(dist_man_MANS) DISTCLEANFILES = src/config.scm CLEANFILES = \ diff --git a/build-aux/git-version-gen b/build-aux/git-version-gen new file mode 100755 index 0000000..bd2c4b6 --- /dev/null +++ b/build-aux/git-version-gen @@ -0,0 +1,226 @@ +#!/bin/sh +# Print a version string. +scriptversion=2016-05-08.18; # UTC + +# Copyright (C) 2007-2016 Free Software Foundation, Inc. +# +# This program 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. +# +# This program 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 this program. If not, see . + +# This script is derived from GIT-VERSION-GEN from GIT: http://git.or.cz/. +# It may be run two ways: +# - from a git repository in which the "git describe" command below +# produces useful output (thus requiring at least one signed tag) +# - from a non-git-repo directory containing a .tarball-version file, which +# presumes this script is invoked like "./git-version-gen .tarball-version". + +# In order to use intra-version strings in your project, you will need two +# separate generated version string files: +# +# .tarball-version - present only in a distribution tarball, and not in +# a checked-out repository. Created with contents that were learned at +# the last time autoconf was run, and used by git-version-gen. Must not +# be present in either $(srcdir) or $(builddir) for git-version-gen to +# give accurate answers during normal development with a checked out tree, +# but must be present in a tarball when there is no version control system. +# Therefore, it cannot be used in any dependencies. GNUmakefile has +# hooks to force a reconfigure at distribution time to get the value +# correct, without penalizing normal development with extra reconfigures. +# +# .version - present in a checked-out repository and in a distribution +# tarball. Usable in dependencies, particularly for files that don't +# want to depend on config.h but do want to track version changes. +# Delete this file prior to any autoconf run where you want to rebuild +# files to pick up a version string change; and leave it stale to +# minimize rebuild time after unrelated changes to configure sources. +# +# As with any generated file in a VC'd directory, you should add +# /.version to .gitignore, so that you don't accidentally commit it. +# .tarball-version is never generated in a VC'd directory, so needn't +# be listed there. +# +# Use the following line in your configure.ac, so that $(VERSION) will +# automatically be up-to-date each time configure is run (and note that +# since configure.ac no longer includes a version string, Makefile rules +# should not depend on configure.ac for version updates). +# +# AC_INIT([GNU project], +# m4_esyscmd([build-aux/git-version-gen .tarball-version]), +# [bug-project@example]) +# +# Then use the following lines in your Makefile.am, so that .version +# will be present for dependencies, and so that .version and +# .tarball-version will exist in distribution tarballs. +# +# EXTRA_DIST = $(top_srcdir)/.version +# BUILT_SOURCES = $(top_srcdir)/.version +# $(top_srcdir)/.version: +# echo $(VERSION) > $@-t && mv $@-t $@ +# dist-hook: +# echo $(VERSION) > $(distdir)/.tarball-version + + +me=$0 + +version="git-version-gen $scriptversion + +Copyright 2011 Free Software Foundation, Inc. +There is NO warranty. You may redistribute this software +under the terms of the GNU General Public License. +For more information about these matters, see the files named COPYING." + +usage="\ +Usage: $me [OPTION]... \$srcdir/.tarball-version [TAG-NORMALIZATION-SED-SCRIPT] +Print a version string. + +Options: + + --prefix PREFIX prefix of git tags (default 'v') + --fallback VERSION + fallback version to use if \"git --version\" fails + + --help display this help and exit + --version output version information and exit + +Running without arguments will suffice in most cases." + +prefix=v +fallback= + +while test $# -gt 0; do + case $1 in + --help) echo "$usage"; exit 0;; + --version) echo "$version"; exit 0;; + --prefix) shift; prefix=${1?};; + --fallback) shift; fallback=${1?};; + -*) + echo "$0: Unknown option '$1'." >&2 + echo "$0: Try '--help' for more information." >&2 + exit 1;; + *) + if test "x$tarball_version_file" = x; then + tarball_version_file="$1" + elif test "x$tag_sed_script" = x; then + tag_sed_script="$1" + else + echo "$0: extra non-option argument '$1'." >&2 + exit 1 + fi;; + esac + shift +done + +if test "x$tarball_version_file" = x; then + echo "$usage" + exit 1 +fi + +tag_sed_script="${tag_sed_script:-s/x/x/}" + +nl=' +' + +# Avoid meddling by environment variable of the same name. +v= +v_from_git= + +# First see if there is a tarball-only version file. +# then try "git describe", then default. +if test -f $tarball_version_file +then + v=`cat $tarball_version_file` || v= + case $v in + *$nl*) v= ;; # reject multi-line output + [0-9]*) ;; + *) v= ;; + esac + test "x$v" = x \ + && echo "$0: WARNING: $tarball_version_file is missing or damaged" 1>&2 +fi + +if test "x$v" != x +then + : # use $v +# Otherwise, if there is at least one git commit involving the working +# directory, and "git describe" output looks sensible, use that to +# derive a version string. +elif test "`git log -1 --pretty=format:x . 2>&1`" = x \ + && v=`git describe --abbrev=4 --match="$prefix*" HEAD 2>/dev/null \ + || git describe --abbrev=4 HEAD 2>/dev/null` \ + && v=`printf '%s\n' "$v" | sed "$tag_sed_script"` \ + && case $v in + $prefix[0-9]*) ;; + *) (exit 1) ;; + esac +then + # Is this a new git that lists number of commits since the last + # tag or the previous older version that did not? + # Newer: v6.10-77-g0f8faeb + # Older: v6.10-g0f8faeb + case $v in + *-*-*) : git describe is okay three part flavor ;; + *-*) + : git describe is older two part flavor + # Recreate the number of commits and rewrite such that the + # result is the same as if we were using the newer version + # of git describe. + vtag=`echo "$v" | sed 's/-.*//'` + commit_list=`git rev-list "$vtag"..HEAD 2>/dev/null` \ + || { commit_list=failed; + echo "$0: WARNING: git rev-list failed" 1>&2; } + numcommits=`echo "$commit_list" | wc -l` + v=`echo "$v" | sed "s/\(.*\)-\(.*\)/\1-$numcommits-\2/"`; + test "$commit_list" = failed && v=UNKNOWN + ;; + esac + + # Change the first '-' to a '.', so version-comparing tools work properly. + # Remove the "g" in git describe's output string, to save a byte. + v=`echo "$v" | sed 's/-/./;s/\(.*\)-g/\1-/'`; + v_from_git=1 +elif test "x$fallback" = x || git --version >/dev/null 2>&1; then + v=UNKNOWN +else + v=$fallback +fi + +v=`echo "$v" |sed "s/^$prefix//"` + +# Test whether to append the "-dirty" suffix only if the version +# string we're using came from git. I.e., skip the test if it's "UNKNOWN" +# or if it came from .tarball-version. +if test "x$v_from_git" != x; then + # Don't declare a version "dirty" merely because a time stamp has changed. + git update-index --refresh > /dev/null 2>&1 + + dirty=`exec 2>/dev/null;git diff-index --name-only HEAD` || dirty= + case "$dirty" in + '') ;; + *) # Append the suffix only if there isn't one already. + case $v in + *-dirty) ;; + *) v="$v-dirty" ;; + esac ;; + esac +fi + +# Omit the trailing newline, so that m4_esyscmd can use the result directly. +printf %s "$v" + +# Local variables: +# eval: (add-hook 'write-file-hooks 'time-stamp) +# time-stamp-start: "scriptversion=" +# time-stamp-format: "%:y-%02m-%02d.%02H" +# time-stamp-time-zone: "UTC0" +# time-stamp-end: "; # UTC" +# End: diff --git a/configure.ac b/configure.ac index 97c900b..5940555 100644 --- a/configure.ac +++ b/configure.ac @@ -19,10 +19,13 @@ # along with GNU Mcron. If not, see . AC_PREREQ(2.61) -AC_INIT([GNU Mcron], [1.0.8], [bug-mcron@gnu.org]) +AC_INIT([GNU Mcron], + m4_esyscmd([build-aux/git-version-gen .tarball-version]), + [bug-mcron@gnu.org]) AC_CONFIG_SRCDIR([src/wrapper.c]) AC_CONFIG_AUX_DIR([build-aux]) AC_REQUIRE_AUX_FILE([test-driver.scm]) +AC_REQUIRE_AUX_FILE([git-version-gen]) AM_INIT_AUTOMAKE([subdir-objects -Wall -Wno-override]) AM_SILENT_RULES([yes]) # enables silent rules by default -- cgit v1.2.3