dmbcs/mcron
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Compare commits

merge into: dmbcs:keyring
Branches Tags
dmbcs:trunk
dmbcs:keyring
dmbcs:v1.2.3
dmbcs:v1.2.2
dmbcs:v1.2.1
dmbcs:v1.2.0
dmbcs:v1.1.4
dmbcs:v1.1.3
dmbcs:v1.1.2
dmbcs:v1.1.1
dmbcs:v1.1
dmbcs:1.0.8
dmbcs:1.0.7
dmbcs:1.0.6
dmbcs:1.0.5
dmbcs:1.0.4
dmbcs:1.0.3
dmbcs:1.0.2
dmbcs:1.0.2.rc1
dmbcs:1.0.1
dmbcs:1.0.0
dmbcs:0.99.2
dmbcs:0.99.1
...
pull from: dmbcs:trunk
Branches Tags
dmbcs:keyring
dmbcs:trunk
dmbcs:v1.2.3
dmbcs:v1.2.2
dmbcs:v1.2.1
dmbcs:v1.2.0
dmbcs:v1.1.4
dmbcs:v1.1.3
dmbcs:v1.1.2
dmbcs:v1.1.1
dmbcs:v1.1
dmbcs:1.0.8
dmbcs:1.0.7
dmbcs:1.0.6
dmbcs:1.0.5
dmbcs:1.0.4
dmbcs:1.0.3
dmbcs:1.0.2
dmbcs:1.0.2.rc1
dmbcs:1.0.1
dmbcs:1.0.0
dmbcs:0.99.2
dmbcs:0.99.1

No commits in common. "keyring" and "trunk" have entirely different histories.
keyring ... trunk

52 changed files with 9327 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

10
.dir-locals.el Normal file
View 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)))))

47
.gitignore vendored Normal file
View file

@ -0,0 +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
depcomp
install-sh
missing
pre-inst-env
stamp-h1
texinfo.tex

1
.prev-version Normal file
View file

@ -0,0 +1 @@
1.1.1

6
AUTHORS Normal file
View file

@ -0,0 +1,6 @@
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>

674
COPYING Normal file
View file

@ -0,0 +1,674 @@
GNU GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The GNU General Public License is a free, copyleft license for
software and other kinds of works.
The licenses for most software and other practical works are designed
to take away your freedom to share and change the works. By contrast,
the GNU General Public License is intended to guarantee your freedom to
share and change all versions of a program--to make sure it remains free
software for all its users. We, the Free Software Foundation, use the
GNU General Public License for most of our software; it applies also to
any other work released this way by its authors. You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
them if you wish), that you receive source code or can get it if you
want it, that you can change the software or use pieces of it in new
free programs, and that you know you can do these things.
To protect your rights, we need to prevent others from denying you
these rights or asking you to surrender the rights. Therefore, you have
certain responsibilities if you distribute copies of the software, or if
you modify it: responsibilities to respect the freedom of others.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must pass on to the recipients the same
freedoms that you received. You must make sure that they, too, receive
or can get the source code. And you must show them these terms so they
know their rights.
Developers that use the GNU GPL protect your rights with two steps:
(1) assert copyright on the software, and (2) offer you this License
giving you legal permission to copy, distribute and/or modify it.
For the developers' and authors' protection, the GPL clearly explains
that there is no warranty for this free software. For both users' and
authors' sake, the GPL requires that modified versions be marked as
changed, so that their problems will not be attributed erroneously to
authors of previous versions.
Some devices are designed to deny users access to install or run
modified versions of the software inside them, although the manufacturer
can do so. This is fundamentally incompatible with the aim of
protecting users' freedom to change the software. The systematic
pattern of such abuse occurs in the area of products for individuals to
use, which is precisely where it is most unacceptable. Therefore, we
have designed this version of the GPL to prohibit the practice for those
products. If such problems arise substantially in other domains, we
stand ready to extend this provision to those domains in future versions
of the GPL, as needed to protect the freedom of users.
Finally, every program is threatened constantly by software patents.
States should not allow patents to restrict development and use of
software on general-purpose computers, but in those that do, we wish to
avoid the special danger that patents applied to a free program could
make it effectively proprietary. To prevent this, the GPL assures that
patents cannot be used to render the program non-free.
The precise terms and conditions for copying, distribution and
modification follow.
TERMS AND CONDITIONS
0. Definitions.
"This License" refers to version 3 of the GNU General Public License.
"Copyright" also means copyright-like laws that apply to other kinds of
works, such as semiconductor masks.
"The Program" refers to any copyrightable work licensed under this
License. Each licensee is addressed as "you". "Licensees" and
"recipients" may be individuals or organizations.
To "modify" a work means to copy from or adapt all or part of the work
in a fashion requiring copyright permission, other than the making of an
exact copy. The resulting work is called a "modified version" of the
earlier work or a work "based on" the earlier work.
A "covered work" means either the unmodified Program or a work based
on the Program.
To "propagate" a work means to do anything with it that, without
permission, would make you directly or secondarily liable for
infringement under applicable copyright law, except executing it on a
computer or modifying a private copy. Propagation includes copying,
distribution (with or without modification), making available to the
public, and in some countries other activities as well.
To "convey" a work means any kind of propagation that enables other
parties to make or receive copies. Mere interaction with a user through
a computer network, with no transfer of a copy, is not conveying.
An interactive user interface displays "Appropriate Legal Notices"
to the extent that it includes a convenient and prominently visible
feature that (1) displays an appropriate copyright notice, and (2)
tells the user that there is no warranty for the work (except to the
extent that warranties are provided), that licensees may convey the
work under this License, and how to view a copy of this License. If
the interface presents a list of user commands or options, such as a
menu, a prominent item in the list meets this criterion.
1. Source Code.
The "source code" for a work means the preferred form of the work
for making modifications to it. "Object code" means any non-source
form of a work.
A "Standard Interface" means an interface that either is an official
standard defined by a recognized standards body, or, in the case of
interfaces specified for a particular programming language, one that
is widely used among developers working in that language.
The "System Libraries" of an executable work include anything, other
than the work as a whole, that (a) is included in the normal form of
packaging a Major Component, but which is not part of that Major
Component, and (b) serves only to enable use of the work with that
Major Component, or to implement a Standard Interface for which an
implementation is available to the public in source code form. A
"Major Component", in this context, means a major essential component
(kernel, window system, and so on) of the specific operating system
(if any) on which the executable work runs, or a compiler used to
produce the work, or an object code interpreter used to run it.
The "Corresponding Source" for a work in object code form means all
the source code needed to generate, install, and (for an executable
work) run the object code and to modify the work, including scripts to
control those activities. However, it does not include the work's
System Libraries, or general-purpose tools or generally available free
programs which are used unmodified in performing those activities but
which are not part of the work. For example, Corresponding Source
includes interface definition files associated with source files for
the work, and the source code for shared libraries and dynamically
linked subprograms that the work is specifically designed to require,
such as by intimate data communication or control flow between those
subprograms and other parts of the work.
The Corresponding Source need not include anything that users
can regenerate automatically from other parts of the Corresponding
Source.
The Corresponding Source for a work in source code form is that
same work.
2. Basic Permissions.
All rights granted under this License are granted for the term of
copyright on the Program, and are irrevocable provided the stated
conditions are met. This License explicitly affirms your unlimited
permission to run the unmodified Program. The output from running a
covered work is covered by this License only if the output, given its
content, constitutes a covered work. This License acknowledges your
rights of fair use or other equivalent, as provided by copyright law.
You may make, run and propagate covered works that you do not
convey, without conditions so long as your license otherwise remains
in force. You may convey covered works to others for the sole purpose
of having them make modifications exclusively for you, or provide you
with facilities for running those works, provided that you comply with
the terms of this License in conveying all material for which you do
not control copyright. Those thus making or running the covered works
for you must do so exclusively on your behalf, under your direction
and control, on terms that prohibit them from making any copies of
your copyrighted material outside their relationship with you.
Conveying under any other circumstances is permitted solely under
the conditions stated below. Sublicensing is not allowed; section 10
makes it unnecessary.
3. Protecting Users' Legal Rights From Anti-Circumvention Law.
No covered work shall be deemed part of an effective technological
measure under any applicable law fulfilling obligations under article
11 of the WIPO copyright treaty adopted on 20 December 1996, or
similar laws prohibiting or restricting circumvention of such
measures.
When you convey a covered work, you waive any legal power to forbid
circumvention of technological measures to the extent such circumvention
is effected by exercising rights under this License with respect to
the covered work, and you disclaim any intention to limit operation or
modification of the work as a means of enforcing, against the work's
users, your or third parties' legal rights to forbid circumvention of
technological measures.
4. Conveying Verbatim Copies.
You may convey verbatim copies of the Program's source code as you
receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice;
keep intact all notices stating that this License and any
non-permissive terms added in accord with section 7 apply to the code;
keep intact all notices of the absence of any warranty; and give all
recipients a copy of this License along with the Program.
You may charge any price or no price for each copy that you convey,
and you may offer support or warranty protection for a fee.
5. Conveying Modified Source Versions.
You may convey a work based on the Program, or the modifications to
produce it from the Program, in the form of source code under the
terms of section 4, provided that you also meet all of these conditions:
a) The work must carry prominent notices stating that you modified
it, and giving a relevant date.
b) The work must carry prominent notices stating that it is
released under this License and any conditions added under section
7. This requirement modifies the requirement in section 4 to
"keep intact all notices".
c) You must license the entire work, as a whole, under this
License to anyone who comes into possession of a copy. This
License will therefore apply, along with any applicable section 7
additional terms, to the whole of the work, and all its parts,
regardless of how they are packaged. This License gives no
permission to license the work in any other way, but it does not
invalidate such permission if you have separately received it.
d) If the work has interactive user interfaces, each must display
Appropriate Legal Notices; however, if the Program has interactive
interfaces that do not display Appropriate Legal Notices, your
work need not make them do so.
A compilation of a covered work with other separate and independent
works, which are not by their nature extensions of the covered work,
and which are not combined with it such as to form a larger program,
in or on a volume of a storage or distribution medium, is called an
"aggregate" if the compilation and its resulting copyright are not
used to limit the access or legal rights of the compilation's users
beyond what the individual works permit. Inclusion of a covered work
in an aggregate does not cause this License to apply to the other
parts of the aggregate.
6. Conveying Non-Source Forms.
You may convey a covered work in object code form under the terms
of sections 4 and 5, provided that you also convey the
machine-readable Corresponding Source under the terms of this License,
in one of these ways:
a) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by the
Corresponding Source fixed on a durable physical medium
customarily used for software interchange.
b) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by a
written offer, valid for at least three years and valid for as
long as you offer spare parts or customer support for that product
model, to give anyone who possesses the object code either (1) a
copy of the Corresponding Source for all the software in the
product that is covered by this License, on a durable physical
medium customarily used for software interchange, for a price no
more than your reasonable cost of physically performing this
conveying of source, or (2) access to copy the
Corresponding Source from a network server at no charge.
c) Convey individual copies of the object code with a copy of the
written offer to provide the Corresponding Source. This
alternative is allowed only occasionally and noncommercially, and
only if you received the object code with such an offer, in accord
with subsection 6b.
d) Convey the object code by offering access from a designated
place (gratis or for a charge), and offer equivalent access to the
Corresponding Source in the same way through the same place at no
further charge. You need not require recipients to copy the
Corresponding Source along with the object code. If the place to
copy the object code is a network server, the Corresponding Source
may be on a different server (operated by you or a third party)
that supports equivalent copying facilities, provided you maintain
clear directions next to the object code saying where to find the
Corresponding Source. Regardless of what server hosts the
Corresponding Source, you remain obligated to ensure that it is
available for as long as needed to satisfy these requirements.
e) Convey the object code using peer-to-peer transmission, provided
you inform other peers where the object code and Corresponding
Source of the work are being offered to the general public at no
charge under subsection 6d.
A separable portion of the object code, whose source code is excluded
from the Corresponding Source as a System Library, need not be
included in conveying the object code work.
A "User Product" is either (1) a "consumer product", which means any
tangible personal property which is normally used for personal, family,
or household purposes, or (2) anything designed or sold for incorporation
into a dwelling. In determining whether a product is a consumer product,
doubtful cases shall be resolved in favor of coverage. For a particular
product received by a particular user, "normally used" refers to a
typical or common use of that class of product, regardless of the status
of the particular user or of the way in which the particular user
actually uses, or expects or is expected to use, the product. A product
is a consumer product regardless of whether the product has substantial
commercial, industrial or non-consumer uses, unless such uses represent
the only significant mode of use of the product.
"Installation Information" for a User Product means any methods,
procedures, authorization keys, or other information required to install
and execute modified versions of a covered work in that User Product from
a modified version of its Corresponding Source. The information must
suffice to ensure that the continued functioning of the modified object
code is in no case prevented or interfered with solely because
modification has been made.
If you convey an object code work under this section in, or with, or
specifically for use in, a User Product, and the conveying occurs as
part of a transaction in which the right of possession and use of the
User Product is transferred to the recipient in perpetuity or for a
fixed term (regardless of how the transaction is characterized), the
Corresponding Source conveyed under this section must be accompanied
by the Installation Information. But this requirement does not apply
if neither you nor any third party retains the ability to install
modified object code on the User Product (for example, the work has
been installed in ROM).
The requirement to provide Installation Information does not include a
requirement to continue to provide support service, warranty, or updates
for a work that has been modified or installed by the recipient, or for
the User Product in which it has been modified or installed. Access to a
network may be denied when the modification itself materially and
adversely affects the operation of the network or violates the rules and
protocols for communication across the network.
Corresponding Source conveyed, and Installation Information provided,
in accord with this section must be in a format that is publicly
documented (and with an implementation available to the public in
source code form), and must require no special password or key for
unpacking, reading or copying.
7. Additional Terms.
"Additional permissions" are terms that supplement the terms of this
License by making exceptions from one or more of its conditions.
Additional permissions that are applicable to the entire Program shall
be treated as though they were included in this License, to the extent
that they are valid under applicable law. If additional permissions
apply only to part of the Program, that part may be used separately
under those permissions, but the entire Program remains governed by
this License without regard to the additional permissions.
When you convey a copy of a covered work, you may at your option
remove any additional permissions from that copy, or from any part of
it. (Additional permissions may be written to require their own
removal in certain cases when you modify the work.) You may place
additional permissions on material, added by you to a covered work,
for which you have or can give appropriate copyright permission.
Notwithstanding any other provision of this License, for material you
add to a covered work, you may (if authorized by the copyright holders of
that material) supplement the terms of this License with terms:
a) Disclaiming warranty or limiting liability differently from the
terms of sections 15 and 16 of this License; or
b) Requiring preservation of specified reasonable legal notices or
author attributions in that material or in the Appropriate Legal
Notices displayed by works containing it; or
c) Prohibiting misrepresentation of the origin of that material, or
requiring that modified versions of such material be marked in
reasonable ways as different from the original version; or
d) Limiting the use for publicity purposes of names of licensors or
authors of the material; or
e) Declining to grant rights under trademark law for use of some
trade names, trademarks, or service marks; or
f) Requiring indemnification of licensors and authors of that
material by anyone who conveys the material (or modified versions of
it) with contractual assumptions of liability to the recipient, for
any liability that these contractual assumptions directly impose on
those licensors and authors.
All other non-permissive additional terms are considered "further
restrictions" within the meaning of section 10. If the Program as you
received it, or any part of it, contains a notice stating that it is
governed by this License along with a term that is a further
restriction, you may remove that term. If a license document contains
a further restriction but permits relicensing or conveying under this
License, you may add to a covered work material governed by the terms
of that license document, provided that the further restriction does
not survive such relicensing or conveying.
If you add terms to a covered work in accord with this section, you
must place, in the relevant source files, a statement of the
additional terms that apply to those files, or a notice indicating
where to find the applicable terms.
Additional terms, permissive or non-permissive, may be stated in the
form of a separately written license, or stated as exceptions;
the above requirements apply either way.
8. Termination.
You may not propagate or modify a covered work except as expressly
provided under this License. Any attempt otherwise to propagate or
modify it is void, and will automatically terminate your rights under
this License (including any patent licenses granted under the third
paragraph of section 11).
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, you do not qualify to receive new licenses for the same
material under section 10.
9. Acceptance Not Required for Having Copies.
You are not required to accept this License in order to receive or
run a copy of the Program. Ancillary propagation of a covered work
occurring solely as a consequence of using peer-to-peer transmission
to receive a copy likewise does not require acceptance. However,
nothing other than this License grants you permission to propagate or
modify any covered work. These actions infringe copyright if you do
not accept this License. Therefore, by modifying or propagating a
covered work, you indicate your acceptance of this License to do so.
10. Automatic Licensing of Downstream Recipients.
Each time you convey a covered work, the recipient automatically
receives a license from the original licensors, to run, modify and
propagate that work, subject to this License. You are not responsible
for enforcing compliance by third parties with this License.
An "entity transaction" is a transaction transferring control of an
organization, or substantially all assets of one, or subdividing an
organization, or merging organizations. If propagation of a covered
work results from an entity transaction, each party to that
transaction who receives a copy of the work also receives whatever
licenses to the work the party's predecessor in interest had or could
give under the previous paragraph, plus a right to possession of the
Corresponding Source of the work from the predecessor in interest, if
the predecessor has it or can get it with reasonable efforts.
You may not impose any further restrictions on the exercise of the
rights granted or affirmed under this License. For example, you may
not impose a license fee, royalty, or other charge for exercise of
rights granted under this License, and you may not initiate litigation
(including a cross-claim or counterclaim in a lawsuit) alleging that
any patent claim is infringed by making, using, selling, offering for
sale, or importing the Program or any portion of it.
11. Patents.
A "contributor" is a copyright holder who authorizes use under this
License of the Program or a work on which the Program is based. The
work thus licensed is called the contributor's "contributor version".
A contributor's "essential patent claims" are all patent claims
owned or controlled by the contributor, whether already acquired or
hereafter acquired, that would be infringed by some manner, permitted
by this License, of making, using, or selling its contributor version,
but do not include claims that would be infringed only as a
consequence of further modification of the contributor version. For
purposes of this definition, "control" includes the right to grant
patent sublicenses in a manner consistent with the requirements of
this License.
Each contributor grants you a non-exclusive, worldwide, royalty-free
patent license under the contributor's essential patent claims, to
make, use, sell, offer for sale, import and otherwise run, modify and
propagate the contents of its contributor version.
In the following three paragraphs, a "patent license" is any express
agreement or commitment, however denominated, not to enforce a patent
(such as an express permission to practice a patent or covenant not to
sue for patent infringement). To "grant" such a patent license to a
party means to make such an agreement or commitment not to enforce a
patent against the party.
If you convey a covered work, knowingly relying on a patent license,
and the Corresponding Source of the work is not available for anyone
to copy, free of charge and under the terms of this License, through a
publicly available network server or other readily accessible means,
then you must either (1) cause the Corresponding Source to be so
available, or (2) arrange to deprive yourself of the benefit of the
patent license for this particular work, or (3) arrange, in a manner
consistent with the requirements of this License, to extend the patent
license to downstream recipients. "Knowingly relying" means you have
actual knowledge that, but for the patent license, your conveying the
covered work in a country, or your recipient's use of the covered work
in a country, would infringe one or more identifiable patents in that
country that you have reason to believe are valid.
If, pursuant to or in connection with a single transaction or
arrangement, you convey, or propagate by procuring conveyance of, a
covered work, and grant a patent license to some of the parties
receiving the covered work authorizing them to use, propagate, modify
or convey a specific copy of the covered work, then the patent license
you grant is automatically extended to all recipients of the covered
work and works based on it.
A patent license is "discriminatory" if it does not include within
the scope of its coverage, prohibits the exercise of, or is
conditioned on the non-exercise of one or more of the rights that are
specifically granted under this License. You may not convey a covered
work if you are a party to an arrangement with a third party that is
in the business of distributing software, under which you make payment
to the third party based on the extent of your activity of conveying
the work, and under which the third party grants, to any of the
parties who would receive the covered work from you, a discriminatory
patent license (a) in connection with copies of the covered work
conveyed by you (or copies made from those copies), or (b) primarily
for and in connection with specific products or compilations that
contain the covered work, unless you entered into that arrangement,
or that patent license was granted, prior to 28 March 2007.
Nothing in this License shall be construed as excluding or limiting
any implied license or other defenses to infringement that may
otherwise be available to you under applicable patent law.
12. No Surrender of Others' Freedom.
If conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot convey a
covered work so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you may
not convey it at all. For example, if you agree to terms that obligate you
to collect a royalty for further conveying from those to whom you convey
the Program, the only way you could satisfy both those terms and this
License would be to refrain entirely from conveying the Program.
13. Use with the GNU Affero General Public License.
Notwithstanding any other provision of this License, you have
permission to link or combine any covered work with a work licensed
under version 3 of the GNU Affero General Public License into a single
combined work, and to convey the resulting work. The terms of this
License will continue to apply to the part which is the covered work,
but the special requirements of the GNU Affero General Public License,
section 13, concerning interaction through a network will apply to the
combination as such.
14. Revised Versions of this License.
The Free Software Foundation may publish revised and/or new versions of
the GNU General Public 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.
Each version is given a distinguishing version number. If the
Program specifies that a certain numbered version of the GNU General
Public License "or any later version" applies to it, you have the
option of following the terms and conditions either of that numbered
version or of any later version published by the Free Software
Foundation. If the Program does not specify a version number of the
GNU General Public License, you may choose any version ever published
by the Free Software Foundation.
If the Program specifies that a proxy can decide which future
versions of the GNU General Public License can be used, that proxy's
public statement of acceptance of a version permanently authorizes you
to choose that version for the Program.
Later license versions may give you additional or different
permissions. However, no additional obligations are imposed on any
author or copyright holder as a result of your choosing to follow a
later version.
15. Disclaimer of Warranty.
THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
16. Limitation of Liability.
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
SUCH DAMAGES.
17. Interpretation of Sections 15 and 16.
If the disclaimer of warranty and limitation of liability provided
above cannot be given local legal effect according to their terms,
reviewing courts shall apply local law that most closely approximates
an absolute waiver of all civil liability in connection with the
Program, unless a warranty or assumption of liability accompanies a
copy of the Program in return for a fee.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
state the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) <year> <name of author>
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/>.
Also add information on how to contact you by electronic and paper mail.
If the program does terminal interaction, make it output a short
notice like this when it starts in an interactive mode:
<program> Copyright (C) <year> <name of author>
This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, your program's commands
might be different; for a GUI interface, you would use an "about box".
You should also get your employer (if you work as a programmer) or school,
if any, to sign a "copyright disclaimer" for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
<http://www.gnu.org/licenses/>.
The GNU General Public License does not permit incorporating your program
into proprietary programs. If your program is a subroutine library, you
may consider it more useful to permit linking proprietary applications with
the library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License. But first, please read
<http://www.gnu.org/philosophy/why-not-lgpl.html>.

4
ChangeLog Normal file
View file

@ -0,0 +1,4 @@
Normally a ChangeLog is generated at "make dist" time and available in
source tarballs.
If not, see the Git commit log at <http://git.sv.gnu.org/cgit/mcron.git/>.

147
ChangeLog.old Normal file
View 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
View 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
View 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@

196
NEWS Normal file
View file

@ -0,0 +1,196 @@
GNU Mcron NEWS -*- outline -*-
* Noteworthy changes in release 1.2.0 (2020-04-22) [stable]
** Improvements
C code removed, mcron becomes 100% Guile.
Make doc/mcron.texi gender neutral.
Have src/mcron/scripts/mcron.scm (process-user-file): use read and eval
instead of load.
New tests added for extra checks.
* Noteworthy changes in release 1.1.4 (2020-04-12) [stable]
** Improvements
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]
** Improvements
Package contains configure script by default
Authors file change (addition)
Doc fix for 'every second sunday'
guix.scm update
* Noteworthy changes in release 1.1.2 (2018-11-26) [stable]
** Improvements
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.
* Noteworthy changes in release 1.1.1 (2018-04-08) [stable]
** Bug fixes
The "--disable-multi-user" configure variable is not reversed anymore.
'cron' and 'crontab' are now installed unless this option is used.
The programs now sets the GUILE_LOAD_PATH and GUILE_LOAD_COMPILED_PATH
environment variables with the location of the installed Guile modules.
'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]
** Improvements
Some basic tests for the installed programs can be run after 'make install'
with 'make installcheck'.
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%).
* Noteworthy changes in release 1.1 (2018-03-19) [stable]
** New features
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.
** Bug fixes
Child process created when executing a job are now properly cleaned even
when execution fails by using 'dynamic-wind' construct.
** Improvements
GNU Guile 2.2 is now supported.
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.
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.
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'.
** Changes in behavior
The "--enable-debug" configure variable has been removed and replaced with
MCRON_DEBUG environment variable.
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).
* 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.
* 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.

69
README Normal file
View file

@ -0,0 +1,69 @@
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
Do not (yet) install this software on a machine which relies for its
functioning on its current set of crontabs.
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
accurately Vixie compatible (files in /var/cron/tabs*, /var/cron/allow,
/var/cron/deny, /etc/crontab, /var/run/cron.pid) then you will need to clear out
all old crontabs and make new ones afresh - or else look very carefully at the
options you pass to the package configure script, as follows.
It is often the case that GNU/Linux distributions and other Unices hacked the
cron daemon to use different directories to those above. You can use configure
options --spool-dir, --socket-file, --allow-file, --deny-file, --pid-file and
--tmp-dir to make mcron behave similarly. Note that, with the exception of
tmp-dir, none of these files or directories should be accessible by ordinary
(non-root) users.
If your old cron is Vixie, or very similar, mcron should fall right into place
where your old cron was (the binaries cron and crontab will be replaced, but if
your existing system has a binary called crond, you should make this a link
to mcron), and you should be able to continue to use your existing crontabs
without noticing any changes.
If you don't want to clobber your existing cron executables, you can specify
the --program-prefix option to configure with a prefix ending in a
non-alphabetic character, for example "m.", and then run the programs as
m.mcron, m.cron (or m.crond) and m.crontab.
----------------------------------------------------------------------
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.
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.
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.

54
TODO Normal file
View file

@ -0,0 +1,54 @@
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,
are permitted in any medium without royalty provided the copyright
notice and this notice are preserved.
Maybe in the near future...
* Logging.
* Check POSIX compliance (should be okay if Vixie cron was okay).
* Work out how to give each user his own closure (or environment or module
or continuation) for his configuration files so that he can't mess the
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...
* Develop at and batch modes of operation.
* Make compatibilities with other crons (BSD, SYSV, Solaris, Dillon's, ...)
* Port to BSD, other operating systems.
* Full security audit for Vixie mode.
May happen if version 2.0 ever materializes...
* UNIX or TCP socket will allow interrogation and control of a running
daemon (unrelated to, or maybe a major enhancement of, socket used for
communication from crontab process).
* Add anacron functionality (run missed jobs if the daemon is stopped, for
example if a personal computer does not run 24 hours a day).
* TCP socket to allow control via HTTP (web browser interface). Or maybe
crontab-like CGI personality.
* GTK+/d-bus/Gnome3 interface.

5
bootstrap Executable file
View file

@ -0,0 +1,5 @@
#!/bin/sh
# Initialize the build system.
set -e -x
exec autoreconf -vfi

557
build-aux/announce-gen Normal file
View 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
View 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
View 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
View 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
View 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
View 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
View 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) "") ;green
((xfail) "") ;light green
((skip) "") ;blue
((fail xpass) "") ;red
((error) "")) ;magenta
result
"") ;no color
result)))
(define* (test-runner-gnu test-name #:key color? brief? out-port trs-port)
"Return an custom SRFI-64 test runner. TEST-NAME is a string specifying the
file name of the current the test. COLOR? specifies whether to use colors,
and BRIEF?, well, you know. OUT-PORT and TRS-PORT must be output ports. The
current output port is supposed to be redirected to a '.log' file."
(define (test-on-test-begin-gnu runner)
;; Procedure called at the start of an individual test case, before the
;; test expression (and expected value) are evaluated.
(let ((result (cute assq-ref (test-result-alist runner) <>)))
(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.

135
configure.ac Executable file
View file

@ -0,0 +1,135 @@
## 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([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])
AM_SILENT_RULES([yes]) # Enables silent rules by default.
AC_CANONICAL_HOST
dnl We require pkg.m4 (from pkg-config) and guile.m4 (from Guile.)
dnl Make sure they are available when generating the configure script.
m4_pattern_forbid([^PKG_PROG])
m4_pattern_forbid([^PKG_CHECK])
m4_pattern_forbid([^GUILE_P])
m4_pattern_allow([^GUILE_PKG_ERRORS])
# Check for Guile development files.
GUILE_PKG([3.0 2.2 2.0])
# Checks for programs.
GUILE_PROGS
AM_MISSING_PROG(HELP2MAN, help2man, $missing_dir)
# 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.
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])
AC_MSG_RESULT($CONFIG_SPOOL_DIR)
AC_SUBST(CONFIG_SPOOL_DIR)
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])
AC_MSG_RESULT($CONFIG_SOCKET_FILE)
AC_SUBST(CONFIG_SOCKET_FILE)
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])
AC_MSG_RESULT($CONFIG_ALLOW_FILE)
AC_SUBST(CONFIG_ALLOW_FILE)
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])
AC_MSG_RESULT($CONFIG_DENY_FILE)
AC_SUBST(CONFIG_DENY_FILE)
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])
AC_MSG_RESULT($CONFIG_PID_FILE)
AC_SUBST(CONFIG_PID_FILE)
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])
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])
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

BIN
dale.key
View file

Binary file not shown.

5
doc/config.texi.in Normal file
View 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
View 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:

1352
doc/mcron.texi Normal file
View file

File diff suppressed because it is too large Load diff

125
maint.mk Executable file
View 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)

53
src/cron.in Normal file
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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*)))

194
src/mcron/redirect.scm Normal file
View file

@ -0,0 +1,194 @@
;;;; 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/>.
;;;; 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)
#: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
;; sign. The text after the percentage sign is to be fed to the command's
;; standard input, with further unescaped percents being substituted with
;; newlines. The escape character can itself be escaped.
;;
;; This regexp separates the two halves of the string, and indeed determines if
;; the second part is present.
(define action-string-regexp (make-regexp "((\\\\%|[^%])*)%(.*)$"))
;; This regexp identifies an escaped percentage sign.
(define e-percent (make-regexp "\\\\%"))
;; Function to execute some action (this may be a shell command, lamdba function
;; or list of scheme procedures) in a forked process, with the input coming from
;; the string, and output (including the error output) being sent to a pipe
;; opened on a mail transport.
(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
;; variable, and finally in the LOGNAME environment variable. (The case
;; MAILTO="" is dealt with specially below.)
(let* ((mailto (getenv "MAILTO"))
(user (cond (mailto mailto)
(user user)
(else (getenv "LOGNAME"))))
(parent->child (pipe))
(child->parent (pipe))
(child-pid (primitive-fork)))
;; The child process. Close redundant ends of pipes, remap the standard
;; streams, and run the action, taking care to chop off the input part of an
;; action string.
(if (eqv? child-pid 0)
(begin
(close (cdr parent->child))
(close (car child->parent))
(dup2 (port->fdes (car parent->child)) 0)
(close (car parent->child))
(dup2 (port->fdes (cdr child->parent)) 1)
(close (cdr child->parent))
(dup2 1 2)
(cond ((string? action)
(let ((match (regexp-exec action-string-regexp action)))
(system (if match
(let ((action (match:substring match 1)))
(do ((match (regexp-exec e-percent action)
(regexp-exec e-percent action)))
((not match))
(set! action (string-append
(match:prefix match)
"%"
(match:suffix match))))
action)
action))))
((procedure? action) (action))
((list? action) (primitive-eval action)))
(primitive-exit 0)))
;; The parent process. Get rid of redundant pipe ends.
(close (car parent->child))
(close (cdr child->parent))
;; Put stuff to child from after '%' in command line, replacing
;; other %'s with newlines. Ugly or what?
(if (string? action)
(let ((port (cdr parent->child))
(match (regexp-exec action-string-regexp action)))
(if (and match
(match:substring match 3))
(with-input-from-string (match:substring match 3)
(lambda ()
(let loop ()
(let ((next-char (read-char)))
(if (not (eof-object? next-char))
(cond
((char=? next-char #\%)
(newline port)
(loop))
((char=? next-char #\\)
(let ((escape (read-char)))
(if (eof-object? escape)
(display #\\ port)
(if (char=? escape #\%)
(begin
(display #\% port)
(loop))
(begin
(display #\\ port)
(display escape port)
(loop))))))
(else
(display next-char port)
(loop)))))))))))
;; So the child process doesn't hang on to its input expecting more stuff.
(close (cdr parent->child))
;; That's got streaming into the child's input out of the way, now we stream
;; the child's output to a mail sink, but only if there is something there
;; in the first place.
(if (eof-object? (peek-char (car child->parent)))
(read-char (car child->parent))
(begin
(set-current-output-port (if (and (string? mailto)
(string=? mailto ""))
(open-output-file "/dev/null")
;; 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 "@" hostname))
(newline)
(newline)
(do ((next-char (read-char) (read-char)))
((eof-object? next-char))
(display next-char))))
(close (car child->parent))
(waitpid child-pid)))

162
src/mcron/scripts/cron.scm Normal file
View 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
View 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
View 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
View 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))))

205
src/mcron/vixie-specification.scm Normal file
View file

@ -0,0 +1,205 @@
;;;; 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/>.
;;;; 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))
;; A line in a Vixie-style crontab file which gives a command specification
;; carries two pieces of information: a time specification consisting of five
;; space-separated items, and a command which is also separated from the time
;; specification by a space. The line is broken into the two components, and the
;; job procedure run to add the two pieces of information to the job list (this
;; will in turn use the above function to turn the time specification into a
;; function for computing future run times of the command).
(define parse-user-vixie-line-regexp
(make-regexp "^[[:space:]]*(([^[:space:]]+[[:space:]]+){5})(.*)$"))
(define (parse-user-vixie-line line)
(let ((match (regexp-exec parse-user-vixie-line-regexp line)))
(if (not match)
(throw 'mcron-error 10 "Bad job line in Vixie file."))
(job (match:substring match 1)
(lambda () (with-mail-out (match:substring match 3)))
(match:substring match 3))))
;; The case of reading a line from /etc/crontab is similar to above but the user
;; ID appears in the sixth field, before the action.
(define parse-system-vixie-line-regexp
(make-regexp (string-append "^[[:space:]]*(([^[:space:]]+[[:space:]]+){5})"
"([[:alpha:]][[:alnum:]_]*)[[:space:]]+(.*)$")))
(define (parse-system-vixie-line line)
(let ((match (regexp-exec parse-system-vixie-line-regexp line)))
(if (not match)
(throw 'mcron-error 11 "Bad job line in /etc/crontab."))
(let ((user (match:substring match 3)))
(set-configuration-user user)
(job (match:substring match 1)
(lambda () (with-mail-out (match:substring match 4)
user))
(match:substring match 4)))))
;; Procedure to act on an environment variable specification in a Vixie-style
;; configuration file, by adding an entry to the alist above. Returns #t if the
;; operation was successful, #f if the line could not be interpreted as an
;; environment specification.
(define parse-vixie-environment-regexp1
(make-regexp
"^[ \t]*([[:alpha:]_][[:alnum:]_]*)[ \t]*=[ \t]*\"(.*)\"[ \t]*$"))
(define parse-vixie-environment-regexp2
(make-regexp
"^[ \t]*([[:alpha:]_][[:alnum:]_]*)[ \t]*=[ \t]*'(.*)'[ \t]*$"))
(define parse-vixie-environment-regexp3
(make-regexp
"^[ \t]*([[:alpha:]_][[:alnum:]_]*)[ \t]*=[ \t]*(.*[^ \t])[ \t]*$"))
(define parse-vixie-environment-regexp4
(make-regexp
"^[ \t]*([[:alpha:]_][[:alnum:]_]*)[ \t]*=[ \t]*$"))
(define (parse-vixie-environment string)
(let ((match (or (regexp-exec parse-vixie-environment-regexp1 string)
(regexp-exec parse-vixie-environment-regexp2 string)
(regexp-exec parse-vixie-environment-regexp3 string))))
(if match
(append-environment-mods (match:substring match 1)
(match:substring match 2))
(and=> (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
;; appended): the line is blank or contains only a comment, the line contains an
;; environment modifier which will be handled in the mcron environment module,
;; or the line contains a command specification in which case we use the
;; procedure above to add an entry to the internal job list.
;;
;; Note that the environment modifications are cleared, so that there is no
;; interference between crontab files (this might lead to unpredictable
;; behaviour because the order in which crontab files are processed, if there is
;; more than one, is generally undefined).
(define read-vixie-file-comment-regexp
(make-regexp "^[[:space:]]*(#.*)?$"))
(define (read-vixie-port port . parse-vixie-line)
(clear-environment-mods)
(if port
(let ((parse-vixie-line
(if (null? parse-vixie-line) parse-user-vixie-line
(car parse-vixie-line))))
(do ((line (read-line port) (read-line port))
(line-number 1 (1+ line-number)))
((eof-object? line))
(let ((report-line line-number))
;; If the line ends with \, append the next line.
(while (and (>= (string-length line) 1)
(char=? (string-ref line
(- (string-length line) 1))
#\\))
(let ((next-line (read-line port)))
(if (eof-object? next-line)
(set! next-line ""))
(set! line-number (1+ line-number))
(set! line
(string-append
(substring line 0 (- (string-length line) 1))
next-line))))
(catch 'mcron-error
(lambda ()
;; Consider the three cases mentioned in the description.
(or (regexp-exec read-vixie-file-comment-regexp line)
(parse-vixie-environment line)
(parse-vixie-line line)))
(lambda (key exit-code . msg)
(throw 'mcron-error exit-code
(apply string-append
(number->string report-line)
": "
msg)))))))))
;; If a file cannot be opened, we must silently ignore it because it may have
;; been removed by crontab. However, if the file is there it must be parseable,
;; otherwise the error must be propagated to the caller.
(define (read-vixie-file file-path . parse-vixie-line)
(let ((port #f))
(catch #t (lambda () (set! port (open-input-file file-path)))
(lambda (key . args) (set! port #f)))
(if port
(catch 'mcron-error
(lambda ()
(if (null? parse-vixie-line)
(read-vixie-port port)
(read-vixie-port port (car parse-vixie-line)))
(close port))
(lambda (key exit-code . msg)
(close port)
(throw 'mcron-error exit-code
(apply string-append file-path ":" msg)))))))
;; A procedure which determines if the /etc/crontab file has been recently
;; modified, and, if so, signals the main routine to re-read the file. We run
;; under the with-mail-to command so that the process runs as a child,
;; preventing lockup. If cron is supposed to check for updates to /etc/crontab,
;; then this procedure will be called about 5 seconds before every minute.
(define (check-system-crontab)
(with-mail-out (lambda ()
(let ((mtime (stat:mtime (stat "/etc/crontab"))))
(if (> mtime (- (current-time) 60))
(let ((socket (socket AF_UNIX SOCK_STREAM 0)))
(connect socket AF_UNIX config-socket-file)
(display "/etc/crontab" socket)
(close socket)))))))

374
src/mcron/vixie-time.scm Normal file
View file

@ -0,0 +1,374 @@
;;;; 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)
#: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
;; this by making a textual substitution early on in the processing of the
;; strings.
;;
;; We start by defining, once and for all, a list of cons cells consisting of
;; regexps which will match the symbols - which allow an arbitrary number of
;; other letters to appear after them (so that the user can optionally complete
;; the month and day names; this is an extension of Vixie) - and the value which
;; is to replace the symbol.
;;
;; The procedure then takes a string, and then for each symbol in the
;; parse-symbols list attempts to locate an instance and replace it with an
;; ASCII representation of the value it stands for. The procedure returns the
;; modified string. (Note that each symbol can appear only once, which meets the
;; Vixie specifications technically but still allows silly users to mess things
;; up).
(define parse-symbols
(map (lambda (symbol-cell)
(cons (make-regexp (string-append (car symbol-cell) "[[:alpha:]]*")
regexp/icase)
(cdr symbol-cell)))
'(("jan" . "0") ("feb" . "1") ("mar" . "2") ("apr" . "3")
("may" . "4") ("jun" . "5") ("jul" . "6") ("aug" . "7")
("sep" . "8") ("oct" . "9") ("nov" . "10") ("dec" . "11")
("sun" . "0") ("mon" . "1") ("tue" . "2") ("wed" . "3")
("thu" . "4") ("fri" . "5") ("sat" . "6") )))
(define (vixie-substitute-parse-symbols string)
(for-each (lambda (symbol-cell)
(let ((match (regexp-exec (car symbol-cell) string)))
(if match
(set! string (string-append (match:prefix match)
(cdr symbol-cell)
(match:suffix match))))))
parse-symbols)
string)
;; A Vixie time specification is made up of a space-separated list of elements,
;; and the elements consist of a comma-separated list of subelements. The
;; procedure below takes a string holding a subelement, which should have no
;; spaces or symbols (see above) in it, and returns a list of all values which
;; that subelement indicates. There are five distinct cases which must be dealt
;; with: [1] a single '*' which returns a list of all values; [2] a '*' followed
;; by a step specifier; [3] a range and step specifier; [4] a range; and [5] a
;; single number.
;;
;; To perform the computation required for the '*' cases, we need to pass the
;; limit of the allowable range for this subelement as the third argument. As
;; days of the month start at 1 while all the other time components start at 0,
;; we must pass the base of the range to deal with this case also.
(define parse-vixie-subelement-regexp
(make-regexp "^([[:digit:]]+)(-([[:digit:]]+)(/([[:digit:]]+))?)?$"))
(define (parse-vixie-subelement string base limit)
(if (char=? (string-ref string 0) #\*)
(range base limit (if (> (string-length string) 1)
(string->number (substring string 2)) ;; [2]
1)) ;; [1]
(let ((match (regexp-exec parse-vixie-subelement-regexp string)))
(cond ((not match)
(throw 'mcron-error 9
"Bad Vixie-style time specification."))
((match:substring match 5)
(range (string->number (match:substring match 1))
(+ 1 (string->number (match:substring match 3)))
(string->number (match:substring match 5)))) ;; [3]
((match:substring match 3)
(range (string->number (match:substring match 1))
(+ 1 (string->number (match:substring match 3))))) ;; [4]
(else
(list (string->number (match:substring match 1)))))))) ;; [5]
;; A Vixie element contains the entire specification, without spaces or symbols,
;; of the acceptable values for one of the time components (minutes, hours,
;; days, months, week days). Here we break the comma-separated list into
;; subelements, and process each with the procedure above. The return value is a
;; list of all the valid values of all the subcomponents.
;;
;; The second and third arguments are the base and upper limit on the values
;; that can be accepted for this time element.
;;
;; The effect of the 'apply append' is to merge a list of lists into a single
;; list.
(define (parse-vixie-element string base limit)
(apply append
(map (lambda (sub-element)
(parse-vixie-subelement sub-element base limit))
(string-tokenize string (char-set-complement (char-set #\,))))))
(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)
(let ((first-day (tm:wday (cdr (mktime t)))))
(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.
(define (days-in-month month year)
(let ((t (localtime 0))) (set-tm:mday t 0)
(set-tm:mon t (+ month 1))
(set-tm:year t year)
(tm:mday (cdr (mktime t)))))
;; We will be working with a list of time-spec's, one for each element of a time
;; specification (minute, hour, ...). Each time-spec holds three pieces of
;; information: a list of acceptable values for this time component, a procedure
;; to get the component from a tm object, and a procedure to set the component
;; in a tm object.
(define (time-spec:list time-spec) (vector-ref time-spec 0))
(define (time-spec:getter time-spec) (vector-ref time-spec 1))
(define (time-spec:setter time-spec) (vector-ref time-spec 2))
;; This procedure modifies the time tm object by setting the component referred
;; to by the time-spec object to its next acceptable value. If this value is not
;; greater than the original (because we have wrapped around the top of the
;; acceptable values list), then the function returns #t, otherwise it returns
;; #f. Thus, if the return value is true then it will be necessary for the
;; caller to increment the next coarser time component as well.
;;
;; The first part of the let block is a concession to humanity; the procedure is
;; simply unreadable without all of these aliases.
(define (increment-time-component time time-spec)
(let ((time-list (time-spec:list time-spec))
(getter (time-spec:getter time-spec))
(setter (time-spec:setter time-spec))
(find-best-next (@@ (mcron job-specifier) %find-best-next)))
(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
;; time-spec-list is expected to correspond to the component of time in
;; question. If the adjusted value wraps around its allowed range, then the next
;; biggest element of time must be adjusted, and so on.
;; There is no specification allowed for the year component of
;; time. Therefore, if we have to make an adjustment (presumably because a
;; monthly adjustment has wrapped around the top of its range) we can simply
;; go to the next year.
(define (nudge-year! time)
(set-tm:year time (+ (tm:year time) 1)))
;; We nudge the month by finding the next allowable value, and if it wraps
;; around we also nudge the year. The time-spec-list will have time-spec
;; objects for month and weekday.
(define (nudge-month! time time-spec-list)
(and (increment-time-component time (car time-spec-list))
(nudge-year! time)))
;; Try to increment the day component of the time according to the combination
;; of the mday-list and the wday-list. If this wraps around the range, or if
;; this falls outside the current month (31st February, for example), then
;; bump the month, set the day to zero, and recurse on this procedure to find
;; the next day in the new month.
;;
;; The time-spec-list will have time-spec entries for mday, month, and
;; weekday.
(define (nudge-day! time time-spec-list)
(if (or (increment-time-component
time
(vector
(interpolate-weekdays (time-spec:list (car time-spec-list))
(time-spec:list (caddr time-spec-list))
(tm:mon time)
(tm:year time))
tm:mday
set-tm:mday))
(> (tm:mday time) (days-in-month (tm:mon time) (tm:year time))))
(begin
(nudge-month! time (cdr time-spec-list))
(set-tm:mday time 0)
(nudge-day! time time-spec-list))))
;; The hour is bumped to the next accceptable value, and the day is bumped if
;; the hour wraps around.
;;
;; The time-spec-list holds specifications for hour, mday, month and weekday.
(define (nudge-hour! time time-spec-list)
(and (increment-time-component time (car time-spec-list))
(nudge-day! time (cdr time-spec-list))))
;; The minute is bumped to the next accceptable value, and the hour is bumped
;; if the minute wraps around.
;;
;; The time-spec-list holds specifications for minute, hour, day-date, month
;; and weekday.
(define (nudge-min! time time-spec-list)
(and (increment-time-component time (car time-spec-list))
(nudge-hour! time (cdr time-spec-list))))
;; This is a procedure which returns a procedure which computes the next time a
;; command should run after the current time, based on the information in the
;; Vixie-style time specification.
;;
;; We start by computing a list of time-spec objects (described above) for the
;; minute, hour, date, month, year and weekday components of the overall time
;; specification [1]. Special care is taken to produce proper values for
;; fields 2 and 4: according to Vixie specification "If both fields are
;; restricted (ie, aren't *), the command will be run when _either_ field
;; matches the current time." This implies that if one of these fields is *,
;; while the other is not, its value should be '() [0], otherwise
;; interpolate-weekdays below will produce incorrect results.
;; When we create the return procedure, it is this list to
;; which references to a time-spec-list will be bound. It will be used by the
;; returned procedure [3] to compute the next time a function should run. Any
;; 7's in the weekday component of the list (the last one) are folded into 0's
;; (both values represent sunday) [2]. Any 0's in the month-day component of the
;; list are removed (this allows a solitary zero to be used to indicate that
;; jobs should only run on certain days of the _week_) [2.1].
;;
;; The returned procedure itself:-
;;
;; Starts by obtaining the current broken-down time [4], and fixing it to
;; ensure that it is an acceptable value, as follows. Each component from the
;; biggest down is checked for acceptability, and if it is not acceptable it
;; is bumped to the next acceptable value (this may cause higher components to
;; also be bumped if there is range wrap-around) and all the lower components
;; are set to -1 so that it can successfully be bumped up to zero if this is
;; an allowed value. The -1 value will be bumped up subsequently to an allowed
;; value [5].
;;
;; Once it has been asserted that the current time is acceptable, or has been
;; adjusted to one minute before the next acceptable time, the minute
;; component is then bumped to the next acceptable time, which may ripple
;; through the higher components if necessary [6]. We now have the next time
;; the command needs to run.
;;
;; The new time is then converted back into a UNIX time and returned [7].
(define (parse-vixie-time string)
(let ((tokens (string-tokenize (vixie-substitute-parse-symbols string))))
(cond
((> (length tokens) 5)
(throw 'mcron-error 9
"Too many fields in Vixie-style time specification"))
((< (length tokens) 5)
(throw 'mcron-error 9
"Not enough fields in Vixie-style time specification")))
(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! day
0
(remove (lambda (d) (eqv? d 0))
(vector-ref day 0))) ;; [2.1]
(λ (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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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)