Compare commits
	
		
			23 commits
		
	
	
		
	
	| Author | SHA1 | Date | |
|---|---|---|---|
|   | 833ae20c31 | ||
|   | 765bfbf4d9 | ||
|   | 92a940cca5 | ||
|   | d2143dea3f | ||
|   | 6a9bfcea40 | ||
|   | f700f299d4 | ||
|   | 289e4c505e | ||
|   | bfe2a89212 | ||
|   | 6ae3224688 | ||
|   | bc18db8950 | ||
|   | 9781507def | ||
|   | 39857ae844 | ||
|   | b0151cad38 | ||
|   | 42fae5880e | ||
|   | b596461e42 | ||
|   | 6360e88416 | ||
|   | 1eedf3b6d2 | ||
|   | 4a05a2e861 | ||
|   | deaa79a7c6 | ||
|   | ad6e4e5505 | ||
|   | cb88cc9e42 | ||
|   | a8d938c4ed | ||
|   | f22de155b8 | 
					 26 changed files with 706 additions and 631 deletions
				
			
		
							
								
								
									
										84
									
								
								Makefile.am
									
										
									
									
									
								
							
							
						
						
									
										84
									
								
								Makefile.am
									
										
									
									
									
								
							|  | @ -1,6 +1,6 @@ | |||
| ## Process this file with automake to produce Makefile.in. | ||||
| # Copyright © 2003 Dale Mellor <dale_mellor@users.sourceforge.net> | ||||
| # Copyright © 2015, 2016, 2017, 2018 Mathieu Lirzin <mthl@gnu.org> | ||||
| # Copyright © 2015, 2016, 2017, 2018, 2020 Mathieu Lirzin <mthl@gnu.org> | ||||
| # | ||||
| # This file is part of GNU Mcron. | ||||
| # | ||||
|  | @ -21,40 +21,18 @@ | |||
| ## Programs.  ## | ||||
| ## ---------- ## | ||||
| 
 | ||||
| bin_PROGRAMS = bin/mcron | ||||
| bin_SCRIPTS = bin/mcron | ||||
| noinst_SCRIPTS =  | ||||
| 
 | ||||
| if MULTI_USER | ||||
| bin_PROGRAMS += bin/crontab | ||||
| sbin_PROGRAMS = bin/cron | ||||
| bin_SCRIPTS += bin/crontab | ||||
| sbin_SCRIPTS = bin/cron | ||||
| else | ||||
| noinst_PROGRAMS = bin/cron bin/crontab | ||||
| noinst_SCRIPTS += bin/cron bin/crontab | ||||
| endif | ||||
| 
 | ||||
| AM_CPPFLAGS = \ | ||||
|   -DPACKAGE_LOAD_PATH=\"$(guilesitedir)\" \ | ||||
|   -DPACKAGE_LOAD_COMPILED_PATH=\"$(guilesitegodir)\" \ | ||||
|   -D_GNU_SOURCE | ||||
| 
 | ||||
| AM_CFLAGS = @GUILE_CFLAGS@ | ||||
| LDADD = @GUILE_LIBS@ src/libmcron.a | ||||
| 
 | ||||
| bin_mcron_SOURCES = src/mcron.c | ||||
| bin_mcron_DEPENDENCIES = $(compiled_modules) $(noinst_LIBRARIES) | ||||
| 
 | ||||
| bin_cron_SOURCES = src/cron.c | ||||
| bin_cron_DEPENDENCIES = $(compiled_modules) $(noinst_LIBRARIES) | ||||
| 
 | ||||
| bin_crontab_SOURCES = src/crontab.c | ||||
| bin_crontab_DEPENDENCIES = $(compiled_modules) $(noinst_LIBRARIES) | ||||
| 
 | ||||
| # wrapper to be used in the build environment and for running tests. | ||||
| noinst_SCRIPTS = pre-inst-env | ||||
| 
 | ||||
| # local library. | ||||
| noinst_LIBRARIES = src/libmcron.a | ||||
| src_libmcron_a_SOURCES = \ | ||||
|   src/utils.c \ | ||||
|   src/utils.h | ||||
| noinst_SCRIPTS += pre-inst-env | ||||
| 
 | ||||
| ## --------------- ## | ||||
| ## Guile modules.  ## | ||||
|  | @ -97,7 +75,7 @@ compiled_modules = \ | |||
|   $(pkgmodulego_DATA) \ | ||||
|   $(pkgscriptgo_DATA) | ||||
| 
 | ||||
| CLEANFILES = $(compiled_modules) | ||||
| CLEANFILES = $(compiled_modules) bin/crontab bin/cron bin/mcron | ||||
| DISTCLEANFILES = src/mcron/config.scm | ||||
| 
 | ||||
| # Unset 'GUILE_LOAD_COMPILED_PATH' altogether while compiling.  Otherwise, if | ||||
|  | @ -120,6 +98,25 @@ DISTCLEANFILES = src/mcron/config.scm | |||
| 	  --warn=format --warn=unbound-variable --warn=arity-mismatch \ | ||||
| 	  --target="$(host)" --output="$@" "$<" $(devnull_verbose) | ||||
| 
 | ||||
| 
 | ||||
| bin/% : src/%.in Makefile | ||||
| 	$(AM_V_GEN)$(MKDIR_P) bin ; \ | ||||
| 	  sed	-e 's,%PREFIX%,${prefix},g'				\ | ||||
| 		-e 's,%modsrcdir%,${guilesitedir},g'			\ | ||||
| 		-e 's,%modbuilddir%,${guilesitegodir},g'		\ | ||||
| 		-e 's,%localstatedir%,${localstatedir},g'		\ | ||||
| 		-e 's,%pkglibdir%,${pkglibdir},g'			\ | ||||
| 		-e 's,%sysconfdir%,${sysconfdir},g'			\ | ||||
| 		-e 's,%localedir%,${localedir},g'			\ | ||||
| 		-e 's,%VERSION%,@VERSION@,g'				\ | ||||
| 		-e 's,%PACKAGE_BUGREPORT%,@PACKAGE_BUGREPORT@,g'	\ | ||||
| 		-e 's,%PACKAGE_NAME%,@PACKAGE_NAME@,g'			\ | ||||
| 		-e 's,%PACKAGE_URL%,@PACKAGE_URL@,g'			\ | ||||
| 		-e 's,%GUILE%,$(GUILE),g'				\ | ||||
| 	   $< > $@ ; \ | ||||
| 	  chmod a+x $@ | ||||
| 
 | ||||
| 
 | ||||
| ## ------------ ## | ||||
| ## Test suite.  ## | ||||
| ## ------------ ## | ||||
|  | @ -136,10 +133,13 @@ SCM_LOG_DRIVER = \ | |||
| TESTS = \ | ||||
|   tests/basic.sh \ | ||||
|   tests/schedule.sh \ | ||||
|   tests/schedule-2.sh \ | ||||
|   tests/base.scm \ | ||||
|   tests/environment.scm \ | ||||
|   tests/job-specifier.scm \ | ||||
|   tests/redirect.scm \ | ||||
|   tests/utils.scm \ | ||||
|   tests/vixie-specification.scm \ | ||||
|   tests/vixie-time.scm | ||||
| 
 | ||||
| ## -------------- ## | ||||
|  | @ -150,6 +150,9 @@ EXTRA_DIST = \ | |||
|   bootstrap \ | ||||
|   build-aux/guix.scm \ | ||||
|   HACKING \ | ||||
|   src/cron.in \ | ||||
|   src/crontab.in \ | ||||
|   src/mcron.in \ | ||||
|   tests/init.sh \ | ||||
|   $(TESTS) | ||||
| 
 | ||||
|  | @ -160,25 +163,28 @@ EXTRA_DIST = \ | |||
| # Sed command for Transforming program names. | ||||
| transform_exe = s/$(EXEEXT)$$//;$(transform);s/$$/$(EXEEXT)/ | ||||
| 
 | ||||
| if MULTI_USER | ||||
| install-exec-hook: | ||||
| 	tcrontab=`echo crontab$(EXEEXT) | sed '$(transform_exe)'`; \ | ||||
| if MULTI_USER | ||||
| 	tcrontab=`echo crontab | sed '$(transform_exe)'`; \ | ||||
| 	chmod u+s $(DESTDIR)$(bindir)/$${tcrontab} | ||||
| 	tcron=`echo cron | sed '$(transform_exe)'`; \ | ||||
| 	chmod u+s $(DESTDIR)$(sbindir)/$${tcron} | ||||
| endif | ||||
| 	tmcron=`echo mcron | sed '$(transform_exe)'`; | ||||
| 
 | ||||
| installcheck-local: | ||||
| ## Check that only expected programs are installed and configured | ||||
| 	tmcron=`echo mcron$(EXEEXT) | sed '$(transform_exe)'`; \ | ||||
| 	tmcron=`echo mcron | sed '$(transform_exe)'`; \ | ||||
| 	test -e $(DESTDIR)$(bindir)/$${tmcron} | ||||
| if MULTI_USER | ||||
| 	tcrontab=`echo crontab$(EXEEXT) | sed '$(transform_exe)'`; \ | ||||
| 	tcrontab=`echo crontab | sed '$(transform_exe)'`; \ | ||||
| 	test -u $(DESTDIR)$(bindir)/$${tcrontab} | ||||
| 	tcron=`echo cron$(EXEEXT) | sed '$(transform_exe)'`; \ | ||||
| 	tcron=`echo cron | sed '$(transform_exe)'`; \ | ||||
| 	test -e $(DESTDIR)$(sbindir)/$${tcron} | ||||
| else !MULTI_USER | ||||
| 	tcrontab=`echo crontab$(EXEEXT) | sed '$(transform_exe)'`; \ | ||||
| 	tcrontab=`echo crontab | sed '$(transform_exe)'`; \ | ||||
| 	test ! -u $(DESTDIR)$(bindir)/$${tcrontab} | ||||
| 	tcron=`echo cron$(EXEEXT) | sed '$(transform_exe)'`; \ | ||||
| 	tcron=`echo cron | sed '$(transform_exe)'`; \ | ||||
| 	test ! -f $(DESTDIR)$(sbindir)/$${tcron} | ||||
| endif !MULTI_USER | ||||
| 
 | ||||
|  | @ -219,10 +225,10 @@ gen_man = \ | |||
|   esac | ||||
| 
 | ||||
| $(srcdir)/doc/mcron.1: src/mcron/scripts/mcron.scm bin/mcron | ||||
| 	-@prog="mcron"; man_section=1; $(gen_man) | ||||
| 	-@prog="bin/mcron"; man_section=1; $(gen_man) | ||||
| 
 | ||||
| $(srcdir)/doc/crontab.1: src/mcron/scripts/crontab.scm bin/crontab | ||||
| 	-@prog="crontab"; man_section=1; $(gen_man) | ||||
| 	-@prog="bin/crontab"; man_section=1;	 $(gen_man) | ||||
| 
 | ||||
| $(srcdir)/doc/cron.8: src/mcron/scripts/cron.scm bin/cron | ||||
| 	-@prog="cron"; man_section=8; $(gen_man) | ||||
|  |  | |||
							
								
								
									
										9
									
								
								NEWS
									
										
									
									
									
								
							
							
						
						
									
										9
									
								
								NEWS
									
										
									
									
									
								
							|  | @ -1,5 +1,14 @@ | |||
| GNU Mcron NEWS                                    -*- outline -*- | ||||
| 
 | ||||
| * Noteworthy changes in release 1.2.0 (2020-04-22) [stable] | ||||
| 
 | ||||
| ** Improvements | ||||
|   C code removed, mcron becomes 100% Guile. | ||||
|   Make doc/mcron.texi gender neutral. | ||||
|   Have src/mcron/scripts/mcron.scm (process-user-file): use read and eval | ||||
|     instead of load. | ||||
|   New tests added for extra checks. | ||||
| 
 | ||||
| * Noteworthy changes in release 1.1.4 (2020-04-12) [stable] | ||||
| 
 | ||||
| ** Improvements | ||||
|  |  | |||
|  | @ -32,16 +32,16 @@ | |||
|                 '(".git" "autom4te" "Makefile.in" ".go" ".log" | ||||
|                   "stamp-vti" ".dirstamp")) | ||||
|            (any (λ (str) (string-suffix? str file)) | ||||
|                 '("trs""configure" "Makefile" "config.status" "pre-inst-env" | ||||
|                   "aclocal.m4" "bin/cron" "bin/mcron" "bin/crontab" "config.cache" | ||||
|                   "guix.scm"))))) | ||||
|                 '("trs" "configure" "Makefile" "config.status" "pre-inst-env" | ||||
|                   "aclocal.m4" "bin/cron" "bin/mcron" "bin/crontab" | ||||
|                   "config.cache" "guix.scm"))))) | ||||
| 
 | ||||
| (define %srcdir | ||||
|   (or (current-source-directory) ".")) | ||||
| 
 | ||||
| (package | ||||
|   (inherit (specification->package "mcron")) | ||||
|   (version "1.1.4") | ||||
|   (version "1.2.0") | ||||
|   (source (local-file (dirname %srcdir) #:recursive? #t | ||||
|                       #:select? keep-mcron-file?)) | ||||
|   (inputs | ||||
|  |  | |||
							
								
								
									
										41
									
								
								configure.ac
									
										
									
									
									
								
							
							
						
						
									
										41
									
								
								configure.ac
									
										
									
									
									
								
							|  | @ -1,7 +1,7 @@ | |||
| ## Process this file with autoconf to produce a configure script. | ||||
| # Copyright © 2003, 2005, 2012, 2014 Dale Mellor | ||||
| # <dale_mellor@users.sourceforge.net> | ||||
| # Copyright © 2015, 2016, 2017, 2018 Mathieu Lirzin <mthl@gnu.org> | ||||
| # | ||||
| # Copyright © 2003, 2005, 2012, 2014 Dale Mellor <mcron-lsfnyl@rdmp.org> | ||||
| # Copyright © 2015, 2016, 2017, 2018, 2020 Mathieu Lirzin <mthl@gnu.org> | ||||
| # Copyright © 2018 宋文武 <iyzsong@member.fsf.org> | ||||
| # | ||||
| # This file is part of GNU Mcron. | ||||
|  | @ -20,35 +20,30 @@ | |||
| # along with GNU Mcron.  If not, see <http://www.gnu.org/licenses/>. | ||||
| 
 | ||||
| AC_PREREQ(2.61) | ||||
| AC_INIT([GNU Mcron], [1.1.4], [bug-mcron@gnu.org]) | ||||
| AC_CONFIG_SRCDIR([src/mcron.c]) | ||||
| AC_INIT([GNU Mcron], [1.2.0+dmbcs], [bug-mcron@gnu.org]) | ||||
| AC_CONFIG_SRCDIR([src/mcron/scripts/mcron.scm]) | ||||
| AC_CONFIG_AUX_DIR([build-aux]) | ||||
| AC_REQUIRE_AUX_FILE([test-driver.scm]) | ||||
| AM_INIT_AUTOMAKE([subdir-objects -Wall -Wno-override std-options]) | ||||
| AM_SILENT_RULES([yes])		# enables silent rules by default | ||||
| 
 | ||||
| dnl We're fine with GNU make constructs, hence '-Wno-portability'. | ||||
| AM_INIT_AUTOMAKE([1.11 gnu silent-rules subdir-objects color-tests | ||||
|                   -Wall -Wno-override -Wno-portability std-options]) | ||||
| 
 | ||||
| AM_SILENT_RULES([yes])		# Enables silent rules by default. | ||||
| 
 | ||||
| AC_CANONICAL_HOST | ||||
| AC_PROG_AWK | ||||
| AC_PROG_EGREP | ||||
| AM_PROG_CC_C_O | ||||
| AC_PROG_RANLIB | ||||
| AM_PROG_AR | ||||
| 
 | ||||
| dnl We require pkg.m4 (from pkg-config) and guile.m4 (from Guile.) | ||||
| dnl Make sure they are available when generating the configure script. | ||||
| m4_pattern_forbid([^PKG_PROG]) | ||||
| m4_pattern_forbid([^PKG_CHECK]) | ||||
| m4_pattern_forbid([^GUILE_P]) | ||||
| m4_pattern_allow([^GUILE_PKG_ERRORS]) | ||||
| 
 | ||||
| # Check for Guile development files. | ||||
| GUILE_PKG([3.0 2.2 2.0]) | ||||
| 
 | ||||
| # Set Guile flags without using GUILE_FLAGS which is requiring the unused | ||||
| # 'config.rpath' script. | ||||
| PKG_CHECK_MODULES(GUILE, [guile-$GUILE_EFFECTIVE_VERSION]) | ||||
| 
 | ||||
| # Check for 'argp' program arguments parser. | ||||
| AC_CHECK_FUNC(argp_parse, [], AC_MSG_ERROR([argp not found])) | ||||
| 
 | ||||
| # Check for non-POSIX string formatting function. | ||||
| AC_CHECK_FUNC(asprintf, [], AC_MSG_ERROR([asprintf not found])) | ||||
| 
 | ||||
| # Checks for programs. | ||||
| 
 | ||||
| GUILE_PROGS | ||||
| 
 | ||||
| AM_MISSING_PROG(HELP2MAN, help2man, $missing_dir) | ||||
|  |  | |||
|  | @ -158,10 +158,10 @@ example, take the system load into consideration. | |||
| Turns out to be easy to provide complete backwards compatibility with | ||||
| Vixie cron. | ||||
| @item | ||||
| Each user looks after his own files in his own directory.  He can use | ||||
| Each user looks after their own files in their own directory.  They can use | ||||
| more than one to break up complicated cron specifications. | ||||
| @item | ||||
| Each user can run his own daemon.  This removes the need for suid | ||||
| Each user can run their own daemon.  This removes the need for suid | ||||
| programs to manipulate the crontabs, and eliminates many security | ||||
| concerns that surround all existing cron programs. | ||||
| @item | ||||
|  | @ -516,7 +516,7 @@ second-to-last day of every month. | |||
| @emph{NOTE} that this section is definitive.  If there is a difference in | ||||
| behaviour between the mcron program and this part of the manual, then | ||||
| there is a bug in the program.  This section is also copied verbatim | ||||
| from Paul Vixie's documentation for his cron program, and his | ||||
| from Paul Vixie's documentation for their cron program, and their | ||||
| copyright notice is duly reproduced below. | ||||
| 
 | ||||
| There are three problems with this specification. | ||||
|  | @ -815,7 +815,7 @@ place in the part which implements the mcron personality. | |||
| @cindex mcron arguments | ||||
| @cindex command line, mcron | ||||
| @cindex mcron command line | ||||
| Mcron should be run by the user who wants to schedule his jobs.  It | ||||
| Mcron should be run by the user who wants to schedule their jobs.  It | ||||
| may be made a background job using the facilities of the shell.  The | ||||
| basic command is @code{mcron [OPTION ...] [file ...]}  which has the | ||||
| effect of reading all the configuration files specified (subject to | ||||
|  | @ -1026,7 +1026,7 @@ Delete the user's crontab file, and exit. | |||
| @item -e | ||||
| @item --edit | ||||
| Using the editor specified in the user's VISUAL or EDITOR environment | ||||
| variables, allow the user to edit his crontab.  Once the user exits the | ||||
| variables, allow the user to edit their crontab.  Once the user exits the | ||||
| editor, the crontab is checked for parseability, and if it is okay | ||||
| then it is installed as the user's new crontab and the daemon is | ||||
| notified that a change has taken place, so that the new file will | ||||
|  | @ -1231,7 +1231,7 @@ the mcron base. | |||
| 
 | ||||
| @deffn{Scheme procedure} remove-user-jobs user @ | ||||
|   [#:schedule @var{%global-schedule}] | ||||
| The argument @var{user} should be a string naming a user (his | ||||
| The argument @var{user} should be a string naming a user (their | ||||
| login name), or an integer UID, or an object representing the user's passwd | ||||
| entry.  All jobs on the current job list that are scheduled to be run | ||||
| under this personality are removed from the job list. | ||||
|  |  | |||
							
								
								
									
										80
									
								
								src/cron.c
									
										
									
									
									
								
							
							
						
						
									
										80
									
								
								src/cron.c
									
										
									
									
									
								
							|  | @ -1,80 +0,0 @@ | |||
| /* cron.c -- run jobs at scheduled times
 | ||||
|    Copyright © 2003, 2014 Dale Mellor <dale_mellor@users.sourceforge.net> | ||||
|    Copyright © 2015, 2016, 2017 Mathieu Lirzin <mthl@gnu.org> | ||||
| 
 | ||||
|    This file is part of GNU Mcron. | ||||
| 
 | ||||
|    GNU Mcron is free software: you can redistribute it and/or modify | ||||
|    it under the terms of the GNU General Public License as published by | ||||
|    the Free Software Foundation, either version 3 of the License, or | ||||
|    (at your option) any later version. | ||||
| 
 | ||||
|    GNU Mcron is distributed in the hope that it will be useful, | ||||
|    but WITHOUT ANY WARRANTY; without even the implied warranty of | ||||
|    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the | ||||
|    GNU General Public License for more details. | ||||
| 
 | ||||
|    You should have received a copy of the GNU General Public License | ||||
|    along with GNU Mcron.  If not, see <http://www.gnu.org/licenses/>.  */
 | ||||
| 
 | ||||
| #include "utils.h" | ||||
| #include <signal.h> | ||||
| #include <string.h> | ||||
| 
 | ||||
| /* 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[]) | ||||
| { | ||||
|   /* Set Guile load paths to ensure that Mcron modules will be found after
 | ||||
|      installation.  In a build environment let the 'pre-inst-env' script set | ||||
|      the correct paths.  */ | ||||
|   if (getenv ("MCRON_UNINSTALLED") == NULL) | ||||
|     { | ||||
|       wrap_env_path ("GUILE_LOAD_PATH", PACKAGE_LOAD_PATH); | ||||
|       wrap_env_path ("GUILE_LOAD_COMPILED_PATH", PACKAGE_LOAD_COMPILED_PATH); | ||||
|     } | ||||
| 
 | ||||
|   scm_boot_guile (argc, argv, inner_main, NULL); | ||||
| 
 | ||||
|   return EXIT_SUCCESS; | ||||
| } | ||||
| 
 | ||||
| /* Launch the Mcron Guile main program.  */ | ||||
| static void | ||||
| inner_main (void *closure, int argc, char *argv[]) | ||||
| { | ||||
|   scm_set_current_module (scm_c_resolve_module ("mcron scripts cron")); | ||||
|   scm_c_define_gsubr ("c-set-cron-signals", 0, 0, 0, set_cron_signals); | ||||
|   scm_call_0 (scm_variable_ref (scm_c_lookup ("main"))); | ||||
| } | ||||
| 
 | ||||
| /* Set up all the signal handlers.  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 cron 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); | ||||
| } | ||||
							
								
								
									
										53
									
								
								src/cron.in
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										53
									
								
								src/cron.in
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,53 @@ | |||
| #!%GUILE% --no-auto-compile | ||||
| -*- scheme -*- | ||||
| !# | ||||
| 
 | ||||
| ;;;; cron -- run jobs at scheduled times | ||||
| ;;; Copyright © 2003, 2012, 2020  Dale Mellor <mcron-lsfnyl@rdmp.org> | ||||
| ;;; Copyright © 2015, 2016, 2018  Mathieu Lirzin <mthl@gnu.org> | ||||
| ;;; | ||||
| ;;; This file is part of GNU Mcron. | ||||
| ;;; | ||||
| ;;; GNU Mcron is free software: you can redistribute it and/or modify | ||||
| ;;; it under the terms of the GNU General Public License as published by | ||||
| ;;; the Free Software Foundation, either version 3 of the License, or | ||||
| ;;; (at your option) any later version. | ||||
| ;;; | ||||
| ;;; GNU Mcron is distributed in the hope that it will be useful, | ||||
| ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||||
| ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the | ||||
| ;;; GNU General Public License for more details. | ||||
| ;;; | ||||
| ;;; You should have received a copy of the GNU General Public License | ||||
| ;;; along with GNU Mcron.  If not, see <http://www.gnu.org/licenses/>. | ||||
| 
 | ||||
| 
 | ||||
| (unless (getenv "MCRON_UNINSTALLED") | ||||
|   (set! %load-path (cons "%modsrcdir%" %load-path)) | ||||
|   (set! %load-compiled-path (cons "%modbuilddir%" %load-compiled-path))) | ||||
| 
 | ||||
| (use-modules  (mcron scripts cron) | ||||
|               (ice-9 command-line-processor)) | ||||
| 
 | ||||
| (process-command-line  (command-line) | ||||
|    application "cron" | ||||
|    version     "%VERSION%" | ||||
|    usage       "[OPTIONS]" | ||||
|    help-preamble | ||||
|  "Unless an option is specified, run a cron daemon as a detached process," | ||||
|  "reading all the information in the usersʼ crontabs and in /etc/crontab." | ||||
|    option (--schedule=8 -s string->number | ||||
|                         "display the next N (or 8) jobs that will be" | ||||
|                         "run, and exit") | ||||
|    option (--noetc -n "do not check /etc/crontab for updates (use" | ||||
|                    "of this option is HIGHLY RECOMMENDED)") | ||||
|    help-postamble | ||||
|  "Mandatory or optional arguments to long options are also mandatory or " | ||||
|  "optional for any corresponding short options." | ||||
|    bug-address "%PACKAGE_BUGREPORT%" | ||||
|    copyright | ||||
|         "2003, 2012, 2015, 2016, 2018, 2020  Free Software Foundation, Inc." | ||||
|    license     GPLv3) | ||||
| 
 | ||||
| 
 | ||||
| (main --schedule --noetc) | ||||
|  | @ -1,48 +0,0 @@ | |||
| /* crontab.c -- edit users' crontab files
 | ||||
|    Copyright © 2003, 2014 Dale Mellor <dale_mellor@users.sourceforge.net> | ||||
|    Copyright © 2015, 2016, 2017 Mathieu Lirzin <mthl@gnu.org> | ||||
| 
 | ||||
|    This file is part of GNU Mcron. | ||||
| 
 | ||||
|    GNU Mcron is free software: you can redistribute it and/or modify | ||||
|    it under the terms of the GNU General Public License as published by | ||||
|    the Free Software Foundation, either version 3 of the License, or | ||||
|    (at your option) any later version. | ||||
| 
 | ||||
|    GNU Mcron is distributed in the hope that it will be useful, | ||||
|    but WITHOUT ANY WARRANTY; without even the implied warranty of | ||||
|    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the | ||||
|    GNU General Public License for more details. | ||||
| 
 | ||||
|    You should have received a copy of the GNU General Public License | ||||
|    along with GNU Mcron.  If not, see <http://www.gnu.org/licenses/>.  */
 | ||||
| 
 | ||||
| #include "utils.h" | ||||
| 
 | ||||
| /* Forward declarations.  */ | ||||
| static void inner_main (void *closure, int argc, char *argv[]); | ||||
| 
 | ||||
| int | ||||
| main (int argc, char *argv[]) | ||||
| { | ||||
|   /* Set Guile load paths to ensure that Mcron modules will be found after
 | ||||
|      installation.  In a build environment let the 'pre-inst-env' script set | ||||
|      the correct paths.  */ | ||||
|   if (getenv ("MCRON_UNINSTALLED") == NULL) | ||||
|     { | ||||
|       wrap_env_path ("GUILE_LOAD_PATH", PACKAGE_LOAD_PATH); | ||||
|       wrap_env_path ("GUILE_LOAD_COMPILED_PATH", PACKAGE_LOAD_COMPILED_PATH); | ||||
|     } | ||||
| 
 | ||||
|   scm_boot_guile (argc, argv, inner_main, NULL); | ||||
| 
 | ||||
|   return EXIT_SUCCESS; | ||||
| } | ||||
| 
 | ||||
| /* Launch the Mcron Guile main program.  */ | ||||
| static void | ||||
| inner_main (void *closure, int argc, char *argv[]) | ||||
| { | ||||
|   scm_set_current_module (scm_c_resolve_module ("mcron scripts crontab")); | ||||
|   scm_call_0 (scm_variable_ref (scm_c_lookup ("main"))); | ||||
| } | ||||
							
								
								
									
										45
									
								
								src/crontab.in
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										45
									
								
								src/crontab.in
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,45 @@ | |||
| #!%GUILE% --no-auto-compile | ||||
| -*- scheme -*- | ||||
| !# | ||||
| 
 | ||||
| ;;;; crontab -- run jobs at scheduled times | ||||
| ;;; Copyright © 2003, 2020  Dale Mellor <mcron-lsfnyl@rdmp.org> | ||||
| ;;; Copyright © 2015, 2016, 2018  Mathieu Lirzin <mthl@gnu.org> | ||||
| ;;; | ||||
| ;;; This file is part of GNU Mcron. | ||||
| ;;; | ||||
| ;;; GNU Mcron is free software: you can redistribute it and/or modify | ||||
| ;;; it under the terms of the GNU General Public License as published by | ||||
| ;;; the Free Software Foundation, either version 3 of the License, or | ||||
| ;;; (at your option) any later version. | ||||
| ;;; | ||||
| ;;; GNU Mcron is distributed in the hope that it will be useful, | ||||
| ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||||
| ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the | ||||
| ;;; GNU General Public License for more details. | ||||
| ;;; | ||||
| ;;; You should have received a copy of the GNU General Public License | ||||
| ;;; along with GNU Mcron.  If not, see <http://www.gnu.org/licenses/>. | ||||
| 
 | ||||
| 
 | ||||
| (unless (getenv "MCRON_UNINSTALLED") | ||||
|   (set! %load-path (cons "%modsrcdir%" %load-path)) | ||||
|   (set! %load-compiled-path (cons "%modbuilddir%" %load-compiled-path))) | ||||
| 
 | ||||
| (use-modules (mcron scripts crontab) | ||||
|              (ice-9 command-line-processor)) | ||||
| 
 | ||||
| (process-command-line  (command-line) | ||||
|    application "crontab" | ||||
|    version     "%VERSION%" | ||||
|    usage       "[-u user] { -e | -l | -r }" | ||||
|    help-preamble "the default operation is to replace, per 1003.2" | ||||
|    option (--user=  -u  "the user whose files are to be manipulated") | ||||
|    option (--edit   -e  "edit this userʼs crontab") | ||||
|    option (--list   -l  "list this userʼs crontab") | ||||
|    option (--remove -r  "delete the userʼs crontab") | ||||
|    bug-address "%PACKAGE_BUGREPORT%" | ||||
|    copyright   "2003, 2016, 2020  Free Software Foundation, Inc." | ||||
|    license     GPLv3) | ||||
| 
 | ||||
| ((@ (mcron scripts crontab) main) --user --edit --list --remove --!) | ||||
							
								
								
									
										125
									
								
								src/mcron.c
									
										
									
									
									
								
							
							
						
						
									
										125
									
								
								src/mcron.c
									
										
									
									
									
								
							|  | @ -1,125 +0,0 @@ | |||
| /* mcron.c -- run jobs at scheduled times
 | ||||
|    Copyright © 2003, 2014 Dale Mellor <dale_mellor@users.sourceforge.net> | ||||
|    Copyright © 2015, 2016, 2017 Mathieu Lirzin <mthl@gnu.org> | ||||
| 
 | ||||
|    This file is part of GNU Mcron. | ||||
| 
 | ||||
|    GNU Mcron is free software: you can redistribute it and/or modify | ||||
|    it under the terms of the GNU General Public License as published by | ||||
|    the Free Software Foundation, either version 3 of the License, or | ||||
|    (at your option) any later version. | ||||
| 
 | ||||
|    GNU Mcron is distributed in the hope that it will be useful, | ||||
|    but WITHOUT ANY WARRANTY; without even the implied warranty of | ||||
|    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the | ||||
|    GNU General Public License for more details. | ||||
| 
 | ||||
|    You should have received a copy of the GNU General Public License | ||||
|    along with GNU Mcron.  If not, see <http://www.gnu.org/licenses/>.  */
 | ||||
| 
 | ||||
| #include "utils.h" | ||||
| #include <argp.h> | ||||
| #include <string.h> | ||||
| 
 | ||||
| /* Forward declarations.  */ | ||||
| static void inner_main (void *closure, int argc, char *argv[]); | ||||
| static SCM parse_args (int argc, char *argv[]); | ||||
| static error_t parse_opt (int key, char *arg, struct argp_state *state); | ||||
| 
 | ||||
| int | ||||
| main (int argc, char *argv[]) | ||||
| { | ||||
|   /* Set Guile load paths to ensure that Mcron modules will be found after
 | ||||
|      installation.  In a build environment let the 'pre-inst-env' script set | ||||
|      the correct paths.  */ | ||||
|   if (getenv ("MCRON_UNINSTALLED") == NULL) | ||||
|     { | ||||
|       wrap_env_path ("GUILE_LOAD_PATH", PACKAGE_LOAD_PATH); | ||||
|       wrap_env_path ("GUILE_LOAD_COMPILED_PATH", PACKAGE_LOAD_COMPILED_PATH); | ||||
|     } | ||||
| 
 | ||||
|   scm_boot_guile (argc, argv, inner_main, NULL); | ||||
| 
 | ||||
|   return EXIT_SUCCESS; | ||||
| } | ||||
| 
 | ||||
| /* Launch the Mcron Guile main program.  */ | ||||
| static void | ||||
| inner_main (void *closure, int argc, char *argv[]) | ||||
| { | ||||
|   SCM config = parse_args (argc, argv); | ||||
|   scm_set_current_module (scm_c_resolve_module ("mcron scripts mcron")); | ||||
|   scm_call_1 (scm_variable_ref (scm_c_lookup ("main")), config); | ||||
| } | ||||
| 
 | ||||
| /* Handle command line arguments.  */ | ||||
| static SCM | ||||
| parse_args (int argc, char *argv[]) | ||||
| { | ||||
|   static struct argp_option options[] = { | ||||
|     {"schedule", 's', "N", 0, | ||||
|      "Display the next N jobs that will be run"}, | ||||
|     {"daemon", 'd', 0, 0, | ||||
|      "Run as a daemon process"}, | ||||
|     {"stdin", 'i', "FORMAT", 0, | ||||
|      "Format of data passed as standard input or file arguments (default guile)"}, | ||||
|     {0, 0, 0, 0, 0} | ||||
|   }; | ||||
| 
 | ||||
|   static struct argp argp = { | ||||
|     .options = options, | ||||
|     .parser = parse_opt, | ||||
|     .args_doc = "[FILE...]", | ||||
|     .doc = "Run an mcron process according to the specifications in the " | ||||
|     "FILE... (`-' for standard input), or use all the files in " | ||||
|     "~/.config/cron (or the deprecated ~/.cron) with .guile or " | ||||
|     ".vixie extensions." | ||||
|   }; | ||||
| 
 | ||||
|   SCM config = SCM_EOL; | ||||
|   argp_program_version = PACKAGE_STRING; | ||||
|   argp_program_bug_address = PACKAGE_BUGREPORT; | ||||
|   argp_parse (&argp, argc, argv, 0, NULL, &config); | ||||
| 
 | ||||
|   return config; | ||||
| } | ||||
| 
 | ||||
| static error_t | ||||
| parse_opt (int key, char *arg, struct argp_state *state) | ||||
| { | ||||
|   SCM *config = state->input; | ||||
| 
 | ||||
|   switch (key) | ||||
|     { | ||||
|     case 's': | ||||
|       assq_symbol_set_x (config, "schedule", | ||||
|                          scm_from_int (atoi (arg))); | ||||
|       break; | ||||
|     case 'd': | ||||
|       assq_symbol_set_x (config, "daemon", SCM_BOOL_T); | ||||
|       break; | ||||
|     case 'i': | ||||
|       if (strncmp (arg, "vixie", 6) == 0) | ||||
|         assq_symbol_set_x (config, "vixie", SCM_BOOL_T); | ||||
|       break; | ||||
|     case ARGP_KEY_NO_ARGS: | ||||
|       assq_symbol_set_x (config, "files", SCM_EOL); | ||||
|       break; | ||||
|     case ARGP_KEY_ARGS: | ||||
|       { | ||||
|         SCM lst = SCM_EOL; | ||||
|         int filec = state->argc - state->next; | ||||
|         char **filev = state->argv + state->next; | ||||
| 
 | ||||
|         for (int i = filec - 1; i >= 0; i--) | ||||
|           lst = scm_cons (scm_from_locale_string (filev[i]), lst); | ||||
| 
 | ||||
|         assq_symbol_set_x (config, "files", lst); | ||||
|         break; | ||||
|       } | ||||
|     case ARGP_KEY_ARG: | ||||
|     default: | ||||
|       return ARGP_ERR_UNKNOWN; | ||||
|     } | ||||
|   return 0; | ||||
| } | ||||
							
								
								
									
										56
									
								
								src/mcron.in
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										56
									
								
								src/mcron.in
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,56 @@ | |||
| #!%GUILE% --no-auto-compile | ||||
| -*- scheme -*- | ||||
| !# | ||||
| 
 | ||||
| ;;;; mcron -- run jobs at scheduled times | ||||
| ;;; Copyright © 2003, 2012, 2020  Dale Mellor <mcron-lsfnyl@rdmp.org> | ||||
| ;;; Copyright © 2015, 2016, 2018  Mathieu Lirzin <mthl@gnu.org> | ||||
| ;;; | ||||
| ;;; This file is part of GNU Mcron. | ||||
| ;;; | ||||
| ;;; GNU Mcron is free software: you can redistribute it and/or modify | ||||
| ;;; it under the terms of the GNU General Public License as published by | ||||
| ;;; the Free Software Foundation, either version 3 of the License, or | ||||
| ;;; (at your option) any later version. | ||||
| ;;; | ||||
| ;;; GNU Mcron is distributed in the hope that it will be useful, | ||||
| ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||||
| ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the | ||||
| ;;; GNU General Public License for more details. | ||||
| ;;; | ||||
| ;;; You should have received a copy of the GNU General Public License | ||||
| ;;; along with GNU Mcron.  If not, see <http://www.gnu.org/licenses/>. | ||||
| 
 | ||||
| 
 | ||||
| (unless (getenv "MCRON_UNINSTALLED") | ||||
|   (set! %load-path (cons "%modsrcdir%" %load-path)) | ||||
|   (set! %load-compiled-path (cons "%modbuilddir%" %load-compiled-path))) | ||||
| 
 | ||||
| (use-modules  (mcron scripts mcron) | ||||
|               (ice-9 command-line-processor)) | ||||
| 
 | ||||
| (process-command-line  (command-line) | ||||
|        application   "mcron" | ||||
|        version       "%VERSION%" | ||||
|        usage         "[OPTIONS ...] [FILES ...]" | ||||
|        help-preamble | ||||
|   "Run unattended jobs according to instructions in the FILES... " | ||||
|   "(`-' for standard input), or use all the files in ~/.config/cron " | ||||
|   "(or the deprecated ~/.cron) with .guile or .vixie extensions.\n" | ||||
|   "Note that --daemon and --schedule are mutually exclusive." | ||||
|        option  (--daemon  -d  "run as a daemon process") | ||||
|        option  (--schedule=8  -s  string->number | ||||
|                       "display the next N (or 8) jobs that will be run," | ||||
|                       "and then exit") | ||||
|        option  (--stdin=guile  short-i  (λ (in) (or (string=? in "guile") | ||||
|                                                     (string=? in "vixie"))) | ||||
|                       "format of data passed as standard input or file " | ||||
|                       "arguments, 'guile' or 'vixie' (default guile)") | ||||
|        help-postamble | ||||
|   "Mandatory or optional arguments to long options are also mandatory or " | ||||
|   "optional for any corresponding short options." | ||||
|        bug-address "%PACKAGE_BUGREPORT%" | ||||
|        copyright   "2003, 2006, 2014, 2020  Free Software Foundation, Inc." | ||||
|        license     GPLv3) | ||||
| 
 | ||||
| (main --daemon --schedule --stdin --!) | ||||
|  | @ -139,7 +139,7 @@ entries that are to run at this time.  When SCHEDULE is empty next time is | |||
| (define* (display-schedule count #:optional (port (current-output-port)) | ||||
|                            #:key (schedule %global-schedule)) | ||||
|   "Display on PORT a textual list of the next COUNT jobs to run.  This | ||||
| simulates the run of the job loop to display the resquested information. | ||||
| simulates the run of the job loop to display the requested information. | ||||
| Since calling this procedure has the effect of mutating the job timings, the | ||||
| program must exit after.  Otherwise the internal data state will be left | ||||
| unusable." | ||||
|  |  | |||
|  | @ -202,14 +202,14 @@ go into the list.  For example, (range 1 6 2) returns '(1 3 5)." | |||
| ;; 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 parameter object). A similar normalization is applied to | ||||
| ;; the action. | ||||
| ;; 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 parameter object). 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 | ||||
|  | @ -229,7 +229,8 @@ go into the list.  For example, (range 1 6 2) returns '(1 3 5)." | |||
|          (cond ((procedure? time-proc) time-proc) | ||||
|                ((string? time-proc)    (parse-vixie-time time-proc)) | ||||
|                ((list? time-proc)      (lambda (current-time) | ||||
|                                          (primitive-eval time-proc))) | ||||
|                                          (eval time-proc | ||||
|                                (resolve-module '(mcron job-specifier))))) | ||||
|                (else | ||||
|                 (throw 'mcron-error 3 | ||||
|                        "job: invalid first argument (next-time-function; " | ||||
|  |  | |||
|  | @ -1,5 +1,6 @@ | |||
| ;;;; redirect.scm -- modify job outputs | ||||
| ;;; Copyright © 2003 Dale Mellor <dale_mellor@users.sourceforge.net> | ||||
| ;;; Copyright © 2020 Mathieu Lirzin <mthl@gnu.org> | ||||
| ;;; Copyright © 2018 宋文武 <iyzsong@member.fsf.org> | ||||
| ;;; | ||||
| ;;; This file is part of GNU Mcron. | ||||
|  | @ -63,7 +64,10 @@ | |||
| ;; the string, and output (including the error output) being sent to a pipe | ||||
| ;; opened on a mail transport. | ||||
| 
 | ||||
| (define (with-mail-out action . user) | ||||
| (define* (with-mail-out action #:optional user #:key | ||||
|                         (hostname (gethostname)) | ||||
|                         (out (lambda () | ||||
|                                (open-output-pipe config-sendmail)))) | ||||
| 
 | ||||
|   ;; 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 | ||||
|  | @ -72,7 +76,7 @@ | |||
| 
 | ||||
|   (let* ((mailto (getenv "MAILTO")) | ||||
|          (user (cond (mailto mailto) | ||||
|                      ((not (null? user)) (car user)) | ||||
|                      (user user) | ||||
|                      (else (getenv "LOGNAME")))) | ||||
|          (parent->child (pipe)) | ||||
|          (child->parent (pipe)) | ||||
|  | @ -173,11 +177,11 @@ | |||
|                                        (open-output-file "/dev/null") | ||||
|                                        ;; The sendmail command should read | ||||
|                                        ;; recipients from the message header. | ||||
|                                        (open-output-pipe config-sendmail))) | ||||
|                                        (out))) | ||||
|           (set-current-input-port (car child->parent)) | ||||
|           (display "To: ") (display user) (newline) | ||||
|           (display "From: mcron") (newline) | ||||
|           (display (string-append "Subject: " user "@" (gethostname))) | ||||
|           (display (string-append "Subject: " user "@" hostname)) | ||||
|           (newline) | ||||
|           (newline) | ||||
| 
 | ||||
|  |  | |||
|  | @ -17,8 +17,8 @@ | |||
| ;;; You should have received a copy of the GNU General Public License | ||||
| ;;; along with GNU Mcron.  If not, see <http://www.gnu.org/licenses/>. | ||||
| 
 | ||||
| 
 | ||||
| (define-module (mcron scripts cron) | ||||
|   #:use-module (ice-9 getopt-long) | ||||
|   #:use-module (ice-9 ftw) | ||||
|   #:use-module (mcron base) | ||||
|   #:use-module (mcron config) | ||||
|  | @ -28,25 +28,7 @@ | |||
|   #:use-module (srfi srfi-2) | ||||
|   #:export (main)) | ||||
| 
 | ||||
| (define (show-help) | ||||
|   (display "Usage: cron [OPTIONS] | ||||
| Unless an option is specified, run a cron daemon as a detached process, | ||||
| reading all the information in the users' crontabs and in /etc/crontab. | ||||
| 
 | ||||
|   -v, --version             Display version | ||||
|   -h, --help                Display this help message | ||||
|   -sN, --schedule[=]N       Display the next N jobs that will be run by cron | ||||
|   -n, --noetc               Do not check /etc/crontab for updates (HIGHLY | ||||
|                               RECOMMENDED).") | ||||
|   (newline) | ||||
|   (show-package-information)) | ||||
| 
 | ||||
| (define %options | ||||
|   `((schedule (single-char #\s) (value #t) | ||||
|               (predicate ,(λ (str) (string->number str)))) | ||||
|     (noetc    (single-char #\n) (value #f)) | ||||
|     (version  (single-char #\v) (value #f)) | ||||
|     (help     (single-char #\h) (value #f)))) | ||||
| 
 | ||||
| (define (delete-run-file) | ||||
|   "Remove the /var/run/cron.pid file so that crontab and other invocations of | ||||
|  | @ -60,6 +42,8 @@ received." | |||
|     noop) | ||||
|   (quit)) | ||||
| 
 | ||||
| 
 | ||||
| 
 | ||||
| (define (cron-file-descriptors) | ||||
|   "Establish a socket to listen for updates from a crontab program, and return | ||||
| a list containing the file descriptors correponding to the files read by | ||||
|  | @ -74,6 +58,8 @@ crontab.  This requires that command-type is 'cron." | |||
|       (delete-file config-pid-file) | ||||
|       (mcron-error 1 "Cannot bind to UNIX socket " config-socket-file)))) | ||||
| 
 | ||||
| 
 | ||||
| 
 | ||||
| (define (process-files-in-system-directory) | ||||
|   "Process all the files in the crontab directory.  When the job procedure is | ||||
| run on behalf of the configuration files, the jobs are registered on the | ||||
|  | @ -97,15 +83,9 @@ operation.  The permissions on the /var/cron/tabs directory enforce this." | |||
|       (mcron-error 4 | ||||
|         "You do not have permission to access the system crontabs.")))) | ||||
| 
 | ||||
| (define (%process-files schedule? noetc?) | ||||
|   ;; XXX: What is this supposed to do? | ||||
|   (when schedule? | ||||
|     (with-output-to-file config-pid-file noop)) | ||||
| (define (%process-files noetc?) | ||||
|   ;; Clear MAILTO so that outputs are sent to the various users. | ||||
|   (setenv "MAILTO" #f) | ||||
|   ;; XXX: At compile time, this yields a "possibly unbound variable" warning, | ||||
|   ;; but this is OK since it is bound in the C wrapper. | ||||
|   (c-set-cron-signals) | ||||
|   ;; Having defined all the necessary procedures for scanning various sets of | ||||
|   ;; files, we perform the actual configuration of the program depending on | ||||
|   ;; the personality we are running as. If it is mcron, we either scan the | ||||
|  | @ -134,18 +114,10 @@ option.\n") | |||
| ;;; Entry point. | ||||
| ;;; | ||||
| 
 | ||||
| (define* (main #:optional (args (command-line))) | ||||
|   (let ((opts (getopt-long args %options))) | ||||
|     (when config-debug | ||||
|       (debug-enable 'backtrace)) | ||||
|     (cond | ||||
|      ((option-ref opts 'help #f) | ||||
|       (show-help) | ||||
|       (exit 0)) | ||||
|      ((option-ref opts 'version #f) | ||||
|       (show-version "cron") | ||||
|       (exit 0)) | ||||
|      ((not (zero? (getuid))) | ||||
| (define (main --schedule --noetc) | ||||
|     (when  config-debug  (debug-enable 'backtrace)) | ||||
| 
 | ||||
|     (cond  ((not (zero? (getuid))) | ||||
|                (mcron-error 16 | ||||
|                    "This program must be run by the root user (and should" | ||||
|                    " have been installed as such).")) | ||||
|  | @ -155,19 +127,31 @@ option.\n") | |||
|                    " this is not true, remove the file\n   " | ||||
|                    config-pid-file ".)")) | ||||
|            (else | ||||
|       (%process-files (option-ref opts 'schedule #f) | ||||
|                       (option-ref opts 'noetc #f)) | ||||
|       (cond ((option-ref opts 'schedule #f) ;display jobs schedule | ||||
|                (cond (--schedule | ||||
|                       => (λ (count) | ||||
|                            (display-schedule (max 1 (string->number count))) | ||||
|                   (exit 0))) | ||||
|             (else (case (primitive-fork) ;run the daemon | ||||
|                     ((0) | ||||
|                            (exit 0)))) | ||||
|                (%process-files --noetc))) | ||||
| 
 | ||||
|   ;; Daemonize ourself. | ||||
|   (unless  (eq? 0 (primitive-fork))  (exit 0)) | ||||
|   (setsid) | ||||
|                      ;; we can now write the PID file. | ||||
| 
 | ||||
|   ;; Set up process signal handlers, as signals are the only way to terminate | ||||
|   ;; the daemon and we MUST be graceful in defeat. | ||||
|   (for-each   (λ (x)  (sigaction  x | ||||
|                           (λ (sig)  (catch #t | ||||
|                                            (λ () | ||||
|                                              (delete-file config-pid-file) | ||||
|                                              (delete-file config-socket-file)) | ||||
|                                            noop) | ||||
|                              (exit EXIT_FAILURE)))) | ||||
|                 '(SIGTERM SIGINT SIGQUIT SIGHUP)) | ||||
| 
 | ||||
|   ;; We can now write the PID file. | ||||
|   (with-output-to-file  config-pid-file | ||||
|                        (λ () (display (getpid)) (newline)))) | ||||
|                     (else (exit 0))))) | ||||
|                         (λ () (display (getpid)) (newline))) | ||||
| 
 | ||||
|   ;; Forever execute the 'run-job-loop', and when it drops out (can | ||||
|   ;; only be because a message has come in on the socket) we | ||||
|   ;; process the socket request before restarting the loop again. | ||||
|  | @ -175,5 +159,4 @@ option.\n") | |||
|    (let ((fdes-list (cron-file-descriptors))) | ||||
|      (while #t | ||||
|        (run-job-loop fdes-list) | ||||
|            (unless (null? fdes-list) | ||||
|              (process-update-request fdes-list))))))))) | ||||
|        (unless (null? fdes-list) (process-update-request fdes-list)))))) | ||||
|  |  | |||
|  | @ -1,5 +1,5 @@ | |||
| ;;;; crontab -- edit user's cron tabs | ||||
| ;;; Copyright © 2003, 2004 Dale Mellor <dale_mellor@users.sourceforge.net> | ||||
| ;;; Copyright © 2003, 2004 Dale Mellor <> | ||||
| ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org> | ||||
| ;;; | ||||
| ;;; This file is part of GNU Mcron. | ||||
|  | @ -18,31 +18,12 @@ | |||
| ;;; along with GNU Mcron.  If not, see <http://www.gnu.org/licenses/>. | ||||
| 
 | ||||
| (define-module (mcron scripts crontab) | ||||
|   #:use-module (ice-9 getopt-long) | ||||
|   #:use-module (ice-9 rdelim) | ||||
|   #:use-module (mcron config) | ||||
|   #:use-module (mcron utils) | ||||
|   #:use-module (mcron vixie-specification) | ||||
|   #:export (main)) | ||||
| 
 | ||||
| (define* (show-help) | ||||
|   (display "Usage: crontab [-u user] file | ||||
|        crontab [-u user] { -e | -l | -r } | ||||
|                (default operation is replace, per 1003.2) | ||||
|        -e      (edit user's crontab) | ||||
|        -l      (list user's crontab) | ||||
|        -r      (delete user's crontab") | ||||
|   (newline) | ||||
|   (show-package-information)) | ||||
| 
 | ||||
| (define %options | ||||
|   '((user     (single-char #\u) (value #t)) | ||||
|     (edit     (single-char #\e) (value #f)) | ||||
|     (list     (single-char #\l) (value #f)) | ||||
|     (remove   (single-char #\r) (value #f)) | ||||
|     (version  (single-char #\v) (value #f)) | ||||
|     (help     (single-char #\h) (value #f)))) | ||||
| 
 | ||||
| (define (hit-server user-name) | ||||
|   "Tell the running cron daemon that the user corresponding to | ||||
| USER-NAME has modified his crontab.  USER-NAME is written to the | ||||
|  | @ -56,6 +37,25 @@ USER-NAME has modified his crontab.  USER-NAME is written to the | |||
|     (lambda (key . args) | ||||
|       (display "Warning: a cron daemon is not running.\n")))) | ||||
| 
 | ||||
| 
 | ||||
| 
 | ||||
| ;; Display the prompt and wait for user to type his choice. Return #t if the | ||||
| ;; answer begins with 'y' or 'Y', return #f if it begins with 'n' or 'N', | ||||
| ;; otherwise ask again. | ||||
| (define  (get-yes-no prompt . re-prompt) | ||||
|   (unless (null? re-prompt) | ||||
|       (display "Please answer y or n.\n")) | ||||
|   (display (string-append prompt " ")) | ||||
|   (let ((r (read-line))) | ||||
|     (if (not (string-null? r)) | ||||
|         (case (string-ref r 0) | ||||
|               ((#\y #\Y) #t) | ||||
|               ((#\n #\N) #f) | ||||
|               (else (get-yes-no prompt #t))) | ||||
|       (get-yes-no prompt #t)))) | ||||
| 
 | ||||
| 
 | ||||
| 
 | ||||
| (define (in-access-file? file name) | ||||
|   "Scan FILE which should contain one user name per line (such as | ||||
| '/var/cron/allow' and '/var/cron/deny').  Return #t if NAME is in there, and | ||||
|  | @ -78,16 +78,8 @@ USER-NAME has modified his crontab.  USER-NAME is written to the | |||
| ;;; Entry point. | ||||
| ;;; | ||||
| 
 | ||||
| (define* (main #:optional (args (command-line))) | ||||
|   (let ((opts (getopt-long args %options))) | ||||
|     (when config-debug | ||||
|       (debug-enable 'backtrace)) | ||||
|     (cond ((option-ref opts 'help #f) | ||||
|            (show-help) | ||||
|            (exit 0)) | ||||
|           ((option-ref opts 'version #f) | ||||
|            (show-version "crontab") | ||||
|            (exit 0))) | ||||
| (define (main --user --edit --list --remove files) | ||||
|   (when config-debug  (debug-enable 'backtrace)) | ||||
|   (let ((crontab-real-user | ||||
|          ;; This program should have been installed SUID root. Here we get | ||||
|          ;; the passwd entry for the real user who is running this program. | ||||
|  | @ -101,37 +93,19 @@ USER-NAME has modified his crontab.  USER-NAME is written to the | |||
| 
 | ||||
|     ;; Check that no more than one of the mutually exclusive options are | ||||
|     ;; being used. | ||||
|       (when (> (+ (if (option-ref opts 'edit #f) 1 0) | ||||
|                   (if (option-ref opts 'list #f) 1 0) | ||||
|                   (if (option-ref opts 'remove #f) 1 0)) | ||||
|                1) | ||||
|       (when (<  1  (+ (if --edit 1 0) (if --list 1 0) (if --remove 1 0))) | ||||
|         (mcron-error 7 "Only one of options -e, -l or -r can be used.")) | ||||
| 
 | ||||
|       ;; Check that a non-root user is trying to read someone else's files. | ||||
|       (when (and (not (zero? (getuid))) | ||||
|                  (option-ref opts 'user #f)) | ||||
|       (when (and (not (zero? (getuid))) --user) | ||||
|         (mcron-error 8 "Only root can use the -u option.")) | ||||
| 
 | ||||
|       (letrec* (;; Iff the --user option is given, the crontab-user may be | ||||
|                 ;; different from the real user. | ||||
|                 (crontab-user (option-ref opts 'user crontab-real-user)) | ||||
|                 (crontab-user (or --user crontab-real-user)) | ||||
|                 ;; So now we know which crontab file we will be manipulating. | ||||
|                 (crontab-file (string-append config-spool-dir "/" crontab-user)) | ||||
|                 ;; Display the prompt and wait for user to type his | ||||
|                 ;; choice. Return #t if the answer begins with 'y' or 'Y', | ||||
|                 ;; return #f if it begins with 'n' or 'N', otherwise ask | ||||
|                 ;; again. | ||||
|                 (get-yes-no (λ (prompt . re-prompt) | ||||
|                               (if (not (null? re-prompt)) | ||||
|                                   (display "Please answer y or n.\n")) | ||||
|                               (display (string-append prompt " ")) | ||||
|                               (let ((r (read-line))) | ||||
|                                 (if (not (string-null? r)) | ||||
|                                     (case (string-ref r 0) | ||||
|                                       ((#\y #\Y) #t) | ||||
|                                       ((#\n #\N) #f) | ||||
|                                       (else (get-yes-no prompt #t))) | ||||
|                                     (get-yes-no prompt #t)))))) | ||||
|                 (crontab-file | ||||
|                          (string-append config-spool-dir "/" crontab-user))) | ||||
|         ;; 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). | ||||
|  | @ -140,7 +114,7 @@ USER-NAME has modified his crontab.  USER-NAME is written to the | |||
|          ;; character-by-character to the standard output. If anything goes | ||||
|          ;; wrong, it can only mean that this user does not have a crontab | ||||
|          ;; file. | ||||
|          ((option-ref opts 'list #f) | ||||
|          (--list | ||||
|           (catch #t | ||||
|             (λ () | ||||
|               (with-input-from-file crontab-file | ||||
|  | @ -163,7 +137,7 @@ USER-NAME has modified his crontab.  USER-NAME is written to the | |||
|          ;; cron daemon up, and remove the temporary file. If the parse fails, | ||||
|          ;; we give user a choice of editing the file again or quitting the | ||||
|          ;; program and losing all changes made. | ||||
|          ((option-ref opts 'edit #f) | ||||
|          (--edit | ||||
|           (let ((temp-file (string-append config-tmp-dir | ||||
|                                           "/crontab." | ||||
|                                           (number->string (getpid))))) | ||||
|  | @ -191,10 +165,7 @@ USER-NAME has modified his crontab.  USER-NAME is written to the | |||
| 
 | ||||
|          ;; In the remove personality we simply make an effort to delete the | ||||
|          ;; crontab and wake the daemon. No worries if this fails. | ||||
|          ((option-ref opts 'remove #f) | ||||
|           (catch #t | ||||
|             (λ () | ||||
|               (delete-file crontab-file) | ||||
|          (--remove (catch #t (λ ()  (delete-file crontab-file) | ||||
|                                     (hit-server crontab-user)) | ||||
|                           noop)) | ||||
| 
 | ||||
|  | @ -206,8 +177,8 @@ USER-NAME has modified his crontab.  USER-NAME is written to the | |||
|          ;; location; we deal with the standard input in the same way but | ||||
|          ;; different. :-) In either case the server is woken so that it will | ||||
|          ;; read the newly installed crontab. | ||||
|          ((not (null? (option-ref opts '() '()))) | ||||
|           (let ((input-file (car (option-ref opts '() '())))) | ||||
|          ((not (null? files)) | ||||
|           (let ((input-file (car files))) | ||||
|             (catch-mcron-error | ||||
|              (if (string=? input-file "-") | ||||
|                  (let ((input-string (read-string))) | ||||
|  | @ -222,4 +193,4 @@ USER-NAME has modified his crontab.  USER-NAME is written to the | |||
|          ;; The user is being silly. The message here is identical to the one | ||||
|          ;; Vixie cron used to put out, for total compatibility. | ||||
|          (else (mcron-error 15 | ||||
|                  "usage error: file name must be specified for replace."))))))) | ||||
|                  "usage error: file name must be specified for replace.")))))) | ||||
|  |  | |||
|  | @ -1,5 +1,5 @@ | |||
| ;;;; mcron -- run jobs at scheduled times | ||||
| ;;; Copyright © 2003, 2012 Dale Mellor <dale_mellor@users.sourceforge.net> | ||||
| ;;; Copyright © 2003, 2012, 2020  Dale Mellor <> | ||||
| ;;; Copyright © 2015, 2016, 2018  Mathieu Lirzin <mthl@gnu.org> | ||||
| ;;; | ||||
| ;;; This file is part of GNU Mcron. | ||||
|  | @ -19,13 +19,17 @@ | |||
| 
 | ||||
| (define-module (mcron scripts mcron) | ||||
|   #:use-module (ice-9 ftw) | ||||
|   #:use-module (ice-9 local-eval) | ||||
|   #:use-module (ice-9 rdelim) | ||||
|   #:use-module (mcron base) | ||||
|   #:use-module (mcron config) | ||||
|   #:use-module (mcron job-specifier)    ;for user/system files | ||||
|   #:use-module (mcron job-specifier)    ; For user/system files. | ||||
|   #:use-module (mcron utils) | ||||
|   #:use-module (mcron vixie-specification) | ||||
|   #:export (main)) | ||||
| 
 | ||||
| 
 | ||||
| 
 | ||||
| (define process-user-file | ||||
|   (let ((guile-regexp (make-regexp "\\.gui(le)?$")) | ||||
|         (vixie-regexp (make-regexp "\\.vix(ie)?$"))) | ||||
|  | @ -36,12 +40,16 @@ silently ignored." | |||
|       (cond ((string=? "-" file-name) | ||||
|                   (if (string=? input "vixie") | ||||
|                       (read-vixie-port (current-input-port)) | ||||
|                  (eval-string (read-string)))) | ||||
|                       (eval-string (read-string) | ||||
|                                    (resolve-module '(mcron job-specifier))))) | ||||
|             ((or guile-syntax? (regexp-exec guile-regexp file-name)) | ||||
|              (load file-name)) | ||||
|                   (eval-string (read-delimited "" (open-input-file file-name)) | ||||
|                                (resolve-module '(mcron job-specifier)))) | ||||
|             ((regexp-exec vixie-regexp file-name) | ||||
|                   (read-vixie-file file-name)))))) | ||||
| 
 | ||||
| 
 | ||||
| 
 | ||||
| (define (process-files-in-user-directory input-type) | ||||
|   "Process files in $XDG_CONFIG_HOME/cron and/or ~/.cron directories (if | ||||
| $XDG_CONFIG_HOME is not defined uses ~/.config/cron instead)." | ||||
|  | @ -64,6 +72,8 @@ $XDG_CONFIG_HOME is not defined uses ~/.config/cron instead)." | |||
|       (mcron-error 13 | ||||
|         "Cannot read files in your ~/.config/cron (or ~/.cron) directory.")))) | ||||
| 
 | ||||
| 
 | ||||
| 
 | ||||
| (define (%process-files files input-type) | ||||
|   (if (null? files) | ||||
|       (process-files-in-user-directory input-type) | ||||
|  | @ -74,25 +84,21 @@ $XDG_CONFIG_HOME is not defined uses ~/.config/cron instead)." | |||
| ;;; Entry point. | ||||
| ;;; | ||||
| 
 | ||||
| (define* (main #:optional (opts '())) | ||||
|   (when config-debug | ||||
|     (debug-enable 'backtrace)) | ||||
| (define (main --daemon --schedule --stdin file-list) | ||||
| 
 | ||||
|   (%process-files (or (assq-ref opts 'files) '()) | ||||
|                   (if (assq-ref opts 'vixie) "vixie" "guile")) | ||||
| 
 | ||||
|   (cond ((assq-ref opts 'schedule) ;display jobs schedule | ||||
|     (when  config-debug  (debug-enable 'backtrace)) | ||||
|     (%process-files   file-list   (or --stdin "guile")) | ||||
|     (cond (--schedule | ||||
|                => (λ (count) | ||||
|               (display-schedule (max 1 count)) | ||||
|                      (display-schedule | ||||
|                         (max 1 (inexact->exact (floor (string->number count))))) | ||||
|                      (exit 0))) | ||||
|         ((assq-ref opts 'daemon) ;run mcron as a daemon | ||||
|          (case (primitive-fork) | ||||
|            ((0)  (setsid)) | ||||
|           (--daemon   (case (primitive-fork)  ((0)  (setsid)) | ||||
|                                               (else (exit 0))))) | ||||
| 
 | ||||
|   ;; Forever execute the 'run-job-loop', and when it drops out (can | ||||
|   ;; only be because a message has come in on the socket) we process | ||||
|   ;; the socket request before restarting the loop again. | ||||
|     ;; Forever execute the 'run-job-loop', and when it drops out (can only be | ||||
|     ;; because a message has come in on the socket) we process the socket | ||||
|     ;; request before restarting the loop again. | ||||
|     (catch-mcron-error | ||||
|      (let ((fdes-list '())) | ||||
|        (while #t | ||||
|  |  | |||
|  | @ -1,6 +1,6 @@ | |||
| ;;;; vixie-time.scm -- parse Vixie-style times | ||||
| ;;; Copyright © 2003 Dale Mellor <dale_mellor@users.sourceforge.net> | ||||
| ;;; Copyright © 2018 Mathieu Lirzin <mthl@gnu.org> | ||||
| ;;; Copyright © 2018, 2020 Mathieu Lirzin <mthl@gnu.org> | ||||
| ;;; | ||||
| ;;; This file is part of GNU Mcron. | ||||
| ;;; | ||||
|  | @ -360,7 +360,7 @@ accounted for." | |||
|                                    (time-spec:list wday) | ||||
|                                    (tm:mon time) | ||||
|                                    (tm:year time))))) | ||||
|              (nudge-day! (pk time) (pk (cddr time-spec-list))) | ||||
|              (nudge-day! time (cddr time-spec-list)) | ||||
|              (set-tm:hour time -1)) | ||||
|            (unless (member (tm:hour time) | ||||
|                            (time-spec:list hour)) | ||||
|  |  | |||
							
								
								
									
										48
									
								
								src/utils.c
									
										
									
									
									
								
							
							
						
						
									
										48
									
								
								src/utils.c
									
										
									
									
									
								
							|  | @ -1,48 +0,0 @@ | |||
| /* utils.c -- Utility functions.
 | ||||
|    Copyright © 2017 Mathieu Lirzin <mthl@gnu.org> | ||||
| 
 | ||||
|    This file is part of GNU Mcron. | ||||
| 
 | ||||
|    GNU Mcron is free software: you can redistribute it and/or modify | ||||
|    it under the terms of the GNU General Public License as published by | ||||
|    the Free Software Foundation, either version 3 of the License, or | ||||
|    (at your option) any later version. | ||||
| 
 | ||||
|    GNU Mcron is distributed in the hope that it will be useful, | ||||
|    but WITHOUT ANY WARRANTY; without even the implied warranty of | ||||
|    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the | ||||
|    GNU General Public License for more details. | ||||
| 
 | ||||
|    You should have received a copy of the GNU General Public License | ||||
|    along with GNU Mcron.  If not, see <http://www.gnu.org/licenses/>.  */
 | ||||
| 
 | ||||
| #include "utils.h" | ||||
| #include <stdbool.h> | ||||
| #include <stdio.h> | ||||
| 
 | ||||
| void | ||||
| wrap_env_path (const char *envar, const char *dir) | ||||
| { | ||||
|   const char *path = getenv (envar); | ||||
|   if (path == NULL) | ||||
|     setenv (envar, dir, true); | ||||
|   else | ||||
|     { | ||||
|       char *new_path; | ||||
|       int ret = asprintf (&new_path, "%s:%s", dir, path); | ||||
|       if (ret >= 0) | ||||
|         setenv (envar, new_path, true); | ||||
|       else | ||||
|         { | ||||
|           perror (envar); | ||||
|           exit (EXIT_FAILURE); | ||||
|         } | ||||
|       free (new_path); | ||||
|     } | ||||
| } | ||||
| 
 | ||||
| void | ||||
| assq_symbol_set_x (SCM *alst, const char *symbol, SCM val) | ||||
| { | ||||
|   *alst = scm_assq_set_x (*alst, scm_from_utf8_symbol (symbol), val); | ||||
| } | ||||
							
								
								
									
										33
									
								
								src/utils.h
									
										
									
									
									
								
							
							
						
						
									
										33
									
								
								src/utils.h
									
										
									
									
									
								
							|  | @ -1,33 +0,0 @@ | |||
| /* utils.h -- Utility functions.
 | ||||
|    Copyright © 2017 Mathieu Lirzin <mthl@gnu.org> | ||||
| 
 | ||||
|    This file is part of GNU Mcron. | ||||
| 
 | ||||
|    GNU Mcron is free software: you can redistribute it and/or modify | ||||
|    it under the terms of the GNU General Public License as published by | ||||
|    the Free Software Foundation, either version 3 of the License, or | ||||
|    (at your option) any later version. | ||||
| 
 | ||||
|    GNU Mcron is distributed in the hope that it will be useful, | ||||
|    but WITHOUT ANY WARRANTY; without even the implied warranty of | ||||
|    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the | ||||
|    GNU General Public License for more details. | ||||
| 
 | ||||
|    You should have received a copy of the GNU General Public License | ||||
|    along with GNU Mcron.  If not, see <http://www.gnu.org/licenses/>.  */
 | ||||
| 
 | ||||
| #ifndef MCRON_UTILS_H | ||||
| #define MCRON_UTILS_H | ||||
| 
 | ||||
| #include <libguile.h> | ||||
| 
 | ||||
| /**
 | ||||
|    Append DIR in front of ENVAR environment variable value.  If ENVAR is not | ||||
|    defined, then define it with DIR.  Bail out if something went wrong.  */ | ||||
| extern void wrap_env_path (const char *envar, const char *dir); | ||||
| 
 | ||||
| /**
 | ||||
|    In the association list pointed by ALST, set SYMBOL to VAL.  */ | ||||
| extern void assq_symbol_set_x (SCM *alst, const char *symbol, SCM val); | ||||
| 
 | ||||
| #endif /* MCRON_UTILS_H */ | ||||
|  | @ -27,6 +27,9 @@ cat > cron/foo.guile <<EOF | |||
| (job '(next-second) '(display "foo\n")) | ||||
| EOF | ||||
| 
 | ||||
| mcron --schedule=1 cron/foo.guile > "output$$" | ||||
| grep -e "foo" "output$$" || fail_ "'foo.guile' job is not scheduled" | ||||
| 
 | ||||
| mcron --schedule=1 > "output$$" | ||||
| grep -e "foo" "output$$" || fail_ "'foo.guile' job is not scheduled" | ||||
| 
 | ||||
|  |  | |||
|  | @ -56,36 +56,32 @@ | |||
| 
 | ||||
| ;;; TODO: Find more meaningful date examples. | ||||
| 
 | ||||
| (setenv "TZ" ":UTC") | ||||
| 
 | ||||
| (test-equal "next-year" | ||||
|   (list 59989762800 1546293600) | ||||
|   (list (next-year '(1971)) | ||||
|   (list 1893456000 1546300800) | ||||
|   (list (next-year '(130))   ;; This is the year 2030. | ||||
|         (next-year-from 1522095469))) | ||||
| 
 | ||||
| (test-equal "next-month" | ||||
|   (list 28854000 5094000) | ||||
|   (list (next-month '(11)) | ||||
|         (next-month-from 101 '(0 2 4)))) | ||||
|   5097600 | ||||
|   (next-month-from 101 '(0 2 4))) | ||||
| 
 | ||||
| (test-equal "next-day" | ||||
|   (list 2588400 342000) | ||||
|   (list (next-day '(31)) | ||||
|         (next-day-from 4337 '(0 5 10)))) | ||||
|   345600 | ||||
|   (next-day-from 4337 '(0 5 10))) | ||||
| 
 | ||||
| (test-equal "next-hour" | ||||
|   '(3600 82800 3600) | ||||
|   (list (next-hour) | ||||
|         (next-hour '(0)) | ||||
|         (next-hour-from 3 '(0 1 2 3 4)))) | ||||
|   3600 | ||||
|   (next-hour-from 3 '(0 1 2 3 4))) | ||||
| 
 | ||||
| (test-equal "next-minute" | ||||
|   '(240 60) | ||||
|   (list (next-minute '(4 9)) | ||||
|         (next-minute-from 8))) | ||||
|   60 | ||||
|   (next-minute-from 8)) | ||||
| 
 | ||||
| (test-equal "next-second" | ||||
|   '(52 15) | ||||
|   (list (next-second '(52 55)) | ||||
|         (next-second-from 14))) | ||||
|   15 | ||||
|   (next-second-from 14)) | ||||
| 
 | ||||
| ;;; | ||||
| ;;; Check 'configuration-user' manipulation | ||||
|  |  | |||
							
								
								
									
										53
									
								
								tests/redirect.scm
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										53
									
								
								tests/redirect.scm
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,53 @@ | |||
| ;;;; redirect.scm -- tests for (mcron redirect) module | ||||
| ;;; Copyright © 2020 Mathieu Lirzin <mthl@gnu.org> | ||||
| ;;; | ||||
| ;;; This file is part of GNU Mcron. | ||||
| ;;; | ||||
| ;;; GNU Mcron is free software: you can redistribute it and/or modify | ||||
| ;;; it under the terms of the GNU General Public License as published by | ||||
| ;;; the Free Software Foundation, either version 3 of the License, or | ||||
| ;;; (at your option) any later version. | ||||
| ;;; | ||||
| ;;; GNU Mcron is distributed in the hope that it will be useful, | ||||
| ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||||
| ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the | ||||
| ;;; GNU General Public License for more details. | ||||
| ;;; | ||||
| ;;; You should have received a copy of the GNU General Public License | ||||
| ;;; along with GNU Mcron.  If not, see <http://www.gnu.org/licenses/>. | ||||
| 
 | ||||
| (use-modules (ice-9 textual-ports) | ||||
|              (srfi srfi-1) | ||||
|              (srfi srfi-64) | ||||
|              (mcron redirect)) | ||||
| 
 | ||||
| (setenv "TZ" "UTC0") | ||||
| 
 | ||||
| (test-begin "redirect") | ||||
| 
 | ||||
| (define out (mkstemp! (string-copy "foo-XXXXXX"))) | ||||
| 
 | ||||
| (dynamic-wind | ||||
|   (const #t) | ||||
|   (lambda () | ||||
|     (with-mail-out "echo 'foo'" "user0" | ||||
|                    #:out (lambda () out) | ||||
|                    #:hostname "localhost") | ||||
| 
 | ||||
|     (flush-all-ports) | ||||
| 
 | ||||
|     (test-equal "mail output" | ||||
|       "To: user0 | ||||
| From: mcron | ||||
| Subject: user0@localhost | ||||
| 
 | ||||
| foo | ||||
| " | ||||
|       (call-with-input-file (port-filename out) get-string-all))) | ||||
| 
 | ||||
|   (lambda () | ||||
|     (let ((fname (port-filename out))) | ||||
|       (close out) | ||||
|       (delete-file fname)))) | ||||
| 
 | ||||
| (test-end) | ||||
							
								
								
									
										81
									
								
								tests/schedule-2.sh
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										81
									
								
								tests/schedule-2.sh
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,81 @@ | |||
| # schedule-2.sh -- Check mcron schedule output | ||||
| # Copyright © 2020  Dale Mellor <mcron-lsfnyl@rdmp.org> | ||||
| # | ||||
| # This file is part of GNU Mcron. | ||||
| # | ||||
| # GNU Mcron is free software: you can redistribute it and/or modify | ||||
| # it under the terms of the GNU General Public License as published by | ||||
| # the Free Software Foundation, either version 3 of the License, or | ||||
| # (at your option) any later version. | ||||
| # | ||||
| # GNU Mcron is distributed in the hope that it will be useful, | ||||
| # but WITHOUT ANY WARRANTY; without even the implied warranty of | ||||
| # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the | ||||
| # GNU General Public License for more details. | ||||
| # | ||||
| # You should have received a copy of the GNU General Public License | ||||
| # along with GNU Mcron.  If not, see <http://www.gnu.org/licenses/>. | ||||
| 
 | ||||
| source "${srcdir}/tests/init.sh" | ||||
| 
 | ||||
| # Use UTC and SOURCE_DATE_EPOCH to get reproducible result. | ||||
| 
 | ||||
| SOURCE_DATE_EPOCH=1 | ||||
| export SOURCE_DATE_EPOCH | ||||
| 
 | ||||
| TZ=UTC0 | ||||
| export TZ | ||||
| 
 | ||||
| # Use current working directory to store mcron files | ||||
| XDG_CONFIG_HOME=`pwd` | ||||
| export XDG_CONFIG_HOME | ||||
| 
 | ||||
| LC_ALL=C | ||||
| export LC_ALL | ||||
| 
 | ||||
| mkdir cron | ||||
| cat > cron/foo.guile <<EOF | ||||
| (job '(next-second) '(display "foo\n")) | ||||
| EOF | ||||
| 
 | ||||
| cat > expected <<EOF | ||||
| Thu Jan  1 00:00:01 1970 +0000 | ||||
| (display foo | ||||
| ) | ||||
| 
 | ||||
| Thu Jan  1 00:00:02 1970 +0000 | ||||
| (display foo | ||||
| ) | ||||
| 
 | ||||
| Thu Jan  1 00:00:03 1970 +0000 | ||||
| (display foo | ||||
| ) | ||||
| 
 | ||||
| Thu Jan  1 00:00:04 1970 +0000 | ||||
| (display foo | ||||
| ) | ||||
| 
 | ||||
| Thu Jan  1 00:00:05 1970 +0000 | ||||
| (display foo | ||||
| ) | ||||
| 
 | ||||
| Thu Jan  1 00:00:06 1970 +0000 | ||||
| (display foo | ||||
| ) | ||||
| 
 | ||||
| Thu Jan  1 00:00:07 1970 +0000 | ||||
| (display foo | ||||
| ) | ||||
| 
 | ||||
| Thu Jan  1 00:00:08 1970 +0000 | ||||
| (display foo | ||||
| ) | ||||
| 
 | ||||
| EOF | ||||
| 
 | ||||
| mcron -s cron/foo.guile > output | ||||
| diff expected output \ | ||||
|     || skip_ 'The -s option is not fully functional;  | ||||
| this will be fixed with a future version of GNU Guile.' | ||||
| 
 | ||||
| Exit 0 | ||||
|  | @ -26,6 +26,9 @@ export SOURCE_DATE_EPOCH | |||
| TZ=UTC0 | ||||
| export TZ | ||||
| 
 | ||||
| LC_ALL=C | ||||
| export LC_ALL | ||||
| 
 | ||||
| # Use current working directory to store mcron files | ||||
| XDG_CONFIG_HOME=`pwd` | ||||
| export XDG_CONFIG_HOME | ||||
|  |  | |||
							
								
								
									
										144
									
								
								tests/vixie-specification.scm
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										144
									
								
								tests/vixie-specification.scm
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,144 @@ | |||
| ;;;; vixie-specification.scm -- tests for (mcron vixie-specificaion) module | ||||
| ;;; Copyright © 2020 Mathieu Lirzin <mthl@gnu.org> | ||||
| ;;; | ||||
| ;;; This file is part of GNU Mcron. | ||||
| ;;; | ||||
| ;;; GNU Mcron is free software: you can redistribute it and/or modify | ||||
| ;;; it under the terms of the GNU General Public License as published by | ||||
| ;;; the Free Software Foundation, either version 3 of the License, or | ||||
| ;;; (at your option) any later version. | ||||
| ;;; | ||||
| ;;; GNU Mcron is distributed in the hope that it will be useful, | ||||
| ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||||
| ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the | ||||
| ;;; GNU General Public License for more details. | ||||
| ;;; | ||||
| ;;; You should have received a copy of the GNU General Public License | ||||
| ;;; along with GNU Mcron.  If not, see <http://www.gnu.org/licenses/>. | ||||
| 
 | ||||
| (use-modules (srfi srfi-1) | ||||
|              (srfi srfi-64) | ||||
|              (mcron vixie-specification)) | ||||
| 
 | ||||
| (setenv "TZ" "UTC0") | ||||
| 
 | ||||
| ;;; Do not send mail | ||||
| (setenv "MAILTO" "") | ||||
| 
 | ||||
| (define (create-file! content) | ||||
|   "Construct a temporary file port containing CONTENT which must be a string." | ||||
|   (let ((port (mkstemp! (string-copy "file-XXXXXX")))) | ||||
|     (display content port) | ||||
|     (force-output port) | ||||
|     port)) | ||||
| 
 | ||||
| (define (clean-temp port) | ||||
|   "Close and Delete a temporary file port" | ||||
|   (let ((fname (port-filename port))) | ||||
|     (close port) | ||||
|     (delete-file fname))) | ||||
| 
 | ||||
| (define schedule (@@ (mcron base) %global-schedule)) | ||||
| (define schedule-user (@@ (mcron base) schedule-user)) | ||||
| (define set-schedule-user! (@@ (mcron base) set-schedule-user!)) | ||||
| (define job:environment (@@ (mcron base) job:environment)) | ||||
| (define job:displayable (@@ (mcron base) job:displayable)) | ||||
| (define job:user (@@ (mcron base) job:user)) | ||||
| 
 | ||||
| (test-begin "vixie-specification") | ||||
| 
 | ||||
| ;;; Parse user crontab file | ||||
| 
 | ||||
| (define user-crontab-example | ||||
|   "# Example crontab | ||||
| FOO=x | ||||
| BAR=y | ||||
| 
 | ||||
| # Example of job definitions: | ||||
| 17 *	* * *	cd / && run baz | ||||
| 47 6	* * 7	foo -x /tmp/example || bar | ||||
| ") | ||||
| 
 | ||||
| (define user-crontab (create-file! user-crontab-example)) | ||||
| 
 | ||||
| (dynamic-wind | ||||
|   (const #t) | ||||
|   (lambda () | ||||
|     (set-schedule-user! schedule '()) | ||||
|     (read-vixie-file (port-filename user-crontab)) | ||||
| 
 | ||||
|     (test-assert "User schedule has exactly 2 matching jobs" | ||||
|       (lset= string=? | ||||
|              '("cd / && run baz" | ||||
|                "foo -x /tmp/example || bar") | ||||
|              (map job:displayable (schedule-user schedule)))) | ||||
| 
 | ||||
|     (test-assert "Job environment matches configuration" | ||||
|       (every (lambda (j) | ||||
|                (lset= equal? | ||||
|                       '(("FOO" . "x") ("BAR" . "y")) | ||||
|                       (job:environment j))) | ||||
|              (schedule-user schedule)))) | ||||
| 
 | ||||
|   (lambda () | ||||
|     (clean-temp user-crontab))) | ||||
| 
 | ||||
| ;;; Parse system crontab file | ||||
| 
 | ||||
| ;;; Get two existing users from the test environment. | ||||
| (setpwent) | ||||
| (define user0 (getpwent)) | ||||
| (define user1 (or (getpwent) user0)) | ||||
| (define system-crontab-example | ||||
|   (string-append | ||||
|    "# Example crontab | ||||
| BAZ=z | ||||
| 
 | ||||
| 17 *	* * * " (passwd:name user0) " cd / && run baz | ||||
| 47 6	* * 7 "	(passwd:name user1) "   foo -x /tmp/example || bar")) | ||||
| 
 | ||||
| (define sys-crontab (create-file! system-crontab-example)) | ||||
| 
 | ||||
| (dynamic-wind | ||||
|   (const #t) | ||||
|   (lambda () | ||||
|     (set-schedule-user! schedule '()) | ||||
|     (read-vixie-file (port-filename sys-crontab) parse-system-vixie-line) | ||||
| 
 | ||||
|     (test-assert "System schedule has exactly 2 matching jobs" | ||||
|       (lset= equal? | ||||
|              `((,user0 . "cd / && run baz") | ||||
|                (,user1 . "foo -x /tmp/example || bar")) | ||||
|              (map (lambda (j) | ||||
|                     (cons (job:user j) (job:displayable j))) | ||||
|                   (schedule-user schedule)))) | ||||
| 
 | ||||
|     (test-assert "Job environment matches configuration" | ||||
|     (every (lambda (j) | ||||
|              (lset= equal? '(("BAZ" . "z")) (job:environment j))) | ||||
|            (schedule-user schedule)))) | ||||
| 
 | ||||
|   (lambda () | ||||
|     (clean-temp sys-crontab))) | ||||
| 
 | ||||
| ;;; Try to parse a user crontab in a system context | ||||
| 
 | ||||
| (define wrong-system-crontab-example | ||||
|   " | ||||
| # Example of job definitions: | ||||
| 17 *	* * *	ls") | ||||
| 
 | ||||
| (define wrong-sys-crontab (create-file! wrong-system-crontab-example)) | ||||
| 
 | ||||
| (dynamic-wind | ||||
|   (const #t) | ||||
|   (lambda () | ||||
|     (test-error "missing user" | ||||
|       'mcron-error | ||||
|       (read-vixie-file (port-filename wrong-sys-crontab) | ||||
|                        parse-system-vixie-line))) | ||||
| 
 | ||||
|   (lambda () | ||||
|     (clean-temp wrong-sys-crontab))) | ||||
| 
 | ||||
| (test-end) | ||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue