Compare commits
211 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 | ||
|
|
bd37306294 | ||
|
|
56308568da | ||
|
|
fb1d663383 | ||
|
|
5794ea5a5b | ||
|
|
8ae1e8c92e | ||
|
|
bedec44b39 | ||
|
|
2427317b10 | ||
|
|
a373317d96 | ||
|
|
3fdacd1393 |
||
|
|
7d4af7781f |
||
|
|
ba2975649a | ||
|
|
d4b48ee300 | ||
|
|
d51685b2eb | ||
|
|
0d045af94e |
||
|
|
7228d3048a |
||
|
|
efa2f51ae3 |
||
|
|
1c5ec45943 |
||
|
|
a2d93e3b75 |
||
|
|
c2b3e6f124 |
||
|
|
4c32ff4944 |
||
|
|
cf3146b3c5 |
||
|
|
68be2dd2dd |
||
|
|
9187aeb78f |
||
|
|
ef452ce43b |
||
|
|
d8127a386c |
||
|
|
729bae0c98 |
||
|
|
8ab0465d92 |
||
|
|
15fa52f7ec |
||
|
|
56f85cfd8a |
||
|
|
c263834da9 |
||
|
|
95fb914025 |
||
|
|
f71b0b8310 |
||
|
|
fad58ca8c2 |
||
|
|
e66f0dcdd6 |
||
|
|
6c4f93371c |
||
|
|
9ce38228e8 |
||
|
|
5023a8c7ca |
||
|
|
c20e4cc0aa |
||
|
|
4d636af876 |
||
|
|
5af999fb20 |
||
|
|
2169f4a7b3 |
||
|
|
a8511ce35d |
||
|
|
0159423d15 |
||
|
|
b8cbf635cc |
||
|
|
e013e2a6d6 |
||
|
|
d1e0d2a8f7 |
||
|
|
526ce502e5 |
||
|
|
d63db1ce4e |
||
|
|
a1f9e3d7a7 |
||
|
|
07017255a1 |
||
|
|
6583e83d16 |
||
|
|
ac39c00859 |
||
|
|
cae2270fd7 |
||
|
|
426f5d7b38 |
||
|
|
fe9592fd28 |
||
|
|
f908c5395c |
||
|
|
09e452b62a |
||
|
|
44f4fab641 |
||
|
|
64ff2b1ddf |
||
|
|
624ceb4480 |
||
|
|
dd9d6a6b06 |
||
|
|
22ba12d1aa |
||
|
|
98eaa3fb9c |
||
|
|
bb8414e00d |
||
|
|
2961ae8033 |
||
|
|
28624af154 |
||
|
|
b7640b81ed |
||
|
|
d1fdb14a8a |
||
|
|
2b9b54b729 |
||
|
|
5f83aef90f |
||
|
|
b80020ef78 |
||
|
|
266bcf8405 |
||
|
|
319a1dbe4e |
||
|
|
dc5a7a500e |
||
|
|
a0b896c9d5 |
||
|
|
4802dc976b |
||
|
|
c285d36ab2 |
||
|
|
811ad9167a |
||
|
|
dd30cb9e54 |
||
|
|
d011957843 |
||
|
|
c01106387f |
||
|
|
9b52c0d454 |
||
|
|
2b9828f303 |
||
|
|
02d67e7f0e |
||
|
|
245f1ae338 |
||
|
|
f284b52446 |
||
|
|
a0a82a2ef4 |
||
|
|
ab07cf296b |
||
|
|
ec5ece53d6 |
||
|
|
10df45c659 |
||
|
|
f1c498c2dd |
||
|
|
3b5195ed33 |
||
|
|
c2cdfefaca |
||
|
|
ade37c96b7 |
||
|
|
44e0e6f305 |
||
|
|
57b9294277 |
||
|
|
d72716ce16 |
||
|
|
a0b580448c |
||
|
|
d96ede0b09 |
||
|
|
3eb1889f89 |
||
|
|
54a0887f1a |
||
|
|
de58e99aa5 |
||
|
|
41b427e1b2 |
||
|
|
ba294d6a3b |
||
|
|
aaf1b08404 |
||
|
|
ea648c0730 |
||
|
|
a3051133c0 |
||
|
|
5e6233a58d |
||
|
|
c1d2c765ef |
||
|
|
4d518fd3f1 |
||
|
|
d4b4ac5708 |
||
|
|
2d6c072b47 |
||
|
|
61f85be19d |
||
|
|
2c9139f623 |
||
|
|
6a91b6fb3e |
||
|
|
2cdd544a56 |
||
|
|
19d68f7dd6 |
||
|
|
74babba80e |
||
|
|
913e3c65e4 |
||
|
|
109555a9dd |
||
|
|
ea2058f14a |
||
|
|
ae6deb8ea2 |
||
|
|
245413041c |
||
|
|
6a82b53ddd |
||
|
|
10c9f31c6c |
||
|
|
4a56db1609 |
||
|
|
e9fde01d27 |
||
|
|
9d173e23bc |
||
|
|
c9064dde98 |
||
|
|
c87c643ca1 |
||
|
|
73b2294650 |
||
|
|
31baff1a51 | ||
|
|
45b062490a | ||
|
|
0d91ec1b97 | ||
|
|
bca16da451 | ||
|
|
418b81e1af | ||
|
|
52364699ed | ||
|
|
995bc9ca6e | ||
|
|
bb8703b679 | ||
|
|
5097e30bab | ||
|
|
5da0024b93 | ||
|
|
ce0d72ec83 | ||
|
|
8952d2dc44 | ||
|
|
b59f2f5ea6 | ||
|
|
589d5ff8d1 | ||
|
|
fdbaa674a7 | ||
|
|
4da7aec83b | ||
|
|
f2c56d355f | ||
|
|
b2718d2cc9 | ||
|
|
c2a1d931a6 | ||
|
|
960f6e1817 | ||
|
|
805c04fb90 | ||
|
|
831b14d980 | ||
|
|
8be6babb3f | ||
|
|
6cd941e061 | ||
|
|
ba6613fe96 | ||
|
|
b390063628 | ||
|
|
c925e9ad0d | ||
|
|
1712722a7b | ||
|
|
3221c05720 | ||
|
|
3c903bfc80 | ||
|
|
237c234f39 | ||
|
|
98d68831ba | ||
|
|
5e8f47fe44 | ||
|
|
2947d84101 | ||
|
|
c8a1238396 | ||
|
|
36161428fa | ||
|
|
f835793336 | ||
|
|
7ed303705c | ||
|
|
ee280d4efc | ||
|
|
f0feb586b7 | ||
|
|
cdd26d5b00 | ||
|
|
8f136b3d67 | ||
|
|
2dd8fa9d8f | ||
|
|
607d5e060d | ||
|
|
940146bc90 | ||
|
|
754d1d0176 | ||
|
|
c43a9173e6 | ||
|
|
8f430594f4 | ||
|
|
b3202cecf6 | ||
|
|
c0a6eb14c2 | ||
|
|
024027ae2d | ||
|
|
df4fa60a03 | ||
|
|
eca341bd82 | ||
|
|
e6a94adeb3 | ||
|
|
2039060a1d | ||
|
|
bc38f2add2 | ||
|
|
998f7eeaef |
61 changed files with 6628 additions and 2391 deletions
10
.dir-locals.el
Normal file
10
.dir-locals.el
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
;; Per-directory local variables for GNU Emacs 23 and later.
|
||||
|
||||
((nil . ((fill-column . 78)
|
||||
(tab-width . 8)))
|
||||
(c-mode . ((c-file-style . "gnu")
|
||||
(indent-tabs-mode . nil)))
|
||||
(scheme-mode
|
||||
.
|
||||
((indent-tabs-mode . nil)
|
||||
(eval . (put 'mcron-error 'scheme-indent-function 1)))))
|
||||
41
.gitignore
vendored
41
.gitignore
vendored
|
|
@ -1,22 +1,47 @@
|
|||
*.[oa]
|
||||
*.go
|
||||
*.log
|
||||
*.trs
|
||||
*~
|
||||
.deps
|
||||
.dirstamp
|
||||
/bin/cron
|
||||
/bin/crontab
|
||||
/bin/mcron
|
||||
/build-aux/ar-lib
|
||||
/build-aux/compile
|
||||
/build-aux/config.guess
|
||||
/build-aux/config.sub
|
||||
/build-aux/depcomp
|
||||
/build-aux/install-sh
|
||||
/build-aux/mdate-sh
|
||||
/build-aux/missing
|
||||
/build-aux/test-driver
|
||||
/build-aux/texinfo.tex
|
||||
/doc/config.texi
|
||||
/doc/cron.8
|
||||
/doc/crontab.1
|
||||
/doc/mcron.1
|
||||
/doc/mcron.info
|
||||
/doc/stamp-vti
|
||||
/doc/version.texi
|
||||
/mdate-sh
|
||||
INSTALL
|
||||
Makefile
|
||||
Makefile.in
|
||||
aclocal.m4
|
||||
autom4te.cache
|
||||
compile
|
||||
config.cache
|
||||
config.h
|
||||
config.h.in
|
||||
config.log
|
||||
config.scm
|
||||
config.status
|
||||
configure
|
||||
core.scm
|
||||
depcomp
|
||||
install-sh
|
||||
makefile
|
||||
makefile.in
|
||||
mcron
|
||||
mcron.c
|
||||
mcron.info
|
||||
*.o
|
||||
mcron.texinfo
|
||||
missing
|
||||
pre-inst-env
|
||||
stamp-h1
|
||||
texinfo.tex
|
||||
|
|
|
|||
1
.prev-version
Normal file
1
.prev-version
Normal file
|
|
@ -0,0 +1 @@
|
|||
1.1.1
|
||||
24
AUTHORS
24
AUTHORS
|
|
@ -1,18 +1,6 @@
|
|||
Authors of GNU mcron.
|
||||
|
||||
Copyright (C) 2003, 2005, 2006 Dale Mellor
|
||||
|
||||
Copying and distribution of this file, with or without modification,
|
||||
are permitted in any medium without royalty provided the copyright
|
||||
notice and this notice are preserved.
|
||||
|
||||
|
||||
|
||||
Dale Mellor (dale_mellor@users.sourceforge.net)
|
||||
wrote everything from scratch, with some reference to Paul Vixie's code,
|
||||
with the exceptions noted below.
|
||||
|
||||
The section of the manual which describes in detail the syntax for Vixie-style
|
||||
configuration files is copied verbatim from Paul Vixie's own distribution,
|
||||
on the understanding that this is permitted under his copyright notice,
|
||||
which is reproduced in its entirety in this section of the manual.
|
||||
Dale Mellor <mcron-lsfnyl@rdmp.org>
|
||||
Mathieu Lirzin <mthl@gnu.org>
|
||||
Sergey Poznyakoff <cray@gnu.org.ua>
|
||||
Ludovic Courtès <ludo@gnu.org>
|
||||
宋文武 <iyzsong@member.fsf.org>
|
||||
Efraim Flashner <efraim@flashner.co.il>
|
||||
|
|
|
|||
16
BUGS
16
BUGS
|
|
@ -1,16 +0,0 @@
|
|||
GNU mcron --- BUGS -*-text-*-
|
||||
|
||||
Copyright (C) 2003, 2005, 2006 Dale Mellor
|
||||
|
||||
Copying and distribution of this file, with or without modification,
|
||||
are permitted in any medium without royalty provided the copyright
|
||||
notice and this notice are preserved.
|
||||
|
||||
|
||||
|
||||
Please send bug reports to bug-mcron@gnu.org.
|
||||
|
||||
|
||||
The currently-known bugs are:-
|
||||
|
||||
-NONE-
|
||||
167
ChangeLog
167
ChangeLog
|
|
@ -1,165 +1,4 @@
|
|||
2014-05-25 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
Normally a ChangeLog is generated at "make dist" time and available in
|
||||
source tarballs.
|
||||
|
||||
* Juggled build infrastructure so that we can make the minimal man
|
||||
page in the proper autotools way.
|
||||
|
||||
* configure.ac: version to 1.0.8.
|
||||
|
||||
|
||||
2014-04-28 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
|
||||
* We now run against, and require, guile-2.0.
|
||||
|
||||
* configure.ac: version to 1.0.7.
|
||||
|
||||
|
||||
2012-02-04 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
|
||||
* main.scm: added search for initial files in
|
||||
$XDG_CONFIG_HOME/cron directory, defaulting to ~/.config/cron if
|
||||
the environment variable is not set) as well as in ~/.cron
|
||||
directory (this is in line with the current FreeDesktop.org
|
||||
standards).
|
||||
|
||||
|
||||
2010-06-13 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
|
||||
* configure.ac: added --enable-no-vixie-clobber argument to
|
||||
configure so that the root user can avoid overwriting a legacy
|
||||
cron installation.
|
||||
|
||||
* mcron.1: added simple, minimal man page using help2man (the
|
||||
texinfo file is still the primary documentation source).
|
||||
|
||||
* makefile.am: replaced use of mkinstalldirs with install; the
|
||||
former is not supplied with the latest automake (1.11).
|
||||
|
||||
|
||||
2008-02-21 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
|
||||
* ALL FILES: Replaced version 2 GPL notices with version 3 ones.
|
||||
|
||||
* makefile.am: Do not remove COPYING file with make
|
||||
maintainer-clean; if you do it will eventually get replaced with
|
||||
the old version 2 GPL by a subsequent automake.
|
||||
|
||||
* configure.ac: Bumped version to 1.0.4.
|
||||
|
||||
|
||||
2008-01-25 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
|
||||
* main.scm (command-type): Files which are listed on the command
|
||||
line are assumed to be guile configurations if they do not end in
|
||||
.guile or .vixie (previously they were silently ignored).
|
||||
|
||||
* main.scm: Argument to --schedule is no longer optional (the
|
||||
options system goes really screwy with optional values, usually
|
||||
pulling the first non-option argument as a value if one was not
|
||||
intended!)
|
||||
|
||||
* makefile.am: Moved target-specific CFLAGS and LDFLAGS to global
|
||||
AM_* variables, to remove problem with automake requiring
|
||||
AM_PROGS_CC_C_O in configure.ac (!)
|
||||
|
||||
* Version is currently at 1.0.3.
|
||||
|
||||
|
||||
2005-09-02 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
|
||||
* makefile.am, mcron.c.template (main): Modified install-exec-hook
|
||||
so that a proper installation of a Vixie-compatible cron only
|
||||
takes place if we are root - otherwise only mcron is installed as
|
||||
a user-owned program. The guile modules are now installed under
|
||||
mcron's shared data directory, not guile's global directories.
|
||||
|
||||
* mcron-core.scm: Removed job:advance-time, put the code inline
|
||||
where it was called, and changed the instance in the main loop to
|
||||
compute the new time based on the current-time, rather than the
|
||||
previous job time (this makes things behave more reasonably when a
|
||||
laptop awakes from suspend mode).
|
||||
|
||||
* Bumped version to 1.0.2.
|
||||
|
||||
|
||||
2004-05-15 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
|
||||
* Modified all auxiliary files to reflect that the package is now
|
||||
properly homed at www.gnu.org.
|
||||
|
||||
* Bumped version to 1.0.1.
|
||||
|
||||
|
||||
2003-12-11 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
|
||||
* Modified all auxiliary files to reflect that we are now a GNU
|
||||
package.
|
||||
|
||||
* Bumped version to 1.0.0.
|
||||
|
||||
|
||||
2003-12-07 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
|
||||
* configure.ac: Added switches for files and directories used by
|
||||
mcron: --spool-dir, --socket-file, --allow-file, --deny-file,
|
||||
--pid-file and --tmp-dir. All the code has been modified to use
|
||||
these configure options (including the source for the texinfo
|
||||
manual).
|
||||
|
||||
|
||||
2003-12-05 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
|
||||
* configure.ac: Added test for guile version >= 1.6.4.
|
||||
|
||||
* bumped version to 0.99.4.
|
||||
|
||||
|
||||
2003-08-03 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
|
||||
* Third cut, fully functional, modular, production quality, still
|
||||
needs testing...
|
||||
|
||||
* Pulled all functionality into modules, so it can be incorporated
|
||||
into other programs.
|
||||
|
||||
* Bumped version to 0.99.3.
|
||||
|
||||
|
||||
2003-07-20 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
|
||||
* Second cut, now _really_ fully functional (100% Vixie
|
||||
compatible), production quality code, still needs lots of testing
|
||||
doing...
|
||||
|
||||
* Converted from SIGUP-/var/cron/update to select-/var/cron/socket
|
||||
method of communication between crontab and cron.
|
||||
|
||||
* Added implicit job which checks every minute for updates to
|
||||
/etc/crontab.
|
||||
|
||||
* Removed --enable-vixie configuration option - the Vixie programs
|
||||
are built and installed by default now.
|
||||
|
||||
* Bumped version to 0.99.2.
|
||||
|
||||
|
||||
2003-06-28 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
|
||||
* First cut, fully functional, production quality code, just needs
|
||||
testing...
|
||||
|
||||
* Broken/incomplete Guile prevents vixie compatibility from
|
||||
working - this has been disabled by default in the configuration.
|
||||
|
||||
* Version set at 0.99.1
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
________________________________________________________________________________
|
||||
Copyright (C) 2003, 2005, 2006, 2014 Dale Mellor
|
||||
|
||||
Copying and distribution of this file, with or without modification,
|
||||
are permitted in any medium without royalty provided the copyright
|
||||
notice and this notice are preserved.
|
||||
If not, see the Git commit log at <http://git.sv.gnu.org/cgit/mcron.git/>.
|
||||
|
|
|
|||
147
ChangeLog.old
Normal file
147
ChangeLog.old
Normal file
|
|
@ -0,0 +1,147 @@
|
|||
2014-05-25 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
|
||||
* Juggled build infrastructure so that we can make the minimal man
|
||||
page in the proper autotools way.
|
||||
|
||||
* configure.ac: version to 1.0.8.
|
||||
|
||||
2014-04-28 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
|
||||
* We now run against, and require, guile-2.0.
|
||||
|
||||
* configure.ac: version to 1.0.7.
|
||||
|
||||
2012-02-04 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
|
||||
* main.scm: added search for initial files in
|
||||
$XDG_CONFIG_HOME/cron directory, defaulting to ~/.config/cron if
|
||||
the environment variable is not set) as well as in ~/.cron
|
||||
directory (this is in line with the current FreeDesktop.org
|
||||
standards).
|
||||
|
||||
2010-06-13 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
|
||||
* configure.ac: added --enable-no-vixie-clobber argument to
|
||||
configure so that the root user can avoid overwriting a legacy
|
||||
cron installation.
|
||||
|
||||
* mcron.1: added simple, minimal man page using help2man (the
|
||||
texinfo file is still the primary documentation source).
|
||||
|
||||
* makefile.am: replaced use of mkinstalldirs with install; the
|
||||
former is not supplied with the latest automake (1.11).
|
||||
|
||||
2008-02-21 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
|
||||
* ALL FILES: Replaced version 2 GPL notices with version 3 ones.
|
||||
|
||||
* makefile.am: Do not remove COPYING file with make
|
||||
maintainer-clean; if you do it will eventually get replaced with
|
||||
the old version 2 GPL by a subsequent automake.
|
||||
|
||||
* configure.ac: Bumped version to 1.0.4.
|
||||
|
||||
2008-01-25 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
|
||||
* main.scm (command-type): Files which are listed on the command
|
||||
line are assumed to be guile configurations if they do not end in
|
||||
.guile or .vixie (previously they were silently ignored).
|
||||
|
||||
* main.scm: Argument to --schedule is no longer optional (the
|
||||
options system goes really screwy with optional values, usually
|
||||
pulling the first non-option argument as a value if one was not
|
||||
intended!)
|
||||
|
||||
* makefile.am: Moved target-specific CFLAGS and LDFLAGS to global
|
||||
AM_* variables, to remove problem with automake requiring
|
||||
AM_PROGS_CC_C_O in configure.ac (!)
|
||||
|
||||
* Version is currently at 1.0.3.
|
||||
|
||||
2005-09-02 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
|
||||
* makefile.am, mcron.c.template (main): Modified install-exec-hook
|
||||
so that a proper installation of a Vixie-compatible cron only
|
||||
takes place if we are root - otherwise only mcron is installed as
|
||||
a user-owned program. The guile modules are now installed under
|
||||
mcron's shared data directory, not guile's global directories.
|
||||
|
||||
* mcron-core.scm: Removed job:advance-time, put the code inline
|
||||
where it was called, and changed the instance in the main loop to
|
||||
compute the new time based on the current-time, rather than the
|
||||
previous job time (this makes things behave more reasonably when a
|
||||
laptop awakes from suspend mode).
|
||||
|
||||
* Bumped version to 1.0.2.
|
||||
|
||||
2004-05-15 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
|
||||
* Modified all auxiliary files to reflect that the package is now
|
||||
properly homed at www.gnu.org.
|
||||
|
||||
* Bumped version to 1.0.1.
|
||||
|
||||
2003-12-11 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
|
||||
* Modified all auxiliary files to reflect that we are now a GNU
|
||||
package.
|
||||
|
||||
* Bumped version to 1.0.0.
|
||||
|
||||
2003-12-07 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
|
||||
* configure.ac: Added switches for files and directories used by
|
||||
mcron: --spool-dir, --socket-file, --allow-file, --deny-file,
|
||||
--pid-file and --tmp-dir. All the code has been modified to use
|
||||
these configure options (including the source for the texinfo
|
||||
manual).
|
||||
|
||||
2003-12-05 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
|
||||
* configure.ac: Added test for guile version >= 1.6.4.
|
||||
|
||||
* bumped version to 0.99.4.
|
||||
|
||||
2003-08-03 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
|
||||
* Third cut, fully functional, modular, production quality, still
|
||||
needs testing...
|
||||
|
||||
* Pulled all functionality into modules, so it can be incorporated
|
||||
into other programs.
|
||||
|
||||
* Bumped version to 0.99.3.
|
||||
|
||||
2003-07-20 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
|
||||
* Second cut, now _really_ fully functional (100% Vixie
|
||||
compatible), production quality code, still needs lots of testing
|
||||
doing...
|
||||
|
||||
* Converted from SIGUP-/var/cron/update to select-/var/cron/socket
|
||||
method of communication between crontab and cron.
|
||||
|
||||
* Added implicit job which checks every minute for updates to
|
||||
/etc/crontab.
|
||||
|
||||
* Removed --enable-vixie configuration option - the Vixie programs
|
||||
are built and installed by default now.
|
||||
|
||||
* Bumped version to 0.99.2.
|
||||
|
||||
2003-06-28 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
|
||||
* First cut, fully functional, production quality code, just needs
|
||||
testing...
|
||||
|
||||
* Broken/incomplete Guile prevents vixie compatibility from
|
||||
working - this has been disabled by default in the configuration.
|
||||
|
||||
* Version set at 0.99.1
|
||||
|
||||
________________________________________________________________________________
|
||||
Copyright (C) 2003, 2005, 2006, 2014, 2015 Dale Mellor
|
||||
|
||||
Copying and distribution of this file, with or without modification,
|
||||
are permitted in any medium without royalty provided the copyright
|
||||
notice and this notice are preserved.
|
||||
90
HACKING
Normal file
90
HACKING
Normal file
|
|
@ -0,0 +1,90 @@
|
|||
These notes intend to help people working on the checked-out sources.
|
||||
These requirements do not apply when building from a distribution tarball.
|
||||
|
||||
* First Git checkout
|
||||
|
||||
You can get a copy of the source repository like this:
|
||||
|
||||
$ git clone git://git.sv.gnu.org/mcron
|
||||
$ cd mcron
|
||||
|
||||
The next step is to get and check other files needed to build, which are
|
||||
extracted from other source packages:
|
||||
|
||||
$ ./bootstrap
|
||||
|
||||
And there you are! Just
|
||||
|
||||
$ ./configure
|
||||
$ make
|
||||
|
||||
At this point, there should be no difference between your local copy, and the
|
||||
Git master copy:
|
||||
|
||||
$ git diff
|
||||
|
||||
should output no difference.
|
||||
|
||||
Enjoy!
|
||||
|
||||
* Submitting patches
|
||||
|
||||
If you develop a fix or a new feature, please send it to the appropriate
|
||||
bug-reporting address as reported by the --help option of each program. One
|
||||
way to do this is to use vc-dwim <http://www.gnu.org/software/vc-dwim/>), as
|
||||
follows.
|
||||
|
||||
Run the command "vc-dwim --help", copy its definition of the
|
||||
"git-changelog-symlink-init" function into your shell, and then run this
|
||||
function at the top-level directory of the package.
|
||||
|
||||
Edit the (empty) ChangeLog file that this command creates, creating a
|
||||
properly-formatted entry according to the GNU coding standards
|
||||
<http://www.gnu.org/prep/standards/html_node/Change-Logs.html>.
|
||||
|
||||
Make your changes.
|
||||
|
||||
Run the command "vc-dwim" and make sure its output (the diff of all your
|
||||
changes) looks good.
|
||||
|
||||
Run "vc-dwim --commit".
|
||||
|
||||
Run the command "git format-patch --stdout -1", and email its output in,
|
||||
using the output's subject line.
|
||||
|
||||
* Updating auxilary scripts
|
||||
|
||||
Fetch new versions of the files that are maintained in other GNU
|
||||
repositories by running "make fetch". In case any file in the
|
||||
Mcron repository has been updated, commit and re-run the testsuite.
|
||||
|
||||
* Code coverage
|
||||
|
||||
Assuming 'lcov' is installed, it is possible to check the actual code
|
||||
coverage achieved by the test suite by running the following commands:
|
||||
|
||||
$ make check SCM_LOG_DRIVER_FLAGS="--coverage=yes"
|
||||
$ genhtml tests/*.info --output-directory out
|
||||
|
||||
-----
|
||||
|
||||
Copyright © 2002-2017 Free Software Foundation, Inc.
|
||||
Copyright © 2017, 2018 Mathieu Lirzin <mthl@gnu.org>
|
||||
|
||||
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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
Local Variables:
|
||||
mode: outline
|
||||
fill-column: 78
|
||||
End:
|
||||
254
Makefile.am
Executable file
254
Makefile.am
Executable file
|
|
@ -0,0 +1,254 @@
|
|||
## Process this file with automake to produce Makefile.in.
|
||||
# Copyright © 2003 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
# Copyright © 2015, 2016, 2017, 2018, 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/>.
|
||||
|
||||
## ---------- ##
|
||||
## Programs. ##
|
||||
## ---------- ##
|
||||
|
||||
bin_SCRIPTS = bin/mcron
|
||||
noinst_SCRIPTS =
|
||||
|
||||
if MULTI_USER
|
||||
bin_SCRIPTS += bin/crontab
|
||||
sbin_SCRIPTS = bin/cron
|
||||
else
|
||||
noinst_SCRIPTS += bin/cron bin/crontab
|
||||
endif
|
||||
|
||||
# wrapper to be used in the build environment and for running tests.
|
||||
noinst_SCRIPTS += pre-inst-env
|
||||
|
||||
## --------------- ##
|
||||
## Guile modules. ##
|
||||
## --------------- ##
|
||||
|
||||
# Root directory used for installing Guile modules.
|
||||
guilesitedir = $(datarootdir)/guile/site/$(GUILE_EFFECTIVE_VERSION)
|
||||
# Root directory used for installing Guile compiled modules.
|
||||
guilesitegodir = $(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache
|
||||
|
||||
pkgmoduledir = $(guilesitedir)/$(PACKAGE)
|
||||
pkgmodule_DATA = src/mcron/config.scm
|
||||
dist_pkgmodule_DATA = \
|
||||
src/mcron/base.scm \
|
||||
src/mcron/environment.scm \
|
||||
src/mcron/job-specifier.scm \
|
||||
src/mcron/redirect.scm \
|
||||
src/mcron/utils.scm \
|
||||
src/mcron/vixie-specification.scm \
|
||||
src/mcron/vixie-time.scm
|
||||
|
||||
# Alias for 'src/mcron/base.scm' kept for backward compatibility.
|
||||
dist_pkgmodule_DATA += src/mcron/core.scm
|
||||
|
||||
pkgmodulegodir = $(guilesitegodir)/$(PACKAGE)
|
||||
pkgmodulego_DATA = \
|
||||
$(dist_pkgmodule_DATA:.scm=.go) \
|
||||
src/mcron/config.go
|
||||
|
||||
pkgscriptdir = $(pkgmoduledir)/scripts
|
||||
dist_pkgscript_DATA = \
|
||||
src/mcron/scripts/cron.scm \
|
||||
src/mcron/scripts/crontab.scm \
|
||||
src/mcron/scripts/mcron.scm
|
||||
|
||||
pkgscriptgodir = $(pkgmodulegodir)/scripts
|
||||
pkgscriptgo_DATA = $(dist_pkgscript_DATA:.scm=.go)
|
||||
|
||||
compiled_modules = \
|
||||
$(pkgmodulego_DATA) \
|
||||
$(pkgscriptgo_DATA)
|
||||
|
||||
CLEANFILES = $(compiled_modules) bin/crontab bin/cron bin/mcron
|
||||
DISTCLEANFILES = src/mcron/config.scm
|
||||
|
||||
# Unset 'GUILE_LOAD_COMPILED_PATH' altogether while compiling. Otherwise, if
|
||||
# $GUILE_LOAD_COMPILED_PATH contains $(pkgmoduledir), 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. Set GUILE_AUTO_COMPILE to 0 to avoid auto-compiling guild
|
||||
# as a consequence of the previous hack.
|
||||
#
|
||||
# XXX: Use the C locale for when Guile lacks
|
||||
# <http://git.sv.gnu.org/cgit/guile.git/commit/?h=stable-2.0&id=e2c6bf3866d1186c60bacfbd4fe5037087ee5e3f>.
|
||||
.scm.go:
|
||||
$(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 \
|
||||
--load-path="$(builddir)/src" \
|
||||
--load-path="$(srcdir)/src" \
|
||||
--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. ##
|
||||
## ------------ ##
|
||||
|
||||
TEST_EXTENSIONS = .scm .sh
|
||||
AM_TESTS_ENVIRONMENT = env GUILE_AUTO_COMPILE='0'
|
||||
|
||||
SH_LOG_COMPILER = ./pre-inst-env $(SHELL)
|
||||
|
||||
SCM_LOG_DRIVER = \
|
||||
$(builddir)/pre-inst-env $(GUILE) \
|
||||
$(srcdir)/build-aux/test-driver.scm
|
||||
|
||||
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
|
||||
|
||||
## -------------- ##
|
||||
## Distribution. ##
|
||||
## -------------- ##
|
||||
|
||||
EXTRA_DIST = \
|
||||
bootstrap \
|
||||
build-aux/guix.scm \
|
||||
HACKING \
|
||||
src/cron.in \
|
||||
src/crontab.in \
|
||||
src/mcron.in \
|
||||
tests/init.sh \
|
||||
$(TESTS)
|
||||
|
||||
## -------------- ##
|
||||
## Installation. ##
|
||||
## -------------- ##
|
||||
|
||||
# Sed command for Transforming program names.
|
||||
transform_exe = s/$(EXEEXT)$$//;$(transform);s/$$/$(EXEEXT)/
|
||||
|
||||
install-exec-hook:
|
||||
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 | sed '$(transform_exe)'`; \
|
||||
test -e $(DESTDIR)$(bindir)/$${tmcron}
|
||||
if MULTI_USER
|
||||
tcrontab=`echo crontab | sed '$(transform_exe)'`; \
|
||||
test -u $(DESTDIR)$(bindir)/$${tcrontab}
|
||||
tcron=`echo cron | sed '$(transform_exe)'`; \
|
||||
test -e $(DESTDIR)$(sbindir)/$${tcron}
|
||||
else !MULTI_USER
|
||||
tcrontab=`echo crontab | sed '$(transform_exe)'`; \
|
||||
test ! -u $(DESTDIR)$(bindir)/$${tcrontab}
|
||||
tcron=`echo cron | sed '$(transform_exe)'`; \
|
||||
test ! -f $(DESTDIR)$(sbindir)/$${tcron}
|
||||
endif !MULTI_USER
|
||||
|
||||
## --------------- ##
|
||||
## Documentation. ##
|
||||
## --------------- ##
|
||||
|
||||
info_TEXINFOS = doc/mcron.texi
|
||||
doc_mcron_TEXINFOS = doc/fdl.texi
|
||||
nodist_doc_mcron_TEXINFOS = doc/config.texi
|
||||
dist_man_MANS = $(srcdir)/doc/mcron.1
|
||||
extra_mans = \
|
||||
$(srcdir)/doc/crontab.1 \
|
||||
$(srcdir)/doc/cron.8
|
||||
|
||||
if MULTI_USER
|
||||
dist_man_MANS += $(extra_mans)
|
||||
else
|
||||
# Build, distribute, but do not install the extra man pages.
|
||||
all-local: $(extra_mans)
|
||||
EXTRA_DIST += $(extra_mans)
|
||||
endif
|
||||
|
||||
# XXX: Allow the inclusion of 'doc/fdl.texi' and 'doc/config.texi' inside
|
||||
# 'doc/mcron.texi' for 'dvi' and 'pdf' targets.
|
||||
TEXI2DVI = texi2dvi -I doc
|
||||
|
||||
# The 'case' ensures the man pages are only generated if the corresponding
|
||||
# source script (the first prerequisite) has been changed. The second
|
||||
# prerequisites is solely meant to force these docs to be made only after
|
||||
# executables have been compiled.
|
||||
gen_man = \
|
||||
case '$?' in \
|
||||
*$<*) $(AM_V_P) && set -x || echo " HELP2MAN $@"; \
|
||||
LANGUAGE= $(top_builddir)/pre-inst-env $(HELP2MAN) \
|
||||
-s $$man_section -S GNU -p $(PACKAGE_TARNAME) -o $@ $$prog;; \
|
||||
*) : ;; \
|
||||
esac
|
||||
|
||||
$(srcdir)/doc/mcron.1: src/mcron/scripts/mcron.scm bin/mcron
|
||||
-@prog="bin/mcron"; man_section=1; $(gen_man)
|
||||
|
||||
$(srcdir)/doc/crontab.1: src/mcron/scripts/crontab.scm bin/crontab
|
||||
-@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)
|
||||
|
||||
MAINTAINERCLEANFILES = $(dist_man_MANS) $(extra_mans)
|
||||
|
||||
## -------------- ##
|
||||
## Silent rules. ##
|
||||
## -------------- ##
|
||||
|
||||
guilec_verbose = $(guilec_verbose_@AM_V@)
|
||||
guilec_verbose_ = $(guilec_verbose_@AM_DEFAULT_V@)
|
||||
guilec_verbose_0 = @echo " GUILEC " $@;
|
||||
|
||||
devnull_verbose = $(devnull_verbose_@AM_V@)
|
||||
devnull_verbose_ = $(devnull_verbose_@AM_DEFAULT_V@)
|
||||
devnull_verbose_0 = >/dev/null
|
||||
|
||||
## ------------- ##
|
||||
## Maintenance. ##
|
||||
## ------------- ##
|
||||
|
||||
@MAINT_MAKEFILE@
|
||||
224
NEWS
224
NEWS
|
|
@ -1,106 +1,196 @@
|
|||
Historic moments in the life of mcron. -*-text-*-
|
||||
GNU Mcron NEWS -*- outline -*-
|
||||
|
||||
Copyright (C) 2003, 2005, 2006 Dale Mellor
|
||||
* Noteworthy changes in release 1.2.0 (2020-04-22) [stable]
|
||||
|
||||
Copying and distribution of this file, with or without modification,
|
||||
are permitted in any medium without royalty provided the copyright
|
||||
notice and this notice are preserved.
|
||||
** 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]
|
||||
|
||||
Please send bug reports to bug-mcron@gnu.org.
|
||||
** Improvements
|
||||
Added missing #include directives
|
||||
Support Guile 3.0
|
||||
Call 'child-cleanup' when 'select' returns an empty set
|
||||
Avoid 'call-with-current-continuation'
|
||||
Date changes for Copyrights changed for 2020
|
||||
Email updates in documentation
|
||||
|
||||
* Noteworthy changes in release 1.1.3 (2019-11-17) [stable]
|
||||
|
||||
Saturday, 4th February 2012
|
||||
** Improvements
|
||||
Package contains configure script by default
|
||||
Authors file change (addition)
|
||||
Doc fix for 'every second sunday'
|
||||
guix.scm update
|
||||
|
||||
Received a suggestion from Antono Vasiljev to look in FreeDesktop.org's
|
||||
standard user configuration directories for user script files. This is
|
||||
implemented in the GIT repository.
|
||||
* Noteworthy changes in release 1.1.2 (2018-11-26) [stable]
|
||||
|
||||
** Improvements
|
||||
|
||||
Sunday, 20th June 2010
|
||||
The "--with-sendmail" configure variable has been added to allow the usage
|
||||
of a different Mail Transfert Agent (MTA) than 'sendmail -t'. The MTA must
|
||||
be able to guess the actual recipients from the 'To:' message header.
|
||||
|
||||
Standardized the copyright notices on all auxiliary files (including this
|
||||
one!) according to the example set by the GNU hello program. Removed
|
||||
immutable end texts from the texinfo document. These changes are required
|
||||
for Debianization. Released as version 1.0.6.
|
||||
* Noteworthy changes in release 1.1.1 (2018-04-08) [stable]
|
||||
|
||||
** Bug fixes
|
||||
|
||||
Sunday, 13th June 2010
|
||||
The "--disable-multi-user" configure variable is not reversed anymore.
|
||||
'cron' and 'crontab' are now installed unless this option is used.
|
||||
|
||||
Made some technical changes to the build system to aid Debianization.
|
||||
Released without announcement as version 1.0.5.
|
||||
The programs now sets the GUILE_LOAD_PATH and GUILE_LOAD_COMPILED_PATH
|
||||
environment variables with the location of the installed Guile modules.
|
||||
|
||||
The GIT repository has been completely re-hashed, and now represents a
|
||||
complete and faithful history of the package's development since its
|
||||
inception.
|
||||
|
||||
'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', and 'next-second' no
|
||||
longer crashes when passing an optional argument.
|
||||
[bug introduced in mcron-1.1]
|
||||
|
||||
Thursday, 21st February 2008
|
||||
** Improvements
|
||||
|
||||
The source code is now held in a GIT repository, at
|
||||
git://git.savannah.gnu.org/mcron.git.
|
||||
Some basic tests for the installed programs can be run after 'make install'
|
||||
with 'make installcheck'.
|
||||
|
||||
Released version 1.0.4, under the new GPLv3 license, after some prodding by
|
||||
Karl Berry.
|
||||
The configuration files are now processed using a deterministic order.
|
||||
|
||||
The test suite code coverage for mcron modules is now at 66.8% in term of
|
||||
number of lines (mcron-1.1 was at 23.7%).
|
||||
|
||||
Sunday, 16th April 2006
|
||||
Released version 1.0.3. Incorporated many coding suggestions by Sergey
|
||||
Poznyakoff, which makes the program work with daylight savings time shifts,
|
||||
fixes a bug in parsing Vixie-style input files, allows a user the
|
||||
opportunity to correct a crontab entry instead of just wiping out the file.
|
||||
Made it work with Guile 1.8. Updated the manual with GFDL and some minor
|
||||
suggestions from Karl Berry.
|
||||
* Noteworthy changes in release 1.1 (2018-03-19) [stable]
|
||||
|
||||
** New features
|
||||
|
||||
Monday, 2nd January 2006
|
||||
Released version 1.0.2.
|
||||
The 'job' procedure has now a '#:user' keyword argument which allows
|
||||
specifying a different user that will run it.
|
||||
|
||||
Additional man pages for 'cron(8)' and 'crontab(1)' are now generated using
|
||||
GNU Help2man.
|
||||
|
||||
Saturday, 15th May 2004
|
||||
Set up Savannah and the mailing lists so that we are now homed properly at
|
||||
gnu.org. Released version 1.0.1 to reflect this, with CVS tag release_1-0-1
|
||||
(no branch). Hopefully we will now get some feedback!
|
||||
** Bug fixes
|
||||
|
||||
Child process created when executing a job are now properly cleaned even
|
||||
when execution fails by using 'dynamic-wind' construct.
|
||||
|
||||
Friday, 12th December 2003
|
||||
Released version 1.0.0 through rdmp.org. No CVS tag has been created.
|
||||
** Improvements
|
||||
|
||||
GNU Guile 2.2 is now supported.
|
||||
|
||||
Tuesday, 2nd December 2003
|
||||
Mcron is now officially a GNU program. Unfortunately Savannah, the
|
||||
development environment, has been mauled so an immediate GNU release is not
|
||||
likely. No CVS tag has been created.
|
||||
Some procedures are now written using functional style and include a
|
||||
docstring. 'def-macro' usages are now replaced with hygienic macros.
|
||||
|
||||
Compilation is now done using a non-recursive Makefile, supports out of tree
|
||||
builds, and use silent rules by default.
|
||||
|
||||
Tuesday, 5th August 2003
|
||||
Released version 0.99.3. The CVS tag will be release_0-99-3 (no branch).
|
||||
Guile object files creation don't rely on auto-compilation anymore and are
|
||||
installed in 'site-ccache' directory.
|
||||
|
||||
Jobs are now internally represented using SRFI-9 records instead of vectors.
|
||||
|
||||
Sunday, 3rd August 2003
|
||||
Broken the code into modules (which is not the same as saying the code is
|
||||
broken ;-) ).
|
||||
Changelog are generated from Git logs when generating the tarball using
|
||||
Gnulib gitlog-to-changelog script.
|
||||
|
||||
A test suite is now available and can be run with 'make check'.
|
||||
|
||||
Sunday, 20th July 2003
|
||||
Released version 0.99.2. (Now fully functional). The CVS tag is
|
||||
release_0-99-2 (no branch).
|
||||
** Changes in behavior
|
||||
|
||||
The "--enable-debug" configure variable has been removed and replaced with
|
||||
MCRON_DEBUG environment variable.
|
||||
|
||||
Sunday, 20th July 2003
|
||||
It has been a long and painful journey, but we have at last worked out how
|
||||
to work around all the faults in Guile (an implementation with no threads
|
||||
and no UNIX signals!). The code is now really 100% Vixie compatible.
|
||||
The "--disable-multi-user" configure variable is now used to not build and
|
||||
install the 'cron' and 'crontab' programs. It has replaced the
|
||||
"--enable-no-vixie-clobber" which had similar effect.
|
||||
|
||||
(mcron core) module is now deprecated and has been superseeded by
|
||||
(mcron base).
|
||||
|
||||
Saturday, 5th July 2003
|
||||
Released version 0.99.1, with installation of cron and crontab disabled by
|
||||
default (suspect problems with Guile internals are preventing these from
|
||||
working properly). The CVS tag is release_0-99-1 (no branch has been
|
||||
created for it).
|
||||
* Noteworthy changes in release 1.0.8 (2014-04-28) [stable]
|
||||
|
||||
Man page is now generated with GNU Help2man before installation and
|
||||
distributed in the tarball.
|
||||
|
||||
Friday, 4th July 2003
|
||||
We have been accepted as a Savannah project. A CVS repository and web home
|
||||
page have been created. We're still waiting for acceptance as a GNU
|
||||
project.
|
||||
* Noteworthy changes in release 1.0.7 (2012-02-04) [stable]
|
||||
|
||||
Mcron is now compatible with Guile 2.0.
|
||||
|
||||
FreeDesktop.org's standard user configuration directories are now used to
|
||||
find the user script files.
|
||||
|
||||
* Noteworthy changes in release 1.0.6 (2010-06-20) [stable]
|
||||
|
||||
The copyright notices are now standardized on all auxiliary files. This
|
||||
follows the example set by the GNU hello program.
|
||||
|
||||
immutable end texts from the texinfo document are now removed, to
|
||||
accomodate with Debian requirements.
|
||||
|
||||
* Noteworthy changes in release 1.0.5 (2010-06-13) [stable]
|
||||
|
||||
Some technical changes to the build system has been made to help the
|
||||
distribution to Debian.
|
||||
|
||||
The Git repository has been completely re-hashed, and now represents a
|
||||
complete and faithful history of the package's development since its
|
||||
inception.
|
||||
|
||||
* Noteworthy changes in release 1.0.4 (2008-02-21) [stable]
|
||||
|
||||
The source code is now held in a Git repository, which can be checked-out at
|
||||
<git://git.savannah.gnu.org/mcron.git>.
|
||||
|
||||
The code is now covered by the GPLv3 license.
|
||||
|
||||
* Noteworthy changes in release 1.0.3 (2006-04-16) [stable]
|
||||
|
||||
daylight savings time shifts are now properly handled
|
||||
|
||||
Parsing Vixie-style input files has been improved.
|
||||
|
||||
Crontab entries can now be corrected instead of just wiping out the file.
|
||||
|
||||
Mcron is now compatible with Guile 1.8.
|
||||
|
||||
The manual is now licensed under the GNU Free Documentation License (GFDL)
|
||||
|
||||
* Noteworthy changes in release 1.0.2 (2006-01-02) [stable]
|
||||
|
||||
* Noteworthy changes in release 1.0.1 (2004-05-15) [stable]
|
||||
|
||||
The mailing list <bug-mcron@gnu.org> has been set-up.
|
||||
|
||||
* Noteworthy changes in release 1.0 (2003-12-12) [stable]
|
||||
|
||||
Mcron is now officially a GNU program.
|
||||
|
||||
* Noteworthy changes in release 0.99.3 (2003-08-05) [stable]
|
||||
|
||||
The code is now splitted into modules.
|
||||
|
||||
* Noteworthy changes in release 0.99.2 (2003-07-20) [stable]
|
||||
|
||||
The implementation is now really 100% Vixie compatible.
|
||||
|
||||
Some Guile limitations such as the absence of POSIX threads and signals has
|
||||
been worked around.
|
||||
|
||||
* Noteworthy changes in release 0.99.1 (2003-07-05) [stable]
|
||||
|
||||
Installation of cron and crontab is now disabled by default (suspect problems
|
||||
with Guile internals are preventing these from working properly).
|
||||
|
||||
The project is now managed on Savannah. A CVS repository and web page have been
|
||||
created.
|
||||
|
||||
========================================================================
|
||||
|
||||
Copyright © 2003, 2005, 2006 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
Copyright © 2017, 2018 Mathieu Lirzin <mthl@gnu.org>
|
||||
Copyright © 2018 宋文武 <iyzsong@member.fsf.org>
|
||||
|
||||
Copying and distribution of this file, with or without modification,
|
||||
are permitted in any medium without royalty provided the copyright
|
||||
notice and this notice are preserved.
|
||||
|
|
|
|||
56
README
56
README
|
|
@ -1,29 +1,20 @@
|
|||
GNU mcron --- README -*-text-*-
|
||||
|
||||
Copyright (C) 2003, 2005, 2006, 2012, 2014 Dale Mellor
|
||||
|
||||
Copying and distribution of this file, with or without modification,
|
||||
are permitted in any medium without royalty provided the copyright
|
||||
notice and this notice are preserved.
|
||||
|
||||
|
||||
This is version 1.0.8 of the GNU mcron program. It is designed and written by
|
||||
Dale Mellor, and replaces and hugely enhances Vixie cron. It is functionally
|
||||
complete, production quality code (did you expect less?), but has not received
|
||||
much testing yet. It has only been built on a GNU/Linux system, and will most
|
||||
likely fail on others (but you never know...).
|
||||
This is GNU Mcron, a tool to run jobs at scheduled times. It is a complete
|
||||
replacement for Vixie cron. Besides supporting the traditional Vixie syntax
|
||||
for its configuration files, GNU Mcron offers the possibility to define jobs
|
||||
using the Scheme language.
|
||||
|
||||
See the INSTALL file for generic information about how to configure and
|
||||
install GNU Mcron. If this file is not present, see HACKING for
|
||||
preliminary build instructions.
|
||||
|
||||
----------------------------------------------------------------------
|
||||
IMPORTANT NOTICES
|
||||
|
||||
Read the BUGS file.
|
||||
|
||||
Do not (yet) install this software on a machine which relies for its
|
||||
functioning on its current set of crontabs.
|
||||
|
||||
For use as a replacement cron daemon on a system, the package must be installed
|
||||
by root.
|
||||
To not replace the cron daemon on a system, the package must be installed
|
||||
with the --disable-multi-user configure option.
|
||||
|
||||
Before installing this package for the first time, it is necessary to terminate
|
||||
any running cron daemons on your system. If your old cron is not Vixie or
|
||||
|
|
@ -52,22 +43,27 @@ m.mcron, m.cron (or m.crond) and m.crontab.
|
|||
----------------------------------------------------------------------
|
||||
|
||||
|
||||
See the file INSTALL for generic building and installation instructions.
|
||||
After compilation, read the info file for full instructions for use (typing
|
||||
'info -f doc/mcron.info' at the command line should suffice). Notes for end
|
||||
users, sysadmins, and developers who wish to incorporate mcron into their own
|
||||
programs are included here.
|
||||
|
||||
After installation, read the info file for full instructions for use (typing
|
||||
`info mcron' at the command line should suffice). Notes for end users,
|
||||
sysadmins, and developers who wish to incorporate mcron into their own programs
|
||||
are included here.
|
||||
Features which might be implemented sometime sooner or later are noted in the
|
||||
TODO file.
|
||||
|
||||
Known bugs are noted in the BUGS file, and features which might be implemented
|
||||
sometime sooner or later are noted in the TODO file.
|
||||
|
||||
Please send all other bug reports to bug-mcron@gnu.org. Other mailing lists you
|
||||
could subscribe to are help-mcron@gnu.org (for help and advice from the
|
||||
community, including the author) and info-mcron@gnu.org (for news as it
|
||||
happens).
|
||||
Please send all other bug reports to bug-mcron@gnu.org.
|
||||
|
||||
Mcron is free software. See the file COPYING for copying conditions.
|
||||
|
||||
The mcron development home page is at http://www.gnu.org/software/mcron, and it
|
||||
can be obtained from ftp://ftp.gnu.org/pub/gnu/mcron.
|
||||
|
||||
-----
|
||||
|
||||
Copyright © 2003, 2005, 2006, 2012, 2014 Dale Mellor
|
||||
Copyright © 2018 Mathieu Lirzin
|
||||
|
||||
Copying and distribution of this file, with or without modification,
|
||||
are permitted in any medium without royalty provided the copyright
|
||||
notice and this notice are preserved. This file is offered as-is,
|
||||
without warranty of any kind.
|
||||
|
|
|
|||
23
README--git
23
README--git
|
|
@ -1,23 +0,0 @@
|
|||
GNU mcron --- README--git -*-text-*-
|
||||
|
||||
Copyright (C) 2012, 2014 Dale Mellor
|
||||
|
||||
Copying and distribution of this file, with or without modification,
|
||||
are permitted in any medium without royalty provided the copyright
|
||||
notice and this notice are preserved.
|
||||
|
||||
|
||||
If you have pulled mcron from the GIT repository, these are the steps you will
|
||||
need to take to build it the first time:
|
||||
|
||||
1) aclocal
|
||||
2) autoconf
|
||||
3) automake -a (will error)
|
||||
4) ./configure (will error)
|
||||
5) automake -a
|
||||
6) ./configure --prefix={wherever}
|
||||
7) make install
|
||||
|
||||
|
||||
After that it should just be a simple matter of typing `make install' when you
|
||||
want to build a version with changes in it.
|
||||
6
TODO
6
TODO
|
|
@ -1,5 +1,6 @@
|
|||
GNU mcron --- TODO -*-text-*-
|
||||
|
||||
Copyright (C) 2015, 2016 Mathieu Lirzin
|
||||
Copyright (C) 2003, 2005, 2006, 2014 Dale Mellor
|
||||
|
||||
Copying and distribution of this file, with or without modification,
|
||||
|
|
@ -19,6 +20,11 @@ Maybe in the near future...
|
|||
core or other users' files up. Then allow scheme code in the system
|
||||
crontabs.
|
||||
|
||||
* Provide a test suite using SRFI-64 API.
|
||||
<http://srfi.schemers.org/srfi-64/srfi-64.html>.
|
||||
|
||||
* Internationalize Mcron using GNU Gettext and ask the Translation
|
||||
Project to handle the localization.
|
||||
|
||||
|
||||
There are no plans to actually do the following any time soon...
|
||||
|
|
|
|||
5
bootstrap
Executable file
5
bootstrap
Executable file
|
|
@ -0,0 +1,5 @@
|
|||
#!/bin/sh
|
||||
# Initialize the build system.
|
||||
|
||||
set -e -x
|
||||
exec autoreconf -vfi
|
||||
557
build-aux/announce-gen
Normal file
557
build-aux/announce-gen
Normal file
|
|
@ -0,0 +1,557 @@
|
|||
eval '(exit $?0)' && eval 'exec perl -wS "$0" "$@"'
|
||||
& eval 'exec perl -wS "$0" $argv:q'
|
||||
if 0;
|
||||
# Generate a release announcement message.
|
||||
|
||||
my $VERSION = '2018-03-07 03:46'; # UTC
|
||||
# The definition above must lie within the first 8 lines in order
|
||||
# for the Emacs time-stamp write hook (at end) to update it.
|
||||
# If you change this file with Emacs, please let the write hook
|
||||
# do its job. Otherwise, update this string manually.
|
||||
|
||||
# Copyright (C) 2002-2018 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 <https://www.gnu.org/licenses/>.
|
||||
|
||||
# Written by Jim Meyering
|
||||
|
||||
use strict;
|
||||
|
||||
use Getopt::Long;
|
||||
use POSIX qw(strftime);
|
||||
|
||||
(my $ME = $0) =~ s|.*/||;
|
||||
|
||||
my %valid_release_types = map {$_ => 1} qw (alpha beta stable);
|
||||
my @archive_suffixes = ('tar.gz', 'tar.bz2', 'tar.lzma', 'tar.xz');
|
||||
my %digest_classes =
|
||||
(
|
||||
'md5' => (eval { require Digest::MD5; } and 'Digest::MD5'),
|
||||
'sha1' => ((eval { require Digest::SHA; } and 'Digest::SHA')
|
||||
or (eval { require Digest::SHA1; } and 'Digest::SHA1'))
|
||||
);
|
||||
my $srcdir = '.';
|
||||
|
||||
sub usage ($)
|
||||
{
|
||||
my ($exit_code) = @_;
|
||||
my $STREAM = ($exit_code == 0 ? *STDOUT : *STDERR);
|
||||
if ($exit_code != 0)
|
||||
{
|
||||
print $STREAM "Try '$ME --help' for more information.\n";
|
||||
}
|
||||
else
|
||||
{
|
||||
my @types = sort keys %valid_release_types;
|
||||
print $STREAM <<EOF;
|
||||
Usage: $ME [OPTIONS]
|
||||
Generate an announcement message. Run this from builddir.
|
||||
|
||||
OPTIONS:
|
||||
|
||||
These options must be specified:
|
||||
|
||||
--release-type=TYPE TYPE must be one of @types
|
||||
--package-name=PACKAGE_NAME
|
||||
--previous-version=VER
|
||||
--current-version=VER
|
||||
--gpg-key-id=ID The GnuPG ID of the key used to sign the tarballs
|
||||
--url-directory=URL_DIR
|
||||
|
||||
The following are optional:
|
||||
|
||||
--news=NEWS_FILE include the NEWS section about this release
|
||||
from this NEWS_FILE; accumulates.
|
||||
--srcdir=DIR where to find the NEWS_FILEs (default: $srcdir)
|
||||
--bootstrap-tools=TOOL_LIST a comma-separated list of tools, e.g.,
|
||||
autoconf,automake,bison,gnulib
|
||||
--gnulib-version=VERSION report VERSION as the gnulib version, where
|
||||
VERSION is the result of running git describe
|
||||
in the gnulib source directory.
|
||||
required if gnulib is in TOOL_LIST.
|
||||
--no-print-checksums do not emit MD5 or SHA1 checksums
|
||||
--archive-suffix=SUF add SUF to the list of archive suffixes
|
||||
--mail-headers=HEADERS a space-separated list of mail headers, e.g.,
|
||||
To: x\@example.com Cc: y-announce\@example.com,...
|
||||
|
||||
--help display this help and exit
|
||||
--version output version information and exit
|
||||
|
||||
EOF
|
||||
}
|
||||
exit $exit_code;
|
||||
}
|
||||
|
||||
|
||||
=item C<%size> = C<sizes (@file)>
|
||||
|
||||
Compute the sizes of the C<@file> and return them as a hash. Return
|
||||
C<undef> if one of the computation failed.
|
||||
|
||||
=cut
|
||||
|
||||
sub sizes (@)
|
||||
{
|
||||
my (@file) = @_;
|
||||
|
||||
my $fail = 0;
|
||||
my %res;
|
||||
foreach my $f (@file)
|
||||
{
|
||||
my $cmd = "du -h $f";
|
||||
my $t = `$cmd`;
|
||||
# FIXME-someday: give a better diagnostic, a la $PROCESS_STATUS
|
||||
$@
|
||||
and (warn "command failed: '$cmd'\n"), $fail = 1;
|
||||
chomp $t;
|
||||
$t =~ s/^\s*([\d.]+[MkK]).*/${1}B/;
|
||||
$res{$f} = $t;
|
||||
}
|
||||
return $fail ? undef : %res;
|
||||
}
|
||||
|
||||
=item C<print_locations ($title, \@url, \%size, @file)
|
||||
|
||||
Print a section C<$title> dedicated to the list of <@file>, which
|
||||
sizes are stored in C<%size>, and which are available from the C<@url>.
|
||||
|
||||
=cut
|
||||
|
||||
sub print_locations ($\@\%@)
|
||||
{
|
||||
my ($title, $url, $size, @file) = @_;
|
||||
print "Here are the $title:\n";
|
||||
foreach my $url (@{$url})
|
||||
{
|
||||
for my $file (@file)
|
||||
{
|
||||
print " $url/$file";
|
||||
print " (", $$size{$file}, ")"
|
||||
if exists $$size{$file};
|
||||
print "\n";
|
||||
}
|
||||
}
|
||||
print "\n";
|
||||
}
|
||||
|
||||
=item C<print_checksums (@file)
|
||||
|
||||
Print the MD5 and SHA1 signature section for each C<@file>.
|
||||
|
||||
=cut
|
||||
|
||||
sub print_checksums (@)
|
||||
{
|
||||
my (@file) = @_;
|
||||
|
||||
print "Here are the MD5 and SHA1 checksums:\n";
|
||||
print "\n";
|
||||
|
||||
foreach my $meth (qw (md5 sha1))
|
||||
{
|
||||
my $class = $digest_classes{$meth} or next;
|
||||
foreach my $f (@file)
|
||||
{
|
||||
open IN, '<', $f
|
||||
or die "$ME: $f: cannot open for reading: $!\n";
|
||||
binmode IN;
|
||||
my $dig = $class->new->addfile(*IN)->hexdigest;
|
||||
close IN;
|
||||
print "$dig $f\n";
|
||||
}
|
||||
}
|
||||
print "\n";
|
||||
}
|
||||
|
||||
=item C<print_news_deltas ($news_file, $prev_version, $curr_version)
|
||||
|
||||
Print the section of the NEWS file C<$news_file> addressing changes
|
||||
between versions C<$prev_version> and C<$curr_version>.
|
||||
|
||||
=cut
|
||||
|
||||
sub print_news_deltas ($$$)
|
||||
{
|
||||
my ($news_file, $prev_version, $curr_version) = @_;
|
||||
|
||||
my $news_name = $news_file;
|
||||
$news_name =~ s|^\Q$srcdir\E/||;
|
||||
|
||||
print "\n$news_name\n\n";
|
||||
|
||||
# Print all lines from $news_file, starting with the first one
|
||||
# that mentions $curr_version up to but not including
|
||||
# the first occurrence of $prev_version.
|
||||
my $in_items;
|
||||
|
||||
my $re_prefix = qr/(?:\* )?(?:Noteworthy c|Major c|C)(?i:hanges)/;
|
||||
|
||||
my $found_news;
|
||||
open NEWS, '<', $news_file
|
||||
or die "$ME: $news_file: cannot open for reading: $!\n";
|
||||
while (defined (my $line = <NEWS>))
|
||||
{
|
||||
if ( ! $in_items)
|
||||
{
|
||||
# Match lines like these:
|
||||
# * Major changes in release 5.0.1:
|
||||
# * Noteworthy changes in release 6.6 (2006-11-22) [stable]
|
||||
$line =~ /^$re_prefix.*(?:[^\d.]|$)\Q$curr_version\E(?:[^\d.]|$)/o
|
||||
or next;
|
||||
$in_items = 1;
|
||||
print $line;
|
||||
}
|
||||
else
|
||||
{
|
||||
# This regexp must not match version numbers in NEWS items.
|
||||
# For example, they might well say "introduced in 4.5.5",
|
||||
# and we don't want that to match.
|
||||
$line =~ /^$re_prefix.*(?:[^\d.]|$)\Q$prev_version\E(?:[^\d.]|$)/o
|
||||
and last;
|
||||
print $line;
|
||||
$line =~ /\S/
|
||||
and $found_news = 1;
|
||||
}
|
||||
}
|
||||
close NEWS;
|
||||
|
||||
$in_items
|
||||
or die "$ME: $news_file: no matching lines for '$curr_version'\n";
|
||||
$found_news
|
||||
or die "$ME: $news_file: no news item found for '$curr_version'\n";
|
||||
}
|
||||
|
||||
sub print_changelog_deltas ($$)
|
||||
{
|
||||
my ($package_name, $prev_version) = @_;
|
||||
|
||||
# Print new ChangeLog entries.
|
||||
|
||||
# First find all CVS-controlled ChangeLog files.
|
||||
use File::Find;
|
||||
my @changelog;
|
||||
find ({wanted => sub {$_ eq 'ChangeLog' && -d 'CVS'
|
||||
and push @changelog, $File::Find::name}},
|
||||
'.');
|
||||
|
||||
# If there are no ChangeLog files, we're done.
|
||||
@changelog
|
||||
or return;
|
||||
my %changelog = map {$_ => 1} @changelog;
|
||||
|
||||
# Reorder the list of files so that if there are ChangeLog
|
||||
# files in the specified directories, they're listed first,
|
||||
# in this order:
|
||||
my @dir = qw ( . src lib m4 config doc );
|
||||
|
||||
# A typical @changelog array might look like this:
|
||||
# ./ChangeLog
|
||||
# ./po/ChangeLog
|
||||
# ./m4/ChangeLog
|
||||
# ./lib/ChangeLog
|
||||
# ./doc/ChangeLog
|
||||
# ./config/ChangeLog
|
||||
my @reordered;
|
||||
foreach my $d (@dir)
|
||||
{
|
||||
my $dot_slash = $d eq '.' ? $d : "./$d";
|
||||
my $target = "$dot_slash/ChangeLog";
|
||||
delete $changelog{$target}
|
||||
and push @reordered, $target;
|
||||
}
|
||||
|
||||
# Append any remaining ChangeLog files.
|
||||
push @reordered, sort keys %changelog;
|
||||
|
||||
# Remove leading './'.
|
||||
@reordered = map { s!^\./!!; $_ } @reordered;
|
||||
|
||||
print "\nChangeLog entries:\n\n";
|
||||
# print join ("\n", @reordered), "\n";
|
||||
|
||||
$prev_version =~ s/\./_/g;
|
||||
my $prev_cvs_tag = "\U$package_name\E-$prev_version";
|
||||
|
||||
my $cmd = "cvs -n diff -u -r$prev_cvs_tag -rHEAD @reordered";
|
||||
open DIFF, '-|', $cmd
|
||||
or die "$ME: cannot run '$cmd': $!\n";
|
||||
# Print two types of lines, making minor changes:
|
||||
# Lines starting with '+++ ', e.g.,
|
||||
# +++ ChangeLog 22 Feb 2003 16:52:51 -0000 1.247
|
||||
# and those starting with '+'.
|
||||
# Don't print the others.
|
||||
my $prev_printed_line_empty = 1;
|
||||
while (defined (my $line = <DIFF>))
|
||||
{
|
||||
if ($line =~ /^\+\+\+ /)
|
||||
{
|
||||
my $separator = "*"x70 ."\n";
|
||||
$line =~ s///;
|
||||
$line =~ s/\s.*//;
|
||||
$prev_printed_line_empty
|
||||
or print "\n";
|
||||
print $separator, $line, $separator;
|
||||
}
|
||||
elsif ($line =~ /^\+/)
|
||||
{
|
||||
$line =~ s///;
|
||||
print $line;
|
||||
$prev_printed_line_empty = ($line =~ /^$/);
|
||||
}
|
||||
}
|
||||
close DIFF;
|
||||
|
||||
# The exit code should be 1.
|
||||
# Allow in case there are no modified ChangeLog entries.
|
||||
$? == 256 || $? == 128
|
||||
or warn "warning: '$cmd' had unexpected exit code or signal ($?)\n";
|
||||
}
|
||||
|
||||
sub get_tool_versions ($$)
|
||||
{
|
||||
my ($tool_list, $gnulib_version) = @_;
|
||||
@$tool_list
|
||||
or return ();
|
||||
|
||||
my $fail;
|
||||
my @tool_version_pair;
|
||||
foreach my $t (@$tool_list)
|
||||
{
|
||||
if ($t eq 'gnulib')
|
||||
{
|
||||
push @tool_version_pair, ucfirst $t . ' ' . $gnulib_version;
|
||||
next;
|
||||
}
|
||||
# Assume that the last "word" on the first line of
|
||||
# 'tool --version' output is the version string.
|
||||
my ($first_line, undef) = split ("\n", `$t --version`);
|
||||
if ($first_line =~ /.* (\d[\w.-]+)$/)
|
||||
{
|
||||
$t = ucfirst $t;
|
||||
push @tool_version_pair, "$t $1";
|
||||
}
|
||||
else
|
||||
{
|
||||
defined $first_line
|
||||
and $first_line = '';
|
||||
warn "$t: unexpected --version output\n:$first_line";
|
||||
$fail = 1;
|
||||
}
|
||||
}
|
||||
|
||||
$fail
|
||||
and exit 1;
|
||||
|
||||
return @tool_version_pair;
|
||||
}
|
||||
|
||||
{
|
||||
# Neutralize the locale, so that, for instance, "du" does not
|
||||
# issue "1,2" instead of "1.2", what confuses our regexps.
|
||||
$ENV{LC_ALL} = "C";
|
||||
|
||||
my $mail_headers;
|
||||
my $release_type;
|
||||
my $package_name;
|
||||
my $prev_version;
|
||||
my $curr_version;
|
||||
my $gpg_key_id;
|
||||
my @url_dir_list;
|
||||
my @news_file;
|
||||
my $bootstrap_tools;
|
||||
my $gnulib_version;
|
||||
my $print_checksums_p = 1;
|
||||
|
||||
# Reformat the warnings before displaying them.
|
||||
local $SIG{__WARN__} = sub
|
||||
{
|
||||
my ($msg) = @_;
|
||||
# Warnings from GetOptions.
|
||||
$msg =~ s/Option (\w)/option --$1/;
|
||||
warn "$ME: $msg";
|
||||
};
|
||||
|
||||
GetOptions
|
||||
(
|
||||
'mail-headers=s' => \$mail_headers,
|
||||
'release-type=s' => \$release_type,
|
||||
'package-name=s' => \$package_name,
|
||||
'previous-version=s' => \$prev_version,
|
||||
'current-version=s' => \$curr_version,
|
||||
'gpg-key-id=s' => \$gpg_key_id,
|
||||
'url-directory=s' => \@url_dir_list,
|
||||
'news=s' => \@news_file,
|
||||
'srcdir=s' => \$srcdir,
|
||||
'bootstrap-tools=s' => \$bootstrap_tools,
|
||||
'gnulib-version=s' => \$gnulib_version,
|
||||
'print-checksums!' => \$print_checksums_p,
|
||||
'archive-suffix=s' => \@archive_suffixes,
|
||||
|
||||
help => sub { usage 0 },
|
||||
version => sub { print "$ME version $VERSION\n"; exit },
|
||||
) or usage 1;
|
||||
|
||||
my $fail = 0;
|
||||
# Ensure that each required option is specified.
|
||||
$release_type
|
||||
or (warn "release type not specified\n"), $fail = 1;
|
||||
$package_name
|
||||
or (warn "package name not specified\n"), $fail = 1;
|
||||
$prev_version
|
||||
or (warn "previous version string not specified\n"), $fail = 1;
|
||||
$curr_version
|
||||
or (warn "current version string not specified\n"), $fail = 1;
|
||||
$gpg_key_id
|
||||
or (warn "GnuPG key ID not specified\n"), $fail = 1;
|
||||
@url_dir_list
|
||||
or (warn "URL directory name(s) not specified\n"), $fail = 1;
|
||||
|
||||
my @tool_list = split ',', $bootstrap_tools
|
||||
if $bootstrap_tools;
|
||||
|
||||
grep (/^gnulib$/, @tool_list) ^ defined $gnulib_version
|
||||
and (warn "when specifying gnulib as a tool, you must also specify\n"
|
||||
. "--gnulib-version=V, where V is the result of running git describe\n"
|
||||
. "in the gnulib source directory.\n"), $fail = 1;
|
||||
|
||||
!$release_type || exists $valid_release_types{$release_type}
|
||||
or (warn "'$release_type': invalid release type\n"), $fail = 1;
|
||||
|
||||
@ARGV
|
||||
and (warn "too many arguments:\n", join ("\n", @ARGV), "\n"),
|
||||
$fail = 1;
|
||||
$fail
|
||||
and usage 1;
|
||||
|
||||
my $my_distdir = "$package_name-$curr_version";
|
||||
|
||||
my $xd = "$package_name-$prev_version-$curr_version.xdelta";
|
||||
|
||||
my @candidates = map { "$my_distdir.$_" } @archive_suffixes;
|
||||
my @tarballs = grep {-f $_} @candidates;
|
||||
|
||||
@tarballs
|
||||
or die "$ME: none of " . join(', ', @candidates) . " were found\n";
|
||||
my @sizable = @tarballs;
|
||||
-f $xd
|
||||
and push @sizable, $xd;
|
||||
my %size = sizes (@sizable);
|
||||
%size
|
||||
or exit 1;
|
||||
|
||||
my $headers = '';
|
||||
if (defined $mail_headers)
|
||||
{
|
||||
($headers = $mail_headers) =~ s/\s+(\S+:)/\n$1/g;
|
||||
$headers .= "\n";
|
||||
}
|
||||
|
||||
# The markup is escaped as <\# so that when this script is sent by
|
||||
# mail (or part of a diff), Gnus is not triggered.
|
||||
print <<EOF;
|
||||
|
||||
${headers}Subject: $my_distdir released [$release_type]
|
||||
|
||||
<\#secure method=pgpmime mode=sign>
|
||||
|
||||
FIXME: put comments here
|
||||
|
||||
EOF
|
||||
|
||||
if (@url_dir_list == 1 && @tarballs == 1)
|
||||
{
|
||||
# When there's only one tarball and one URL, use a more concise form.
|
||||
my $m = "$url_dir_list[0]/$tarballs[0]";
|
||||
print "Here are the compressed sources and a GPG detached signature[*]:\n"
|
||||
. " $m\n"
|
||||
. " $m.sig\n\n";
|
||||
}
|
||||
else
|
||||
{
|
||||
print_locations ("compressed sources", @url_dir_list, %size, @tarballs);
|
||||
-f $xd
|
||||
and print_locations ("xdelta diffs (useful? if so, "
|
||||
. "please tell bug-gnulib\@gnu.org)",
|
||||
@url_dir_list, %size, $xd);
|
||||
my @sig_files = map { "$_.sig" } @tarballs;
|
||||
print_locations ("GPG detached signatures[*]", @url_dir_list, %size,
|
||||
@sig_files);
|
||||
}
|
||||
|
||||
if ($url_dir_list[0] =~ "gnu\.org")
|
||||
{
|
||||
print "Use a mirror for higher download bandwidth:\n";
|
||||
if (@tarballs == 1 && $url_dir_list[0] =~ m!https://ftp\.gnu\.org/gnu/!)
|
||||
{
|
||||
(my $m = "$url_dir_list[0]/$tarballs[0]")
|
||||
=~ s!https://ftp\.gnu\.org/gnu/!https://ftpmirror\.gnu\.org/!;
|
||||
print " $m\n"
|
||||
. " $m.sig\n\n";
|
||||
|
||||
}
|
||||
else
|
||||
{
|
||||
print " https://www.gnu.org/order/ftp.html\n\n";
|
||||
}
|
||||
}
|
||||
|
||||
$print_checksums_p
|
||||
and print_checksums (@sizable);
|
||||
|
||||
print <<EOF;
|
||||
[*] Use a .sig file to verify that the corresponding file (without the
|
||||
.sig suffix) is intact. First, be sure to download both the .sig file
|
||||
and the corresponding tarball. Then, run a command like this:
|
||||
|
||||
gpg --verify $tarballs[0].sig
|
||||
|
||||
If that command fails because you don't have the required public key,
|
||||
then run this command to import it:
|
||||
|
||||
gpg --keyserver keys.gnupg.net --recv-keys $gpg_key_id
|
||||
|
||||
and rerun the 'gpg --verify' command.
|
||||
EOF
|
||||
|
||||
my @tool_versions = get_tool_versions (\@tool_list, $gnulib_version);
|
||||
@tool_versions
|
||||
and print "\nThis release was bootstrapped with the following tools:",
|
||||
join ('', map {"\n $_"} @tool_versions), "\n";
|
||||
|
||||
print_news_deltas ($_, $prev_version, $curr_version)
|
||||
foreach @news_file;
|
||||
|
||||
$release_type eq 'stable'
|
||||
or print_changelog_deltas ($package_name, $prev_version);
|
||||
|
||||
exit 0;
|
||||
}
|
||||
|
||||
### Setup "GNU" style for perl-mode and cperl-mode.
|
||||
## Local Variables:
|
||||
## mode: perl
|
||||
## perl-indent-level: 2
|
||||
## perl-continued-statement-offset: 2
|
||||
## perl-continued-brace-offset: 0
|
||||
## perl-brace-offset: 0
|
||||
## perl-brace-imaginary-offset: 0
|
||||
## perl-label-offset: -2
|
||||
## perl-extra-newline-before-brace: t
|
||||
## perl-merge-trailing-else: nil
|
||||
## eval: (add-hook 'before-save-hook 'time-stamp)
|
||||
## time-stamp-start: "my $VERSION = '"
|
||||
## time-stamp-format: "%:y-%02m-%02d %02H:%02M"
|
||||
## time-stamp-time-zone: "UTC0"
|
||||
## time-stamp-end: "'; # UTC"
|
||||
## End:
|
||||
179
build-aux/do-release-commit-and-tag
Normal file
179
build-aux/do-release-commit-and-tag
Normal file
|
|
@ -0,0 +1,179 @@
|
|||
#!/bin/sh
|
||||
# In a git/autoconf/automake-enabled project with a NEWS file and a version-
|
||||
# controlled .prev-version file, automate the procedure by which we record
|
||||
# the date, release-type and version string in the NEWS file. That commit
|
||||
# will serve to identify the release, so apply a signed tag to it as well.
|
||||
VERSION=2018-03-07.03 # UTC
|
||||
|
||||
# Note: this is a bash script (could be zsh or dash)
|
||||
|
||||
# Copyright (C) 2009-2018 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 <https://www.gnu.org/licenses/>.
|
||||
|
||||
# Written by Jim Meyering
|
||||
|
||||
ME=$(basename "$0")
|
||||
warn() { printf '%s: %s\n' "$ME" "$*" >&2; }
|
||||
die() { warn "$*"; exit 1; }
|
||||
|
||||
help()
|
||||
{
|
||||
cat <<EOF
|
||||
Usage: $ME [OPTION...] VERSION RELEASE_TYPE
|
||||
|
||||
Run this script from top_srcdir to perform the final pre-release NEWS
|
||||
update in which the date, release-type and version string are
|
||||
recorded. Commit that result with a log entry marking the release,
|
||||
and apply a signed tag. Run it from your project's top-level
|
||||
directory.
|
||||
|
||||
Requirements:
|
||||
- you use git for version-control
|
||||
- a version-controlled .prev-version file
|
||||
- a NEWS file, with line 3 identical to this:
|
||||
$noteworthy_stub
|
||||
|
||||
Options:
|
||||
--branch=BRANCH set release branch (default: $branch)
|
||||
-C, --builddir=DIR location of (configured) Makefile (default: $builddir)
|
||||
--help print this help, then exit
|
||||
--version print version number, then exit
|
||||
|
||||
EXAMPLE:
|
||||
To update NEWS and tag the beta 8.1 release of coreutils, I would run this:
|
||||
|
||||
$ME 8.1 beta
|
||||
|
||||
Report bugs and patches to <bug-gnulib@gnu.org>.
|
||||
EOF
|
||||
exit
|
||||
}
|
||||
|
||||
version()
|
||||
{
|
||||
year=$(echo "$VERSION" | sed 's/[^0-9].*//')
|
||||
cat <<EOF
|
||||
$ME $VERSION
|
||||
Copyright (C) $year Free Software Foundation, Inc,
|
||||
License GPLv3+: GNU GPL version 3 or later <https://gnu.org/licenses/gpl.html>
|
||||
This is free software: you are free to change and redistribute it.
|
||||
There is NO WARRANTY, to the extent permitted by law.
|
||||
EOF
|
||||
exit
|
||||
}
|
||||
|
||||
## ------ ##
|
||||
## Main. ##
|
||||
## ------ ##
|
||||
|
||||
# Constants.
|
||||
noteworthy='* Noteworthy changes in release'
|
||||
noteworthy_stub="$noteworthy ?.? (????-??-??) [?]"
|
||||
|
||||
# Variables.
|
||||
branch=$(git branch | sed -ne '/^\* /{s///;p;q;}')
|
||||
builddir=.
|
||||
|
||||
while test $# != 0
|
||||
do
|
||||
# Handle --option=value by splitting apart and putting back on argv.
|
||||
case $1 in
|
||||
--*=*)
|
||||
opt=$(echo "$1" | sed -e 's/=.*//')
|
||||
val=$(echo "$1" | sed -e 's/[^=]*=//')
|
||||
shift
|
||||
set dummy "$opt" "$val" "$@"; shift
|
||||
;;
|
||||
esac
|
||||
|
||||
case $1 in
|
||||
--help|--version) ${1#--};;
|
||||
--branch) shift; branch=$1; shift ;;
|
||||
-C|--builddir) shift; builddir=$1; shift ;;
|
||||
--*) die "unrecognized option: $1";;
|
||||
*) break;;
|
||||
esac
|
||||
done
|
||||
|
||||
test $# = 2 \
|
||||
|| die "Usage: $ME [OPTION...] VERSION TYPE"
|
||||
|
||||
ver=$1
|
||||
type=$2
|
||||
|
||||
|
||||
## ---------------------- ##
|
||||
## First, sanity checks. ##
|
||||
## ---------------------- ##
|
||||
|
||||
# Verify that $ver looks like a version number, and...
|
||||
echo "$ver"|grep -E '^[0-9][0-9.]*[0-9]$' > /dev/null \
|
||||
|| die "invalid version: $ver"
|
||||
prev_ver=$(cat .prev-version) \
|
||||
|| die 'failed to determine previous version number from .prev-version'
|
||||
|
||||
# Verify that $ver is sensible (> .prev-version).
|
||||
case $(printf "$prev_ver\n$ver\n"|sort -V -u|tr '\n' ':') in
|
||||
"$prev_ver:$ver:") ;;
|
||||
*) die "invalid version: $ver (<= $prev_ver)";;
|
||||
esac
|
||||
|
||||
case $type in
|
||||
alpha|beta|stable) ;;
|
||||
*) die "invalid release type: $type";;
|
||||
esac
|
||||
|
||||
# No local modifications allowed.
|
||||
case $(git diff-index --name-only HEAD) in
|
||||
'') ;;
|
||||
*) die 'this tree is dirty; commit your changes first';;
|
||||
esac
|
||||
|
||||
# Ensure the current branch name is correct:
|
||||
curr_br=$(git rev-parse --symbolic-full-name HEAD)
|
||||
test "$curr_br" = "refs/heads/$branch" || die not on branch $branch
|
||||
|
||||
# Extract package name from Makefile.
|
||||
Makefile=$builddir/Makefile
|
||||
pkg=$(sed -n 's/^PACKAGE = \(.*\)/\1/p' "$Makefile") \
|
||||
|| die "failed to determine package name from $Makefile"
|
||||
|
||||
# Check that line 3 of NEWS is the stub line about to be replaced.
|
||||
test "$(sed -n 3p NEWS)" = "$noteworthy_stub" \
|
||||
|| die "line 3 of NEWS must be exactly '$noteworthy_stub'"
|
||||
|
||||
## --------------- ##
|
||||
## Then, changes. ##
|
||||
## --------------- ##
|
||||
|
||||
# Update NEWS to have today's date, plus desired version number and $type.
|
||||
perl -MPOSIX -ni -e 'my $today = strftime "%F", localtime time;' \
|
||||
-e 'my ($type, $ver) = qw('"$type $ver"');' \
|
||||
-e 'my $pfx = "'"$noteworthy"'";' \
|
||||
-e 'print $.==3 ? "$pfx $ver ($today) [$type]\n" : $_' \
|
||||
NEWS || die 'failed to update NEWS'
|
||||
|
||||
printf "version $ver\n\n* NEWS: Record release date.\n" \
|
||||
| git commit -F - -a || die 'git commit failed'
|
||||
git tag -s -m "$pkg $ver" v$ver HEAD || die 'git tag failed'
|
||||
|
||||
# Local variables:
|
||||
# indent-tabs-mode: nil
|
||||
# eval: (add-hook 'before-save-hook 'time-stamp)
|
||||
# time-stamp-start: "VERSION="
|
||||
# time-stamp-format: "%:y-%02m-%02d.%02H"
|
||||
# time-stamp-time-zone: "UTC0"
|
||||
# time-stamp-end: " # UTC"
|
||||
# End:
|
||||
210
build-aux/gnu-web-doc-update
Normal file
210
build-aux/gnu-web-doc-update
Normal file
|
|
@ -0,0 +1,210 @@
|
|||
#!/bin/sh
|
||||
# Run this after each non-alpha release, to update the web documentation at
|
||||
# https://www.gnu.org/software/$pkg/manual/
|
||||
|
||||
VERSION=2018-03-07.03; # UTC
|
||||
|
||||
# Copyright (C) 2009-2018 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 <https://www.gnu.org/licenses/>.
|
||||
|
||||
ME=$(basename "$0")
|
||||
warn() { printf '%s: %s\n' "$ME" "$*" >&2; }
|
||||
die() { warn "$*"; exit 1; }
|
||||
|
||||
help()
|
||||
{
|
||||
cat <<EOF
|
||||
Usage: $ME
|
||||
|
||||
Run this script from top_srcdir (no arguments) after each non-alpha
|
||||
release, to update the web documentation at
|
||||
https://www.gnu.org/software/\$pkg/manual/
|
||||
|
||||
This script assumes you're using git for revision control, and
|
||||
requires a .prev-version file as well as a Makefile, from which it
|
||||
extracts the version number and package name, respectively. Also, it
|
||||
assumes all documentation is in the doc/ sub-directory.
|
||||
|
||||
Options:
|
||||
-C, --builddir=DIR location of (configured) Makefile (default: .)
|
||||
-n, --dry-run don't actually commit anything
|
||||
-m, --mirror remove out of date files from document server
|
||||
--help print this help, then exit
|
||||
--version print version number, then exit
|
||||
|
||||
Report bugs and patches to <bug-gnulib@gnu.org>.
|
||||
EOF
|
||||
exit
|
||||
}
|
||||
|
||||
version()
|
||||
{
|
||||
year=$(echo "$VERSION" | sed 's/[^0-9].*//')
|
||||
cat <<EOF
|
||||
$ME $VERSION
|
||||
Copyright (C) $year Free Software Foundation, Inc,
|
||||
License GPLv3+: GNU GPL version 3 or later <https://gnu.org/licenses/gpl.html>
|
||||
This is free software: you are free to change and redistribute it.
|
||||
There is NO WARRANTY, to the extent permitted by law.
|
||||
EOF
|
||||
exit
|
||||
}
|
||||
|
||||
# find_tool ENVVAR NAMES...
|
||||
# -------------------------
|
||||
# Search for a required program. Use the value of ENVVAR, if set,
|
||||
# otherwise find the first of the NAMES that can be run (i.e.,
|
||||
# supports --version). If found, set ENVVAR to the program name,
|
||||
# die otherwise.
|
||||
#
|
||||
# FIXME: code duplication, see also bootstrap.
|
||||
find_tool ()
|
||||
{
|
||||
find_tool_envvar=$1
|
||||
shift
|
||||
find_tool_names=$@
|
||||
eval "find_tool_res=\$$find_tool_envvar"
|
||||
if test x"$find_tool_res" = x; then
|
||||
for i
|
||||
do
|
||||
if ($i --version </dev/null) >/dev/null 2>&1; then
|
||||
find_tool_res=$i
|
||||
break
|
||||
fi
|
||||
done
|
||||
else
|
||||
find_tool_error_prefix="\$$find_tool_envvar: "
|
||||
fi
|
||||
test x"$find_tool_res" != x \
|
||||
|| die "one of these is required: $find_tool_names"
|
||||
($find_tool_res --version </dev/null) >/dev/null 2>&1 \
|
||||
|| die "${find_tool_error_prefix}cannot run $find_tool_res --version"
|
||||
eval "$find_tool_envvar=\$find_tool_res"
|
||||
eval "export $find_tool_envvar"
|
||||
}
|
||||
|
||||
## ------ ##
|
||||
## Main. ##
|
||||
## ------ ##
|
||||
|
||||
# Requirements: everything required to bootstrap your package, plus
|
||||
# these.
|
||||
find_tool CVS cvs
|
||||
find_tool GIT git
|
||||
find_tool RSYNC rsync
|
||||
find_tool XARGS gxargs xargs
|
||||
|
||||
builddir=.
|
||||
dryrun=
|
||||
rm_stale='echo'
|
||||
while test $# != 0
|
||||
do
|
||||
# Handle --option=value by splitting apart and putting back on argv.
|
||||
case $1 in
|
||||
--*=*)
|
||||
opt=$(echo "$1" | sed -e 's/=.*//')
|
||||
val=$(echo "$1" | sed -e 's/[^=]*=//')
|
||||
shift
|
||||
set dummy "$opt" "$val" "$@"; shift
|
||||
;;
|
||||
esac
|
||||
|
||||
case $1 in
|
||||
--help|--version) ${1#--};;
|
||||
-C|--builddir) shift; builddir=$1; shift ;;
|
||||
-n|--dry-run) dryrun=echo; shift;;
|
||||
-m|--mirror) rm_stale=''; shift;;
|
||||
--*) die "unrecognized option: $1";;
|
||||
*) break;;
|
||||
esac
|
||||
done
|
||||
|
||||
test $# = 0 \
|
||||
|| die "too many arguments"
|
||||
|
||||
prev=.prev-version
|
||||
version=$(cat $prev) || die "no $prev file?"
|
||||
pkg=$(sed -n 's/^PACKAGE = \(.*\)/\1/p' $builddir/Makefile) \
|
||||
|| die "no Makefile?"
|
||||
tmp_branch=web-doc-$version-$$
|
||||
current_branch=$($GIT branch | sed -ne '/^\* /{s///;p;q;}')
|
||||
|
||||
cleanup()
|
||||
{
|
||||
__st=$?
|
||||
$dryrun rm -rf "$tmp"
|
||||
$GIT checkout "$current_branch"
|
||||
$GIT submodule update --recursive
|
||||
$GIT branch -d $tmp_branch
|
||||
exit $__st
|
||||
}
|
||||
trap cleanup 0
|
||||
trap 'exit $?' 1 2 13 15
|
||||
|
||||
# We must build using sources for which --version reports the
|
||||
# just-released version number, not some string like 7.6.18-20761.
|
||||
# That version string propagates into all documentation.
|
||||
set -e
|
||||
$GIT checkout -b $tmp_branch v$version
|
||||
$GIT submodule update --recursive
|
||||
./bootstrap
|
||||
srcdir=$(pwd)
|
||||
cd "$builddir"
|
||||
builddir=$(pwd)
|
||||
./config.status --recheck
|
||||
./config.status
|
||||
make
|
||||
make web-manual
|
||||
cd "$srcdir"
|
||||
set +e
|
||||
|
||||
tmp=$(mktemp -d web-doc-update.XXXXXX) || exit 1
|
||||
( cd $tmp \
|
||||
&& $CVS -d $USER@cvs.sv.gnu.org:/webcvs/$pkg co $pkg )
|
||||
$RSYNC -avP "$builddir"/doc/manual/ $tmp/$pkg/manual
|
||||
|
||||
(
|
||||
cd $tmp/$pkg/manual
|
||||
|
||||
# Add all the files. This is simpler than trying to add only the
|
||||
# new ones because of new directories
|
||||
# First add non empty dirs individually
|
||||
find . -name CVS -prune -o -type d \! -empty -print \
|
||||
| $XARGS -n1 --no-run-if-empty -- $dryrun $CVS add -ko
|
||||
# Now add all files
|
||||
find . -name CVS -prune -o -type f -print \
|
||||
| $XARGS --no-run-if-empty -- $dryrun $CVS add -ko
|
||||
|
||||
# Report/Remove stale files
|
||||
# excluding doc server specific files like CVS/* and .symlinks
|
||||
if test -n "$rm_stale"; then
|
||||
echo 'Consider the --mirror option if all of the manual is generated,' >&2
|
||||
echo 'which will run `cvs remove` to remove stale files.' >&2
|
||||
fi
|
||||
{ find . \( -name CVS -o -type f -name '.*' \) -prune -o -type f -print
|
||||
(cd "$builddir"/doc/manual/ && find . -type f -print | sed p)
|
||||
} | sort | uniq -u \
|
||||
| $XARGS --no-run-if-empty -- ${rm_stale:-$dryrun} $CVS remove -f
|
||||
|
||||
$dryrun $CVS ci -m $version
|
||||
)
|
||||
|
||||
# Local variables:
|
||||
# eval: (add-hook 'before-save-hook 'time-stamp)
|
||||
# time-stamp-start: "VERSION="
|
||||
# time-stamp-format: "%:y-%02m-%02d.%02H"
|
||||
# time-stamp-time-zone: "UTC0"
|
||||
# time-stamp-end: "; # UTC"
|
||||
# End:
|
||||
440
build-aux/gnupload
Normal file
440
build-aux/gnupload
Normal file
|
|
@ -0,0 +1,440 @@
|
|||
#!/bin/sh
|
||||
# Sign files and upload them.
|
||||
|
||||
scriptversion=2018-03-07.03; # UTC
|
||||
|
||||
# Copyright (C) 2004-2018 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 2, 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 <https://www.gnu.org/licenses/>.
|
||||
|
||||
# Originally written by Alexandre Duret-Lutz <adl@gnu.org>.
|
||||
# The master copy of this file is maintained in the gnulib Git repository.
|
||||
# Please send bug reports and feature requests to bug-gnulib@gnu.org.
|
||||
|
||||
set -e
|
||||
|
||||
GPG='gpg --batch --no-tty'
|
||||
conffile=.gnuploadrc
|
||||
to=
|
||||
dry_run=false
|
||||
replace=
|
||||
symlink_files=
|
||||
delete_files=
|
||||
delete_symlinks=
|
||||
collect_var=
|
||||
dbg=
|
||||
nl='
|
||||
'
|
||||
|
||||
usage="Usage: $0 [OPTION]... [CMD] FILE... [[CMD] FILE...]
|
||||
|
||||
Sign all FILES, and process them at the destinations specified with --to.
|
||||
If CMD is not given, it defaults to uploading. See examples below.
|
||||
|
||||
Commands:
|
||||
--delete delete FILES from destination
|
||||
--symlink create symbolic links
|
||||
--rmsymlink remove symbolic links
|
||||
-- treat the remaining arguments as files to upload
|
||||
|
||||
Options:
|
||||
--to DEST specify a destination DEST for FILES
|
||||
(multiple --to options are allowed)
|
||||
--user NAME sign with key NAME
|
||||
--replace allow replacements of existing files
|
||||
--symlink-regex[=EXPR] use sed script EXPR to compute symbolic link names
|
||||
--dry-run do nothing, show what would have been done
|
||||
(including the constructed directive file)
|
||||
--version output version information and exit
|
||||
--help print this help text and exit
|
||||
|
||||
If --symlink-regex is given without EXPR, then the link target name
|
||||
is created by replacing the version information with '-latest', e.g.:
|
||||
foo-1.3.4.tar.gz -> foo-latest.tar.gz
|
||||
|
||||
Recognized destinations are:
|
||||
alpha.gnu.org:DIRECTORY
|
||||
savannah.gnu.org:DIRECTORY
|
||||
savannah.nongnu.org:DIRECTORY
|
||||
ftp.gnu.org:DIRECTORY
|
||||
build directive files and upload files by FTP
|
||||
download.gnu.org.ua:{alpha|ftp}/DIRECTORY
|
||||
build directive files and upload files by SFTP
|
||||
[user@]host:DIRECTORY upload files with scp
|
||||
|
||||
Options and commands are applied in order. If the file $conffile exists
|
||||
in the current working directory, its contents are prepended to the
|
||||
actual command line options. Use this to keep your defaults. Comments
|
||||
(#) and empty lines in $conffile are allowed.
|
||||
|
||||
<https://www.gnu.org/prep/maintain/html_node/Automated-FTP-Uploads.html>
|
||||
gives some further background.
|
||||
|
||||
Examples:
|
||||
1. Upload foobar-1.0.tar.gz to ftp.gnu.org:
|
||||
gnupload --to ftp.gnu.org:foobar foobar-1.0.tar.gz
|
||||
|
||||
2. Upload foobar-1.0.tar.gz and foobar-1.0.tar.xz to ftp.gnu.org:
|
||||
gnupload --to ftp.gnu.org:foobar foobar-1.0.tar.gz foobar-1.0.tar.xz
|
||||
|
||||
3. Same as above, and also create symbolic links to foobar-latest.tar.*:
|
||||
gnupload --to ftp.gnu.org:foobar \\
|
||||
--symlink-regex \\
|
||||
foobar-1.0.tar.gz foobar-1.0.tar.xz
|
||||
|
||||
4. Upload foobar-0.9.90.tar.gz to two sites:
|
||||
gnupload --to alpha.gnu.org:foobar \\
|
||||
--to sources.redhat.com:~ftp/pub/foobar \\
|
||||
foobar-0.9.90.tar.gz
|
||||
|
||||
5. Delete oopsbar-0.9.91.tar.gz and upload foobar-0.9.91.tar.gz
|
||||
(the -- terminates the list of files to delete):
|
||||
gnupload --to alpha.gnu.org:foobar \\
|
||||
--to sources.redhat.com:~ftp/pub/foobar \\
|
||||
--delete oopsbar-0.9.91.tar.gz \\
|
||||
-- foobar-0.9.91.tar.gz
|
||||
|
||||
gnupload executes a program ncftpput to do the transfers; if you don't
|
||||
happen to have an ncftp package installed, the ncftpput-ftp script in
|
||||
the build-aux/ directory of the gnulib package
|
||||
(https://savannah.gnu.org/projects/gnulib) may serve as a replacement.
|
||||
|
||||
Send patches and bug reports to <bug-gnulib@gnu.org>."
|
||||
|
||||
# Read local configuration file
|
||||
if test -r "$conffile"; then
|
||||
echo "$0: Reading configuration file $conffile"
|
||||
conf=`sed 's/#.*$//;/^$/d' "$conffile" | tr "\015$nl" ' '`
|
||||
eval set x "$conf \"\$@\""
|
||||
shift
|
||||
fi
|
||||
|
||||
while test -n "$1"; do
|
||||
case $1 in
|
||||
-*)
|
||||
collect_var=
|
||||
case $1 in
|
||||
--help)
|
||||
echo "$usage"
|
||||
exit $?
|
||||
;;
|
||||
--to)
|
||||
if test -z "$2"; then
|
||||
echo "$0: Missing argument for --to" 1>&2
|
||||
exit 1
|
||||
elif echo "$2" | grep 'ftp-upload\.gnu\.org' >/dev/null; then
|
||||
echo "$0: Use ftp.gnu.org:PKGNAME or alpha.gnu.org:PKGNAME" >&2
|
||||
echo "$0: for the destination, not ftp-upload.gnu.org (which" >&2
|
||||
echo "$0: is used for direct ftp uploads, not with gnupload)." >&2
|
||||
echo "$0: See --help and its examples if need be." >&2
|
||||
exit 1
|
||||
else
|
||||
to="$to $2"
|
||||
shift
|
||||
fi
|
||||
;;
|
||||
--user)
|
||||
if test -z "$2"; then
|
||||
echo "$0: Missing argument for --user" 1>&2
|
||||
exit 1
|
||||
else
|
||||
GPG="$GPG --local-user $2"
|
||||
shift
|
||||
fi
|
||||
;;
|
||||
--delete)
|
||||
collect_var=delete_files
|
||||
;;
|
||||
--replace)
|
||||
replace="replace: true"
|
||||
;;
|
||||
--rmsymlink)
|
||||
collect_var=delete_symlinks
|
||||
;;
|
||||
--symlink-regex=*)
|
||||
symlink_expr=`expr "$1" : '[^=]*=\(.*\)'`
|
||||
;;
|
||||
--symlink-regex)
|
||||
symlink_expr='s|-[0-9][0-9\.]*\(-[0-9][0-9]*\)\{0,1\}\.|-latest.|'
|
||||
;;
|
||||
--symlink)
|
||||
collect_var=symlink_files
|
||||
;;
|
||||
--dry-run|-n)
|
||||
dry_run=:
|
||||
;;
|
||||
--version)
|
||||
echo "gnupload $scriptversion"
|
||||
exit $?
|
||||
;;
|
||||
--)
|
||||
shift
|
||||
break
|
||||
;;
|
||||
-*)
|
||||
echo "$0: Unknown option '$1', try '$0 --help'" 1>&2
|
||||
exit 1
|
||||
;;
|
||||
esac
|
||||
;;
|
||||
*)
|
||||
if test -z "$collect_var"; then
|
||||
break
|
||||
else
|
||||
eval "$collect_var=\"\$$collect_var $1\""
|
||||
fi
|
||||
;;
|
||||
esac
|
||||
shift
|
||||
done
|
||||
|
||||
dprint()
|
||||
{
|
||||
echo "Running $* ..."
|
||||
}
|
||||
|
||||
if $dry_run; then
|
||||
dbg=dprint
|
||||
fi
|
||||
|
||||
if test -z "$to"; then
|
||||
echo "$0: Missing destination sites" >&2
|
||||
exit 1
|
||||
fi
|
||||
|
||||
if test -n "$symlink_files"; then
|
||||
x=`echo "$symlink_files" | sed 's/[^ ]//g;s/ //g'`
|
||||
if test -n "$x"; then
|
||||
echo "$0: Odd number of symlink arguments" >&2
|
||||
exit 1
|
||||
fi
|
||||
fi
|
||||
|
||||
if test $# = 0; then
|
||||
if test -z "${symlink_files}${delete_files}${delete_symlinks}"; then
|
||||
echo "$0: No file to upload" 1>&2
|
||||
exit 1
|
||||
fi
|
||||
else
|
||||
# Make sure all files exist. We don't want to ask
|
||||
# for the passphrase if the script will fail.
|
||||
for file
|
||||
do
|
||||
if test ! -f $file; then
|
||||
echo "$0: Cannot find '$file'" 1>&2
|
||||
exit 1
|
||||
elif test -n "$symlink_expr"; then
|
||||
linkname=`echo $file | sed "$symlink_expr"`
|
||||
if test -z "$linkname"; then
|
||||
echo "$0: symlink expression produces empty results" >&2
|
||||
exit 1
|
||||
elif test "$linkname" = $file; then
|
||||
echo "$0: symlink expression does not alter file name" >&2
|
||||
exit 1
|
||||
fi
|
||||
fi
|
||||
done
|
||||
fi
|
||||
|
||||
# Make sure passphrase is not exported in the environment.
|
||||
unset passphrase
|
||||
unset passphrase_fd_0
|
||||
GNUPGHOME=${GNUPGHOME:-$HOME/.gnupg}
|
||||
|
||||
# Reset PATH to be sure that echo is a built-in. We will later use
|
||||
# 'echo $passphrase' to output the passphrase, so it is important that
|
||||
# it is a built-in (third-party programs tend to appear in 'ps'
|
||||
# listings with their arguments...).
|
||||
# Remember this script runs with 'set -e', so if echo is not built-in
|
||||
# it will exit now.
|
||||
if $dry_run || grep -q "^use-agent" $GNUPGHOME/gpg.conf; then :; else
|
||||
PATH=/empty echo -n "Enter GPG passphrase: "
|
||||
stty -echo
|
||||
read -r passphrase
|
||||
stty echo
|
||||
echo
|
||||
passphrase_fd_0="--passphrase-fd 0"
|
||||
fi
|
||||
|
||||
if test $# -ne 0; then
|
||||
for file
|
||||
do
|
||||
echo "Signing $file ..."
|
||||
rm -f $file.sig
|
||||
echo "$passphrase" | $dbg $GPG $passphrase_fd_0 -ba -o $file.sig $file
|
||||
done
|
||||
fi
|
||||
|
||||
|
||||
# mkdirective DESTDIR BASE FILE STMT
|
||||
# Arguments: See upload, below
|
||||
mkdirective ()
|
||||
{
|
||||
stmt="$4"
|
||||
if test -n "$3"; then
|
||||
stmt="
|
||||
filename: $3$stmt"
|
||||
fi
|
||||
|
||||
cat >${2}.directive<<EOF
|
||||
version: 1.2
|
||||
directory: $1
|
||||
comment: gnupload v. $scriptversion$stmt
|
||||
EOF
|
||||
if $dry_run; then
|
||||
echo "File ${2}.directive:"
|
||||
cat ${2}.directive
|
||||
echo "File ${2}.directive:" | sed 's/./-/g'
|
||||
fi
|
||||
}
|
||||
|
||||
mksymlink ()
|
||||
{
|
||||
while test $# -ne 0
|
||||
do
|
||||
echo "symlink: $1 $2"
|
||||
shift
|
||||
shift
|
||||
done
|
||||
}
|
||||
|
||||
# upload DEST DESTDIR BASE FILE STMT FILES
|
||||
# Arguments:
|
||||
# DEST Destination site;
|
||||
# DESTDIR Destination directory;
|
||||
# BASE Base name for the directive file;
|
||||
# FILE Name of the file to distribute (may be empty);
|
||||
# STMT Additional statements for the directive file;
|
||||
# FILES List of files to upload.
|
||||
upload ()
|
||||
{
|
||||
dest=$1
|
||||
destdir=$2
|
||||
base=$3
|
||||
file=$4
|
||||
stmt=$5
|
||||
files=$6
|
||||
|
||||
rm -f $base.directive $base.directive.asc
|
||||
case $dest in
|
||||
alpha.gnu.org:*)
|
||||
mkdirective "$destdir" "$base" "$file" "$stmt"
|
||||
echo "$passphrase" | $dbg $GPG $passphrase_fd_0 --clearsign $base.directive
|
||||
$dbg ncftpput ftp-upload.gnu.org /incoming/alpha $files $base.directive.asc
|
||||
;;
|
||||
ftp.gnu.org:*)
|
||||
mkdirective "$destdir" "$base" "$file" "$stmt"
|
||||
echo "$passphrase" | $dbg $GPG $passphrase_fd_0 --clearsign $base.directive
|
||||
$dbg ncftpput ftp-upload.gnu.org /incoming/ftp $files $base.directive.asc
|
||||
;;
|
||||
savannah.gnu.org:*)
|
||||
if test -z "$files"; then
|
||||
echo "$0: warning: standalone directives not applicable for $dest" >&2
|
||||
fi
|
||||
$dbg ncftpput savannah.gnu.org /incoming/savannah/$destdir $files
|
||||
;;
|
||||
savannah.nongnu.org:*)
|
||||
if test -z "$files"; then
|
||||
echo "$0: warning: standalone directives not applicable for $dest" >&2
|
||||
fi
|
||||
$dbg ncftpput savannah.nongnu.org /incoming/savannah/$destdir $files
|
||||
;;
|
||||
download.gnu.org.ua:alpha/*|download.gnu.org.ua:ftp/*)
|
||||
destdir_p1=`echo "$destdir" | sed 's,^[^/]*/,,'`
|
||||
destdir_topdir=`echo "$destdir" | sed 's,/.*,,'`
|
||||
mkdirective "$destdir_p1" "$base" "$file" "$stmt"
|
||||
echo "$passphrase" | $dbg $GPG $passphrase_fd_0 --clearsign $base.directive
|
||||
for f in $files $base.directive.asc
|
||||
do
|
||||
echo put $f
|
||||
done | $dbg sftp -b - puszcza.gnu.org.ua:/incoming/$destdir_topdir
|
||||
;;
|
||||
/*)
|
||||
dest_host=`echo "$dest" | sed 's,:.*,,'`
|
||||
mkdirective "$destdir" "$base" "$file" "$stmt"
|
||||
echo "$passphrase" | $dbg $GPG $passphrase_fd_0 --clearsign $base.directive
|
||||
$dbg cp $files $base.directive.asc $dest_host
|
||||
;;
|
||||
*)
|
||||
if test -z "$files"; then
|
||||
echo "$0: warning: standalone directives not applicable for $dest" >&2
|
||||
fi
|
||||
$dbg scp $files $dest
|
||||
;;
|
||||
esac
|
||||
rm -f $base.directive $base.directive.asc
|
||||
}
|
||||
|
||||
#####
|
||||
# Process any standalone directives
|
||||
stmt=
|
||||
if test -n "$symlink_files"; then
|
||||
stmt="$stmt
|
||||
`mksymlink $symlink_files`"
|
||||
fi
|
||||
|
||||
for file in $delete_files
|
||||
do
|
||||
stmt="$stmt
|
||||
archive: $file"
|
||||
done
|
||||
|
||||
for file in $delete_symlinks
|
||||
do
|
||||
stmt="$stmt
|
||||
rmsymlink: $file"
|
||||
done
|
||||
|
||||
if test -n "$stmt"; then
|
||||
for dest in $to
|
||||
do
|
||||
destdir=`echo $dest | sed 's/[^:]*://'`
|
||||
upload "$dest" "$destdir" "`hostname`-$$" "" "$stmt"
|
||||
done
|
||||
fi
|
||||
|
||||
# Process actual uploads
|
||||
for dest in $to
|
||||
do
|
||||
for file
|
||||
do
|
||||
echo "Uploading $file to $dest ..."
|
||||
stmt=
|
||||
#
|
||||
# allowing file replacement is all or nothing.
|
||||
if test -n "$replace"; then stmt="$stmt
|
||||
$replace"
|
||||
fi
|
||||
#
|
||||
files="$file $file.sig"
|
||||
destdir=`echo $dest | sed 's/[^:]*://'`
|
||||
if test -n "$symlink_expr"; then
|
||||
linkname=`echo $file | sed "$symlink_expr"`
|
||||
stmt="$stmt
|
||||
symlink: $file $linkname
|
||||
symlink: $file.sig $linkname.sig"
|
||||
fi
|
||||
upload "$dest" "$destdir" "$file" "$file" "$stmt" "$files"
|
||||
done
|
||||
done
|
||||
|
||||
exit 0
|
||||
|
||||
# Local variables:
|
||||
# eval: (add-hook 'before-save-hook 'time-stamp)
|
||||
# time-stamp-start: "scriptversion="
|
||||
# time-stamp-format: "%:y-%02m-%02d.%02H"
|
||||
# time-stamp-time-zone: "UTC0"
|
||||
# time-stamp-end: "; # UTC"
|
||||
# End:
|
||||
55
build-aux/guix.scm
Normal file
55
build-aux/guix.scm
Normal file
|
|
@ -0,0 +1,55 @@
|
|||
;;;; guix.scm -- Guix package definition
|
||||
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
|
||||
;;; Copyright © 2018 宋文武 <iyzsong@member.fsf.org>
|
||||
;;; Copyright © 2019 Efraim Flashner <efraim@flashner.co.il>
|
||||
;;;
|
||||
;;; 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 popen)
|
||||
(ice-9 rdelim)
|
||||
(gnu)
|
||||
(guix)
|
||||
(srfi srfi-1))
|
||||
|
||||
(define (keep-mcron-file? file stat)
|
||||
;; Return #t if FILE in Mcron repository must be kept, #f otherwise. FILE
|
||||
;; is an absolute file name and STAT is the result of 'lstat' applied to
|
||||
;; FILE.
|
||||
(not (or (any (λ (str) (string-contains file str))
|
||||
'(".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")))))
|
||||
|
||||
(define %srcdir
|
||||
(or (current-source-directory) "."))
|
||||
|
||||
(package
|
||||
(inherit (specification->package "mcron"))
|
||||
(version "1.2.0")
|
||||
(source (local-file (dirname %srcdir) #:recursive? #t
|
||||
#:select? keep-mcron-file?))
|
||||
(inputs
|
||||
`(("guile" ,(specification->package "guile@2.2"))))
|
||||
(native-inputs
|
||||
`(("autoconf" ,(specification->package "autoconf"))
|
||||
("automake" ,(specification->package "automake"))
|
||||
("help2man" ,(specification->package "help2man"))
|
||||
("pkg-config" ,(specification->package "pkg-config"))
|
||||
("texinfo" ,(specification->package "texinfo"))
|
||||
("tzdata" ,(specification->package "tzdata")))))
|
||||
38
build-aux/pre-inst-env.in
Normal file
38
build-aux/pre-inst-env.in
Normal file
|
|
@ -0,0 +1,38 @@
|
|||
#!/bin/sh
|
||||
|
||||
# Copyright © 2015, 2016 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/>.
|
||||
|
||||
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/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/bin:$PATH"
|
||||
export PATH
|
||||
|
||||
# Define $MCRON_UNINSTALLED to prevent 'mcron' from prepending @moduledir@ to
|
||||
# the Guile load paths.
|
||||
MCRON_UNINSTALLED=1
|
||||
export MCRON_UNINSTALLED
|
||||
|
||||
srcdir="@srcdir@"
|
||||
export srcdir
|
||||
|
||||
exec "$@"
|
||||
232
build-aux/test-driver.scm
Normal file
232
build-aux/test-driver.scm
Normal file
|
|
@ -0,0 +1,232 @@
|
|||
;;;; test-driver.scm - Guile test driver for Automake testsuite harness
|
||||
|
||||
(define script-version "2018-03-25.05") ;UTC
|
||||
|
||||
;;; Copyright © 2015-2018 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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;;; 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.
|
||||
;;;
|
||||
;;; To use it, you have to manually copy this file in the ‘build-aux’
|
||||
;;; directory of your package, then adapt the following snippets to your
|
||||
;;; actual needs:
|
||||
;;;
|
||||
;;; configure.ac:
|
||||
;;; AC_CONFIG_AUX_DIR([build-aux])
|
||||
;;; AC_REQUIRE_AUX_FILE([test-driver.scm])
|
||||
;;; AC_PATH_PROG([GUILE], [guile])
|
||||
;;;
|
||||
;;; Makefile.am
|
||||
;;; TEST_LOG_DRIVER = $(GUILE) $(top_srcdir)/build-aux/test-driver.scm
|
||||
;;; AM_TESTS_ENVIRONMENT = env GUILE_AUTO_COMPILE='0'
|
||||
;;; TESTS = foo.test
|
||||
;;; EXTRA_DIST = $(TESTS)
|
||||
;;;
|
||||
;;; foo.test
|
||||
;;; (use-modules (srfi srfi-64))
|
||||
;;; (test-begin "foo")
|
||||
;;; (test-assert "assertion example" #t)
|
||||
;;; (test-end "foo")
|
||||
;;;
|
||||
;;; See <https://srfi.schemers.org/srfi-64/srfi-64.html> for general
|
||||
;;; information about SRFI-64 usage.
|
||||
;;;
|
||||
;;;; Code:
|
||||
|
||||
(use-modules (ice-9 getopt-long)
|
||||
(ice-9 match)
|
||||
(ice-9 pretty-print)
|
||||
(srfi srfi-11)
|
||||
(srfi srfi-26)
|
||||
(srfi srfi-64)
|
||||
(system vm coverage)
|
||||
(system vm vm))
|
||||
|
||||
(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}}]
|
||||
[--coverage={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
|
||||
(coverage (value #t))
|
||||
(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: ~S~%" 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) "[0;32m") ;green
|
||||
((xfail) "[1;32m") ;light green
|
||||
((skip) "[1;34m") ;blue
|
||||
((fail xpass) "[0;31m") ;red
|
||||
((error) "[0;35m")) ;magenta
|
||||
result
|
||||
"[m") ;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) <>)))
|
||||
(format #t "test-name: ~A~%" (result 'test-name))
|
||||
(format #t "location: ~A~%"
|
||||
(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.
|
||||
(format out-port "~A: ~A - ~A~%"
|
||||
(result->string (test-result-kind runner) #:colorize? color?)
|
||||
test-name (test-runner-test-name runner)))
|
||||
(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))
|
||||
(format #t "result: ~a~%" (result->string (result 'result-kind)))
|
||||
(newline)
|
||||
(format trs-port ":test-result: ~A ~A~%"
|
||||
(result->string (test-result-kind runner))
|
||||
(test-runner-test-name runner))))
|
||||
|
||||
(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.
|
||||
(format trs-port ":global-test-result: ~A~%"
|
||||
(if fail "FAIL" (if skip "SKIP" "PASS")))
|
||||
(format trs-port ":recheck: ~A~%"
|
||||
(if fail "yes" "no"))
|
||||
(format trs-port ":copy-in-global-log: ~A~%"
|
||||
(if (or fail skip) "yes" "no"))
|
||||
(when brief?
|
||||
;; Display the global test group result on the console.
|
||||
(format out-port "~A: ~A~%"
|
||||
(result->string (if fail 'fail (if skip 'skip 'pass))
|
||||
#:colorize? color?)
|
||||
test-name))
|
||||
#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
|
||||
(match (option '() '())
|
||||
(()
|
||||
(display "missing test script argument\n" (current-error-port))
|
||||
(exit 1))
|
||||
((script . args)
|
||||
(let ((log (open-file (option 'log-file "") "w0"))
|
||||
(trs (open-file (option 'trs-file "") "wl"))
|
||||
(out (duplicate-port (current-output-port) "wl")))
|
||||
(define (check)
|
||||
(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)
|
||||
(primitive-load script)))
|
||||
|
||||
(redirect-port log (current-output-port))
|
||||
(redirect-port log (current-warning-port))
|
||||
(redirect-port log (current-error-port))
|
||||
|
||||
(if (not (option->boolean opts 'coverage))
|
||||
(check)
|
||||
(begin
|
||||
;; The debug engine is required for tracing coverage data.
|
||||
(set-vm-engine! 'debug)
|
||||
(let-values (((data result) (with-code-coverage check)))
|
||||
(let* ((file (string-append (option 'test-name #f) ".info"))
|
||||
(port (open-output-file file)))
|
||||
(coverage-data->lcov data port)
|
||||
(close port)))))
|
||||
|
||||
(close-port log)
|
||||
(close-port trs)
|
||||
(close-port out))))))
|
||||
(exit 0))
|
||||
|
||||
;;; Local Variables:
|
||||
;;; eval: (add-hook 'before-save-hook 'time-stamp)
|
||||
;;; time-stamp-start: "(define script-version \""
|
||||
;;; time-stamp-format: "%:y-%02m-%02d.%02H"
|
||||
;;; time-stamp-time-zone: "UTC0"
|
||||
;;; time-stamp-end: "\") ;UTC"
|
||||
;;; End:
|
||||
|
||||
;;;; test-driver.scm ends here.
|
||||
192
configure.ac
Normal file → Executable file
192
configure.ac
Normal file → Executable file
|
|
@ -1,110 +1,69 @@
|
|||
# -*- Autoconf -*-
|
||||
# Process this file with autoconf to produce a configure script.
|
||||
|
||||
|
||||
# Copyright (C) 2003, 2005, 2012, 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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
## Process this file with autoconf to produce a configure script.
|
||||
#
|
||||
# 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.
|
||||
#
|
||||
# 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/>.
|
||||
|
||||
AC_PREREQ(2.61)
|
||||
AC_INIT([mcron], [1.0.8], [dale_mellor@users.sourceforge.net])
|
||||
AM_INIT_AUTOMAKE
|
||||
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])
|
||||
|
||||
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])
|
||||
|
||||
AC_MSG_CHECKING([whether debugging is requested])
|
||||
AC_ARG_ENABLE(debug,
|
||||
AC_HELP_STRING([--enable-debug],
|
||||
[enable debugging and traceback on error]),
|
||||
CONFIG_DEBUG=$enableval,
|
||||
CONFIG_DEBUG=no)
|
||||
AC_MSG_RESULT($CONFIG_DEBUG)
|
||||
if test "$CONFIG_DEBUG" = "no"; then
|
||||
CONFIG_DEBUG="#f"
|
||||
else
|
||||
CONFIG_DEBUG="#t"
|
||||
fi
|
||||
AC_SUBST(CONFIG_DEBUG)
|
||||
AM_SILENT_RULES([yes]) # Enables silent rules by default.
|
||||
|
||||
AC_CANONICAL_HOST
|
||||
|
||||
AC_PROG_AWK
|
||||
AC_PROG_EGREP
|
||||
AM_PROG_CC_C_O
|
||||
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])
|
||||
|
||||
PKG_CHECK_MODULES(GUILE, guile-2.0)
|
||||
# Check for Guile development files.
|
||||
GUILE_PKG([3.0 2.2 2.0])
|
||||
|
||||
# Checks for programs.
|
||||
|
||||
GUILE_PROGS
|
||||
|
||||
AM_MISSING_PROG(HELP2MAN, help2man, $missing_dir)
|
||||
|
||||
AC_CHECK_PROGS(SED, sed)
|
||||
if test "x$ac_cv_prog_SED" = "x"; then
|
||||
AC_MSG_ERROR(sed not found)
|
||||
fi
|
||||
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)
|
||||
fi
|
||||
AC_CHECK_PROGS(CP, cp)
|
||||
if test "x$ac_cv_prog_CP" = "x"; then
|
||||
AC_MSG_ERROR(cp not found)
|
||||
fi
|
||||
|
||||
|
||||
# Now find a sendmail or equivalent.
|
||||
|
||||
AC_CHECK_PROGS(SENDMAIL, sendmail)
|
||||
if test "x$ac_cv_prog_SENDMAIL" != "x"; then
|
||||
AC_MSG_CHECKING(sendmail path and arguments)
|
||||
ac_cv_prog_SENDMAIL="`$ac_cv_prog_WHICH sendmail` -FCronDaemon -odi -oem "
|
||||
dnl -or0s"
|
||||
AC_MSG_RESULT($ac_cv_prog_SENDMAIL)
|
||||
|
||||
else
|
||||
AC_CHECK_PROGS(SENDMAIL, mail)
|
||||
if test "x$ac_cv_prog_SENDMAIL" != "x"; then
|
||||
AC_MSG_CHECKING(mail path)
|
||||
ac_cv_prog_SENDMAIL="`$ac_cv_prog_WHICH mail` -d "
|
||||
AC_MSG_RESULT($ac_cv_prog_SENDMAIL)
|
||||
else
|
||||
AC_MSG_RESULT(No mail program found)
|
||||
fi
|
||||
fi
|
||||
SENDMAIL=$ac_cv_prog_SENDMAIL
|
||||
|
||||
|
||||
# Find out if we are avoiding Vixie.
|
||||
|
||||
AC_MSG_CHECKING([whether to avoid clobbering a Vixie installation])
|
||||
AC_ARG_ENABLE(no-vixie-clobber,
|
||||
AC_HELP_STRING([--enable-no-vixie-clobber],
|
||||
[do not install with program names that would override a legacy cron installation]),
|
||||
NO_VIXIE_CLOBBER=$enableval,
|
||||
NO_VIXIE_CLOBBER=[no])
|
||||
AC_MSG_RESULT($NO_VIXIE_CLOBBER)
|
||||
AC_SUBST(NO_VIXIE_CLOBBER)
|
||||
# Let users choose the Mail Transfert Agent (MTA) of their choice. Default to
|
||||
# a non-absolute program name to make it a loose dependency resolved at
|
||||
# runtime.
|
||||
AC_ARG_WITH([sendmail],
|
||||
[AS_HELP_STRING([--with-sendmail=COMMAND],
|
||||
[command to read an email message from standard input, and send it])],
|
||||
[SENDMAIL="$withval"],
|
||||
[SENDMAIL="sendmail -t"])
|
||||
AC_SUBST([SENDMAIL])
|
||||
|
||||
AC_ARG_ENABLE([multi-user],
|
||||
[AS_HELP_STRING([--disable-multi-user],
|
||||
[Don't Install legacy cron and crontab programs])],
|
||||
[enable_multi_user="$enableval"],
|
||||
[enable_multi_user="yes"])
|
||||
AM_CONDITIONAL([MULTI_USER], [test "x$enable_multi_user" = xyes])
|
||||
|
||||
# Configure the various files that mcron uses at runtime.
|
||||
|
||||
|
|
@ -112,8 +71,8 @@ AC_MSG_CHECKING([which spool directory to use])
|
|||
AC_ARG_WITH(spool-dir,
|
||||
AC_HELP_STRING([--with-spool-dir],
|
||||
[the crontab spool directory (/var/cron/tabs)]),
|
||||
CONFIG_SPOOL_DIR=$withval,
|
||||
CONFIG_SPOOL_DIR=[/var/cron/tabs])
|
||||
CONFIG_SPOOL_DIR=$withval,
|
||||
CONFIG_SPOOL_DIR=[/var/cron/tabs])
|
||||
AC_MSG_RESULT($CONFIG_SPOOL_DIR)
|
||||
AC_SUBST(CONFIG_SPOOL_DIR)
|
||||
|
||||
|
|
@ -121,8 +80,8 @@ AC_MSG_CHECKING([name of socket])
|
|||
AC_ARG_WITH(socket-file,
|
||||
AC_HELP_STRING([--with-socket-file],
|
||||
[unix pathname for cron socket (/var/cron/socket)]),
|
||||
CONFIG_SOCKET_FILE=$withval,
|
||||
CONFIG_SOCKET_FILE=[/var/cron/socket])
|
||||
CONFIG_SOCKET_FILE=$withval,
|
||||
CONFIG_SOCKET_FILE=[/var/cron/socket])
|
||||
AC_MSG_RESULT($CONFIG_SOCKET_FILE)
|
||||
AC_SUBST(CONFIG_SOCKET_FILE)
|
||||
|
||||
|
|
@ -130,8 +89,8 @@ AC_MSG_CHECKING([name of allow file])
|
|||
AC_ARG_WITH(allow-file,
|
||||
AC_HELP_STRING([--with-allow-file],
|
||||
[the file of allowed users (/var/cron/allow)]),
|
||||
CONFIG_ALLOW_FILE=$withval,
|
||||
CONFIG_ALLOW_FILE=[/var/cron/allow])
|
||||
CONFIG_ALLOW_FILE=$withval,
|
||||
CONFIG_ALLOW_FILE=[/var/cron/allow])
|
||||
AC_MSG_RESULT($CONFIG_ALLOW_FILE)
|
||||
AC_SUBST(CONFIG_ALLOW_FILE)
|
||||
|
||||
|
|
@ -139,8 +98,8 @@ AC_MSG_CHECKING([name of deny file])
|
|||
AC_ARG_WITH(deny-file,
|
||||
AC_HELP_STRING([--with-deny-file],
|
||||
[the file of barred users (/var/cron/deny)]),
|
||||
CONFIG_DENY_FILE=$withval,
|
||||
CONFIG_DENY_FILE=[/var/cron/deny])
|
||||
CONFIG_DENY_FILE=$withval,
|
||||
CONFIG_DENY_FILE=[/var/cron/deny])
|
||||
AC_MSG_RESULT($CONFIG_DENY_FILE)
|
||||
AC_SUBST(CONFIG_DENY_FILE)
|
||||
|
||||
|
|
@ -148,8 +107,8 @@ AC_MSG_CHECKING([name of PID file])
|
|||
AC_ARG_WITH(pid-file,
|
||||
AC_HELP_STRING([--with-pid-file],
|
||||
[the file to record cron's PID (/var/run/cron.pid)]),
|
||||
CONFIG_PID_FILE=$withval,
|
||||
CONFIG_PID_FILE=[/var/run/cron.pid])
|
||||
CONFIG_PID_FILE=$withval,
|
||||
CONFIG_PID_FILE=[/var/run/cron.pid])
|
||||
AC_MSG_RESULT($CONFIG_PID_FILE)
|
||||
AC_SUBST(CONFIG_PID_FILE)
|
||||
|
||||
|
|
@ -157,19 +116,20 @@ AC_MSG_CHECKING([directory to hold temporary files])
|
|||
AC_ARG_WITH(tmp-dir,
|
||||
AC_HELP_STRING([--with-tmp-dir],
|
||||
[directory to hold temporary files (/tmp)]),
|
||||
CONFIG_TMP_DIR=$withval,
|
||||
CONFIG_TMP_DIR=[/tmp])
|
||||
CONFIG_TMP_DIR=$withval,
|
||||
CONFIG_TMP_DIR=[/tmp])
|
||||
AC_MSG_RESULT($CONFIG_TMP_DIR)
|
||||
AC_SUBST(CONFIG_TMP_DIR)
|
||||
|
||||
# Include the Maintainer's Makefile fragment, if it's here.
|
||||
MAINT_MAKEFILE=/dev/null
|
||||
AS_IF([test -r "$srcdir/maint.mk"],
|
||||
[MAINT_MAKEFILE="$srcdir/maint.mk"])
|
||||
AC_SUBST_FILE([MAINT_MAKEFILE])
|
||||
|
||||
|
||||
|
||||
# This is to support `make DESTDIR=...'
|
||||
|
||||
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([pre-inst-env:build-aux/pre-inst-env.in],
|
||||
[chmod +x pre-inst-env])
|
||||
AC_CONFIG_FILES([doc/config.texi
|
||||
Makefile
|
||||
src/mcron/config.scm])
|
||||
AC_OUTPUT
|
||||
|
|
|
|||
5
doc/config.texi.in
Normal file
5
doc/config.texi.in
Normal file
|
|
@ -0,0 +1,5 @@
|
|||
@set CONFIG_SOCKET_FILE @CONFIG_SOCKET_FILE@
|
||||
@set CONFIG_SPOOL_DIR @CONFIG_SPOOL_DIR@
|
||||
@set CONFIG_PID_FILE @CONFIG_PID_FILE@
|
||||
@set CONFIG_ALLOW_FILE @CONFIG_ALLOW_FILE@
|
||||
@set CONFIG_DENY_FILE @CONFIG_DENY_FILE@
|
||||
505
doc/fdl.texi
Normal file
505
doc/fdl.texi
Normal file
|
|
@ -0,0 +1,505 @@
|
|||
@c The GNU Free Documentation License.
|
||||
@center Version 1.3, 3 November 2008
|
||||
|
||||
@c This file is intended to be included within another document,
|
||||
@c hence no sectioning command or @node.
|
||||
|
||||
@display
|
||||
Copyright @copyright{} 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc.
|
||||
@uref{http://fsf.org/}
|
||||
|
||||
Everyone is permitted to copy and distribute verbatim copies
|
||||
of this license document, but changing it is not allowed.
|
||||
@end display
|
||||
|
||||
@enumerate 0
|
||||
@item
|
||||
PREAMBLE
|
||||
|
||||
The purpose of this License is to make a manual, textbook, or other
|
||||
functional and useful document @dfn{free} in the sense of freedom: to
|
||||
assure everyone the effective freedom to copy and redistribute it,
|
||||
with or without modifying it, either commercially or noncommercially.
|
||||
Secondarily, this License preserves for the author and publisher a way
|
||||
to get credit for their work, while not being considered responsible
|
||||
for modifications made by others.
|
||||
|
||||
This License is a kind of ``copyleft'', which means that derivative
|
||||
works of the document must themselves be free in the same sense. It
|
||||
complements the GNU General Public License, which is a copyleft
|
||||
license designed for free software.
|
||||
|
||||
We have designed this License in order to use it for manuals for free
|
||||
software, because free software needs free documentation: a free
|
||||
program should come with manuals providing the same freedoms that the
|
||||
software does. But this License is not limited to software manuals;
|
||||
it can be used for any textual work, regardless of subject matter or
|
||||
whether it is published as a printed book. We recommend this License
|
||||
principally for works whose purpose is instruction or reference.
|
||||
|
||||
@item
|
||||
APPLICABILITY AND DEFINITIONS
|
||||
|
||||
This License applies to any manual or other work, in any medium, that
|
||||
contains a notice placed by the copyright holder saying it can be
|
||||
distributed under the terms of this License. Such a notice grants a
|
||||
world-wide, royalty-free license, unlimited in duration, to use that
|
||||
work under the conditions stated herein. The ``Document'', below,
|
||||
refers to any such manual or work. Any member of the public is a
|
||||
licensee, and is addressed as ``you''. You accept the license if you
|
||||
copy, modify or distribute the work in a way requiring permission
|
||||
under copyright law.
|
||||
|
||||
A ``Modified Version'' of the Document means any work containing the
|
||||
Document or a portion of it, either copied verbatim, or with
|
||||
modifications and/or translated into another language.
|
||||
|
||||
A ``Secondary Section'' is a named appendix or a front-matter section
|
||||
of the Document that deals exclusively with the relationship of the
|
||||
publishers or authors of the Document to the Document's overall
|
||||
subject (or to related matters) and contains nothing that could fall
|
||||
directly within that overall subject. (Thus, if the Document is in
|
||||
part a textbook of mathematics, a Secondary Section may not explain
|
||||
any mathematics.) The relationship could be a matter of historical
|
||||
connection with the subject or with related matters, or of legal,
|
||||
commercial, philosophical, ethical or political position regarding
|
||||
them.
|
||||
|
||||
The ``Invariant Sections'' are certain Secondary Sections whose titles
|
||||
are designated, as being those of Invariant Sections, in the notice
|
||||
that says that the Document is released under this License. If a
|
||||
section does not fit the above definition of Secondary then it is not
|
||||
allowed to be designated as Invariant. The Document may contain zero
|
||||
Invariant Sections. If the Document does not identify any Invariant
|
||||
Sections then there are none.
|
||||
|
||||
The ``Cover Texts'' are certain short passages of text that are listed,
|
||||
as Front-Cover Texts or Back-Cover Texts, in the notice that says that
|
||||
the Document is released under this License. A Front-Cover Text may
|
||||
be at most 5 words, and a Back-Cover Text may be at most 25 words.
|
||||
|
||||
A ``Transparent'' copy of the Document means a machine-readable copy,
|
||||
represented in a format whose specification is available to the
|
||||
general public, that is suitable for revising the document
|
||||
straightforwardly with generic text editors or (for images composed of
|
||||
pixels) generic paint programs or (for drawings) some widely available
|
||||
drawing editor, and that is suitable for input to text formatters or
|
||||
for automatic translation to a variety of formats suitable for input
|
||||
to text formatters. A copy made in an otherwise Transparent file
|
||||
format whose markup, or absence of markup, has been arranged to thwart
|
||||
or discourage subsequent modification by readers is not Transparent.
|
||||
An image format is not Transparent if used for any substantial amount
|
||||
of text. A copy that is not ``Transparent'' is called ``Opaque''.
|
||||
|
||||
Examples of suitable formats for Transparent copies include plain
|
||||
ASCII without markup, Texinfo input format, La@TeX{} input
|
||||
format, SGML or XML using a publicly available
|
||||
DTD, and standard-conforming simple HTML,
|
||||
PostScript or PDF designed for human modification. Examples
|
||||
of transparent image formats include PNG, XCF and
|
||||
JPG@. Opaque formats include proprietary formats that can be
|
||||
read and edited only by proprietary word processors, SGML or
|
||||
XML for which the DTD and/or processing tools are
|
||||
not generally available, and the machine-generated HTML,
|
||||
PostScript or PDF produced by some word processors for
|
||||
output purposes only.
|
||||
|
||||
The ``Title Page'' means, for a printed book, the title page itself,
|
||||
plus such following pages as are needed to hold, legibly, the material
|
||||
this License requires to appear in the title page. For works in
|
||||
formats which do not have any title page as such, ``Title Page'' means
|
||||
the text near the most prominent appearance of the work's title,
|
||||
preceding the beginning of the body of the text.
|
||||
|
||||
The ``publisher'' means any person or entity that distributes copies
|
||||
of the Document to the public.
|
||||
|
||||
A section ``Entitled XYZ'' means a named subunit of the Document whose
|
||||
title either is precisely XYZ or contains XYZ in parentheses following
|
||||
text that translates XYZ in another language. (Here XYZ stands for a
|
||||
specific section name mentioned below, such as ``Acknowledgements'',
|
||||
``Dedications'', ``Endorsements'', or ``History''.) To ``Preserve the Title''
|
||||
of such a section when you modify the Document means that it remains a
|
||||
section ``Entitled XYZ'' according to this definition.
|
||||
|
||||
The Document may include Warranty Disclaimers next to the notice which
|
||||
states that this License applies to the Document. These Warranty
|
||||
Disclaimers are considered to be included by reference in this
|
||||
License, but only as regards disclaiming warranties: any other
|
||||
implication that these Warranty Disclaimers may have is void and has
|
||||
no effect on the meaning of this License.
|
||||
|
||||
@item
|
||||
VERBATIM COPYING
|
||||
|
||||
You may copy and distribute the Document in any medium, either
|
||||
commercially or noncommercially, provided that this License, the
|
||||
copyright notices, and the license notice saying this License applies
|
||||
to the Document are reproduced in all copies, and that you add no other
|
||||
conditions whatsoever to those of this License. You may not use
|
||||
technical measures to obstruct or control the reading or further
|
||||
copying of the copies you make or distribute. However, you may accept
|
||||
compensation in exchange for copies. If you distribute a large enough
|
||||
number of copies you must also follow the conditions in section 3.
|
||||
|
||||
You may also lend copies, under the same conditions stated above, and
|
||||
you may publicly display copies.
|
||||
|
||||
@item
|
||||
COPYING IN QUANTITY
|
||||
|
||||
If you publish printed copies (or copies in media that commonly have
|
||||
printed covers) of the Document, numbering more than 100, and the
|
||||
Document's license notice requires Cover Texts, you must enclose the
|
||||
copies in covers that carry, clearly and legibly, all these Cover
|
||||
Texts: Front-Cover Texts on the front cover, and Back-Cover Texts on
|
||||
the back cover. Both covers must also clearly and legibly identify
|
||||
you as the publisher of these copies. The front cover must present
|
||||
the full title with all words of the title equally prominent and
|
||||
visible. You may add other material on the covers in addition.
|
||||
Copying with changes limited to the covers, as long as they preserve
|
||||
the title of the Document and satisfy these conditions, can be treated
|
||||
as verbatim copying in other respects.
|
||||
|
||||
If the required texts for either cover are too voluminous to fit
|
||||
legibly, you should put the first ones listed (as many as fit
|
||||
reasonably) on the actual cover, and continue the rest onto adjacent
|
||||
pages.
|
||||
|
||||
If you publish or distribute Opaque copies of the Document numbering
|
||||
more than 100, you must either include a machine-readable Transparent
|
||||
copy along with each Opaque copy, or state in or with each Opaque copy
|
||||
a computer-network location from which the general network-using
|
||||
public has access to download using public-standard network protocols
|
||||
a complete Transparent copy of the Document, free of added material.
|
||||
If you use the latter option, you must take reasonably prudent steps,
|
||||
when you begin distribution of Opaque copies in quantity, to ensure
|
||||
that this Transparent copy will remain thus accessible at the stated
|
||||
location until at least one year after the last time you distribute an
|
||||
Opaque copy (directly or through your agents or retailers) of that
|
||||
edition to the public.
|
||||
|
||||
It is requested, but not required, that you contact the authors of the
|
||||
Document well before redistributing any large number of copies, to give
|
||||
them a chance to provide you with an updated version of the Document.
|
||||
|
||||
@item
|
||||
MODIFICATIONS
|
||||
|
||||
You may copy and distribute a Modified Version of the Document under
|
||||
the conditions of sections 2 and 3 above, provided that you release
|
||||
the Modified Version under precisely this License, with the Modified
|
||||
Version filling the role of the Document, thus licensing distribution
|
||||
and modification of the Modified Version to whoever possesses a copy
|
||||
of it. In addition, you must do these things in the Modified Version:
|
||||
|
||||
@enumerate A
|
||||
@item
|
||||
Use in the Title Page (and on the covers, if any) a title distinct
|
||||
from that of the Document, and from those of previous versions
|
||||
(which should, if there were any, be listed in the History section
|
||||
of the Document). You may use the same title as a previous version
|
||||
if the original publisher of that version gives permission.
|
||||
|
||||
@item
|
||||
List on the Title Page, as authors, one or more persons or entities
|
||||
responsible for authorship of the modifications in the Modified
|
||||
Version, together with at least five of the principal authors of the
|
||||
Document (all of its principal authors, if it has fewer than five),
|
||||
unless they release you from this requirement.
|
||||
|
||||
@item
|
||||
State on the Title page the name of the publisher of the
|
||||
Modified Version, as the publisher.
|
||||
|
||||
@item
|
||||
Preserve all the copyright notices of the Document.
|
||||
|
||||
@item
|
||||
Add an appropriate copyright notice for your modifications
|
||||
adjacent to the other copyright notices.
|
||||
|
||||
@item
|
||||
Include, immediately after the copyright notices, a license notice
|
||||
giving the public permission to use the Modified Version under the
|
||||
terms of this License, in the form shown in the Addendum below.
|
||||
|
||||
@item
|
||||
Preserve in that license notice the full lists of Invariant Sections
|
||||
and required Cover Texts given in the Document's license notice.
|
||||
|
||||
@item
|
||||
Include an unaltered copy of this License.
|
||||
|
||||
@item
|
||||
Preserve the section Entitled ``History'', Preserve its Title, and add
|
||||
to it an item stating at least the title, year, new authors, and
|
||||
publisher of the Modified Version as given on the Title Page. If
|
||||
there is no section Entitled ``History'' in the Document, create one
|
||||
stating the title, year, authors, and publisher of the Document as
|
||||
given on its Title Page, then add an item describing the Modified
|
||||
Version as stated in the previous sentence.
|
||||
|
||||
@item
|
||||
Preserve the network location, if any, given in the Document for
|
||||
public access to a Transparent copy of the Document, and likewise
|
||||
the network locations given in the Document for previous versions
|
||||
it was based on. These may be placed in the ``History'' section.
|
||||
You may omit a network location for a work that was published at
|
||||
least four years before the Document itself, or if the original
|
||||
publisher of the version it refers to gives permission.
|
||||
|
||||
@item
|
||||
For any section Entitled ``Acknowledgements'' or ``Dedications'', Preserve
|
||||
the Title of the section, and preserve in the section all the
|
||||
substance and tone of each of the contributor acknowledgements and/or
|
||||
dedications given therein.
|
||||
|
||||
@item
|
||||
Preserve all the Invariant Sections of the Document,
|
||||
unaltered in their text and in their titles. Section numbers
|
||||
or the equivalent are not considered part of the section titles.
|
||||
|
||||
@item
|
||||
Delete any section Entitled ``Endorsements''. Such a section
|
||||
may not be included in the Modified Version.
|
||||
|
||||
@item
|
||||
Do not retitle any existing section to be Entitled ``Endorsements'' or
|
||||
to conflict in title with any Invariant Section.
|
||||
|
||||
@item
|
||||
Preserve any Warranty Disclaimers.
|
||||
@end enumerate
|
||||
|
||||
If the Modified Version includes new front-matter sections or
|
||||
appendices that qualify as Secondary Sections and contain no material
|
||||
copied from the Document, you may at your option designate some or all
|
||||
of these sections as invariant. To do this, add their titles to the
|
||||
list of Invariant Sections in the Modified Version's license notice.
|
||||
These titles must be distinct from any other section titles.
|
||||
|
||||
You may add a section Entitled ``Endorsements'', provided it contains
|
||||
nothing but endorsements of your Modified Version by various
|
||||
parties---for example, statements of peer review or that the text has
|
||||
been approved by an organization as the authoritative definition of a
|
||||
standard.
|
||||
|
||||
You may add a passage of up to five words as a Front-Cover Text, and a
|
||||
passage of up to 25 words as a Back-Cover Text, to the end of the list
|
||||
of Cover Texts in the Modified Version. Only one passage of
|
||||
Front-Cover Text and one of Back-Cover Text may be added by (or
|
||||
through arrangements made by) any one entity. If the Document already
|
||||
includes a cover text for the same cover, previously added by you or
|
||||
by arrangement made by the same entity you are acting on behalf of,
|
||||
you may not add another; but you may replace the old one, on explicit
|
||||
permission from the previous publisher that added the old one.
|
||||
|
||||
The author(s) and publisher(s) of the Document do not by this License
|
||||
give permission to use their names for publicity for or to assert or
|
||||
imply endorsement of any Modified Version.
|
||||
|
||||
@item
|
||||
COMBINING DOCUMENTS
|
||||
|
||||
You may combine the Document with other documents released under this
|
||||
License, under the terms defined in section 4 above for modified
|
||||
versions, provided that you include in the combination all of the
|
||||
Invariant Sections of all of the original documents, unmodified, and
|
||||
list them all as Invariant Sections of your combined work in its
|
||||
license notice, and that you preserve all their Warranty Disclaimers.
|
||||
|
||||
The combined work need only contain one copy of this License, and
|
||||
multiple identical Invariant Sections may be replaced with a single
|
||||
copy. If there are multiple Invariant Sections with the same name but
|
||||
different contents, make the title of each such section unique by
|
||||
adding at the end of it, in parentheses, the name of the original
|
||||
author or publisher of that section if known, or else a unique number.
|
||||
Make the same adjustment to the section titles in the list of
|
||||
Invariant Sections in the license notice of the combined work.
|
||||
|
||||
In the combination, you must combine any sections Entitled ``History''
|
||||
in the various original documents, forming one section Entitled
|
||||
``History''; likewise combine any sections Entitled ``Acknowledgements'',
|
||||
and any sections Entitled ``Dedications''. You must delete all
|
||||
sections Entitled ``Endorsements.''
|
||||
|
||||
@item
|
||||
COLLECTIONS OF DOCUMENTS
|
||||
|
||||
You may make a collection consisting of the Document and other documents
|
||||
released under this License, and replace the individual copies of this
|
||||
License in the various documents with a single copy that is included in
|
||||
the collection, provided that you follow the rules of this License for
|
||||
verbatim copying of each of the documents in all other respects.
|
||||
|
||||
You may extract a single document from such a collection, and distribute
|
||||
it individually under this License, provided you insert a copy of this
|
||||
License into the extracted document, and follow this License in all
|
||||
other respects regarding verbatim copying of that document.
|
||||
|
||||
@item
|
||||
AGGREGATION WITH INDEPENDENT WORKS
|
||||
|
||||
A compilation of the Document or its derivatives with other separate
|
||||
and independent documents or works, in or on a volume of a storage or
|
||||
distribution medium, is called an ``aggregate'' if the copyright
|
||||
resulting from the compilation is not used to limit the legal rights
|
||||
of the compilation's users beyond what the individual works permit.
|
||||
When the Document is included in an aggregate, this License does not
|
||||
apply to the other works in the aggregate which are not themselves
|
||||
derivative works of the Document.
|
||||
|
||||
If the Cover Text requirement of section 3 is applicable to these
|
||||
copies of the Document, then if the Document is less than one half of
|
||||
the entire aggregate, the Document's Cover Texts may be placed on
|
||||
covers that bracket the Document within the aggregate, or the
|
||||
electronic equivalent of covers if the Document is in electronic form.
|
||||
Otherwise they must appear on printed covers that bracket the whole
|
||||
aggregate.
|
||||
|
||||
@item
|
||||
TRANSLATION
|
||||
|
||||
Translation is considered a kind of modification, so you may
|
||||
distribute translations of the Document under the terms of section 4.
|
||||
Replacing Invariant Sections with translations requires special
|
||||
permission from their copyright holders, but you may include
|
||||
translations of some or all Invariant Sections in addition to the
|
||||
original versions of these Invariant Sections. You may include a
|
||||
translation of this License, and all the license notices in the
|
||||
Document, and any Warranty Disclaimers, provided that you also include
|
||||
the original English version of this License and the original versions
|
||||
of those notices and disclaimers. In case of a disagreement between
|
||||
the translation and the original version of this License or a notice
|
||||
or disclaimer, the original version will prevail.
|
||||
|
||||
If a section in the Document is Entitled ``Acknowledgements'',
|
||||
``Dedications'', or ``History'', the requirement (section 4) to Preserve
|
||||
its Title (section 1) will typically require changing the actual
|
||||
title.
|
||||
|
||||
@item
|
||||
TERMINATION
|
||||
|
||||
You may not copy, modify, sublicense, or distribute the Document
|
||||
except as expressly provided under this License. Any attempt
|
||||
otherwise to copy, modify, sublicense, or distribute it is void, and
|
||||
will automatically terminate your rights under this License.
|
||||
|
||||
However, if you cease all violation of this License, then your license
|
||||
from a particular copyright holder is reinstated (a) provisionally,
|
||||
unless and until the copyright holder explicitly and finally
|
||||
terminates your license, and (b) permanently, if the copyright holder
|
||||
fails to notify you of the violation by some reasonable means prior to
|
||||
60 days after the cessation.
|
||||
|
||||
Moreover, your license from a particular copyright holder is
|
||||
reinstated permanently if the copyright holder notifies you of the
|
||||
violation by some reasonable means, this is the first time you have
|
||||
received notice of violation of this License (for any work) from that
|
||||
copyright holder, and you cure the violation prior to 30 days after
|
||||
your receipt of the notice.
|
||||
|
||||
Termination of your rights under this section does not terminate the
|
||||
licenses of parties who have received copies or rights from you under
|
||||
this License. If your rights have been terminated and not permanently
|
||||
reinstated, receipt of a copy of some or all of the same material does
|
||||
not give you any rights to use it.
|
||||
|
||||
@item
|
||||
FUTURE REVISIONS OF THIS LICENSE
|
||||
|
||||
The Free Software Foundation may publish new, revised versions
|
||||
of the GNU Free Documentation License from time to time. Such new
|
||||
versions will be similar in spirit to the present version, but may
|
||||
differ in detail to address new problems or concerns. See
|
||||
@uref{http://www.gnu.org/copyleft/}.
|
||||
|
||||
Each version of the License is given a distinguishing version number.
|
||||
If the Document specifies that a particular numbered version of this
|
||||
License ``or any later version'' applies to it, you have the option of
|
||||
following the terms and conditions either of that specified version or
|
||||
of any later version that has been published (not as a draft) by the
|
||||
Free Software Foundation. If the Document does not specify a version
|
||||
number of this License, you may choose any version ever published (not
|
||||
as a draft) by the Free Software Foundation. If the Document
|
||||
specifies that a proxy can decide which future versions of this
|
||||
License can be used, that proxy's public statement of acceptance of a
|
||||
version permanently authorizes you to choose that version for the
|
||||
Document.
|
||||
|
||||
@item
|
||||
RELICENSING
|
||||
|
||||
``Massive Multiauthor Collaboration Site'' (or ``MMC Site'') means any
|
||||
World Wide Web server that publishes copyrightable works and also
|
||||
provides prominent facilities for anybody to edit those works. A
|
||||
public wiki that anybody can edit is an example of such a server. A
|
||||
``Massive Multiauthor Collaboration'' (or ``MMC'') contained in the
|
||||
site means any set of copyrightable works thus published on the MMC
|
||||
site.
|
||||
|
||||
``CC-BY-SA'' means the Creative Commons Attribution-Share Alike 3.0
|
||||
license published by Creative Commons Corporation, a not-for-profit
|
||||
corporation with a principal place of business in San Francisco,
|
||||
California, as well as future copyleft versions of that license
|
||||
published by that same organization.
|
||||
|
||||
``Incorporate'' means to publish or republish a Document, in whole or
|
||||
in part, as part of another Document.
|
||||
|
||||
An MMC is ``eligible for relicensing'' if it is licensed under this
|
||||
License, and if all works that were first published under this License
|
||||
somewhere other than this MMC, and subsequently incorporated in whole
|
||||
or in part into the MMC, (1) had no cover texts or invariant sections,
|
||||
and (2) were thus incorporated prior to November 1, 2008.
|
||||
|
||||
The operator of an MMC Site may republish an MMC contained in the site
|
||||
under CC-BY-SA on the same site at any time before August 1, 2009,
|
||||
provided the MMC is eligible for relicensing.
|
||||
|
||||
@end enumerate
|
||||
|
||||
@page
|
||||
@heading ADDENDUM: How to use this License for your documents
|
||||
|
||||
To use this License in a document you have written, include a copy of
|
||||
the License in the document and put the following copyright and
|
||||
license notices just after the title page:
|
||||
|
||||
@smallexample
|
||||
@group
|
||||
Copyright (C) @var{year} @var{your name}.
|
||||
Permission is granted to copy, distribute and/or modify this document
|
||||
under the terms of the GNU Free Documentation License, Version 1.3
|
||||
or any later version published by the Free Software Foundation;
|
||||
with no Invariant Sections, no Front-Cover Texts, and no Back-Cover
|
||||
Texts. A copy of the license is included in the section entitled ``GNU
|
||||
Free Documentation License''.
|
||||
@end group
|
||||
@end smallexample
|
||||
|
||||
If you have Invariant Sections, Front-Cover Texts and Back-Cover Texts,
|
||||
replace the ``with@dots{}Texts.''@: line with this:
|
||||
|
||||
@smallexample
|
||||
@group
|
||||
with the Invariant Sections being @var{list their titles}, with
|
||||
the Front-Cover Texts being @var{list}, and with the Back-Cover Texts
|
||||
being @var{list}.
|
||||
@end group
|
||||
@end smallexample
|
||||
|
||||
If you have Invariant Sections without Cover Texts, or some other
|
||||
combination of the three, merge those two alternatives to suit the
|
||||
situation.
|
||||
|
||||
If your document contains nontrivial examples of program code, we
|
||||
recommend releasing these examples in parallel under your choice of
|
||||
free software license, such as the GNU General Public License,
|
||||
to permit their use in free software.
|
||||
|
||||
@c Local Variables:
|
||||
@c ispell-local-pdict: "ispell-dict"
|
||||
@c End:
|
||||
|
|
@ -1,15 +1,18 @@
|
|||
\input texinfo
|
||||
@c %**start of header
|
||||
@setfilename mcron.info
|
||||
@settitle mcron @VERSION@
|
||||
@include config.texi
|
||||
@include version.texi
|
||||
@settitle mcron @value{VERSION}
|
||||
@c %**end of header
|
||||
|
||||
@syncodeindex fn cp
|
||||
|
||||
@copying This manual is for GNU mcron (version @VERSION@), which is a
|
||||
@copying This manual is for GNU mcron (version @value{VERSION}), which is a
|
||||
program for running jobs at scheduled times.
|
||||
|
||||
Copyright @copyright{} 2003, 2005, 2006, 2012, 2014 Dale Mellor
|
||||
Copyright @copyright{} 2018 Mathieu Lirzin
|
||||
|
||||
@quotation
|
||||
Permission is granted to copy, distribute and/or modify this
|
||||
|
|
@ -61,6 +64,7 @@ running jobs at scheduled times.
|
|||
* Syntax:: All the possibilities for configuring cron jobs.
|
||||
* Invoking:: What happens when you run the mcron command.
|
||||
* Guile modules:: Incorporating mcron into another Guile program.
|
||||
* GNU Free Documentation License:: The license of this manual.
|
||||
* Index:: The complete index.
|
||||
|
||||
@detailmenu
|
||||
|
|
@ -68,40 +72,40 @@ running jobs at scheduled times.
|
|||
|
||||
Simple examples
|
||||
|
||||
* Guile Simple Examples::
|
||||
* Vixie Simple Examples::
|
||||
* Guile Simple Examples::
|
||||
* Vixie Simple Examples::
|
||||
|
||||
Full available syntax
|
||||
|
||||
* Guile Syntax::
|
||||
* Extended Guile examples::
|
||||
* Vixie Syntax::
|
||||
* Guile Syntax::
|
||||
* Extended Guile examples::
|
||||
* Vixie Syntax::
|
||||
|
||||
Extended Guile examples
|
||||
|
||||
* AT commands::
|
||||
* Every second Sunday::
|
||||
* Two hours every day::
|
||||
* Missing the first appointment::
|
||||
* Penultimate day of every month::
|
||||
* AT commands::
|
||||
* Every second Sunday::
|
||||
* Two hours every day::
|
||||
* Missing the first appointment::
|
||||
* Penultimate day of every month::
|
||||
|
||||
Vixie
|
||||
|
||||
* Paul Vixie's copyright::
|
||||
* Crontab file::
|
||||
* Incompatibilities with old Unices::
|
||||
* Paul Vixie's copyright::
|
||||
* Crontab file::
|
||||
* Incompatibilities with old Unices::
|
||||
|
||||
Detailed invoking
|
||||
|
||||
* Invoking mcron::
|
||||
* Invoking cron or crond::
|
||||
* Invoking mcron::
|
||||
* Invoking cron or crond::
|
||||
* Invoking crontab::
|
||||
* Behaviour on laptops::
|
||||
* Exit codes::
|
||||
* Exit codes::
|
||||
|
||||
Guile modules
|
||||
|
||||
* The core module:: The job list and execution loop.
|
||||
* The base module:: The job list and execution loop.
|
||||
* The redirect module:: Sending output of jobs to a mail box.
|
||||
* The vixie-time module:: Parsing vixie-style time specifications.
|
||||
* The job-specifier module:: All commands for scheme configuration files.
|
||||
|
|
@ -154,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
|
||||
|
|
@ -182,8 +186,8 @@ been to allow such simple specifications to be made easily. The
|
|||
examples show how to create the command descriptions, and subsequently
|
||||
how to run mcron to make them happen.
|
||||
@menu
|
||||
* Guile Simple Examples::
|
||||
* Vixie Simple Examples::
|
||||
* Guile Simple Examples::
|
||||
* Vixie Simple Examples::
|
||||
@end menu
|
||||
|
||||
@node Guile Simple Examples, Vixie Simple Examples, Simple examples, Simple examples
|
||||
|
|
@ -258,9 +262,9 @@ on your system, as root.
|
|||
@node Syntax, Invoking, Simple examples, Top
|
||||
@chapter Full available syntax
|
||||
@menu
|
||||
* Guile Syntax::
|
||||
* Extended Guile examples::
|
||||
* Vixie Syntax::
|
||||
* Guile Syntax::
|
||||
* Extended Guile examples::
|
||||
* Vixie Syntax::
|
||||
@end menu
|
||||
@node Guile Syntax, Extended Guile examples, Syntax, Syntax
|
||||
@section Guile Syntax
|
||||
|
|
@ -268,11 +272,13 @@ on your system, as root.
|
|||
@cindex guile syntax
|
||||
@cindex syntax, guile
|
||||
@findex job
|
||||
In Guile-formatted configuration files each command that needs
|
||||
executing is introduced with the @code{job} function. This function
|
||||
always takes two arguments, the first a time specification, and the
|
||||
second a command specification. An optional third argument may contain
|
||||
a string to display when this job is listed in a schedule.
|
||||
In Guile-formatted configuration files each command that needs executing is
|
||||
introduced with the @code{job} function. This function always takes two
|
||||
arguments, the first a time specification, and the second a command
|
||||
specification. An optional third argument may contain a string to display
|
||||
when this job is listed in a schedule. Additionally a @var{user} keyword
|
||||
argument can be supplied to use a different user than the one defined in
|
||||
@code{configuration-user} global variable.
|
||||
|
||||
@cindex time specification, procedure
|
||||
@cindex procedure time specification
|
||||
|
|
@ -324,7 +330,7 @@ taken to be program code made up of the functions @code{(next-second
|
|||
. args)}, @code{(next-minute...)}, etc, where the optional arguments
|
||||
can be supplied with the @code{(range)} function above (these
|
||||
functions are analogous to the ones above except that they implicitly
|
||||
assume the current time; it is supplied by the mcron core when the
|
||||
assume the current time; it is supplied by the mcron base when the
|
||||
list is eval'd).
|
||||
|
||||
@cindex time specification
|
||||
|
|
@ -339,13 +345,12 @@ on Vixie syntax for this.
|
|||
@cindex job execution
|
||||
@cindex command execution
|
||||
@cindex execution
|
||||
The second argument to the @code{(job)} function can be either a
|
||||
string, a list, or a function. In all cases the command is executed in
|
||||
the user's home directory, under the user's own UID. If a string is
|
||||
passed, it is assumed to be shell script and is executed with the
|
||||
user's default shell. If a list is passed it is assumed to be scheme
|
||||
code and is eval'd as such. A supplied function should take exactly
|
||||
zero arguments, and will be called at the pertinent times.
|
||||
The second argument to the @code{(job)} function can be either a string, a
|
||||
list, or a function. The command is executed in the home directory and with
|
||||
the UID of @var{user}. If a string is passed, it is assumed to be shell
|
||||
script and is executed with the user's default shell. If a list is passed it
|
||||
is assumed to be scheme code and is eval'd as such. A supplied function
|
||||
should take exactly zero arguments, and will be called at the pertinent times.
|
||||
|
||||
@subsection Sending output as e-mail
|
||||
@cindex email output
|
||||
|
|
@ -392,11 +397,11 @@ they seem. The following examples illustrate some pitfalls, and
|
|||
demonstrate how to code around them.
|
||||
|
||||
@menu
|
||||
* AT commands::
|
||||
* Every second Sunday::
|
||||
* Two hours every day::
|
||||
* Missing the first appointment::
|
||||
* Penultimate day of every month::
|
||||
* AT commands::
|
||||
* Every second Sunday::
|
||||
* Two hours every day::
|
||||
* Missing the first appointment::
|
||||
* Penultimate day of every month::
|
||||
@end menu
|
||||
|
||||
@node AT commands, Every second Sunday, Extended Guile examples, Extended Guile examples
|
||||
|
|
@ -429,7 +434,7 @@ the student to understand how this works!).
|
|||
(let* ((next-month (next-month-from current-time))
|
||||
(first-day (tm:wday (localtime next-month)))
|
||||
(second-sunday (if (eqv? first-day 0)
|
||||
8
|
||||
7
|
||||
(- 14 first-day))))
|
||||
(+ next-month (* 24 60 60 second-sunday))))
|
||||
"my-program")
|
||||
|
|
@ -511,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.
|
||||
|
|
@ -545,9 +550,9 @@ the variable and runs the command in the user's default shell, as
|
|||
advertised by the /etc/passwd file.
|
||||
|
||||
@menu
|
||||
* Paul Vixie's copyright::
|
||||
* Crontab file::
|
||||
* Incompatibilities with old Unices::
|
||||
* Paul Vixie's copyright::
|
||||
* Crontab file::
|
||||
* Incompatibilities with old Unices::
|
||||
@end menu
|
||||
|
||||
|
||||
|
|
@ -796,11 +801,11 @@ place in the part which implements the mcron personality.
|
|||
|
||||
|
||||
@menu
|
||||
* Invoking mcron::
|
||||
* Invoking cron or crond::
|
||||
* Invoking mcron::
|
||||
* Invoking cron or crond::
|
||||
* Invoking crontab::
|
||||
* Behaviour on laptops::
|
||||
* Exit codes::
|
||||
* Exit codes::
|
||||
@end menu
|
||||
|
||||
@node Invoking mcron, Invoking cron or crond, Invoking, Invoking
|
||||
|
|
@ -810,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
|
||||
|
|
@ -893,25 +898,25 @@ standard output.
|
|||
@cindex invoking cron
|
||||
@cindex crond, invokation
|
||||
@cindex invoking crond
|
||||
@cindex @CONFIG_SPOOL_DIR@
|
||||
@cindex @CONFIG_SOCKET_FILE@
|
||||
@cindex @value{CONFIG_SPOOL_DIR}
|
||||
@cindex @value{CONFIG_SOCKET_FILE}
|
||||
NOTE THAT THIS SECTION ONLY APPLIES IF THE @code{cron} or
|
||||
@code{crond}, and @code{crontab} PROGRAMS HAVE BEEN INSTALLED BY THE
|
||||
SYSTEM ADMINISTRATOR.
|
||||
|
||||
If the program runs by the name of @code{cron} or @code{crond}, then
|
||||
it will read all the files in @code{@CONFIG_SPOOL_DIR@} (which should only
|
||||
be readable by root) and the file @code{/etc/crontab}, and then
|
||||
detaches itself from the terminal to live forever as a daemon
|
||||
it will read all the files in @code{@value{CONFIG_SPOOL_DIR}} (which
|
||||
should only be readable by root) and the file @code{/etc/crontab}, and
|
||||
then detaches itself from the terminal to live forever as a daemon
|
||||
process. Additionally, it creates a UNIX socket at
|
||||
@code{@CONFIG_SOCKET_FILE@}, and listens for messages sent to that socket
|
||||
consisting of a user name whose crontabs have been changed. In this
|
||||
case, the program will re-read that user's crontab. This is for
|
||||
correct functioning with the crontab program.
|
||||
@code{@value{CONFIG_SOCKET_FILE}}, and listens for messages sent to
|
||||
that socket consisting of a user name whose crontabs have been
|
||||
changed. In this case, the program will re-read that user's crontab.
|
||||
This is for correct functioning with the crontab program.
|
||||
|
||||
Further, if the @code{--noetc} option was not used, a job is scheduled
|
||||
to run every minute to check if /etc/crontab has been modified
|
||||
recently. If so, this file will also be re-read.
|
||||
Further, unless the @code{--noetc} option is used, a job is scheduled to run
|
||||
every minute to check if @code{/etc/crontab} has been modified. If so, this
|
||||
file will also be re-read.
|
||||
|
||||
The options which may be used with this program are as follows.
|
||||
|
||||
|
|
@ -1021,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
|
||||
|
|
@ -1060,7 +1065,7 @@ No problems.
|
|||
|
||||
@item 1
|
||||
An attempt has been made to start cron but there is already a
|
||||
@CONFIG_PID_FILE@ file. If there really is no other cron daemon
|
||||
@value{CONFIG_PID_FILE} file. If there really is no other cron daemon
|
||||
running (this does not include invokations of mcron) then you should
|
||||
remove this file before attempting to run cron.
|
||||
|
||||
|
|
@ -1078,9 +1083,9 @@ to be specified in one of these forms.
|
|||
|
||||
@item 4
|
||||
An attempt to run cron has been made by a user who does not have
|
||||
permission to access the crontabs in @CONFIG_SPOOL_DIR@. These files
|
||||
should be readable only by root, and the cron daemon must be run as
|
||||
root.
|
||||
permission to access the crontabs in @value{CONFIG_SPOOL_DIR}. These
|
||||
files should be readable only by root, and the cron daemon must be run
|
||||
as root.
|
||||
|
||||
@item 5
|
||||
An attempt to run mcron has been made, but there are no jobs to
|
||||
|
|
@ -1088,7 +1093,7 @@ schedule!
|
|||
|
||||
@item 6
|
||||
The system administrator has blocked this user from using crontab with
|
||||
the files @CONFIG_ALLOW_FILE@ and @CONFIG_DENY_FILE@.
|
||||
the files @value{CONFIG_ALLOW_FILE} and @value{CONFIG_DENY_FILE}.
|
||||
|
||||
@item 7
|
||||
Crontab has been run with more than one of the arguments @code{-l},
|
||||
|
|
@ -1147,26 +1152,26 @@ non-absolute time specified on the Gregorian calendar (the first day
|
|||
of next week, for example). Finally, it may be the wish of the user to
|
||||
provide a program with the functionality of mcron plus a bit extra.
|
||||
|
||||
The core module maintains mcron's internal job lists, and provides the
|
||||
The base module maintains mcron's internal job lists, and provides the
|
||||
main wait-run-wait loop that is mcron's main function. It also
|
||||
introduces the facilities for accumulating a set of environment
|
||||
modifiers, which take effect when jobs run.
|
||||
|
||||
@menu
|
||||
* The core module:: The job list and execution loop.
|
||||
* The base module:: The job list and execution loop.
|
||||
* The redirect module:: Sending output of jobs to a mail box.
|
||||
* The vixie-time module:: Parsing vixie-style time specifications.
|
||||
* The job-specifier module:: All commands for scheme configuration files.
|
||||
* The vixie-specification module:: Commands for reading vixie-style crontabs.
|
||||
@end menu
|
||||
|
||||
@node The core module, The redirect module, Guile modules, Guile modules
|
||||
@section The core module
|
||||
@node The base module, The redirect module, Guile modules, Guile modules
|
||||
@section The base module
|
||||
@cindex guile module
|
||||
@cindex core module
|
||||
@cindex modules, core
|
||||
@cindex base module
|
||||
@cindex modules, base
|
||||
|
||||
This module may be used by including @code{(use-modules (mcron core))}
|
||||
This module may be used by including @code{(use-modules (mcron base))}
|
||||
in a program. The main functions are @code{add-job} and
|
||||
@code{run-job-loop}, which allow a program to create a list of job
|
||||
specifications to run, and then to initiate the wait-run-wait loop
|
||||
|
|
@ -1192,7 +1197,9 @@ This procedure causes all the environment modifiers that have been
|
|||
specified so far to be forgotten.
|
||||
@end deffn
|
||||
|
||||
@deffn{Scheme procedure} add-job time-proc action displayable configuration-time configuration-user
|
||||
@deffn{Scheme procedure} add-job time-proc action displayable @
|
||||
configuration-time configuration-user @
|
||||
[#:schedule @var{%global-schedule}]
|
||||
This procedure adds a job specification to the list of all jobs to
|
||||
run. @var{time-proc} should be a procedure taking exactly one argument
|
||||
which will be a UNIX time. This procedure must compute the next time
|
||||
|
|
@ -1207,7 +1214,8 @@ computed. Finally, @var{configuration-user} should be the passwd entry
|
|||
for the user under whose personality the job is to run.
|
||||
@end deffn
|
||||
|
||||
@deffn{Scheme procedure} run-job-loop . fd-list
|
||||
@deffn{Scheme procedure} run-job-loop @var{fd-list} @
|
||||
[#:schedule @var{%global-schedule}]
|
||||
@cindex file descriptors
|
||||
@cindex interrupting the mcron loop
|
||||
This procedure returns only under exceptional circumstances, but
|
||||
|
|
@ -1218,20 +1226,24 @@ becoming available for reading on one of the file descriptors in the
|
|||
fd-list, if supplied. Only in this case will the procedure return to
|
||||
the calling program, which may then make modifications to the job list
|
||||
before calling the @code{run-job-loop} procedure again to resume execution of
|
||||
the mcron core.
|
||||
the mcron base.
|
||||
@end deffn
|
||||
|
||||
@deffn{Scheme procedure} remove-user-jobs user
|
||||
|
||||
The argument @var{user} should be a string naming a user (his
|
||||
@deffn{Scheme procedure} remove-user-jobs user @
|
||||
[#:schedule @var{%global-schedule}]
|
||||
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.
|
||||
@end deffn
|
||||
|
||||
@deffn{Scheme procedure} get-schedule count
|
||||
@deffn{Scheme procedure} display-schedule @var{count} [@var{port}] @
|
||||
[#:schedule @var{%global-schedule}]
|
||||
@cindex schedule of jobs
|
||||
The argument @var{count} should be an integer value giving the number
|
||||
This procedure is used to display a textual list of the next COUNT jobs
|
||||
to run.
|
||||
|
||||
The argument @var{count} must be an integer value giving the number
|
||||
of time-points in the future to report that jobs will run as. Note
|
||||
that this procedure is disruptive; if @code{run-job-loop} is called
|
||||
after this procedure, the first job to run will be the one after the
|
||||
|
|
@ -1239,7 +1251,7 @@ last job that was reported in the schedule report. The report itself
|
|||
is returned to the calling program as a string.
|
||||
@end deffn
|
||||
|
||||
@node The redirect module, The vixie-time module, The core module, Guile modules
|
||||
@node The redirect module, The vixie-time module, The base module, Guile modules
|
||||
@section The redirect module
|
||||
@cindex redirect module
|
||||
@cindex modules, redirect
|
||||
|
|
@ -1248,7 +1260,7 @@ This module is introduced to a program with the command
|
|||
@code{(use-modules (mcron redirect))}.
|
||||
|
||||
This module provides the @code{with-mail-out} function, described
|
||||
fully in @ref{Guile Syntax}.
|
||||
fully in @ref{Guile Syntax}.
|
||||
|
||||
@node The vixie-time module, The job-specifier module, The redirect module, Guile modules
|
||||
@section The vixie-time module
|
||||
|
|
@ -1260,7 +1272,7 @@ vixie-time))}.
|
|||
|
||||
This module provides a single method for converting a vixie-style time
|
||||
specification into a procedure which can be used as the
|
||||
@code{next-time-function} to the core @code{add-job} procedure, or to
|
||||
@code{next-time-function} to the base @code{add-job} procedure, or to
|
||||
the @code{job-specifier} @code{job} procedure. See @ref{Vixie Syntax}
|
||||
for full details of the allowed format for the time string.
|
||||
|
||||
|
|
@ -1325,7 +1337,12 @@ return silently. Otherwise, the behaviour is identical to
|
|||
|
||||
Once this module has been declared in a program, a crontab file can be
|
||||
used to augment the current job list with a call to
|
||||
@code{read-vixie-file}.
|
||||
@code{read-vixie-file}.
|
||||
|
||||
@node GNU Free Documentation License
|
||||
@appendix GNU Free Documentation License
|
||||
|
||||
@include fdl.texi
|
||||
|
||||
@node Index, , Guile modules, Top
|
||||
@unnumbered Index
|
||||
125
maint.mk
Executable file
125
maint.mk
Executable file
|
|
@ -0,0 +1,125 @@
|
|||
## Maintainer-only Makefile fragment
|
||||
# Copyright © 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/>.
|
||||
|
||||
# Rebuild Makefile.in if this file is modifed.
|
||||
Makefile.in: maint.mk
|
||||
|
||||
## -------------------- ##
|
||||
## Third-party files. ##
|
||||
## ---------------------##
|
||||
|
||||
WGET = wget
|
||||
|
||||
# Git repositories on Savannah.
|
||||
git_sv_host = git.savannah.gnu.org
|
||||
|
||||
# Some repositories we sync files from.
|
||||
sv_git_am = 'https://$(git_sv_host)/gitweb/?p=automake.git;a=blob_plain;hb=HEAD;f='
|
||||
sv_git_gl = 'https://$(git_sv_host)/gitweb/?p=gnulib.git;a=blob_plain;hb=HEAD;f='
|
||||
|
||||
# Files that we fetch and which we compare against.
|
||||
# Note that the 'lib/COPYING' file must still be synced by hand.
|
||||
fetchfiles = \
|
||||
$(sv_git_am)contrib/test-driver.scm \
|
||||
$(sv_git_gl)build-aux/do-release-commit-and-tag \
|
||||
${sv_git_gl}build-aux/gnu-web-doc-update \
|
||||
$(sv_git_gl)build-aux/gnupload
|
||||
|
||||
# Fetch the latest versions of few scripts and files we care about.
|
||||
# A retrieval failure or a copying failure usually mean serious problems,
|
||||
# so we'll just bail out if 'wget' or 'cp' fail.
|
||||
fetch:
|
||||
$(AM_V_at)rm -rf Fetchdir
|
||||
$(AM_V_at)mkdir Fetchdir
|
||||
$(AM_V_GEN)set -e; \
|
||||
if $(AM_V_P); then wget_opts=; else wget_opts=-nv; fi; \
|
||||
for url in $(fetchfiles); do \
|
||||
file=`printf '%s\n' "$$url" | sed 's|^.*/||; s|^.*=||'`; \
|
||||
$(WGET) $$wget_opts "$$url" -O Fetchdir/$$file || exit 1; \
|
||||
if cmp Fetchdir/$$file $(srcdir)/build-aux/$$file >/dev/null; then \
|
||||
: Nothing to do; \
|
||||
else \
|
||||
echo "$@: updating file $$file"; \
|
||||
cp Fetchdir/$$file $(srcdir)/build-aux/$$file || exit 1; \
|
||||
fi; \
|
||||
done
|
||||
$(AM_V_at)rm -rf Fetchdir
|
||||
.PHONY: fetch
|
||||
|
||||
# If it's not already specified, derive the GPG key ID from
|
||||
# the signed tag we've just applied to mark this release.
|
||||
gpg_key_ID = \
|
||||
$$(cd $(srcdir) \
|
||||
&& git cat-file tag v$(VERSION) \
|
||||
| gpgv --status-fd 1 --keyring /dev/null - - 2>/dev/null \
|
||||
| awk '/^\[GNUPG:\] ERRSIG / {print $$3; exit}')
|
||||
|
||||
# Use alpha.gnu.org for alpha and beta releases.
|
||||
# Use ftp.gnu.org for stable releases.
|
||||
gnu_ftp_host-alpha = alpha.gnu.org
|
||||
gnu_ftp_host-beta = alpha.gnu.org
|
||||
gnu_ftp_host-stable = ftp.gnu.org
|
||||
gnu_rel_host = $(gnu_ftp_host-$(release-type))
|
||||
|
||||
noteworthy_changes = * Noteworthy changes in release ?.? (????-??-??) [?]
|
||||
|
||||
.PHONY: release
|
||||
release:
|
||||
cd $(srcdir) && rm -rf autom4te.cache && ./bootstrap && ./configure
|
||||
$(AM_V_at)$(MAKE) Makefile
|
||||
$(AM_V_at)$(srcdir)/build-aux/announce-gen \
|
||||
--mail-headers='To: ??? Mail-Followup-To: $(PACKAGE_BUGREPORT)' \
|
||||
--release-type=$(release-type) \
|
||||
--package=$(PACKAGE) \
|
||||
--prev=`cat .prev-version` \
|
||||
--curr=$(VERSION) \
|
||||
--gpg-key-id=$(gpg_key_ID) \
|
||||
--srcdir=$(srcdir) \
|
||||
--news=$(srcdir)/NEWS \
|
||||
--bootstrap-tools=autoconf,automake,help2man \
|
||||
--no-print-checksums \
|
||||
--url-dir=https://ftp.gnu.org/gnu/$(PACKAGE) \
|
||||
> ~/announce-$(PACKAGE)-$(VERSION)
|
||||
$(AM_V_at)echo $(VERSION) > .prev-version
|
||||
$(AM_V_at)perl -pi \
|
||||
-e '$$. == 3 and print "$(noteworthy_changes)\n\n\n"' \
|
||||
$(srcdir)/NEWS
|
||||
$(AM_V_at)msg=`printf '%s\n' 'maint: Post-release administrivia' '' \
|
||||
'* NEWS: Add header line for next release.' \
|
||||
'* .prev-version: Record previous version.'` || exit 1; \
|
||||
git commit -m "$$msg" -a
|
||||
|
||||
.PHONY: upload
|
||||
upload:
|
||||
$(srcdir)/build-aux/gnupload $(GNUPLOADFLAGS) \
|
||||
--to $(gnu_rel_host):$(PACKAGE) \
|
||||
$(DIST_ARCHIVES)
|
||||
|
||||
.PHONY: web-manual
|
||||
web-manual:
|
||||
$(AM_V_at)cd '$(srcdir)/doc'; \
|
||||
$(SHELL) ../build-aux/gendocs.sh \
|
||||
-o '$(abs_builddir)/doc/manual' \
|
||||
--email $(PACKAGE_BUGREPORT) $(PACKAGE) \
|
||||
"$(PACKAGE_STRING) Reference Manual"
|
||||
$(AM_V_at)echo " *** Upload the doc/manual directory to web-cvs."
|
||||
|
||||
.PHONY: web-manual-update
|
||||
web-manual-update:
|
||||
$(AM_V_GEN)cd $(srcdir) \
|
||||
&& build-aux/gnu-web-doc-update -C $(abs_builddir)
|
||||
84
makefile.am
84
makefile.am
|
|
@ -1,84 +0,0 @@
|
|||
## Makefile for the toplevel directory of mcron.
|
||||
## 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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
## Process this file with automake to produce Makefile.in
|
||||
|
||||
SUBDIRS = scm/mcron .
|
||||
|
||||
ED = @ED@ # !!!! Are these needed?
|
||||
CP = @CP@
|
||||
|
||||
MAINTAINERCLEANFILES = configure makefile makefile.in config.guess config.sub \
|
||||
install-sh missing texinfo.tex INSTALL \
|
||||
aclocal.m4 compile depcomp mcron.1
|
||||
|
||||
CLEANFILES = mcron.c core.scm
|
||||
|
||||
EXTRA_DIST = makefile.ed mcron.c.template BUGS
|
||||
|
||||
info_TEXINFOS = mcron.texinfo
|
||||
|
||||
dist_man_MANS = 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:...\"
|
||||
|
||||
|
||||
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
|
||||
|
||||
|
||||
#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
|
||||
|
||||
|
||||
# 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.
|
||||
mcron.1 : mcron.c
|
||||
$(HELP2MAN) -n 'a program to run tasks at regular (or not) intervals' \
|
||||
./mcron > mcron.1
|
||||
34
makefile.ed
34
makefile.ed
|
|
@ -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 <http://www.gnu.org/licenses/>.
|
||||
#
|
||||
#
|
||||
#
|
||||
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
|
||||
120
mcron.c.template
120
mcron.c.template
|
|
@ -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 <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
/*
|
||||
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 <string.h>
|
||||
#include <signal.h>
|
||||
#include <libguile.h>
|
||||
|
||||
|
||||
|
||||
/* 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;
|
||||
}
|
||||
|
|
@ -1,35 +0,0 @@
|
|||
;; -*-scheme-*-
|
||||
|
||||
;; 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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
|
||||
;; Some constants set by the configuration process.
|
||||
|
||||
(define-module (mcron config))
|
||||
|
||||
(define-public config-debug @CONFIG_DEBUG@)
|
||||
(define-public config-package-string "@PACKAGE_STRING@")
|
||||
(define-public config-package-bugreport "@PACKAGE_BUGREPORT@")
|
||||
(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@")
|
||||
|
|
@ -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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
|
||||
;; 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.
|
||||
|
|
@ -1,105 +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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
|
||||
|
||||
;; 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))
|
||||
|
||||
|
||||
|
||||
|
||||
;; The env-alist is an association list of variable names and values. Variables
|
||||
;; later in the list will take precedence over variables before. We return a
|
||||
;; fixed-up version in which some variables are given specific default values
|
||||
;; (which the user can override), and two variables which the user is not
|
||||
;; allowed to control are added at the end of the list.
|
||||
|
||||
(define (impose-default-environment env-alist passwd-entry)
|
||||
(append `(("HOME" . ,(passwd:dir passwd-entry))
|
||||
("CWD" . ,(passwd:dir passwd-entry))
|
||||
("SHELL" . ,(passwd:shell passwd-entry))
|
||||
("TERM" . #f)
|
||||
("TERMCAP" . #f))
|
||||
env-alist
|
||||
`(("LOGNAME" . ,(passwd:name passwd-entry))
|
||||
("USER" . ,(passwd:name passwd-entry)))))
|
||||
|
||||
|
||||
|
||||
|
||||
;; Modify the UNIX environment for the current process according to the given
|
||||
;; association list of variables, with the default variable values imposed.
|
||||
|
||||
(define (modify-environment env-alist passwd-entry)
|
||||
(for-each (lambda (variable)
|
||||
(setenv (car variable) (cdr variable)))
|
||||
(impose-default-environment env-alist passwd-entry)))
|
||||
|
||||
|
||||
|
||||
|
||||
;; 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)
|
||||
|
|
@ -1,272 +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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
|
||||
|
||||
;; 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)
|
||||
#: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
|
||||
find-best-next)
|
||||
#:use-module (mcron core)
|
||||
#:use-module (mcron environment)
|
||||
#:use-module (mcron vixie-time)
|
||||
#:re-export (append-environment-mods))
|
||||
|
||||
|
||||
|
||||
;; Function (available to user configuration files) which 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).
|
||||
|
||||
(define (range start end . step)
|
||||
(let ((step (if (or (null? step)
|
||||
(<= (car step) 0))
|
||||
1
|
||||
(car step))))
|
||||
(let loop ((start start))
|
||||
(if (>= start end) '()
|
||||
(cons start
|
||||
(loop (+ start step)))))))
|
||||
|
||||
|
||||
|
||||
;; Internal function (not supposed to be used directly in configuration files;
|
||||
;; it is exported from the module for the convenience of other parts of the
|
||||
;; mcron implementation) which 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 list, and the smallest element larger than the current
|
||||
;; value. If an example of the latter cannot be found, 9999 will be returned.
|
||||
|
||||
(define (find-best-next current next-list)
|
||||
(let ((current-best (cons 9999 9999)))
|
||||
(for-each (lambda (allowed-time)
|
||||
(if (< allowed-time (car current-best))
|
||||
(set-car! current-best allowed-time))
|
||||
(if (and (> allowed-time current)
|
||||
(< allowed-time (cdr current-best)))
|
||||
(set-cdr! current-best allowed-time)))
|
||||
next-list)
|
||||
current-best))
|
||||
|
||||
|
||||
|
||||
;; 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)))
|
||||
|
|
@ -1,503 +0,0 @@
|
|||
;; 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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
|
||||
|
||||
;; 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.
|
||||
|
||||
|
||||
|
||||
;; Pull in some constants set by the builder (via autoconf) at configuration
|
||||
;; time. Turn debugging on if indicated.
|
||||
|
||||
(use-modules (mcron config))
|
||||
(if config-debug (begin (debug-enable 'debug)
|
||||
(debug-enable 'backtrace)))
|
||||
|
||||
|
||||
|
||||
;; To determine the name of the program, scan the first item of the command line
|
||||
;; backwards for the first non-alphabetic character. This allows names like
|
||||
;; in.cron to be accepted as an invocation of the cron command.
|
||||
|
||||
(use-modules (ice-9 regex) (ice-9 rdelim))
|
||||
|
||||
(define command-name (match:substring (regexp-exec (make-regexp "[[:alpha:]]*$")
|
||||
(car (command-line)))))
|
||||
|
||||
|
||||
|
||||
;; Code contributed by Sergey Poznyakoff. Print an error message (made up from
|
||||
;; the parts of rest), and if the error is fatal (present and non-zero) then
|
||||
;; exit to the system with this code.
|
||||
|
||||
(define (mcron-error exit-code . rest)
|
||||
(with-output-to-port (current-error-port)
|
||||
(lambda ()
|
||||
(for-each display (append (list command-name ": ") rest))
|
||||
(newline)))
|
||||
(if (and exit-code (not (eq? exit-code 0)))
|
||||
(primitive-exit exit-code)))
|
||||
|
||||
|
||||
|
||||
;; Code contributed by Sergey Poznyakoff. Execute body. If an 'mcron-error
|
||||
;; exception occurs, print its diagnostics and exit with its error code.
|
||||
|
||||
(defmacro catch-mcron-error (. body)
|
||||
`(catch 'mcron-error
|
||||
(lambda ()
|
||||
,@body)
|
||||
(lambda (key exit-code . msg)
|
||||
(apply mcron-error exit-code msg))))
|
||||
|
||||
|
||||
|
||||
;; 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.
|
||||
|
||||
(define command-type (cond ((string=? command-name "mcron") 'mcron)
|
||||
((or (string=? command-name "cron")
|
||||
(string=? command-name "crond")) 'cron)
|
||||
((string=? command-name "crontab") 'crontab)
|
||||
(else
|
||||
(mcron-error 12 "The command name is invalid."))))
|
||||
|
||||
|
||||
|
||||
;; 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.
|
||||
|
||||
(use-modules (ice-9 getopt-long))
|
||||
|
||||
(define options
|
||||
(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))))))
|
||||
|
||||
;; If the user asked for the version of this program, give it to him and get
|
||||
;; out.
|
||||
|
||||
(if (option-ref options 'version #f)
|
||||
(begin
|
||||
(display (string-append "\n
|
||||
" command-name " (" config-package-string ")\n
|
||||
Written by Dale Mellor\n
|
||||
\n
|
||||
Copyright (C) 2003, 2006, 2014 Dale Mellor\n
|
||||
This is free software; see the source for copying conditions. There is NO\n
|
||||
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n
|
||||
"))
|
||||
(quit)))
|
||||
|
||||
|
||||
|
||||
;; Likewise if the user requested the help text.
|
||||
|
||||
(if (option-ref options 'help #f)
|
||||
(begin
|
||||
(display (string-append "
|
||||
Usage: " (car (command-line))
|
||||
(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
|
||||
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
|
||||
RECOMMENDED).")
|
||||
|
||||
((crontab)
|
||||
(string-append " [-u user] file\n"
|
||||
" " (car (command-line)) " [-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"
|
||||
" -r (delete user's crontab)\n"))
|
||||
|
||||
(else "rubbish"))
|
||||
|
||||
"\n\n
|
||||
Report bugs to " config-package-bugreport ".\n
|
||||
"))
|
||||
(quit)))
|
||||
|
||||
|
||||
|
||||
;; This is called from the C front-end whenever a terminal signal is
|
||||
;; received. We 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.
|
||||
|
||||
(define (delete-run-file)
|
||||
(catch #t (lambda () (delete-file config-pid-file)
|
||||
(delete-file config-socket-file))
|
||||
noop)
|
||||
(quit))
|
||||
|
||||
|
||||
|
||||
;; 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).
|
||||
|
||||
(if (eq? command-type 'cron)
|
||||
(begin
|
||||
(if (not (eqv? (getuid) 0))
|
||||
(mcron-error 16
|
||||
"This program must be run by the root user (and should "
|
||||
"have been installed as such)."))
|
||||
(if (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
|
||||
".)"))
|
||||
(if (not (option-ref options 'schedule #f))
|
||||
(with-output-to-file config-pid-file noop))
|
||||
(setenv "MAILTO" #f)
|
||||
(c-set-cron-signals)))
|
||||
|
||||
|
||||
|
||||
;; Define the functions available to the configuration files. While we're here,
|
||||
;; we'll get the core loaded as well.
|
||||
|
||||
(use-modules (mcron core)
|
||||
(mcron job-specifier)
|
||||
(mcron vixie-specification))
|
||||
|
||||
|
||||
|
||||
;; Procedure to slurp the standard input into a string.
|
||||
|
||||
(define (stdin->string)
|
||||
(with-output-to-string (lambda () (do ((in (read-char) (read-char)))
|
||||
((eof-object? in))
|
||||
(display in)))))
|
||||
|
||||
|
||||
|
||||
;; 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.
|
||||
|
||||
(if (eq? command-type 'crontab)
|
||||
(begin
|
||||
(load "crontab.scm")
|
||||
(quit)))
|
||||
|
||||
|
||||
|
||||
;; Code contributed by Sergey Poznyakoff. Determine if the given file is a
|
||||
;; regular file or not.
|
||||
|
||||
(define (regular-file? file)
|
||||
(catch 'system-error
|
||||
(lambda ()
|
||||
(eq? (stat:type (stat file)) 'regular))
|
||||
(lambda (key call fmt args . rest)
|
||||
(mcron-error 0 (apply format (append (list #f fmt) args)))
|
||||
#f)))
|
||||
|
||||
|
||||
|
||||
;; Procedure which processes any configuration file according to the
|
||||
;; extension. If a file is not recognized, it is silently ignored (this deals
|
||||
;; properly with most editors' backup files, for instance).
|
||||
|
||||
(define guile-file-regexp (make-regexp "\\.gui(le)?$"))
|
||||
(define vixie-file-regexp (make-regexp "\\.vix(ie)?$"))
|
||||
|
||||
(define (process-user-file file-path . assume-guile)
|
||||
(cond ((string=? file-path "-")
|
||||
(if (string=? (option-ref options 'stdin "guile") "vixie")
|
||||
(read-vixie-port (current-input-port))
|
||||
(eval-string (stdin->string))))
|
||||
((or (not (null? assume-guile))
|
||||
(regexp-exec guile-file-regexp file-path))
|
||||
(load file-path))
|
||||
((regexp-exec vixie-file-regexp file-path)
|
||||
(read-vixie-file file-path))))
|
||||
|
||||
|
||||
|
||||
;; Procedure to run through all the files in a user's ~/.cron and/or
|
||||
;; $XDG_CONFIG_HOME/cron or ~/.config/cron directories (only happens under the
|
||||
;; mcron personality).
|
||||
|
||||
(define (process-files-in-user-directory)
|
||||
(let ((errors 0)
|
||||
(home-directory (passwd:dir (getpw (getuid)))))
|
||||
(map (lambda (config-directory)
|
||||
(catch #t
|
||||
(lambda ()
|
||||
(let ((directory (opendir config-directory)))
|
||||
(do ((file-name (readdir directory) (readdir directory)))
|
||||
((eof-object? file-name) (closedir directory))
|
||||
(process-user-file (string-append config-directory
|
||||
"/"
|
||||
file-name)))))
|
||||
(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")))
|
||||
(if (eq? 2 errors)
|
||||
(mcron-error 13
|
||||
"Cannot read files in your ~/.config/cron (or ~/.cron) "
|
||||
"directory."))))
|
||||
|
||||
|
||||
|
||||
;; Procedure to check that a user name is in the passwd database (it may happen
|
||||
;; that a user is removed after creating a crontab). If the user name is valid,
|
||||
;; the full passwd entry for that user is returned to the caller.
|
||||
|
||||
(define (valid-user user-name)
|
||||
(setpwent)
|
||||
(do ((entry (getpw) (getpw)))
|
||||
((or (not entry)
|
||||
(string=? (passwd:name entry) user-name))
|
||||
(endpwent)
|
||||
entry)))
|
||||
|
||||
|
||||
|
||||
;; Procedure to process all the files in the crontab directory, making sure that
|
||||
;; each file is for a legitimate user and setting the configuration-user to that
|
||||
;; user. In this way, when the job procedure is run on behalf of the
|
||||
;; configuration files, the jobs are registered with the system with the
|
||||
;; appropriate user. Note that only the root user should be able to perform this
|
||||
;; operation, but we leave it to the permissions on the /var/cron/tabs directory
|
||||
;; to enforce this.
|
||||
|
||||
(use-modules (srfi srfi-2)) ;; For and-let*.
|
||||
|
||||
(define (process-files-in-system-directory)
|
||||
(catch #t
|
||||
(lambda ()
|
||||
(let ((directory (opendir config-spool-dir)))
|
||||
(do ((file-name (readdir directory) (readdir directory)))
|
||||
((eof-object? file-name))
|
||||
(and-let* ((user (valid-user file-name)))
|
||||
(set-configuration-user user) ;; / ?? !!!!
|
||||
(catch-mcron-error
|
||||
(read-vixie-file (string-append config-spool-dir
|
||||
"/"
|
||||
file-name)))))))
|
||||
(lambda (key . args)
|
||||
(mcron-error
|
||||
4
|
||||
"You do not have permission to access the system crontabs."))))
|
||||
|
||||
|
||||
|
||||
;; 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)
|
||||
(if (not (option-ref options 'noetc #f))
|
||||
(begin
|
||||
(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
|
||||
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.
|
||||
|
||||
(if (option-ref options 'daemon (eq? command-type 'cron))
|
||||
(begin
|
||||
(if (not (eqv? (primitive-fork) 0))
|
||||
(quit))
|
||||
(setsid)
|
||||
(if (eq? command-type 'cron)
|
||||
(with-output-to-file config-pid-file
|
||||
(lambda () (display (getpid)) (newline))))))
|
||||
|
||||
|
||||
|
||||
;; If we are running as cron or crond, we establish a socket to listen for
|
||||
;; updates from a crontab program. This is put into fd-list so that we can
|
||||
;; inform the main wait-run-wait execution loop to listen for incoming messages
|
||||
;; on this socket.
|
||||
|
||||
(define fd-list '())
|
||||
|
||||
(if (eq? command-type 'cron)
|
||||
(catch #t
|
||||
(lambda ()
|
||||
(let ((socket (socket AF_UNIX SOCK_STREAM 0)))
|
||||
(bind socket AF_UNIX config-socket-file)
|
||||
(listen socket 5)
|
||||
(set! fd-list (list socket))))
|
||||
(lambda (key . args)
|
||||
(delete-file config-pid-file)
|
||||
(mcron-error 1
|
||||
"Cannot bind to UNIX socket "
|
||||
config-socket-file))))
|
||||
|
||||
|
||||
|
||||
|
||||
;; This function is called whenever a message comes in on the above socket. We
|
||||
;; 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 we drop all the system jobs and
|
||||
;; re-read the /etc/crontab file.
|
||||
|
||||
(define (process-update-request)
|
||||
(let* ((socket (car (accept (car fd-list))))
|
||||
(user-name (read-line socket)))
|
||||
(close socket)
|
||||
(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)))))))
|
||||
|
||||
|
||||
|
||||
;; Added by Sergey Poznyakoff. This no-op will collect zombie child processes
|
||||
;; as soon as they die. This is a big improvement as previously they stayed
|
||||
;; around the system until the next time mcron wakes to fire a new job off.
|
||||
|
||||
;; Unfortunately it seems to interact badly with the select system call,
|
||||
;; wreaking havoc...
|
||||
|
||||
;; (sigaction SIGCHLD (lambda (sig) noop) SA_RESTART)
|
||||
|
||||
|
||||
|
||||
;; 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 fd-list.
|
||||
|
||||
(catch-mcron-error
|
||||
(while #t
|
||||
(run-job-loop fd-list)
|
||||
(if (not (null? fd-list))
|
||||
(process-update-request))))
|
||||
|
|
@ -1,271 +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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
|
||||
|
||||
(define-module (mcron core)
|
||||
#:use-module (mcron environment)
|
||||
#: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
|
||||
;;
|
||||
;; (vector 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))
|
||||
|
||||
|
||||
|
||||
;; Convenience functions for getting and setting the elements of a job object.
|
||||
|
||||
(define (job:user job) (vector-ref job 0))
|
||||
(define (job:next-time-function job) (vector-ref job 1))
|
||||
(define (job:action job) (vector-ref job 2))
|
||||
(define (job:environment job) (vector-ref job 3))
|
||||
(define (job:displayable job) (vector-ref job 4))
|
||||
(define (job:next-time job) (vector-ref job 5))
|
||||
|
||||
|
||||
|
||||
;; 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 (vector 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)
|
||||
(vector-set! job
|
||||
5
|
||||
((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))
|
||||
(vector-set! job
|
||||
5
|
||||
((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)))))))
|
||||
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)
|
||||
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 --!)
|
||||
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 --!)
|
||||
248
src/mcron/base.scm
Normal file
248
src/mcron/base.scm
Normal file
|
|
@ -0,0 +1,248 @@
|
|||
;;;; base.scm -- core procedures
|
||||
;;; Copyright © 2003 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
;;; Copyright © 2015, 2016, 2018 Mathieu Lirzin <mthl@gnu.org>
|
||||
;;; Copyright © 2016, 2020 Ludovic Courtès <ludo@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/>.
|
||||
|
||||
;;;; Commentary:
|
||||
;;;
|
||||
;;; This module provides the core data structures for scheduling jobs and the
|
||||
;;; procedures for running those jobs.
|
||||
;;;
|
||||
;;;; Code:
|
||||
|
||||
(define-module (mcron base)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 control)
|
||||
#:use-module (mcron environment)
|
||||
#:use-module (mcron utils)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-2)
|
||||
#:use-module (srfi srfi-9)
|
||||
#:use-module (srfi srfi-111)
|
||||
#:export (add-job
|
||||
remove-user-jobs
|
||||
display-schedule
|
||||
run-job-loop
|
||||
;; Deprecated and undocumented procedures.
|
||||
use-system-job-list
|
||||
use-user-job-list
|
||||
clear-system-jobs)
|
||||
#:re-export (clear-environment-mods
|
||||
append-environment-mods))
|
||||
|
||||
;; A cron job.
|
||||
(define-record-type <job>
|
||||
(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 variables that need to be set before the ACTION is run.
|
||||
(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!))
|
||||
|
||||
;; A schedule of cron jobs.
|
||||
(define-record-type <schedule>
|
||||
;; The schedule is composed of a 'user' and 'system' schedule. This makes
|
||||
;; removing all the jobs belonging to one group easy, which is required for
|
||||
;; full vixie compatibility.
|
||||
(make-schedule user system current)
|
||||
schedule?
|
||||
;; list for jobs that may be placed in '/etc/crontab'.
|
||||
(system schedule-system set-schedule-system!) ;list of <job>
|
||||
;; list for all other jobs.
|
||||
(user schedule-user set-schedule-user!) ;list of <job>
|
||||
(current schedule-current set-schedule-current!)) ;symbol 'user or 'system
|
||||
|
||||
(define %global-schedule
|
||||
;; Global schedule used by 'mcron' and 'cron'.
|
||||
(make-schedule '() '() 'user))
|
||||
|
||||
(define* (use-system-job-list #:key (schedule %global-schedule))
|
||||
"Mutate '%global-schedule' to use system jobs.
|
||||
This procedure is deprecated."
|
||||
(set-schedule-current! schedule 'system))
|
||||
|
||||
(define* (use-user-job-list #:key (schedule %global-schedule))
|
||||
"Mutate '%global-schedule' to use user jobs.
|
||||
This procedure is deprecated."
|
||||
(set-schedule-current! schedule 'user))
|
||||
|
||||
(define* (remove-user-jobs user #:key (schedule %global-schedule))
|
||||
"Remove user jobs from SCHEDULE belonging to USER. USER must be either a
|
||||
username, a UID, or a passwd entry."
|
||||
(let ((user* (get-user user)))
|
||||
(set-schedule-user! schedule
|
||||
(filter (lambda (job)
|
||||
(not (eqv? (passwd:uid user*)
|
||||
(passwd:uid (job:user job)))))
|
||||
(schedule-user schedule)))))
|
||||
|
||||
(define* (clear-system-jobs #:key (schedule %global-schedule))
|
||||
"Remove all the system jobs from SCHEDULE."
|
||||
(set-schedule-system! schedule '()))
|
||||
|
||||
(define* (add-job time-proc action displayable configuration-time
|
||||
configuration-user
|
||||
#:key (schedule %global-schedule))
|
||||
"Add a new job with the given specifications to the current job set in
|
||||
SCHEDULE."
|
||||
(let ((entry (make-job configuration-user
|
||||
time-proc
|
||||
action
|
||||
(get-current-environment-mods-copy)
|
||||
displayable
|
||||
(time-proc configuration-time))))
|
||||
(if (eq? (schedule-current schedule) 'user)
|
||||
(set-schedule-user! schedule (cons entry (schedule-user schedule)))
|
||||
(set-schedule-system! schedule
|
||||
(cons entry (schedule-system schedule))))))
|
||||
|
||||
(define* (find-next-jobs #:key (schedule %global-schedule))
|
||||
"Locate the jobs in SCHEDULE with the lowest (soonest) next-times. Return a
|
||||
list where the head is the next scheduled time and the rest are all the job
|
||||
entries that are to run at this time. When SCHEDULE is empty next time is
|
||||
'#f'."
|
||||
(let loop ((jobs
|
||||
(append (schedule-system schedule) (schedule-user schedule)))
|
||||
(next-time (inf))
|
||||
(next-jobs '()))
|
||||
(match jobs
|
||||
(()
|
||||
(cons (and (finite? next-time) next-time) next-jobs))
|
||||
((job . rest)
|
||||
(let ((this-time (job:next-time job)))
|
||||
(cond ((< this-time next-time)
|
||||
(loop rest this-time (list job)))
|
||||
((= this-time next-time)
|
||||
(loop rest next-time (cons job next-jobs)))
|
||||
(else
|
||||
(loop rest next-time next-jobs))))))))
|
||||
|
||||
(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 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."
|
||||
(unless (<= count 0)
|
||||
(match (find-next-jobs #:schedule schedule)
|
||||
((#f . jobs)
|
||||
#f)
|
||||
((time . jobs)
|
||||
(let ((date-string (strftime "%c %z\n" (localtime time))))
|
||||
(for-each (lambda (job)
|
||||
(display date-string port)
|
||||
(display (job:displayable job) port)
|
||||
(newline port)
|
||||
(newline port)
|
||||
(job:next-time-set! job ((job:next-time-function job)
|
||||
(job:next-time job))))
|
||||
jobs))))
|
||||
(display-schedule (- count 1) port #:schedule schedule)))
|
||||
|
||||
;;;
|
||||
;;; Running jobs
|
||||
;;;
|
||||
|
||||
(define number-children
|
||||
;; For proper housekeeping, it is necessary to keep a record of the number
|
||||
;; of child processes we fork off to run the jobs.
|
||||
(box 0))
|
||||
|
||||
(define (update-number-children! proc)
|
||||
;; Apply PROC to the value stored in 'number-children'.
|
||||
(set-box! number-children (proc (unbox number-children))))
|
||||
|
||||
(define (run-job job)
|
||||
"Run JOB in a separate process. The process is run as JOB user with the
|
||||
environment properly set. Update the NEXT-TIME field of JOB by computing its
|
||||
next value."
|
||||
(if (= (primitive-fork) 0)
|
||||
(dynamic-wind ;child
|
||||
(const #t)
|
||||
(λ ()
|
||||
(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 ;parent
|
||||
(update-number-children! 1+)
|
||||
(job:next-time-set! job ((job:next-time-function job)
|
||||
(current-time))))))
|
||||
|
||||
(define (child-cleanup)
|
||||
;; Give any zombie children a chance to die, and decrease the number known
|
||||
;; to exist.
|
||||
(unless (or (<= (unbox number-children) 0)
|
||||
(= (car (waitpid WAIT_ANY WNOHANG)) 0))
|
||||
(update-number-children! 1-)
|
||||
(child-cleanup)))
|
||||
|
||||
(define* (run-job-loop #:optional fd-list #:key (schedule %global-schedule))
|
||||
;; 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).
|
||||
(cond-expand
|
||||
((or guile-3.0 guile-2.2) ;2.2 and 3.0
|
||||
(define select* select))
|
||||
(else
|
||||
;; On Guile 2.0, 'select' could throw upon EINTR or EAGAIN.
|
||||
(define (select* read write except time)
|
||||
(catch 'system-error
|
||||
(lambda ()
|
||||
(select read write except time))
|
||||
(lambda args
|
||||
(if (member (system-error-errno args) (list EAGAIN EINTR))
|
||||
'(() () ())
|
||||
(apply throw args)))))))
|
||||
|
||||
(let/ec break
|
||||
(let loop ()
|
||||
(match (find-next-jobs #:schedule schedule)
|
||||
((next-time . next-jobs-lst)
|
||||
(let ((sleep-time (if next-time
|
||||
(- next-time (current-time))
|
||||
2000000000)))
|
||||
(when (> sleep-time 0)
|
||||
(match (select* fd-list '() '() sleep-time)
|
||||
((() () ())
|
||||
;; 'select' returned an empty set, perhaps because it got
|
||||
;; EINTR or EAGAIN. It's a good time to wait for child
|
||||
;; processes.
|
||||
(child-cleanup))
|
||||
(((lst ...) () ())
|
||||
;; There's some activity so leave the loop.
|
||||
(break))))
|
||||
|
||||
(for-each run-job next-jobs-lst)
|
||||
(child-cleanup)
|
||||
(loop)))))))
|
||||
42
src/mcron/config.scm.in
Normal file
42
src/mcron/config.scm.in
Normal file
|
|
@ -0,0 +1,42 @@
|
|||
;;;; config.scm -- variables defined at configure time
|
||||
;;; Copyright © 2003 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
;;; Copyright © 2015, 2016 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/>.
|
||||
|
||||
(define-module (mcron config))
|
||||
|
||||
(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@")
|
||||
|
||||
;;;
|
||||
;;; Runtime configuration
|
||||
;;;
|
||||
|
||||
(define-public config-debug
|
||||
;; Trigger the display of Guile stack traces on errors.
|
||||
(getenv "MCRON_DEBUG"))
|
||||
37
src/mcron/core.scm
Normal file
37
src/mcron/core.scm
Normal file
|
|
@ -0,0 +1,37 @@
|
|||
;;;; core.scm -- alias for (mcron base) kept for backward compatibility
|
||||
;;; 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/>.
|
||||
|
||||
;;; TODO: Deprecate this alias in next major version.
|
||||
|
||||
(define-module (mcron core)
|
||||
#:use-module (mcron base)
|
||||
#:export (;; Deprecated
|
||||
get-schedule)
|
||||
#:re-export (add-job
|
||||
remove-user-jobs
|
||||
run-job-loop
|
||||
clear-environment-mods
|
||||
append-environment-mods
|
||||
;; Deprecated and undocumented procedures.
|
||||
use-system-job-list
|
||||
use-user-job-list
|
||||
clear-system-jobs))
|
||||
|
||||
(define (get-schedule count)
|
||||
(with-output-to-string
|
||||
(lambda () (display-schedule count))))
|
||||
100
src/mcron/environment.scm
Normal file
100
src/mcron/environment.scm
Normal file
|
|
@ -0,0 +1,100 @@
|
|||
;;;; environment.scm -- interact with the job process environment
|
||||
;;; Copyright © 2003 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
;;; 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/>.
|
||||
|
||||
;;;; 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)
|
||||
#:use-module (srfi srfi-111)
|
||||
#:export (modify-environment
|
||||
clear-environment-mods
|
||||
append-environment-mods
|
||||
get-current-environment-mods-copy))
|
||||
|
||||
;;;
|
||||
;;; Configuration files
|
||||
;;;
|
||||
|
||||
(define %current-environment-mods
|
||||
;; Global variable containing an alist of environment variables populated as
|
||||
;; we parse configuration files.
|
||||
(box '()))
|
||||
|
||||
(define* (get-current-environment-mods-copy
|
||||
#:key (environ %current-environment-mods))
|
||||
"Return a snapshot of the current environment modifications from ENVIRON.
|
||||
This snapshot is a copy of the environment so that modifying it doesn't
|
||||
impact ENVIRON."
|
||||
;; Each time a job is registered we should call this procedure.
|
||||
(list-copy (unbox environ)))
|
||||
|
||||
(define* (clear-environment-mods #:key (environ %current-environment-mods))
|
||||
"Remove all entries in the ENVIRON environment."
|
||||
;; 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) by calling this procedure.
|
||||
(set-box! environ '()))
|
||||
|
||||
(define* (append-environment-mods name value
|
||||
#:key (environ %current-environment-mods))
|
||||
"Set NAME to VALUE in the ENVIRON environment. If VALUES is #f then NAME is
|
||||
considered unset."
|
||||
;; This procedure is used implicitly by the Vixie parser, and can be used
|
||||
;; directly by users in scheme configuration files.
|
||||
(set-box! environ (append (unbox environ) `((,name . ,value))))
|
||||
;; XXX: The return value is purely for the convenience of the
|
||||
;; '(@ (mcron vixie-specification) parse-vixie-environment)'.
|
||||
#t)
|
||||
|
||||
;;;
|
||||
;;; Job runtime
|
||||
;;;
|
||||
|
||||
(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))))))
|
||||
258
src/mcron/job-specifier.scm
Normal file
258
src/mcron/job-specifier.scm
Normal file
|
|
@ -0,0 +1,258 @@
|
|||
;;;; job-specifier.scm -- public interface for defining jobs
|
||||
;;; Copyright © 2003 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
;;; Copyright © 2016, 2017, 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/>.
|
||||
|
||||
;;;; 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)
|
||||
#:use-module (mcron base)
|
||||
#:use-module (mcron environment)
|
||||
#:use-module (mcron utils)
|
||||
#:use-module (mcron vixie-time)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-111)
|
||||
#: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)."
|
||||
(let ((step* (max step 1)))
|
||||
(unfold (λ (i) (>= i end)) ;predicate
|
||||
identity ;value
|
||||
(λ (i) (+ step* i)) ;next seed
|
||||
start))) ;seed
|
||||
|
||||
(define (%find-best-next current next-list)
|
||||
;; Takes a value and a list of possible next values. 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, +INF.0 will be returned.
|
||||
(define (exact-min a b)
|
||||
;; A binary implementation of 'min' which preserves the exactness of its
|
||||
;; arguments.
|
||||
(if (< a b) a b))
|
||||
|
||||
(let loop ((smallest (inf)) (closest+ (inf)) (lst next-list))
|
||||
(match lst
|
||||
(() (cons smallest closest+))
|
||||
((time . rest)
|
||||
(loop (exact-min time smallest)
|
||||
(if (> time current) (exact-min time closest+) closest+)
|
||||
rest)))))
|
||||
|
||||
(define (bump-time time value-list component higher-component
|
||||
set-component! set-higher-component!)
|
||||
;; 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 :-)
|
||||
(if (null? value-list)
|
||||
(set-component! time (1+ (component time)))
|
||||
(match (%find-best-next (component time) value-list)
|
||||
((smallest . closest+)
|
||||
(cond ((inf? closest+)
|
||||
(set-higher-component! time (1+ (higher-component time)))
|
||||
(set-component! time smallest))
|
||||
(else
|
||||
(set-component! time closest+))))))
|
||||
(first (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 #:optional (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 #:optional (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 #:optional (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 #:optional (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 #:optional (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 #:optional (second-list '()))
|
||||
(let ((time (localtime current-time)))
|
||||
(bump-time time second-list tm:sec tm:min set-tm:sec set-tm:min)))
|
||||
|
||||
;;; The following procedures are convenient for configuration files. They are
|
||||
;;; wrappers for the next-X-from functions above, by implicitly using
|
||||
;;; %CURRENT-ACTION-TIME as the time argument.
|
||||
|
||||
(define %current-action-time
|
||||
;; 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.
|
||||
(make-parameter 0))
|
||||
|
||||
(define* (next-year #:optional (args '()))
|
||||
"Compute the next year from %CURRENT-ACTION-TIME parameter object."
|
||||
(next-year-from (%current-action-time) args))
|
||||
|
||||
(define* (next-month #:optional (args '()))
|
||||
"Compute the next month from %CURRENT-ACTION-TIME parameter object."
|
||||
(next-month-from (%current-action-time) args))
|
||||
|
||||
(define* (next-day #:optional (args '()))
|
||||
"Compute the next day from %CURRENT-ACTION-TIME parameter object."
|
||||
(next-day-from (%current-action-time) args))
|
||||
|
||||
(define* (next-hour #:optional (args '()))
|
||||
"Compute the next hour from %CURRENT-ACTION-TIME parameter object."
|
||||
(next-hour-from (%current-action-time) args))
|
||||
|
||||
(define* (next-minute #:optional (args '()))
|
||||
"Compute the next minute from %CURRENT-ACTION-TIME parameter object."
|
||||
(next-minute-from (%current-action-time) args))
|
||||
|
||||
(define* (next-second #:optional (args '()))
|
||||
"Compute the next second from %CURRENT-ACTION-TIME parameter object."
|
||||
(next-second-from (%current-action-time) 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 (box (getpw (getuid))))
|
||||
|
||||
(define configuration-time
|
||||
;; Use SOURCE_DATE_EPOCH environment variable to support reproducible tests.
|
||||
(if (getenv "SOURCE_DATE_EPOCH") 0 (current-time)))
|
||||
|
||||
(define (set-configuration-user user)
|
||||
(set-box! configuration-user (get-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 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
|
||||
;; right at the top of this program).
|
||||
|
||||
(define* (job time-proc action #:optional displayable
|
||||
#:key (user (unbox configuration-user)))
|
||||
(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)
|
||||
(eval time-proc
|
||||
(resolve-module '(mcron job-specifier)))))
|
||||
(else
|
||||
(throw 'mcron-error 3
|
||||
"job: invalid first argument (next-time-function; "
|
||||
"should be function, string or list)"))))
|
||||
(displayable
|
||||
(cond (displayable displayable)
|
||||
((procedure? action) "Lambda function")
|
||||
((string? action) action)
|
||||
((list? action) (simple-format #f "~A" action))))
|
||||
(user* (get-user user)))
|
||||
(add-job (lambda (current-time)
|
||||
(parameterize ((%current-action-time current-time))
|
||||
;; 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
|
||||
user*)))
|
||||
|
|
@ -1,40 +1,45 @@
|
|||
;; 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 <http://www.gnu.org/licenses/>.
|
||||
;;;; 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.
|
||||
;;;
|
||||
;;; 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/>.
|
||||
|
||||
|
||||
|
||||
;; 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.
|
||||
;;;; 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)
|
||||
#:use-module ((mcron config) :select (config-sendmail))
|
||||
#:use-module (mcron vixie-time))
|
||||
|
||||
|
||||
#:use-module (ice-9 popen)
|
||||
#:use-module (ice-9 regex)
|
||||
#:use-module (mcron config)
|
||||
#:use-module (mcron vixie-time)
|
||||
#:export (with-mail-out))
|
||||
|
||||
;; An action string consists of a sequence of characters forming a command
|
||||
;; executable by the shell, possibly followed by an non-escaped percentage
|
||||
|
|
@ -59,9 +64,10 @@
|
|||
;; 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)
|
||||
(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
|
||||
|
|
@ -70,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))
|
||||
|
|
@ -169,14 +175,13 @@
|
|||
(set-current-output-port (if (and (string? mailto)
|
||||
(string=? mailto ""))
|
||||
(open-output-file "/dev/null")
|
||||
(open-output-pipe
|
||||
(string-append config-sendmail
|
||||
" "
|
||||
user))))
|
||||
;; The sendmail command should read
|
||||
;; recipients from the message header.
|
||||
(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)
|
||||
|
||||
162
src/mcron/scripts/cron.scm
Normal file
162
src/mcron/scripts/cron.scm
Normal file
|
|
@ -0,0 +1,162 @@
|
|||
;;;; cron -- daemon for running jobs at scheduled times
|
||||
;;; Copyright © 2003, 2012 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
;;; 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/>.
|
||||
|
||||
|
||||
(define-module (mcron scripts cron)
|
||||
#:use-module (ice-9 ftw)
|
||||
#:use-module (mcron base)
|
||||
#:use-module (mcron config)
|
||||
#:use-module (mcron job-specifier)
|
||||
#:use-module (mcron utils)
|
||||
#:use-module (mcron vixie-specification)
|
||||
#:use-module (srfi srfi-2)
|
||||
#:export (main))
|
||||
|
||||
|
||||
|
||||
(define (delete-run-file)
|
||||
"Remove the /var/run/cron.pid file so that crontab and other invocations of
|
||||
cron don't get the wrong idea that a daemon is currently running. This
|
||||
procedure is called from the C front-end whenever a terminal signal is
|
||||
received."
|
||||
(catch #t
|
||||
(λ ()
|
||||
(delete-file config-pid-file)
|
||||
(delete-file config-socket-file))
|
||||
noop)
|
||||
(quit))
|
||||
|
||||
|
||||
|
||||
(define (cron-file-descriptors)
|
||||
"Establish a socket to listen for updates from a crontab program, and return
|
||||
a list containing the file descriptors correponding to the files read by
|
||||
crontab. This requires that command-type is 'cron."
|
||||
(catch #t
|
||||
(λ ()
|
||||
(let ((sock (socket AF_UNIX SOCK_STREAM 0)))
|
||||
(bind sock AF_UNIX config-socket-file)
|
||||
(listen sock 5)
|
||||
(list sock)))
|
||||
(λ (key . args)
|
||||
(delete-file config-pid-file)
|
||||
(mcron-error 1 "Cannot bind to UNIX socket " config-socket-file))))
|
||||
|
||||
|
||||
|
||||
(define (process-files-in-system-directory)
|
||||
"Process all the files in the crontab directory. When the job procedure is
|
||||
run on behalf of the configuration files, the jobs are registered on the
|
||||
system with the appropriate user. Only root should be able to perform this
|
||||
operation. The permissions on the /var/cron/tabs directory enforce this."
|
||||
|
||||
(define (user-entry name)
|
||||
;; Return the user database entry if NAME is valid, otherwise #f.
|
||||
(false-if-exception (getpwnam name)))
|
||||
|
||||
(catch #t
|
||||
(λ ()
|
||||
(for-each
|
||||
(λ (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)))))
|
||||
(scandir config-spool-dir)))
|
||||
(λ (key . args)
|
||||
(mcron-error 4
|
||||
"You do not have permission to access the system crontabs."))))
|
||||
|
||||
(define (%process-files noetc?)
|
||||
;; Clear MAILTO so that outputs are sent to the various users.
|
||||
(setenv "MAILTO" #f)
|
||||
;; Having defined all the necessary procedures for scanning various sets of
|
||||
;; files, we perform the actual configuration of the program depending on
|
||||
;; the personality we are running as. If it is mcron, we either scan the
|
||||
;; files passed on the command line, or else all the ones in the user's
|
||||
;; .config/cron (or .cron) directory. If we are running under the cron
|
||||
;; personality, we read the /var/cron/tabs directory and also the
|
||||
;; /etc/crontab file.
|
||||
(process-files-in-system-directory)
|
||||
(use-system-job-list)
|
||||
(catch-mcron-error
|
||||
(read-vixie-file "/etc/crontab" parse-system-vixie-line))
|
||||
(use-user-job-list)
|
||||
(unless noetc?
|
||||
(display "\
|
||||
WARNING: cron will check for updates to /etc/crontab EVERY MINUTE. If you do
|
||||
not use this file, or you are prepared to manually restart cron whenever you
|
||||
make a change, then it is HIGHLY RECOMMENDED that you use the --noetc
|
||||
option.\n")
|
||||
(set-configuration-user "root")
|
||||
(job '(- (next-minute-from (next-minute)) 6)
|
||||
check-system-crontab
|
||||
"/etc/crontab update checker.")))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Entry point.
|
||||
;;;
|
||||
|
||||
(define (main --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)."))
|
||||
((access? config-pid-file F_OK)
|
||||
(mcron-error 1
|
||||
"A cron daemon is already running.\n (If you are sure"
|
||||
" this is not true, remove the file\n "
|
||||
config-pid-file ".)"))
|
||||
(else
|
||||
(cond (--schedule
|
||||
=> (λ (count)
|
||||
(display-schedule (max 1 (string->number count)))
|
||||
(exit 0))))
|
||||
(%process-files --noetc)))
|
||||
|
||||
;; Daemonize ourself.
|
||||
(unless (eq? 0 (primitive-fork)) (exit 0))
|
||||
(setsid)
|
||||
|
||||
;; 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)))
|
||||
|
||||
;; Forever execute the 'run-job-loop', and when it drops out (can
|
||||
;; only be because a message has come in on the socket) we
|
||||
;; process the socket request before restarting the loop again.
|
||||
(catch-mcron-error
|
||||
(let ((fdes-list (cron-file-descriptors)))
|
||||
(while #t
|
||||
(run-job-loop fdes-list)
|
||||
(unless (null? fdes-list) (process-update-request fdes-list))))))
|
||||
196
src/mcron/scripts/crontab.scm
Normal file
196
src/mcron/scripts/crontab.scm
Normal file
|
|
@ -0,0 +1,196 @@
|
|||
;;;; crontab -- edit user's cron tabs
|
||||
;;; Copyright © 2003, 2004 Dale Mellor <>
|
||||
;;; Copyright © 2016 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/>.
|
||||
|
||||
(define-module (mcron scripts crontab)
|
||||
#:use-module (ice-9 rdelim)
|
||||
#:use-module (mcron config)
|
||||
#:use-module (mcron utils)
|
||||
#:use-module (mcron vixie-specification)
|
||||
#:export (main))
|
||||
|
||||
(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
|
||||
'/var/cron/socket' UNIX socket."
|
||||
(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"))))
|
||||
|
||||
|
||||
|
||||
;; 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
|
||||
#f otherwise. if FILE cannot be opened, a error is signaled."
|
||||
(catch #t
|
||||
(lambda ()
|
||||
(with-input-from-file file
|
||||
(lambda ()
|
||||
(let loop ((input (read-line)))
|
||||
(cond ((eof-object? input)
|
||||
#f)
|
||||
((string=? input name)
|
||||
#t)
|
||||
(else
|
||||
(loop (read-line))))))))
|
||||
(const '())))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Entry point.
|
||||
;;;
|
||||
|
||||
(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.
|
||||
(passwd:name (getpw (getuid)))))
|
||||
|
||||
;; If the real user is not allowed to use crontab due to the
|
||||
;; /var/cron/allow and/or /var/cron/deny files, bomb out now.
|
||||
(if (or (eq? (in-access-file? config-allow-file crontab-real-user) #f)
|
||||
(eq? (in-access-file? config-deny-file crontab-real-user) #t))
|
||||
(mcron-error 6 "Access denied by system operator."))
|
||||
|
||||
;; Check that no more than one of the mutually exclusive options are
|
||||
;; being used.
|
||||
(when (< 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))) --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 (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)))
|
||||
;; 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.
|
||||
(--list
|
||||
(catch #t
|
||||
(λ ()
|
||||
(with-input-from-file crontab-file
|
||||
(λ ()
|
||||
(do ((input (read-char) (read-char)))
|
||||
((eof-object? input))
|
||||
(display input)))))
|
||||
(λ (key . args)
|
||||
(display (string-append "No crontab for "
|
||||
crontab-user
|
||||
" exists.\n")))))
|
||||
|
||||
;; In the edit personality, we determine the name of a temporary file
|
||||
;; and an editor command, copy an existing crontab file (if it is
|
||||
;; there) to the temporary file, making sure the ownership is set so
|
||||
;; the real user can edit it; once the editor returns we try to read
|
||||
;; the file to check that it is parseable (but do nothing more with
|
||||
;; the configuration), and if it is okay (this program is still
|
||||
;; running!) we move the temporary file to the real crontab, wake the
|
||||
;; cron daemon up, and remove the temporary file. If the parse fails,
|
||||
;; we give user a choice of editing the file again or quitting the
|
||||
;; program and losing all changes made.
|
||||
(--edit
|
||||
(let ((temp-file (string-append config-tmp-dir
|
||||
"/crontab."
|
||||
(number->string (getpid)))))
|
||||
(catch #t
|
||||
(λ () (copy-file crontab-file temp-file))
|
||||
(λ (key . args) (with-output-to-file temp-file noop)))
|
||||
(chown temp-file (getuid) (getgid))
|
||||
(let retry ()
|
||||
(system (string-append
|
||||
(or (getenv "VISUAL") (getenv "EDITOR") "vi")
|
||||
" "
|
||||
temp-file))
|
||||
(catch 'mcron-error
|
||||
(λ () (read-vixie-file temp-file))
|
||||
(λ (key exit-code . msg)
|
||||
(apply mcron-error 0 msg)
|
||||
(if (get-yes-no "Edit again?")
|
||||
(retry)
|
||||
(begin
|
||||
(mcron-error 0 "Crontab not changed")
|
||||
(primitive-exit 0))))))
|
||||
(copy-file temp-file crontab-file)
|
||||
(delete-file temp-file)
|
||||
(hit-server crontab-user)))
|
||||
|
||||
;; In the remove personality we simply make an effort to delete the
|
||||
;; crontab and wake the daemon. No worries if this fails.
|
||||
(--remove (catch #t (λ () (delete-file crontab-file)
|
||||
(hit-server crontab-user))
|
||||
noop))
|
||||
|
||||
;; XXX: This comment is wrong.
|
||||
;; In the case of the replace personality we loop over all the
|
||||
;; arguments on the command line, and for each one parse the file to
|
||||
;; make sure it is parseable (but subsequently ignore the
|
||||
;; configuration), and all being well we copy it to the crontab
|
||||
;; location; we deal with the standard input in the same way but
|
||||
;; different. :-) In either case the server is woken so that it will
|
||||
;; read the newly installed crontab.
|
||||
((not (null? files))
|
||||
(let ((input-file (car files)))
|
||||
(catch-mcron-error
|
||||
(if (string=? input-file "-")
|
||||
(let ((input-string (read-string)))
|
||||
(read-vixie-port (open-input-string input-string))
|
||||
(with-output-to-file crontab-file
|
||||
(λ () (display input-string))))
|
||||
(begin
|
||||
(read-vixie-file input-file)
|
||||
(copy-file input-file crontab-file))))
|
||||
(hit-server crontab-user)))
|
||||
|
||||
;; The user is being silly. The message here is identical to the one
|
||||
;; Vixie cron used to put out, for total compatibility.
|
||||
(else (mcron-error 15
|
||||
"usage error: file name must be specified for replace."))))))
|
||||
109
src/mcron/scripts/mcron.scm
Normal file
109
src/mcron/scripts/mcron.scm
Normal file
|
|
@ -0,0 +1,109 @@
|
|||
;;;; mcron -- run jobs at scheduled times
|
||||
;;; Copyright © 2003, 2012, 2020 Dale Mellor <>
|
||||
;;; 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/>.
|
||||
|
||||
(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 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)?$")))
|
||||
(lambda* (file-name #:optional guile-syntax? #:key (input "guile"))
|
||||
"Process FILE-NAME according its extension. When GUILE-SYNTAX? is TRUE,
|
||||
force guile syntax usage. If FILE-NAME format is not recognized, it is
|
||||
silently ignored."
|
||||
(cond ((string=? "-" file-name)
|
||||
(if (string=? input "vixie")
|
||||
(read-vixie-port (current-input-port))
|
||||
(eval-string (read-string)
|
||||
(resolve-module '(mcron job-specifier)))))
|
||||
((or guile-syntax? (regexp-exec guile-regexp 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)."
|
||||
(let ((errors 0)
|
||||
(home-directory (passwd:dir (getpw (getuid)))))
|
||||
(map (λ (dir)
|
||||
(catch #t
|
||||
(λ ()
|
||||
(for-each (λ (file)
|
||||
(process-user-file (string-append dir "/" file)
|
||||
#:input input-type))
|
||||
(scandir dir)))
|
||||
(λ (key . args)
|
||||
(set! errors (1+ errors)))))
|
||||
(list (string-append home-directory "/.cron")
|
||||
(string-append (or (getenv "XDG_CONFIG_HOME")
|
||||
(string-append home-directory "/.config"))
|
||||
"/cron")))
|
||||
(when (eq? 2 errors)
|
||||
(mcron-error 13
|
||||
"Cannot read files in your ~/.config/cron (or ~/.cron) directory."))))
|
||||
|
||||
|
||||
|
||||
(define (%process-files files input-type)
|
||||
(if (null? files)
|
||||
(process-files-in-user-directory input-type)
|
||||
(for-each (λ (file) (process-user-file file #t)) files)))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Entry point.
|
||||
;;;
|
||||
|
||||
(define (main --daemon --schedule --stdin file-list)
|
||||
|
||||
(when config-debug (debug-enable 'backtrace))
|
||||
(%process-files file-list (or --stdin "guile"))
|
||||
(cond (--schedule
|
||||
=> (λ (count)
|
||||
(display-schedule
|
||||
(max 1 (inexact->exact (floor (string->number count)))))
|
||||
(exit 0)))
|
||||
(--daemon (case (primitive-fork) ((0) (setsid))
|
||||
(else (exit 0)))))
|
||||
|
||||
;; Forever execute the 'run-job-loop', and when it drops out (can only be
|
||||
;; because a message has come in on the socket) we process the socket
|
||||
;; request before restarting the loop again.
|
||||
(catch-mcron-error
|
||||
(let ((fdes-list '()))
|
||||
(while #t
|
||||
(run-job-loop fdes-list)
|
||||
;; we can also drop out of run-job-loop because of a SIGCHLD,
|
||||
;; so must test FDES-LIST.
|
||||
(unless (null? fdes-list)
|
||||
(process-update-request fdes-list))))))
|
||||
104
src/mcron/utils.scm
Normal file
104
src/mcron/utils.scm
Normal file
|
|
@ -0,0 +1,104 @@
|
|||
;;;; utils.scm -- helper procedures
|
||||
;;; Copyright © 2003, 2012 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
;;; 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/>.
|
||||
|
||||
(define-module (mcron utils)
|
||||
#:use-module (ice-9 rdelim)
|
||||
#:use-module (mcron config)
|
||||
#:use-module (mcron base)
|
||||
#:use-module (mcron job-specifier)
|
||||
#:use-module (mcron vixie-specification)
|
||||
#:export (catch-mcron-error
|
||||
mcron-error
|
||||
show-version
|
||||
show-package-information
|
||||
process-update-request
|
||||
get-user)
|
||||
#:re-export (read-string))
|
||||
|
||||
(define (mcron-error exit-code . rest)
|
||||
"Print an error message (made up from the parts of REST), and if the
|
||||
EXIT-CODE error is fatal (present and non-zero) then exit to the system with
|
||||
EXIT-CODE."
|
||||
(with-output-to-port (current-error-port)
|
||||
(lambda ()
|
||||
(for-each display (cons "mcron: " rest))
|
||||
(newline)))
|
||||
(when (and exit-code (not (eq? exit-code 0)))
|
||||
(primitive-exit exit-code)))
|
||||
|
||||
(define-syntax-rule (catch-mcron-error exp ...)
|
||||
"Evaluate EXP .... if an 'mcron-error exception occurs, print its diagnostics
|
||||
and exit with its error code."
|
||||
(catch 'mcron-error
|
||||
(lambda () exp ...)
|
||||
(lambda (key exit-code . msg)
|
||||
(apply mcron-error exit-code msg))))
|
||||
|
||||
(define (show-version command)
|
||||
"Display version information for COMMAND and quit."
|
||||
(let* ((name config-package-name)
|
||||
(short-name (cadr (string-split name #\space)))
|
||||
(version config-package-version))
|
||||
(simple-format #t "~a (~a) ~a
|
||||
Copyright (C) 2020 the ~a authors.
|
||||
License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>
|
||||
This is free software: you are free to change and redistribute it.
|
||||
There is NO WARRANTY, to the extent permitted by law.\n"
|
||||
command name version short-name)))
|
||||
|
||||
(define (show-package-information)
|
||||
"Display where to get help and send bug reports."
|
||||
(simple-format #t "\nReport bugs to: ~a.
|
||||
~a home page: <~a>
|
||||
General help using GNU software: <http://www.gnu.org/gethelp/>\n"
|
||||
config-package-bugreport
|
||||
config-package-name
|
||||
config-package-url))
|
||||
|
||||
(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)))))))
|
||||
|
||||
(define (get-user spec)
|
||||
"Return the passwd entry corresponding to SPEC. If SPEC is passwd entry
|
||||
then return it. If SPEC is not a valid specification throw an exception."
|
||||
(cond ((or (string? spec) (integer? spec))
|
||||
(getpw spec))
|
||||
((vector? spec) ;assume a user passwd entry
|
||||
spec)
|
||||
(else
|
||||
(throw 'invalid-user-specification spec))))
|
||||
|
|
@ -1,45 +1,45 @@
|
|||
;; 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 <http://www.gnu.org/licenses/>.
|
||||
;;;; vixie-specification.scm -- read Vixie-sytle configuration file
|
||||
;;; Copyright © 2003 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
;;;
|
||||
;;; 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/>.
|
||||
|
||||
|
||||
|
||||
;; 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.
|
||||
;;;; 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)
|
||||
#:use-module (ice-9 regex)
|
||||
#:use-module (ice-9 rdelim)
|
||||
#:use-module (mcron base)
|
||||
#:use-module (mcron config)
|
||||
#:use-module (mcron job-specifier)
|
||||
#:use-module (mcron redirect)
|
||||
#:use-module (mcron vixie-time)
|
||||
#:use-module (srfi srfi-1)
|
||||
#: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))
|
||||
|
||||
|
||||
check-system-crontab))
|
||||
|
||||
;; A line in a Vixie-style crontab file which gives a command specification
|
||||
;; carries two pieces of information: a time specification consisting of five
|
||||
|
|
@ -108,11 +108,9 @@
|
|||
(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)))))
|
||||
|
||||
|
||||
|
||||
(and=> (regexp-exec parse-vixie-environment-regexp4 string)
|
||||
(λ (match)
|
||||
(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
|
||||
|
|
@ -162,13 +160,11 @@
|
|||
(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)))))))))
|
||||
(throw 'mcron-error exit-code
|
||||
(apply string-append
|
||||
(number->string report-line)
|
||||
": "
|
||||
msg)))))))))
|
||||
|
||||
|
||||
|
||||
|
|
@ -1,29 +1,28 @@
|
|||
;; 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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;;; vixie-time.scm -- parse Vixie-style times
|
||||
;;; Copyright © 2003 Dale Mellor <dale_mellor@users.sourceforge.net>
|
||||
;;; Copyright © 2018, 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/>.
|
||||
|
||||
(define-module (mcron vixie-time)
|
||||
#:export (parse-vixie-time)
|
||||
#:use-module (mcron job-specifier))
|
||||
|
||||
|
||||
(use-modules (srfi srfi-1) (srfi srfi-13) (srfi srfi-14)
|
||||
(ice-9 regex))
|
||||
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 regex)
|
||||
#:use-module (mcron job-specifier)
|
||||
#:use-module (srfi srfi-1)
|
||||
#: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
|
||||
|
|
@ -123,27 +122,20 @@
|
|||
(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)
|
||||
"Given a list of days in the month MDAY-LIST and a list of days in the week
|
||||
WDAY-LIST, return an augmented list of days in the month with weekdays
|
||||
accounted for."
|
||||
(let ((t (localtime 0)))
|
||||
(set-tm:mday t 1)
|
||||
(set-tm:mon t month)
|
||||
(set-tm:year t year)
|
||||
(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)))))
|
||||
|
||||
|
||||
(define (range-wday wday)
|
||||
(let* ((first (- wday first-day))
|
||||
(first* (if (negative? first) (+ 7 first) first)))
|
||||
(range (1+ first*) 32 7)))
|
||||
(apply append mday-list (map range-wday 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.
|
||||
|
|
@ -179,15 +171,17 @@
|
|||
;; 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))
|
||||
(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))
|
||||
|
||||
|
||||
(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)))
|
||||
(match (find-best-next (getter time) time-list)
|
||||
((smallest . closest+)
|
||||
(let ((infinite (inf? closest+)))
|
||||
(if infinite
|
||||
(setter time smallest)
|
||||
(setter time closest+))
|
||||
infinite)))))
|
||||
|
||||
;; 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
|
||||
|
|
@ -313,73 +307,68 @@
|
|||
((< (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]
|
||||
(match (map-in-order
|
||||
(λ (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]
|
||||
((and time-spec-list (min hour day month wday))
|
||||
(vector-set! wday
|
||||
0
|
||||
(map (lambda (time-spec)
|
||||
(if (eqv? time-spec 7) 0 time-spec))
|
||||
(vector-ref wday 0))) ;; [2]
|
||||
|
||||
(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! day
|
||||
0
|
||||
(remove (lambda (d) (eqv? d 0))
|
||||
(vector-ref day 0))) ;; [2.1]
|
||||
|
||||
(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]
|
||||
(λ (current-time) ;; [3]
|
||||
(let ((time (localtime current-time))) ;; [4]
|
||||
(unless (member (tm:mon time) (time-spec:list month))
|
||||
(nudge-month! time (cdddr time-spec-list))
|
||||
(set-tm:mday time 0))
|
||||
(when (or (eqv? (tm:mday time) 0)
|
||||
(not (member (tm:mday time)
|
||||
(interpolate-weekdays
|
||||
(time-spec:list day)
|
||||
(time-spec:list wday)
|
||||
(tm:mon time)
|
||||
(tm:year time)))))
|
||||
(nudge-day! time (cddr time-spec-list))
|
||||
(set-tm:hour time -1))
|
||||
(unless (member (tm:hour time)
|
||||
(time-spec:list hour))
|
||||
(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]
|
||||
(first (mktime time)))))))) ;; [7]
|
||||
|
||||
|
||||
215
tests/base.scm
Normal file
215
tests/base.scm
Normal file
|
|
@ -0,0 +1,215 @@
|
|||
;;;; base.scm -- tests for (mcron base) module
|
||||
;;; Copyright © 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/>.
|
||||
|
||||
(use-modules (srfi srfi-64)
|
||||
(srfi srfi-111)
|
||||
(mcron base))
|
||||
|
||||
(test-begin "base")
|
||||
|
||||
(setlocale LC_ALL "C")
|
||||
(setenv "TZ" "UTC0")
|
||||
|
||||
;;; Import private procedures.
|
||||
(define make-schedule (@@ (mcron base) make-schedule))
|
||||
(define schedule-current (@@ (mcron base) schedule-current))
|
||||
(define schedule-user (@@ (mcron base) schedule-user))
|
||||
(define schedule-system (@@ (mcron base) schedule-system))
|
||||
(define make-job (@@ (mcron base) make-job))
|
||||
(define find-next-jobs (@@ (mcron base) find-next-jobs))
|
||||
|
||||
(define %user0 #("user0" "x" 0 0 "user0" "/var/empty" "/bin/sh"))
|
||||
(define %user1 #("user1" "x" 1 1 "user1" "/var/empty" "/bin/sh"))
|
||||
|
||||
(define* (make-dummy-job #:optional (displayable "dummy")
|
||||
#:key
|
||||
(user (getpw))
|
||||
(time-proc 1+)
|
||||
(action (λ () "dummy action"))
|
||||
(environment '())
|
||||
(next-time 0))
|
||||
(make-job user time-proc action environment displayable next-time))
|
||||
|
||||
;;; Check 'use-system-job-list' and 'use-user-job-list' effect
|
||||
(let ((schdl (make-schedule '() '() 'user)))
|
||||
(use-system-job-list #:schedule schdl)
|
||||
(test-eq "use-system-job-list"
|
||||
'system
|
||||
(schedule-current schdl))
|
||||
|
||||
(use-user-job-list #:schedule schdl)
|
||||
(test-eq "use-user-job-list"
|
||||
'user
|
||||
(schedule-current schdl)))
|
||||
|
||||
;;; Check that 'remove-user-jobs' with only one type of user job clears the
|
||||
;;; schedule.
|
||||
(let* ((job (make-dummy-job #:user %user0))
|
||||
(schdl (make-schedule (list job) '() 'user)))
|
||||
(remove-user-jobs %user0 #:schedule schdl)
|
||||
(test-equal "remove-user-jobs: only one"
|
||||
'()
|
||||
(schedule-user schdl)))
|
||||
|
||||
;;; Check that 'remove-user-jobs' with only two types of user jobs keep the
|
||||
;;; other user jobs in the schedule.
|
||||
(let* ((job0 (make-dummy-job #:user %user0))
|
||||
(job1 (make-dummy-job #:user %user1))
|
||||
(schdl (make-schedule (list job0 job1) '() 'user)))
|
||||
(remove-user-jobs %user0 #:schedule schdl)
|
||||
(test-equal "remove-user-jobs: keep one"
|
||||
(list job1)
|
||||
(schedule-user schdl)))
|
||||
|
||||
;;; Check that 'clear-system-jobs' removes all system jobs and has no effect
|
||||
;;; on the user jobs.
|
||||
(let* ((job0 (make-dummy-job #:user %user0))
|
||||
(job1 (make-dummy-job #:user %user1))
|
||||
(schdl (make-schedule (list job0) (list job1) 'user)))
|
||||
(clear-system-jobs #:schedule schdl)
|
||||
(test-assert "clear-system-jobs: basic"
|
||||
(and (equal? (list job0) (schedule-user schdl))
|
||||
(equal? '() (schedule-system schdl)))))
|
||||
|
||||
;;; Check that 'add-job' adds a user job when the current schedule is 'user.
|
||||
(let ((schdl (make-schedule '() '() 'user)))
|
||||
(add-job 1+ (const #t) "job0" 0 "user" #:schedule schdl)
|
||||
(test-assert "add-job: user schedule"
|
||||
(and (= 1 (length (schedule-user schdl)))
|
||||
(= 0 (length (schedule-system schdl))))))
|
||||
|
||||
;;; Check that 'add-job' adds a system job when the current schedule is
|
||||
;;; 'system.
|
||||
(let ((schdl (make-schedule '() '() 'system)))
|
||||
(add-job 1+ (const #t) "job0" 0 "user" #:schedule schdl)
|
||||
(test-assert "add-job: system schedule"
|
||||
(and (= 0 (length (schedule-user schdl)))
|
||||
(= 1 (length (schedule-system schdl))))))
|
||||
|
||||
;;; Check that 'find-next-jobs' find the soonest job.
|
||||
(let* ((job0 (make-dummy-job #:user %user0 #:next-time 5))
|
||||
(job1 (make-dummy-job #:user %user1 #:next-time 10))
|
||||
(schdl (make-schedule (list job0) (list job1) 'user)))
|
||||
(test-equal "find-next-jobs: basic"
|
||||
(list 5 job0)
|
||||
(find-next-jobs #:schedule schdl)))
|
||||
|
||||
;;; Check that 'find-next-jobs' can find multiple soonest jobs.
|
||||
(let* ((job0 (make-dummy-job #:user %user0 #:next-time 5))
|
||||
(job1 (make-dummy-job #:user %user1 #:next-time 5))
|
||||
(schdl (make-schedule (list job0) (list job1) 'user)))
|
||||
(test-equal "find-next-jobs: two jobs"
|
||||
(list 5 job0 job1)
|
||||
(find-next-jobs #:schedule schdl)))
|
||||
|
||||
;;; Check that 'find-next-jobs' returns #f when the schedule is empty.
|
||||
(let ((schdl (make-schedule '() '() 'user)))
|
||||
(test-equal "find-next-jobs: empty"
|
||||
(list #f)
|
||||
(find-next-jobs #:schedule schdl)))
|
||||
|
||||
;;; Check output of 'display-schedule' with a basic schedule.
|
||||
(test-assert "display-schedule: basic"
|
||||
(and (equal?
|
||||
"Thu Jan 1 00:00:05 1970 +0000\ndummy\n\n"
|
||||
(let* ((job0 (make-dummy-job #:user %user0 #:next-time 5))
|
||||
(job1 (make-dummy-job #:user %user1 #:next-time 10))
|
||||
(schdl (make-schedule (list job0) (list job1) 'user)))
|
||||
(with-output-to-string
|
||||
(λ () (display-schedule 1 #:schedule schdl)))))
|
||||
(equal?
|
||||
(string-append
|
||||
"Thu Jan 1 00:00:05 1970 +0000\ndummy\n\n"
|
||||
"Thu Jan 1 00:00:06 1970 +0000\ndummy\n\n")
|
||||
(let* ((job0 (make-dummy-job #:user %user0 #:next-time 5))
|
||||
(job1 (make-dummy-job #:user %user1 #:next-time 10))
|
||||
(schdl (make-schedule (list job0) (list job1) 'user)))
|
||||
(with-output-to-string
|
||||
(λ () (display-schedule 2 #:schedule schdl)))))))
|
||||
|
||||
;;; Check output of 'display-schedule' with an empty schedule.
|
||||
(let ((schdl (make-schedule '() '() 'user)))
|
||||
(test-equal "display-schedule: empty"
|
||||
""
|
||||
(with-output-to-string
|
||||
(λ () (display-schedule 1 #:schedule schdl)))))
|
||||
|
||||
;;;
|
||||
;;; Running jobs
|
||||
;;;
|
||||
|
||||
;;; Import private global.
|
||||
(define number-children (@@ (mcron base) number-children))
|
||||
|
||||
;;; Import private procedures.
|
||||
(define update-number-children! (@@ (mcron base) update-number-children!))
|
||||
(define child-cleanup (@@ (mcron base) child-cleanup))
|
||||
(define run-job (@@ (mcron base) run-job))
|
||||
|
||||
;;; Check 'number-children' initial value.
|
||||
(test-equal "number-children: init"
|
||||
0
|
||||
(unbox number-children))
|
||||
|
||||
;;; Check 'update-number-children!' incrementation.
|
||||
(test-equal "update-number-children!: 1+"
|
||||
2
|
||||
(begin
|
||||
(update-number-children! 1+)
|
||||
(update-number-children! 1+)
|
||||
(unbox number-children)))
|
||||
|
||||
;;; Check 'update-number-children!' decrementation.
|
||||
(test-equal "update-number-children!: 1-"
|
||||
1
|
||||
(begin
|
||||
(update-number-children! 1-)
|
||||
(unbox number-children)))
|
||||
|
||||
;;; Check 'update-number-children!' constant value.
|
||||
(test-equal "update-number-children!: set value"
|
||||
0
|
||||
(begin
|
||||
(update-number-children! (const 0))
|
||||
(unbox number-children)))
|
||||
|
||||
;;; Check 'run-job' and 'child-cleanup'.
|
||||
;;; XXX: Having to use the filesystem for a unit test is wrong.
|
||||
(let* ((filename (tmpnam))
|
||||
(action (λ () (close-port (open-output-file filename))))
|
||||
(job (make-dummy-job #:user (getpw (getuid)) #:action action)))
|
||||
(dynamic-wind
|
||||
(const #t)
|
||||
(λ ()
|
||||
(sigaction SIGCHLD (const #t))
|
||||
(run-job job)
|
||||
;; Wait for the SIGCHLD signal sent when job exits.
|
||||
(pause)
|
||||
;; Check 'run-job' result and if the number of children is up-to-date.
|
||||
(test-equal "run-job: basic"
|
||||
1
|
||||
(and (access? filename F_OK)
|
||||
(unbox number-children)))
|
||||
(child-cleanup)
|
||||
;; Check that 'child-cleanup' updates the number of children.
|
||||
(test-equal "child-cleanup: one" 0 (unbox number-children)))
|
||||
(λ ()
|
||||
(and (access? filename F_OK) (delete-file filename))
|
||||
(sigaction SIGCHLD SIG_DFL))))
|
||||
|
||||
(test-end)
|
||||
36
tests/basic.sh
Normal file
36
tests/basic.sh
Normal file
|
|
@ -0,0 +1,36 @@
|
|||
# basic.sh -- basic tests for mcron
|
||||
# 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/>.
|
||||
|
||||
source "${srcdir}/tests/init.sh"
|
||||
|
||||
# Use current working directory to store mcron files
|
||||
XDG_CONFIG_HOME=`pwd`
|
||||
export XDG_CONFIG_HOME
|
||||
|
||||
mkdir cron
|
||||
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"
|
||||
|
||||
Exit 0
|
||||
92
tests/environment.scm
Normal file
92
tests/environment.scm
Normal file
|
|
@ -0,0 +1,92 @@
|
|||
;;;; environment.scm -- tests for (mcron environment) module
|
||||
;;; Copyright © 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/>.
|
||||
|
||||
(use-modules (srfi srfi-64)
|
||||
(srfi srfi-111)
|
||||
(mcron environment))
|
||||
|
||||
(test-begin "environment")
|
||||
|
||||
;;; Check 'current-environment-mods' initial value which should be empty.
|
||||
(test-equal "current-environment-mods: init"
|
||||
'()
|
||||
(unbox (@@ (mcron environment) %current-environment-mods)))
|
||||
|
||||
;;; Check 'current-environment-mods-copy' with an empty environment
|
||||
(test-assert "current-environment-mods-copy: empty"
|
||||
(let* ((env (box '()))
|
||||
(copy0 (get-current-environment-mods-copy #:environ env))
|
||||
(copy1 (get-current-environment-mods-copy #:environ env)))
|
||||
(set! copy1 (assoc-set! copy1 "FOO" "BAR"))
|
||||
(and (equal? '() (unbox env))
|
||||
(equal? '() copy0)
|
||||
(equal? '(("FOO" . "BAR")) copy1))))
|
||||
|
||||
;;; Check 'current-environment-mods-copy' with a basic environment
|
||||
(test-assert "current-environment-mods-copy: basic"
|
||||
(let* ((init-env '(("a" . "1") ("b" . "2")))
|
||||
(env (box init-env))
|
||||
(copy0 (get-current-environment-mods-copy #:environ env))
|
||||
(copy1 (get-current-environment-mods-copy #:environ env)))
|
||||
(set! copy1 (assoc-set! copy1 "c" "3"))
|
||||
(and (equal? init-env (unbox env))
|
||||
(equal? init-env copy0)
|
||||
(equal? `(("c" . "3") . ,init-env) copy1))))
|
||||
|
||||
;;; Check 'append-environment-mods' basic call
|
||||
(test-equal "append-environment-mods: basic"
|
||||
"BAR"
|
||||
(let ((env (box '())))
|
||||
(append-environment-mods "FOO" "BAR" #:environ env)
|
||||
(assoc-ref (unbox env) "FOO")))
|
||||
|
||||
;;; Check 'append-environment-mods' that when adding the same key twice the
|
||||
;;; later is placed after the previous one.
|
||||
(test-equal "append-environment-mods: twice"
|
||||
'(("FOO" . "BAR") ("FOO" . "BAZ"))
|
||||
(let ((env (box '())))
|
||||
(append-environment-mods "FOO" "BAR" #:environ env)
|
||||
(append-environment-mods "FOO" "BAZ" #:environ env)
|
||||
(unbox env)))
|
||||
|
||||
;;; Check 'clear-environment-mods' side effect
|
||||
(test-equal "clear-environment-mods: effect"
|
||||
'()
|
||||
(let ((env (box '())))
|
||||
(append-environment-mods "FOO" "BAR" #:environ env)
|
||||
(append-environment-mods "FOO" "BAZ" #:environ env)
|
||||
(clear-environment-mods #:environ env)
|
||||
(unbox env)))
|
||||
|
||||
;;; Check 'modify-environment' basic call
|
||||
(test-assert "modifiy-environment: basic"
|
||||
(begin
|
||||
(modify-environment '(("FOO" . "bar")) (getpw))
|
||||
(equal? (getenv "FOO") "bar")))
|
||||
|
||||
(test-assert "modifiy-environment: user & logname"
|
||||
;; Check that USER and LOGNAME environment variables can't be changed.
|
||||
(let* ((user-entry (pk (getpw)))
|
||||
(user-name (passwd:name user-entry)))
|
||||
(modify-environment '(("USER" . "alice")) user-entry)
|
||||
(modify-environment '(("LOGNAME" . "bob")) user-entry)
|
||||
(equal? user-name
|
||||
(pk (getenv "USER"))
|
||||
(pk (getenv "LOGNAME")))))
|
||||
|
||||
(test-end)
|
||||
605
tests/init.sh
Normal file
605
tests/init.sh
Normal file
|
|
@ -0,0 +1,605 @@
|
|||
# source this file; set up for tests
|
||||
|
||||
# Copyright (C) 2009-2017 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 <https://www.gnu.org/licenses/>.
|
||||
|
||||
# Using this file in a test
|
||||
# =========================
|
||||
#
|
||||
# The typical skeleton of a test looks like this:
|
||||
#
|
||||
# #!/bin/sh
|
||||
# . "${srcdir=.}/init.sh"; path_prepend_ .
|
||||
# Execute some commands.
|
||||
# Note that these commands are executed in a subdirectory, therefore you
|
||||
# need to prepend "../" to relative filenames in the build directory.
|
||||
# Note that the "path_prepend_ ." is useful only if the body of your
|
||||
# test invokes programs residing in the initial directory.
|
||||
# For example, if the programs you want to test are in src/, and this test
|
||||
# script is named tests/test-1, then you would use "path_prepend_ ../src",
|
||||
# or perhaps export PATH='$(abs_top_builddir)/src$(PATH_SEPARATOR)'"$$PATH"
|
||||
# to all tests via automake's TESTS_ENVIRONMENT.
|
||||
# Set the exit code 0 for success, 77 for skipped, or 1 or other for failure.
|
||||
# Use the skip_ and fail_ functions to print a diagnostic and then exit
|
||||
# with the corresponding exit code.
|
||||
# Exit $?
|
||||
|
||||
# Executing a test that uses this file
|
||||
# ====================================
|
||||
#
|
||||
# Running a single test:
|
||||
# $ make check TESTS=test-foo.sh
|
||||
#
|
||||
# Running a single test, with verbose output:
|
||||
# $ make check TESTS=test-foo.sh VERBOSE=yes
|
||||
#
|
||||
# Running a single test, keeping the temporary directory:
|
||||
# $ make check TESTS=test-foo.sh KEEP=yes
|
||||
#
|
||||
# Running a single test, with single-stepping:
|
||||
# 1. Go into a sub-shell:
|
||||
# $ bash
|
||||
# 2. Set relevant environment variables from TESTS_ENVIRONMENT in the
|
||||
# Makefile:
|
||||
# $ export srcdir=../../tests # this is an example
|
||||
# 3. Execute the commands from the test, copy&pasting them one by one:
|
||||
# $ . "$srcdir/init.sh"; path_prepend_ .
|
||||
# ...
|
||||
# 4. Finally
|
||||
# $ exit
|
||||
|
||||
ME_=`expr "./$0" : '.*/\(.*\)$'`
|
||||
|
||||
# We use a trap below for cleanup. This requires us to go through
|
||||
# hoops to get the right exit status transported through the handler.
|
||||
# So use 'Exit STATUS' instead of 'exit STATUS' inside of the tests.
|
||||
# Turn off errexit here so that we don't trip the bug with OSF1/Tru64
|
||||
# sh inside this function.
|
||||
Exit () { set +e; (exit $1); exit $1; }
|
||||
|
||||
# Print warnings (e.g., about skipped and failed tests) to this file number.
|
||||
# Override by defining to say, 9, in init.cfg, and putting say,
|
||||
# export ...ENVVAR_SETTINGS...; $(SHELL) 9>&2
|
||||
# in the definition of TESTS_ENVIRONMENT in your tests/Makefile.am file.
|
||||
# This is useful when using automake's parallel tests mode, to print
|
||||
# the reason for skip/failure to console, rather than to the .log files.
|
||||
: ${stderr_fileno_=2}
|
||||
|
||||
# Note that correct expansion of "$*" depends on IFS starting with ' '.
|
||||
# Always write the full diagnostic to stderr.
|
||||
# When stderr_fileno_ is not 2, also emit the first line of the
|
||||
# diagnostic to that file descriptor.
|
||||
warn_ ()
|
||||
{
|
||||
# If IFS does not start with ' ', set it and emit the warning in a subshell.
|
||||
case $IFS in
|
||||
' '*) printf '%s\n' "$*" >&2
|
||||
test $stderr_fileno_ = 2 \
|
||||
|| { printf '%s\n' "$*" | sed 1q >&$stderr_fileno_ ; } ;;
|
||||
*) (IFS=' '; warn_ "$@");;
|
||||
esac
|
||||
}
|
||||
fail_ () { warn_ "$ME_: failed test: $@"; Exit 1; }
|
||||
skip_ () { warn_ "$ME_: skipped test: $@"; Exit 77; }
|
||||
fatal_ () { warn_ "$ME_: hard error: $@"; Exit 99; }
|
||||
framework_failure_ () { warn_ "$ME_: set-up failure: $@"; Exit 99; }
|
||||
|
||||
# This is used to simplify checking of the return value
|
||||
# which is useful when ensuring a command fails as desired.
|
||||
# I.e., just doing `command ... &&fail=1` will not catch
|
||||
# a segfault in command for example. With this helper you
|
||||
# instead check an explicit exit code like
|
||||
# returns_ 1 command ... || fail
|
||||
returns_ () {
|
||||
# Disable tracing so it doesn't interfere with stderr of the wrapped command
|
||||
{ set +x; } 2>/dev/null
|
||||
|
||||
local exp_exit="$1"
|
||||
shift
|
||||
"$@"
|
||||
test $? -eq $exp_exit && ret_=0 || ret_=1
|
||||
|
||||
if test "$VERBOSE" = yes && test "$gl_set_x_corrupts_stderr_" = false; then
|
||||
set -x
|
||||
fi
|
||||
{ return $ret_; } 2>/dev/null
|
||||
}
|
||||
|
||||
# Sanitize this shell to POSIX mode, if possible.
|
||||
DUALCASE=1; export DUALCASE
|
||||
if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
|
||||
emulate sh
|
||||
NULLCMD=:
|
||||
alias -g '${1+"$@"}'='"$@"'
|
||||
setopt NO_GLOB_SUBST
|
||||
else
|
||||
case `(set -o) 2>/dev/null` in
|
||||
*posix*) set -o posix ;;
|
||||
esac
|
||||
fi
|
||||
|
||||
# We require $(...) support unconditionally.
|
||||
# We require non-surprising "local" semantics (this eliminates dash).
|
||||
# This takes the admittedly draconian step of eliminating dash, because the
|
||||
# assignment tab=$(printf '\t') works fine, yet preceding it with "local "
|
||||
# transforms it into an assignment that sets the variable to the empty string.
|
||||
# That is too counter-intuitive, and can lead to subtle run-time malfunction.
|
||||
# The example below is less subtle in that with dash, it evokes the run-time
|
||||
# exception "dash: 1: local: 1: bad variable name".
|
||||
# We require a few additional shell features only when $EXEEXT is nonempty,
|
||||
# in order to support automatic $EXEEXT emulation:
|
||||
# - hyphen-containing alias names
|
||||
# - we prefer to use ${var#...} substitution, rather than having
|
||||
# to work around lack of support for that feature.
|
||||
# The following code attempts to find a shell with support for these features.
|
||||
# If the current shell passes the test, we're done. Otherwise, test other
|
||||
# shells until we find one that passes. If one is found, re-exec it.
|
||||
# If no acceptable shell is found, skip the current test.
|
||||
#
|
||||
# The "...set -x; P=1 true 2>err..." test is to disqualify any shell that
|
||||
# emits "P=1" into err, as /bin/sh from SunOS 5.11 and OpenBSD 4.7 do.
|
||||
#
|
||||
# Use "9" to indicate success (rather than 0), in case some shell acts
|
||||
# like Solaris 10's /bin/sh but exits successfully instead of with status 2.
|
||||
|
||||
# Eval this code in a subshell to determine a shell's suitability.
|
||||
# 10 - passes all tests; ok to use
|
||||
# 9 - ok, but enabling "set -x" corrupts app stderr; prefer higher score
|
||||
# ? - not ok
|
||||
gl_shell_test_script_='
|
||||
test $(echo y) = y || exit 1
|
||||
f_local_() { local v=1; }; f_local_ || exit 1
|
||||
f_dash_local_fail_() { local t=$(printf " 1"); }; f_dash_local_fail_
|
||||
score_=10
|
||||
if test "$VERBOSE" = yes; then
|
||||
test -n "$( (exec 3>&1; set -x; P=1 true 2>&3) 2> /dev/null)" && score_=9
|
||||
fi
|
||||
test -z "$EXEEXT" && exit $score_
|
||||
shopt -s expand_aliases
|
||||
alias a-b="echo zoo"
|
||||
v=abx
|
||||
test ${v%x} = ab \
|
||||
&& test ${v#a} = bx \
|
||||
&& test $(a-b) = zoo \
|
||||
&& exit $score_
|
||||
'
|
||||
|
||||
if test "x$1" = "x--no-reexec"; then
|
||||
shift
|
||||
else
|
||||
# Assume a working shell. Export to subshells (setup_ needs this).
|
||||
gl_set_x_corrupts_stderr_=false
|
||||
export gl_set_x_corrupts_stderr_
|
||||
|
||||
# Record the first marginally acceptable shell.
|
||||
marginal_=
|
||||
|
||||
# Search for a shell that meets our requirements.
|
||||
for re_shell_ in __current__ "${CONFIG_SHELL:-no_shell}" \
|
||||
/bin/sh bash dash zsh pdksh fail
|
||||
do
|
||||
test "$re_shell_" = no_shell && continue
|
||||
|
||||
# If we've made it all the way to the sentinel, "fail" without
|
||||
# finding even a marginal shell, skip this test.
|
||||
if test "$re_shell_" = fail; then
|
||||
test -z "$marginal_" && skip_ failed to find an adequate shell
|
||||
re_shell_=$marginal_
|
||||
break
|
||||
fi
|
||||
|
||||
# When testing the current shell, simply "eval" the test code.
|
||||
# Otherwise, run it via $re_shell_ -c ...
|
||||
if test "$re_shell_" = __current__; then
|
||||
# 'eval'ing this code makes Solaris 10's /bin/sh exit with
|
||||
# $? set to 2. It does not evaluate any of the code after the
|
||||
# "unexpected" first '('. Thus, we must run it in a subshell.
|
||||
( eval "$gl_shell_test_script_" ) > /dev/null 2>&1
|
||||
else
|
||||
"$re_shell_" -c "$gl_shell_test_script_" 2>/dev/null
|
||||
fi
|
||||
|
||||
st_=$?
|
||||
|
||||
# $re_shell_ works just fine. Use it.
|
||||
if test $st_ = 10; then
|
||||
gl_set_x_corrupts_stderr_=false
|
||||
break
|
||||
fi
|
||||
|
||||
# If this is our first marginally acceptable shell, remember it.
|
||||
if test "$st_:$marginal_" = 9: ; then
|
||||
marginal_="$re_shell_"
|
||||
gl_set_x_corrupts_stderr_=true
|
||||
fi
|
||||
done
|
||||
|
||||
if test "$re_shell_" != __current__; then
|
||||
# Found a usable shell. Preserve -v and -x.
|
||||
case $- in
|
||||
*v*x* | *x*v*) opts_=-vx ;;
|
||||
*v*) opts_=-v ;;
|
||||
*x*) opts_=-x ;;
|
||||
*) opts_= ;;
|
||||
esac
|
||||
re_shell=$re_shell_
|
||||
export re_shell
|
||||
exec "$re_shell_" $opts_ "$0" --no-reexec "$@"
|
||||
echo "$ME_: exec failed" 1>&2
|
||||
exit 127
|
||||
fi
|
||||
fi
|
||||
|
||||
# If this is bash, turn off all aliases.
|
||||
test -n "$BASH_VERSION" && unalias -a
|
||||
|
||||
# Note that when supporting $EXEEXT (transparently mapping from PROG_NAME to
|
||||
# PROG_NAME.exe), we want to support hyphen-containing names like test-acos.
|
||||
# That is part of the shell-selection test above. Why use aliases rather
|
||||
# than functions? Because support for hyphen-containing aliases is more
|
||||
# widespread than that for hyphen-containing function names.
|
||||
test -n "$EXEEXT" && shopt -s expand_aliases
|
||||
|
||||
# Enable glibc's malloc-perturbing option.
|
||||
# This is useful for exposing code that depends on the fact that
|
||||
# malloc-related functions often return memory that is mostly zeroed.
|
||||
# If you have the time and cycles, use valgrind to do an even better job.
|
||||
: ${MALLOC_PERTURB_=87}
|
||||
export MALLOC_PERTURB_
|
||||
|
||||
# This is a stub function that is run upon trap (upon regular exit and
|
||||
# interrupt). Override it with a per-test function, e.g., to unmount
|
||||
# a partition, or to undo any other global state changes.
|
||||
cleanup_ () { :; }
|
||||
|
||||
# Emit a header similar to that from diff -u; Print the simulated "diff"
|
||||
# command so that the order of arguments is clear. Don't bother with @@ lines.
|
||||
emit_diff_u_header_ ()
|
||||
{
|
||||
printf '%s\n' "diff -u $*" \
|
||||
"--- $1 1970-01-01" \
|
||||
"+++ $2 1970-01-01"
|
||||
}
|
||||
|
||||
# Arrange not to let diff or cmp operate on /dev/null,
|
||||
# since on some systems (at least OSF/1 5.1), that doesn't work.
|
||||
# When there are not two arguments, or no argument is /dev/null, return 2.
|
||||
# When one argument is /dev/null and the other is not empty,
|
||||
# cat the nonempty file to stderr and return 1.
|
||||
# Otherwise, return 0.
|
||||
compare_dev_null_ ()
|
||||
{
|
||||
test $# = 2 || return 2
|
||||
|
||||
if test "x$1" = x/dev/null; then
|
||||
test -s "$2" || return 0
|
||||
emit_diff_u_header_ "$@"; sed 's/^/+/' "$2"
|
||||
return 1
|
||||
fi
|
||||
|
||||
if test "x$2" = x/dev/null; then
|
||||
test -s "$1" || return 0
|
||||
emit_diff_u_header_ "$@"; sed 's/^/-/' "$1"
|
||||
return 1
|
||||
fi
|
||||
|
||||
return 2
|
||||
}
|
||||
|
||||
for diff_opt_ in -u -U3 -c '' no; do
|
||||
test "$diff_opt_" != no &&
|
||||
diff_out_=`exec 2>/dev/null; diff $diff_opt_ "$0" "$0" < /dev/null` &&
|
||||
break
|
||||
done
|
||||
if test "$diff_opt_" != no; then
|
||||
if test -z "$diff_out_"; then
|
||||
compare_ () { diff $diff_opt_ "$@"; }
|
||||
else
|
||||
compare_ ()
|
||||
{
|
||||
# If no differences were found, AIX and HP-UX 'diff' produce output
|
||||
# like "No differences encountered". Hide this output.
|
||||
diff $diff_opt_ "$@" > diff.out
|
||||
diff_status_=$?
|
||||
test $diff_status_ -eq 0 || cat diff.out || diff_status_=2
|
||||
rm -f diff.out || diff_status_=2
|
||||
return $diff_status_
|
||||
}
|
||||
fi
|
||||
elif cmp -s /dev/null /dev/null 2>/dev/null; then
|
||||
compare_ () { cmp -s "$@"; }
|
||||
else
|
||||
compare_ () { cmp "$@"; }
|
||||
fi
|
||||
|
||||
# Usage: compare EXPECTED ACTUAL
|
||||
#
|
||||
# Given compare_dev_null_'s preprocessing, defer to compare_ if 2 or more.
|
||||
# Otherwise, propagate $? to caller: any diffs have already been printed.
|
||||
compare ()
|
||||
{
|
||||
# This looks like it can be factored to use a simple "case $?"
|
||||
# after unchecked compare_dev_null_ invocation, but that would
|
||||
# fail in a "set -e" environment.
|
||||
if compare_dev_null_ "$@"; then
|
||||
return 0
|
||||
else
|
||||
case $? in
|
||||
1) return 1;;
|
||||
*) compare_ "$@";;
|
||||
esac
|
||||
fi
|
||||
}
|
||||
|
||||
# An arbitrary prefix to help distinguish test directories.
|
||||
testdir_prefix_ () { printf gt; }
|
||||
|
||||
# Run the user-overridable cleanup_ function, remove the temporary
|
||||
# directory and exit with the incoming value of $?.
|
||||
remove_tmp_ ()
|
||||
{
|
||||
__st=$?
|
||||
cleanup_
|
||||
if test "$KEEP" = yes; then
|
||||
echo "Not removing temporary directory $test_dir_"
|
||||
else
|
||||
# cd out of the directory we're about to remove
|
||||
cd "$initial_cwd_" || cd / || cd /tmp
|
||||
chmod -R u+rwx "$test_dir_"
|
||||
# If removal fails and exit status was to be 0, then change it to 1.
|
||||
rm -rf "$test_dir_" || { test $__st = 0 && __st=1; }
|
||||
fi
|
||||
exit $__st
|
||||
}
|
||||
|
||||
# Given a directory name, DIR, if every entry in it that matches *.exe
|
||||
# contains only the specified bytes (see the case stmt below), then print
|
||||
# a space-separated list of those names and return 0. Otherwise, don't
|
||||
# print anything and return 1. Naming constraints apply also to DIR.
|
||||
find_exe_basenames_ ()
|
||||
{
|
||||
feb_dir_=$1
|
||||
feb_fail_=0
|
||||
feb_result_=
|
||||
feb_sp_=
|
||||
for feb_file_ in $feb_dir_/*.exe; do
|
||||
# If there was no *.exe file, or there existed a file named "*.exe" that
|
||||
# was deleted between the above glob expansion and the existence test
|
||||
# below, just skip it.
|
||||
test "x$feb_file_" = "x$feb_dir_/*.exe" && test ! -f "$feb_file_" \
|
||||
&& continue
|
||||
# Exempt [.exe, since we can't create a function by that name, yet
|
||||
# we can't invoke [ by PATH search anyways due to shell builtins.
|
||||
test "x$feb_file_" = "x$feb_dir_/[.exe" && continue
|
||||
case $feb_file_ in
|
||||
*[!-a-zA-Z/0-9_.+]*) feb_fail_=1; break;;
|
||||
*) # Remove leading file name components as well as the .exe suffix.
|
||||
feb_file_=${feb_file_##*/}
|
||||
feb_file_=${feb_file_%.exe}
|
||||
feb_result_="$feb_result_$feb_sp_$feb_file_";;
|
||||
esac
|
||||
feb_sp_=' '
|
||||
done
|
||||
test $feb_fail_ = 0 && printf %s "$feb_result_"
|
||||
return $feb_fail_
|
||||
}
|
||||
|
||||
# Consider the files in directory, $1.
|
||||
# For each file name of the form PROG.exe, create an alias named
|
||||
# PROG that simply invokes PROG.exe, then return 0. If any selected
|
||||
# file name or the directory name, $1, contains an unexpected character,
|
||||
# define no alias and return 1.
|
||||
create_exe_shims_ ()
|
||||
{
|
||||
case $EXEEXT in
|
||||
'') return 0 ;;
|
||||
.exe) ;;
|
||||
*) echo "$0: unexpected \$EXEEXT value: $EXEEXT" 1>&2; return 1 ;;
|
||||
esac
|
||||
|
||||
base_names_=`find_exe_basenames_ $1` \
|
||||
|| { echo "$0 (exe_shim): skipping directory: $1" 1>&2; return 0; }
|
||||
|
||||
if test -n "$base_names_"; then
|
||||
for base_ in $base_names_; do
|
||||
alias "$base_"="$base_$EXEEXT"
|
||||
done
|
||||
fi
|
||||
|
||||
return 0
|
||||
}
|
||||
|
||||
# Use this function to prepend to PATH an absolute name for each
|
||||
# specified, possibly-$initial_cwd_-relative, directory.
|
||||
path_prepend_ ()
|
||||
{
|
||||
while test $# != 0; do
|
||||
path_dir_=$1
|
||||
case $path_dir_ in
|
||||
'') fail_ "invalid path dir: '$1'";;
|
||||
/*) abs_path_dir_=$path_dir_;;
|
||||
*) abs_path_dir_=$initial_cwd_/$path_dir_;;
|
||||
esac
|
||||
case $abs_path_dir_ in
|
||||
*:*) fail_ "invalid path dir: '$abs_path_dir_'";;
|
||||
esac
|
||||
PATH="$abs_path_dir_:$PATH"
|
||||
|
||||
# Create an alias, FOO, for each FOO.exe in this directory.
|
||||
create_exe_shims_ "$abs_path_dir_" \
|
||||
|| fail_ "something failed (above): $abs_path_dir_"
|
||||
shift
|
||||
done
|
||||
export PATH
|
||||
}
|
||||
|
||||
setup_ ()
|
||||
{
|
||||
if test "$VERBOSE" = yes; then
|
||||
# Test whether set -x may cause the selected shell to corrupt an
|
||||
# application's stderr. Many do, including zsh-4.3.10 and the /bin/sh
|
||||
# from SunOS 5.11, OpenBSD 4.7 and Irix 5.x and 6.5.
|
||||
# If enabling verbose output this way would cause trouble, simply
|
||||
# issue a warning and refrain.
|
||||
if $gl_set_x_corrupts_stderr_; then
|
||||
warn_ "using SHELL=$SHELL with 'set -x' corrupts stderr"
|
||||
else
|
||||
set -x
|
||||
fi
|
||||
fi
|
||||
|
||||
initial_cwd_=$PWD
|
||||
|
||||
pfx_=`testdir_prefix_`
|
||||
test_dir_=`mktempd_ "$initial_cwd_" "$pfx_-$ME_.XXXX"` \
|
||||
|| fail_ "failed to create temporary directory in $initial_cwd_"
|
||||
cd "$test_dir_" || fail_ "failed to cd to temporary directory"
|
||||
|
||||
# As autoconf-generated configure scripts do, ensure that IFS
|
||||
# is defined initially, so that saving and restoring $IFS works.
|
||||
gl_init_sh_nl_='
|
||||
'
|
||||
IFS=" "" $gl_init_sh_nl_"
|
||||
|
||||
# This trap statement, along with a trap on 0 below, ensure that the
|
||||
# temporary directory, $test_dir_, is removed upon exit as well as
|
||||
# upon receipt of any of the listed signals.
|
||||
for sig_ in 1 2 3 13 15; do
|
||||
eval "trap 'Exit $(expr $sig_ + 128)' $sig_"
|
||||
done
|
||||
}
|
||||
|
||||
# Create a temporary directory, much like mktemp -d does.
|
||||
# Written by Jim Meyering.
|
||||
#
|
||||
# Usage: mktempd_ /tmp phoey.XXXXXXXXXX
|
||||
#
|
||||
# First, try to use the mktemp program.
|
||||
# Failing that, we'll roll our own mktemp-like function:
|
||||
# - try to get random bytes from /dev/urandom
|
||||
# - failing that, generate output from a combination of quickly-varying
|
||||
# sources and gzip. Ignore non-varying gzip header, and extract
|
||||
# "random" bits from there.
|
||||
# - given those bits, map to file-name bytes using tr, and try to create
|
||||
# the desired directory.
|
||||
# - make only $MAX_TRIES_ attempts
|
||||
|
||||
# Helper function. Print $N pseudo-random bytes from a-zA-Z0-9.
|
||||
rand_bytes_ ()
|
||||
{
|
||||
n_=$1
|
||||
|
||||
# Maybe try openssl rand -base64 $n_prime_|tr '+/=\012' abcd first?
|
||||
# But if they have openssl, they probably have mktemp, too.
|
||||
|
||||
chars_=abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789
|
||||
dev_rand_=/dev/urandom
|
||||
if test -r "$dev_rand_"; then
|
||||
# Note: 256-length($chars_) == 194; 3 copies of $chars_ is 186 + 8 = 194.
|
||||
dd ibs=$n_ count=1 if=$dev_rand_ 2>/dev/null \
|
||||
| LC_ALL=C tr -c $chars_ 01234567$chars_$chars_$chars_
|
||||
return
|
||||
fi
|
||||
|
||||
n_plus_50_=`expr $n_ + 50`
|
||||
cmds_='date; date +%N; free; who -a; w; ps auxww; ps ef; netstat -n'
|
||||
data_=` (eval "$cmds_") 2>&1 | gzip `
|
||||
|
||||
# Ensure that $data_ has length at least 50+$n_
|
||||
while :; do
|
||||
len_=`echo "$data_"|wc -c`
|
||||
test $n_plus_50_ -le $len_ && break;
|
||||
data_=` (echo "$data_"; eval "$cmds_") 2>&1 | gzip `
|
||||
done
|
||||
|
||||
echo "$data_" \
|
||||
| dd bs=1 skip=50 count=$n_ 2>/dev/null \
|
||||
| LC_ALL=C tr -c $chars_ 01234567$chars_$chars_$chars_
|
||||
}
|
||||
|
||||
mktempd_ ()
|
||||
{
|
||||
case $# in
|
||||
2);;
|
||||
*) fail_ "Usage: mktempd_ DIR TEMPLATE";;
|
||||
esac
|
||||
|
||||
destdir_=$1
|
||||
template_=$2
|
||||
|
||||
MAX_TRIES_=4
|
||||
|
||||
# Disallow any trailing slash on specified destdir:
|
||||
# it would subvert the post-mktemp "case"-based destdir test.
|
||||
case $destdir_ in
|
||||
/ | //) destdir_slash_=$destdir;;
|
||||
*/) fail_ "invalid destination dir: remove trailing slash(es)";;
|
||||
*) destdir_slash_=$destdir_/;;
|
||||
esac
|
||||
|
||||
case $template_ in
|
||||
*XXXX) ;;
|
||||
*) fail_ \
|
||||
"invalid template: $template_ (must have a suffix of at least 4 X's)";;
|
||||
esac
|
||||
|
||||
# First, try to use mktemp.
|
||||
d=`unset TMPDIR; { mktemp -d -t -p "$destdir_" "$template_"; } 2>/dev/null` &&
|
||||
|
||||
# The resulting name must be in the specified directory.
|
||||
case $d in "$destdir_slash_"*) :;; *) false;; esac &&
|
||||
|
||||
# It must have created the directory.
|
||||
test -d "$d" &&
|
||||
|
||||
# It must have 0700 permissions. Handle sticky "S" bits.
|
||||
perms=`ls -dgo "$d" 2>/dev/null` &&
|
||||
case $perms in drwx--[-S]---*) :;; *) false;; esac && {
|
||||
echo "$d"
|
||||
return
|
||||
}
|
||||
|
||||
# If we reach this point, we'll have to create a directory manually.
|
||||
|
||||
# Get a copy of the template without its suffix of X's.
|
||||
base_template_=`echo "$template_"|sed 's/XX*$//'`
|
||||
|
||||
# Calculate how many X's we've just removed.
|
||||
template_length_=`echo "$template_" | wc -c`
|
||||
nx_=`echo "$base_template_" | wc -c`
|
||||
nx_=`expr $template_length_ - $nx_`
|
||||
|
||||
err_=
|
||||
i_=1
|
||||
while :; do
|
||||
X_=`rand_bytes_ $nx_`
|
||||
candidate_dir_="$destdir_slash_$base_template_$X_"
|
||||
err_=`mkdir -m 0700 "$candidate_dir_" 2>&1` \
|
||||
&& { echo "$candidate_dir_"; return; }
|
||||
test $MAX_TRIES_ -le $i_ && break;
|
||||
i_=`expr $i_ + 1`
|
||||
done
|
||||
fail_ "$err_"
|
||||
}
|
||||
|
||||
# If you want to override the testdir_prefix_ function,
|
||||
# or to add more utility functions, use this file.
|
||||
test -f "$srcdir/init.cfg" \
|
||||
&& . "$srcdir/init.cfg"
|
||||
|
||||
setup_ "$@"
|
||||
# This trap is here, rather than in the setup_ function, because some
|
||||
# shells run the exit trap at shell function exit, rather than script exit.
|
||||
trap remove_tmp_ 0
|
||||
168
tests/job-specifier.scm
Normal file
168
tests/job-specifier.scm
Normal file
|
|
@ -0,0 +1,168 @@
|
|||
;;;; job-specifier.scm -- tests for (mcron job-specifier) module
|
||||
;;; Copyright © 2016 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 match)
|
||||
(srfi srfi-64)
|
||||
(srfi srfi-111)
|
||||
(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))
|
||||
|
||||
(define %find-best-next (@@ (mcron job-specifier) %find-best-next))
|
||||
|
||||
(test-assert "%find-best-next: exact"
|
||||
;; Ensure that '%find-best-next' preserves the exactness of the numbers
|
||||
;; inside the NEXT-LIST argument.
|
||||
(match (pk 'match (%find-best-next 1 '(0 2)))
|
||||
((a . b) (and (exact? a) (exact? b)))))
|
||||
|
||||
;;;
|
||||
;;; Check 'next-...' procedures.
|
||||
;;;
|
||||
|
||||
;;; TODO: Find more meaningful date examples.
|
||||
|
||||
(setenv "TZ" ":UTC")
|
||||
|
||||
(test-equal "next-year"
|
||||
(list 1893456000 1546300800)
|
||||
(list (next-year '(130)) ;; This is the year 2030.
|
||||
(next-year-from 1522095469)))
|
||||
|
||||
(test-equal "next-month"
|
||||
5097600
|
||||
(next-month-from 101 '(0 2 4)))
|
||||
|
||||
(test-equal "next-day"
|
||||
345600
|
||||
(next-day-from 4337 '(0 5 10)))
|
||||
|
||||
(test-equal "next-hour"
|
||||
3600
|
||||
(next-hour-from 3 '(0 1 2 3 4)))
|
||||
|
||||
(test-equal "next-minute"
|
||||
60
|
||||
(next-minute-from 8))
|
||||
|
||||
(test-equal "next-second"
|
||||
15
|
||||
(next-second-from 14))
|
||||
|
||||
;;;
|
||||
;;; Check 'configuration-user' manipulation
|
||||
;;;
|
||||
|
||||
(define configuration-user (@@ (mcron job-specifier) configuration-user))
|
||||
|
||||
;;; Call 'set-configuration-user' with a valid uid.
|
||||
(let ((uid (getuid)))
|
||||
(test-equal "set-configuration-user: uid"
|
||||
uid
|
||||
(begin
|
||||
(set-configuration-user uid)
|
||||
(passwd:uid (unbox configuration-user)))))
|
||||
|
||||
(define entry
|
||||
;; Random user entry.
|
||||
(getpw))
|
||||
|
||||
;;; Call 'set-configuration-user' with a valid user name.
|
||||
(let ((name (passwd:name entry)))
|
||||
(test-equal "set-configuration-user: name"
|
||||
name
|
||||
(begin
|
||||
(set-configuration-user name)
|
||||
(passwd:name (unbox configuration-user)))))
|
||||
|
||||
(define root-entry (getpw 0))
|
||||
|
||||
;;; Call 'set-configuration-user' with a passwd entry.
|
||||
(test-equal "set-configuration-user: passwd entry"
|
||||
root-entry
|
||||
(begin
|
||||
(set-configuration-user root-entry)
|
||||
(unbox configuration-user)))
|
||||
|
||||
;;; Call 'set-configuration-user' with an invalid uid.
|
||||
(test-error "set-configuration-user: invalid uid"
|
||||
#t
|
||||
(set-configuration-user -20000))
|
||||
|
||||
;;; Call 'set-configuration-user' with an invalid spec.
|
||||
(test-error "set-configuration-user: invalid spec"
|
||||
#t
|
||||
(set-configuration-user 'wrong))
|
||||
|
||||
;;;
|
||||
;;; Check the 'job' procedure
|
||||
;;;
|
||||
|
||||
(test-assert "job: procedure timeproc"
|
||||
(job 1+ "dummy action"))
|
||||
|
||||
(test-assert "job: list timeproc"
|
||||
(job '(next-hour '(0)) "dummy action"))
|
||||
|
||||
(test-assert "job: string timeproc"
|
||||
(job "30 4 1,15 * 5" "dummy action"))
|
||||
|
||||
(test-error "job: invalid string timeproc"
|
||||
'mcron-error
|
||||
(job "30 4 1,15 * WRONG" "dummy action"))
|
||||
|
||||
(test-error "job: invalid timeproc"
|
||||
'mcron-error
|
||||
(job 42 "dummy action"))
|
||||
|
||||
(test-assert "job: procedure action"
|
||||
(job 1+ (λ () (display "hello\n"))))
|
||||
|
||||
(test-assert "job: list action"
|
||||
(job 1+ '(display "hello\n")))
|
||||
|
||||
(test-assert "job: string action"
|
||||
(job 1+ "echo hello"))
|
||||
|
||||
(test-error "job: string action"
|
||||
'mcron-error
|
||||
(job 1+ 42))
|
||||
|
||||
(test-assert "job: user name"
|
||||
(job 1+ "dummy action" #:user (getuid)))
|
||||
|
||||
(test-end)
|
||||
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
|
||||
131
tests/schedule.sh
Normal file
131
tests/schedule.sh
Normal file
|
|
@ -0,0 +1,131 @@
|
|||
# schedule.sh -- Check mcron schedule output
|
||||
# Copyright © 2017, 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/>.
|
||||
|
||||
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
|
||||
|
||||
LC_ALL=C
|
||||
export LC_ALL
|
||||
|
||||
# Use current working directory to store mcron files
|
||||
XDG_CONFIG_HOME=`pwd`
|
||||
export XDG_CONFIG_HOME
|
||||
|
||||
mkdir cron
|
||||
cat > cron/foo.guile <<EOF
|
||||
(job '(next-second) '(display "foo\n"))
|
||||
EOF
|
||||
|
||||
cat > cron/bar.guile <<EOF
|
||||
(job '(next-second) '(display "bar\n"))
|
||||
EOF
|
||||
|
||||
cat > expected <<EOF
|
||||
Thu Jan 1 00:00:01 1970 +0000
|
||||
(display bar
|
||||
)
|
||||
|
||||
Thu Jan 1 00:00:01 1970 +0000
|
||||
(display foo
|
||||
)
|
||||
|
||||
Thu Jan 1 00:00:02 1970 +0000
|
||||
(display bar
|
||||
)
|
||||
|
||||
Thu Jan 1 00:00:02 1970 +0000
|
||||
(display foo
|
||||
)
|
||||
|
||||
Thu Jan 1 00:00:03 1970 +0000
|
||||
(display bar
|
||||
)
|
||||
|
||||
Thu Jan 1 00:00:03 1970 +0000
|
||||
(display foo
|
||||
)
|
||||
|
||||
Thu Jan 1 00:00:04 1970 +0000
|
||||
(display bar
|
||||
)
|
||||
|
||||
Thu Jan 1 00:00:04 1970 +0000
|
||||
(display foo
|
||||
)
|
||||
|
||||
Thu Jan 1 00:00:05 1970 +0000
|
||||
(display bar
|
||||
)
|
||||
|
||||
Thu Jan 1 00:00:05 1970 +0000
|
||||
(display foo
|
||||
)
|
||||
|
||||
Thu Jan 1 00:00:06 1970 +0000
|
||||
(display bar
|
||||
)
|
||||
|
||||
Thu Jan 1 00:00:06 1970 +0000
|
||||
(display foo
|
||||
)
|
||||
|
||||
Thu Jan 1 00:00:07 1970 +0000
|
||||
(display bar
|
||||
)
|
||||
|
||||
Thu Jan 1 00:00:07 1970 +0000
|
||||
(display foo
|
||||
)
|
||||
|
||||
Thu Jan 1 00:00:08 1970 +0000
|
||||
(display bar
|
||||
)
|
||||
|
||||
Thu Jan 1 00:00:08 1970 +0000
|
||||
(display foo
|
||||
)
|
||||
|
||||
Thu Jan 1 00:00:09 1970 +0000
|
||||
(display bar
|
||||
)
|
||||
|
||||
Thu Jan 1 00:00:09 1970 +0000
|
||||
(display foo
|
||||
)
|
||||
|
||||
Thu Jan 1 00:00:10 1970 +0000
|
||||
(display bar
|
||||
)
|
||||
|
||||
Thu Jan 1 00:00:10 1970 +0000
|
||||
(display foo
|
||||
)
|
||||
|
||||
EOF
|
||||
|
||||
mcron --schedule=10 > output
|
||||
diff expected output || fail_ "schedule output is not correct"
|
||||
|
||||
Exit 0
|
||||
111
tests/utils.scm
Normal file
111
tests/utils.scm
Normal file
|
|
@ -0,0 +1,111 @@
|
|||
;;;; utils.scm -- tests for (mcron utils) module
|
||||
;;; Copyright © 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/>.
|
||||
|
||||
(use-modules (ice-9 match)
|
||||
(ice-9 rdelim)
|
||||
(srfi srfi-64)
|
||||
(mcron config)
|
||||
(mcron utils))
|
||||
|
||||
(test-begin "utils")
|
||||
|
||||
;;; Check 'mcron-error' error code return value.
|
||||
(test-equal "mcron-error: exit code"
|
||||
42
|
||||
(match (primitive-fork)
|
||||
(0 ;child
|
||||
(mcron-error 42 "exit with 42"))
|
||||
((= waitpid (pid . exit-code)) ;parent
|
||||
(status:exit-val exit-code))))
|
||||
|
||||
;;; Check 'mcron-error' output with basic error code.
|
||||
(test-equal "mcron-error: output"
|
||||
"mcron: token"
|
||||
(call-with-output-string
|
||||
(λ (port)
|
||||
(match (pipe)
|
||||
((in . out)
|
||||
(match (primitive-fork)
|
||||
(0 ;child
|
||||
(close in)
|
||||
(with-error-to-port out
|
||||
(λ () (mcron-error 37 "token"))))
|
||||
((= waitpid (pid . exit-code)) ;parent
|
||||
(close out)
|
||||
(display (read-line in) port))))))))
|
||||
|
||||
;;; Check mcron-error output when error code is 0.
|
||||
(test-equal "mcron-error: output no-exit"
|
||||
"mcron: foobar\n"
|
||||
(call-with-output-string
|
||||
(λ (port)
|
||||
(with-error-to-port port
|
||||
(λ ()
|
||||
(mcron-error 0 "foo" "bar"))))))
|
||||
|
||||
;;; Check that mcron-error doesn't print anything on the standard output.
|
||||
(test-equal "mcron-error: only stderr"
|
||||
""
|
||||
(with-output-to-string
|
||||
(λ () (mcron-error 0 "foo" "bar"))))
|
||||
|
||||
;;;
|
||||
;;; Check user interface conformance to GNU Coding Standards
|
||||
;;;
|
||||
|
||||
(test-assert "show-version"
|
||||
(let ((out (with-output-to-string (λ () (show-version "dummy")))))
|
||||
(and (string-contains out config-package-version)
|
||||
(string-contains out config-package-name))))
|
||||
|
||||
(test-assert "show-package-information"
|
||||
(let ((out (with-output-to-string (λ () (show-package-information)))))
|
||||
(string-contains out config-package-bugreport)))
|
||||
|
||||
;;;
|
||||
;;; Check 'get-user'
|
||||
;;;
|
||||
|
||||
(define entry
|
||||
;; Random user entry.
|
||||
(getpw))
|
||||
|
||||
;;; Call 'get-user' with a valid uid.
|
||||
(let ((uid (getuid)))
|
||||
(test-equal "get-user: uid"
|
||||
uid
|
||||
(passwd:uid (get-user uid))))
|
||||
|
||||
;;; Call 'get-user' with a valid user name.
|
||||
(let ((name (passwd:name entry)))
|
||||
(test-equal "get-user: name"
|
||||
name
|
||||
(passwd:name (get-user name))))
|
||||
|
||||
;;; Call 'get-user' with a passwd entry.
|
||||
(test-equal "get-user: passwd entry"
|
||||
entry
|
||||
(get-user entry))
|
||||
|
||||
;;; Call 'get-user' with an invalid uid.
|
||||
(test-error "get-user: invalid uid" #t (get-user -20000))
|
||||
|
||||
;;; Call 'get-user' with an invalid spec.
|
||||
(test-error "get-user: invalid spec" #t (get-user 'wrong))
|
||||
|
||||
(test-end)
|
||||
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)
|
||||
118
tests/vixie-time.scm
Normal file
118
tests/vixie-time.scm
Normal file
|
|
@ -0,0 +1,118 @@
|
|||
;;;; vixie-time.scm -- tests for (mcron vixie-time) module
|
||||
;;; Copyright © 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/>.
|
||||
|
||||
(use-modules (srfi srfi-1)
|
||||
(srfi srfi-64)
|
||||
(mcron vixie-time))
|
||||
|
||||
(setenv "TZ" "UTC0")
|
||||
|
||||
(test-begin "vixie-time")
|
||||
|
||||
(define (times-equal spec times proc)
|
||||
(test-equal spec
|
||||
(cdr times)
|
||||
(fold-right (λ (val acc)
|
||||
(cons (proc val) acc))
|
||||
'()
|
||||
(drop-right times 1))))
|
||||
|
||||
(times-equal
|
||||
"every minute"
|
||||
'(0 60 120 180 240 300 360 420)
|
||||
(parse-vixie-time "* * * * *"))
|
||||
|
||||
(times-equal
|
||||
"every hour"
|
||||
(list 0
|
||||
3600
|
||||
(* 2 3600)
|
||||
(* 3 3600)
|
||||
(* 4 3600)
|
||||
(* 5 3600)
|
||||
(* 6 3600)
|
||||
(* 7 3600))
|
||||
(parse-vixie-time "0 * * * *"))
|
||||
|
||||
(times-equal
|
||||
"every day"
|
||||
(list 0
|
||||
(* 24 3600)
|
||||
(* 2 24 3600)
|
||||
(* 3 24 3600)
|
||||
(* 4 24 3600)
|
||||
(* 5 24 3600)
|
||||
(* 6 24 3600)
|
||||
(* 7 24 3600))
|
||||
(parse-vixie-time "0 0 * * *"))
|
||||
|
||||
(times-equal
|
||||
"every month"
|
||||
(list 0
|
||||
(* 31 86400) ;jan
|
||||
(* (+ 31 28) 86400) ;fev
|
||||
(* (+ 31 28 31) 86400) ;mar
|
||||
(* (+ 31 28 31 30) 86400) ;avr
|
||||
(* (+ 31 28 31 30 31) 86400) ;may
|
||||
(* (+ 31 28 31 30 31 30) 86400) ;jun
|
||||
(* (+ 31 28 31 30 31 30 31) 86400)) ;july
|
||||
(parse-vixie-time "0 0 1 * *"))
|
||||
|
||||
(times-equal
|
||||
"every year"
|
||||
(list 0
|
||||
(* 365 86400) ;1971
|
||||
(* 2 365 86400) ;1972 (leap)
|
||||
(* (+ (* 2 365) 366) 86400) ;1973
|
||||
(* (+ (* 3 365) 366) 86400) ;1974
|
||||
(* (+ (* 4 365) 366) 86400) ;1975
|
||||
(* (+ (* 5 365) 366) 86400) ;1976 (leap)
|
||||
(* (+ (* 5 365) (* 2 366)) 86400)) ;1977
|
||||
(parse-vixie-time "0 0 1 0 *"))
|
||||
|
||||
(times-equal
|
||||
"30 4 1,15 * 5"
|
||||
(list 0
|
||||
(+ (* 4 3600) 1800)
|
||||
(+ (* 28 3600) 1800)
|
||||
(+ (* 8 86400) (* 4 3600) 1800)
|
||||
(+ (* 13 86400) (* 28 3600) 1800)
|
||||
(+ (* 15 86400) (* 4 3600) 1800)
|
||||
(+ (* 532 3600) 1800))
|
||||
(parse-vixie-time "30 4 1,15 * 5"))
|
||||
|
||||
;;;
|
||||
;;; Errors
|
||||
;;;
|
||||
|
||||
;; FIXME: infinite loop
|
||||
;; (test-error "month 0" #t
|
||||
;; (let ((p (parse-vixie-time "0 0 0 * *")))
|
||||
;; (p 1234)))
|
||||
|
||||
(test-error
|
||||
"not enough fields"
|
||||
'mcron-error
|
||||
(parse-vixie-time "1 2 3 4"))
|
||||
|
||||
(test-error
|
||||
"too many fields"
|
||||
'mcron-error
|
||||
(parse-vixie-time "1 2 3 4 5 6"))
|
||||
|
||||
(test-end)
|
||||
Loading…
Add table
Add a link
Reference in a new issue