From 61cad7bbaf63389b520b695eefdd735bc11a8aa6 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Fri, 10 Feb 2012 16:47:07 +0000 Subject: [PATCH] whenjobs initial version. --- .gitignore | 29 ++- COPYING | 339 +++++++++++++++++++++++++++++++++++ Makefile.am | 4 +- README | 87 +++++++++ configure.ac | 51 +++++- daemon/Makefile.am | 81 ++++++++- daemon/daemon.ml | 188 ++++++++++++++++++++ daemon/daemon.mli | 33 ++++ daemon/syslog.ml | 26 +++ daemon/syslog.mli | 20 +++ daemon/syslog_c.c | 55 ++++++ daemon/whenjobsd.ml | 129 ++++++++++++++ daemon/whenjobsd.pod | 130 ++++++++++++++ lib/Makefile.am | 87 +++++++++ lib/config.ml.in | 20 +++ lib/flock.c | 50 ++++++ lib/pa_when.ml | 210 ++++++++++++++++++++++ lib/whenfile.ml | 42 +++++ lib/whenfile.mli | 50 ++++++ lib/whenlock.ml | 67 +++++++ lib/whenlock.mli | 34 ++++ lib/whenproto.x | 72 ++++++++ lib/whenutils.ml | 353 ++++++++++++++++++++++++++++++++++++ lib/whenutils.mli | 165 +++++++++++++++++ tests/parsing/Makefile.am | 69 ++++++++ tests/parsing/t010_load.ml | 19 ++ tests/parsing/t020_simple.ml | 56 ++++++ tests/parsing/t030_jobnames.ml | 37 ++++ tests/parsing/test_load.ml | 43 +++++ tools/Makefile.am | 78 +++++++- tools/tutorial.ml | 47 +++++ tools/whenjobs.ml | 394 +++++++++++++++++++++++++++++++++++++++++ tools/whenjobs.pod | 215 ++++++++++++++++++++++ whenjobs.spec.in | 75 ++++++++ 34 files changed, 3346 insertions(+), 9 deletions(-) create mode 100644 COPYING create mode 100644 README create mode 100644 daemon/daemon.ml create mode 100644 daemon/daemon.mli create mode 100644 daemon/syslog.ml create mode 100644 daemon/syslog.mli create mode 100644 daemon/syslog_c.c create mode 100644 daemon/whenjobsd.ml create mode 100644 daemon/whenjobsd.pod create mode 100644 lib/Makefile.am create mode 100644 lib/config.ml.in create mode 100644 lib/flock.c create mode 100644 lib/pa_when.ml create mode 100644 lib/whenfile.ml create mode 100644 lib/whenfile.mli create mode 100644 lib/whenlock.ml create mode 100644 lib/whenlock.mli create mode 100644 lib/whenproto.x create mode 100644 lib/whenutils.ml create mode 100644 lib/whenutils.mli create mode 100644 tests/parsing/Makefile.am create mode 100644 tests/parsing/t010_load.ml create mode 100644 tests/parsing/t020_simple.ml create mode 100644 tests/parsing/t030_jobnames.ml create mode 100644 tests/parsing/test_load.ml create mode 100644 tools/tutorial.ml create mode 100644 tools/whenjobs.ml create mode 100644 tools/whenjobs.pod create mode 100644 whenjobs.spec.in diff --git a/.gitignore b/.gitignore index af123c0..ac752c8 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,10 @@ .deps *~ +*.cmi +*.cmo +*.cmx +*.cma +*.cmxa *.o Makefile.in Makefile @@ -13,12 +18,32 @@ Makefile /config.status /config.sub /configure -/daemon/lexer.c -/daemon/parser.c +/daemon/.depend +/daemon/libdaemon.a +/daemon/whenjobsd +/daemon/whenjobsd.8 +/daemon/whenproto.x +/daemon/whenproto_srv.ml +/daemon/whenproto_srv.mli /depcomp /install-sh +/lib/.depend +/lib/config.ml +/lib/liblibrary.a +/lib/whenproto_aux.ml +/lib/whenproto_aux.mli /libtool /ltmain.sh /missing /stamp-h1 +/tests/parsing/.depend +/tests/parsing/test_load +/tools/.depend +/tools/libdir.ml +/tools/whenjobs +/tools/whenjobs.1 +/tools/whenproto.x +/tools/whenproto_clnt.ml +/tools/whenproto_clnt.mli +/whenjobs.spec /ylwrap diff --git a/COPYING b/COPYING new file mode 100644 index 0000000..d511905 --- /dev/null +++ b/COPYING @@ -0,0 +1,339 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Lesser General Public License instead.) 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 +this service 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 make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. 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. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute 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 and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +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 +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the 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 a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, 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. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE 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. + + 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 +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + 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 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, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) year name of author + Gnomovision 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, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +This 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. diff --git a/Makefile.am b/Makefile.am index 3cec9e7..d0a3cfb 100644 --- a/Makefile.am +++ b/Makefile.am @@ -17,6 +17,8 @@ ACLOCAL_AMFLAGS = -I m4 -SUBDIRS = daemon tools +EXTRA_DIST = COPYING README whenjobs.spec whenjobs.spec.in + +SUBDIRS = lib daemon tools tests/parsing CLEANFILES = *~ diff --git a/README b/README new file mode 100644 index 0000000..d3444ef --- /dev/null +++ b/README @@ -0,0 +1,87 @@ +Whenjobs is a powerful but simple cron replacement. + +Two key advantages over cron are a simpler syntax for writing rules +and a powerful dependency system that lets one job depend on variables +set when other jobs run (allowing, for example, one job to run only +when another job has finished successfully). + +Below is an example whenjobs script so you can get a feel for the +language. Read the whenjobs(1) man page for full information. + + ---------------------------------------------------------------------- + (* Every 10 minutes, get the latest tagged version from the + * git repository. The variable 'tag' will be set to something + * like "v1.2.3", "v1.2.4", etc over time as new releases get + * tagged. + *) + every 10 minutes : + << + cd /my/git/repo + tag=`git-describe --tags` + whenjobs --set version $tag + >> + + (* When the 'version' variable changes (ie. a new release is + * tagged) try to build it. 'changes' is a function that compares + * the previous value of a variable from when this job last ran + * with the current value of a variable, and returns true if the + * previous and current values are different. + *) + when changes version : + << + cd /my/git/buildrepo + git pull + git reset --hard $version + ./configure + make clean all check dist + whenjobs --set successful_local_build $version + >> + + (* In parallel, build on a remote machine. *) + when changes version : + << + ssh remote ./do_build $version + whenjobs --set successful_remote_build $version + >> + + (* Only when the new release has been successfully built on local + * and remote, upload it to the website. + *) + when successful_local_build == version && + successful_remote_build == version: + << + cd /my/git/buildrepo + curl -T name-$success.tar.gz ftp://ftp.example.com/upload/ + >> + ---------------------------------------------------------------------- + +To get started with whenjobs, edit your script: + + whenjobs -e + +or list the current script: + + whenjobs -l + +You must run 'whenjobsd' (the whenjobs daemon) as the local user. +Each user must run their own daemon. You can query the state of the +daemon of start it using the whenjobs command line tool: + + whenjobs --daemon-start + whenjobs --daemon-status + whenjobs --daemon-stop + +If you want the daemon to start when the machine is booted, add the +following line to /etc/rc.local (replace 'username' with your +username): + + su username -c /usr/sbin/whenjobsd + +Whenjobs is an open source project distributed under the GNU General +Public License, version 2 or at your option any later version. Read +the file 'COPYING' for the full license. + +The home page is: +http://people.redhat.com/~rjones/whenjobs + +Send patches or suggestions to Richard Jones . diff --git a/configure.ac b/configure.ac index f192971..2b90666 100644 --- a/configure.ac +++ b/configure.ac @@ -58,12 +58,55 @@ fi dnl Check support for 64 bit file offsets. AC_SYS_LARGEFILE -dnl lex and yacc, or hopefully GNU equivalents. -AC_PROG_LEX -AC_PROG_YACC +dnl OCaml compiler. +AC_PROG_OCAML +if test "$OCAMLC" = "no"; then + AC_MSG_ERROR([You must install the OCaml compiler]) +fi + +AM_CONDITIONAL([HAVE_OCAMLOPT], [test "x$OCAMLOPT" != "xno"]) + +dnl Camlp4 is required. +AC_PROG_CAMLP4 +if test "x$CAMLP4" = "xno"; then + AC_MSG_ERROR([You must install camlp4 (the OCaml macro preprocessor)]) +fi + +dnl OCaml findlib ("ocamlfind") is required. +AC_PROG_FINDLIB +if test "x$OCAMLFIND" = "xno"; then + AC_MSG_ERROR([You must install OCaml findlib (the ocamlfind command)]) +fi + +dnl OCaml calendar library is required. +AC_CHECK_OCAML_PKG(calendar) +if test "x$OCAML_PKG_calendar" = "xno"; then + AC_MSG_ERROR([You must install OCaml calendar library version 2]) +fi + +dnl OCaml ocamlnet RPC library + dependencies (version 3) is required. +AC_CHECK_OCAML_PKG(rpc) +if test "x$OCAML_PKG_rpc" = "xno"; then + AC_MSG_ERROR([You must install OCaml ocamlnet library version 3]) +fi + +AC_CHECK_PROG(OCAMLRPCGEN,ocamlrpcgen,ocamlrpcgen) +if test "x$OCAMLRPCGEN" = "xno"; then + AC_MSG_ERROR([You must install the ocamlrpcgen program]) +fi + +dnl Check for POD (for manual pages). +AC_CHECK_PROG(PERLDOC,perldoc,perldoc) +if test "x$PERLDOC" = "xno"; then + AC_MSG_ERROR([You must install the perldoc program]) +fi AC_CONFIG_HEADERS([config.h]) AC_CONFIG_FILES([Makefile daemon/Makefile - tools/Makefile]) + lib/config.ml + lib/Makefile + tests/parsing/Makefile + tools/Makefile + whenjobs.spec]) AC_OUTPUT diff --git a/daemon/Makefile.am b/daemon/Makefile.am index 057074c..55ac8a1 100644 --- a/daemon/Makefile.am +++ b/daemon/Makefile.am @@ -15,4 +15,83 @@ # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -CLEANFILES = *~ +sbin_SCRIPTS = whenjobsd + +OCAMLPACKAGES = -package unix,num,camlp4.lib,rpc -I ../lib + +OCAMLCFLAGS = -g -warn-error CDEFLMPSUVYZX $(OCAMLPACKAGES) +OCAMLOPTFLAGS = $(OCAMLCFLAGS) + +# These should be in alphabetical order. +SOURCES = \ + daemon.mli \ + daemon.ml \ + syslog.mli \ + syslog.ml \ + whenjobsd.ml \ + whenproto_srv.mli \ + whenproto_srv.ml + +# In dependency order. +OBJECTS = \ + syslog.cmo \ + whenproto_srv.cmo \ + daemon.cmo \ + whenjobsd.cmo + +# Daemon. +noinst_LIBRARIES = libdaemon.a +libdaemon_a_SOURCES = syslog_c.c +libdaemon_a_CFLAGS = -I$(shell $(OCAMLC) -where) + +whenproto_srv.ml whenproto_srv.mli: whenproto.x + $(OCAMLRPCGEN) -int int32 -hyper int64 -srv $< + +whenproto.x: ../lib/whenproto.x + ln -f $< $@ + +whenjobsd: ../lib/whenlib.cma $(OBJECTS) libdaemon.a + $(OCAMLFIND) c -custom $(OCAMLCFLAGS) -ccopt -L../lib \ + -linkpkg whenlib.cma \ + libdaemon_a-syslog_c.o \ + $(OBJECTS) -o $@ + +# Rules for all OCaml files. +%.cmi: %.mli ../lib/whenlib.cma + $(OCAMLFIND) ocamlc $(OCAMLCFLAGS) -c $< -o $@ +%.cmo: %.ml ../lib/whenlib.cma + $(OCAMLFIND) ocamlc $(OCAMLCFLAGS) -c $< -o $@ +%.cmx: %.ml ../lib/whenlib.cma + $(OCAMLFIND) ocamlopt $(OCAMLOPTFLAGS) -c $< -o $@ + +SUFFIXES = .cmo .cmi .cmx .ml .mli .mll .mly + +# OCaml dependencies. +depend: .depend + +.depend: $(SOURCES) + rm -f $@ $@-t + $(OCAMLFIND) ocamldep $^ | \ + $(SED) -e 's/ *$$//' | \ + $(SED) -e :a -e '/ *\\$$/N; s/ *\\\n */ /; ta' | \ + LANG=C sort > $@-t + mv $@-t $@ + +-include .depend + +# Manual page. +man_MANS = whenjobsd.8 + +whenjobsd.8: whenjobsd.pod + pod2man \ + -c "Job scheduling" \ + --release "$(PACKAGE)-$(VERSION)" \ + --section 8 \ + --stderr --utf8 \ + $< > $@ + +CLEANFILES = \ + *.cmi *.cmo *.cmx *.cma *.cmxa *~ \ + whenproto.x \ + whenproto_srv.ml whenproto_srv.mli \ + whenjobsd diff --git a/daemon/daemon.ml b/daemon/daemon.ml new file mode 100644 index 0000000..fba3ae5 --- /dev/null +++ b/daemon/daemon.ml @@ -0,0 +1,188 @@ +(* whenjobs + * Copyright (C) 2012 Red Hat 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 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, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +open Whenutils + +open Unix +open Printf + +(* All jobs that are loaded. Maps name -> [job] structure. *) +let jobs = ref StringMap.empty + +(* Map variable names to jobs which depend on that variable. This + * gives us a quick way to tell which jobs might need to be reevaluated + * when a variable is set. + *) +let dependencies = ref StringMap.empty + +(* Current values of variables. Using the referentially transparent + * type Map is very useful here because it lets us cheaply keep + * previous values of variables. + *) +let variables : variables ref = ref StringMap.empty + +(* $HOME/.whenjobs *) +let jobsdir = ref "" + +(* Was debugging requested on the command line? *) +let debug = ref false + +let esys = Unixqueue.standard_event_system () + +let rec init j d = + jobsdir := j; + debug := d; + + Whenlock.create_lock !jobsdir; + + (* Remove old socket if it exists. *) + let addr = sprintf "%s/socket" !jobsdir in + (try unlink addr with Unix_error _ -> ()); + + ignore ( + Whenproto_srv.When.V1.create_server + ~proc_reload_file + ~proc_set_variable + ~proc_get_variable + ~proc_get_variable_names + (Rpc_server.Unix addr) + Rpc.Tcp (* not TCP, this is the same as SOCK_STREAM *) + Rpc.Socket + esys + ) + +and proc_reload_file () = + if !debug then Syslog.notice "remote call: reload_file"; + + try reload_file (); `ok + with Failure err -> `error err + +and proc_set_variable (name, value) = + if !debug then Syslog.notice "remote call: set_variable %s" name; + + let value = variable_of_rpc value in + variables := StringMap.add name value !variables; + + (* Which jobs need to be re-evaluated? *) + let jobnames = try StringMap.find name !dependencies with Not_found -> [] in + let jobs = reevaluate_jobs jobnames in + run_jobs jobs + +and proc_get_variable name = + if !debug then Syslog.notice "remote call: get_variable %s" name; + + try rpc_of_variable (StringMap.find name !variables) + with (* all non-existent variables are empty strings *) + Not_found -> `string_t "" + +and proc_get_variable_names () = + if !debug then Syslog.notice "remote call: get_variable_names"; + + (* Only return variables that are non-empty. *) + let vars = StringMap.fold ( + fun name value xs -> if value <> T_string "" then name :: xs else xs + ) !variables [] in + let vars = Array.of_list vars in + Array.sort compare vars; + vars + +(* Reload the jobs file. *) +and reload_file () = + let file = sprintf "%s/jobs.cmo" !jobsdir in + Whenfile.init (); + + let js = + try + Dynlink.loadfile file; + let jobs = Whenfile.get_jobs () in + Syslog.notice "loaded %d job(s) from %s" (List.length jobs) file; + jobs + with + | Dynlink.Error err -> + let err = Dynlink.error_message err in + Syslog.error "error loading jobs: %s" err; + failwith err + | exn -> + failwith (Printexc.to_string exn) in + + (* Set 'jobs' and related global variables. *) + let () = + let map = List.fold_left ( + fun map j -> + let name = j.job_name in + StringMap.add name j map + ) StringMap.empty js in + jobs := map in + + let () = + let map = List.fold_left ( + fun map j -> + let deps = dependencies_of_job j in + let name = j.job_name in + List.fold_left ( + fun map d -> + let names = try StringMap.find d map with Not_found -> [] in + StringMap.add d (name :: names) map + ) map deps + ) StringMap.empty js in + dependencies := map in + + (* Re-evaluate all jobs. *) + let jobs = reevaluate_jobs (StringMap.keys !jobs) in + run_jobs jobs + +(* Re-evaluate each named job, in a loop until we reach a fixpoint. + * Return the names of all the jobs that need to be run. + *) +and reevaluate_jobs jobnames = + let rec loop set jobnames = + let set' = + List.fold_left ( + fun set jobname -> + let job = + try StringMap.find jobname !jobs + with Not_found -> assert false in + assert (jobname = job.job_name); + + let r, job' = job_evaluate job !variables in + jobs := StringMap.add jobname job' !jobs; + + if !debug then + Syslog.notice "evaluate %s -> %b\n" jobname r; + + if r then StringSet.add jobname set else set + ) set jobnames in + if StringSet.compare set set' <> 0 then + loop set' jobnames + else + set' + in + let set = loop StringSet.empty jobnames in + StringSet.elements set + +and run_jobs jobnames = + let run_job job = + Syslog.notice "running %s" job.job_name; + () (* XXX *) + in + + List.iter run_job + (List.map (fun jobname -> StringMap.find jobname !jobs) jobnames) + +let main_loop () = + Unixqueue.run esys diff --git a/daemon/daemon.mli b/daemon/daemon.mli new file mode 100644 index 0000000..d860714 --- /dev/null +++ b/daemon/daemon.mli @@ -0,0 +1,33 @@ +(* whenjobs + * Copyright (C) 2012 Red Hat 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 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, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +(** Daemon functions. *) + +val init : string -> bool -> unit + (** Initialize the daemon. This sets up the socket and should + be called before the daemon forks. + + The parameters are [jobsdir] and [debug]. *) + +val reload_file : unit -> unit + (** (Re-)load the file [$jobsdir/jobs.cmo]. + + This can raise [Failure] if the operation fails. *) + +val main_loop : unit -> unit + (** Run the main loop. *) diff --git a/daemon/syslog.ml b/daemon/syslog.ml new file mode 100644 index 0000000..086a408 --- /dev/null +++ b/daemon/syslog.ml @@ -0,0 +1,26 @@ +(* whenjobs daemon + * Copyright (C) 2012 Red Hat 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 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, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +open Printf + +(* C functions, see [syslog_c.c]. *) +external c_notice : string -> unit = "whenjobs_syslog_notice" +external c_error : string -> unit = "whenjobs_syslog_error" + +let notice fs = ksprintf c_notice fs +let error fs = ksprintf c_error fs diff --git a/daemon/syslog.mli b/daemon/syslog.mli new file mode 100644 index 0000000..2707f9c --- /dev/null +++ b/daemon/syslog.mli @@ -0,0 +1,20 @@ +(* whenjobs daemon + * Copyright (C) 2012 Red Hat 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 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, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +val notice : ('a, unit, string, unit) format4 -> 'a +val error : ('a, unit, string, unit) format4 -> 'a diff --git a/daemon/syslog_c.c b/daemon/syslog_c.c new file mode 100644 index 0000000..9ef2a9d --- /dev/null +++ b/daemon/syslog_c.c @@ -0,0 +1,55 @@ +/* whenjobs + * (C) Copyright 2012 Red Hat 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 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, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + */ + +#include + +#include +#include +#include +#include + +#include +#include +#include +#include + +#define FACILITY LOG_CRON + +/* syslog_notice : string -> unit */ +value +whenjobs_syslog_notice (value messagev) +{ + CAMLparam1 (messagev); + const char *message = String_val (messagev); + + syslog (FACILITY|LOG_NOTICE, "%s", message); + + CAMLreturn (Val_unit); +} + +/* syslog_error : string -> unit */ +value +whenjobs_syslog_error (value messagev) +{ + CAMLparam1 (messagev); + const char *message = String_val (messagev); + + syslog (FACILITY|LOG_ERR, "%s", message); + + CAMLreturn (Val_unit); +} diff --git a/daemon/whenjobsd.ml b/daemon/whenjobsd.ml new file mode 100644 index 0000000..a994279 --- /dev/null +++ b/daemon/whenjobsd.ml @@ -0,0 +1,129 @@ +(* whenjobs daemon + * Copyright (C) 2012 Red Hat 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 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, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +open Unix +open Printf + +let () = + (* Running the daemon as root is a mistake. It must be run as a + * non-root user. + *) + let euid = geteuid () in + if euid = 0 then ( + eprintf "whenjobsd: this daemon must run as the local user, NOT root\n"; + exit 1 + ); + + (* $HOME must be defined and must exist and be a directory and must be + * owned by the current user. + *) + let home = + try getenv "HOME" + with Not_found -> + eprintf "whenjobsd: $HOME environment variable must be defined\n"; + exit 1 in + + let stat = + try lstat home + with Unix_error (err, fn, _) -> + eprintf "whenjobsd: %s: %s ($HOME): %s\n" fn home (error_message err); + exit 1 in + if stat.st_kind != S_DIR then ( + eprintf "whenjobsd: %s ($HOME): not a directory\n" home; + exit 1 + ); + + if stat.st_uid != euid then ( + eprintf "whenjobsd: %s ($HOME): not owned by the current user (uid %d)\n" + home euid; + exit 1 + ); + + (* Parse the command line arguments. *) + let debug = ref false in + let do_fork = ref true in + + let display_version () = + printf "%s %s\n" Config.package_name Config.package_version; + exit 0 + in + + let argspec = Arg.align [ + "-d", Arg.Set debug, " Enable extra debugging messages"; + "-f", Arg.Clear do_fork, " Don't fork into background"; + "-V", Arg.Unit display_version, " Display version number and exit"; + "--version", Arg.Unit display_version, " Display version number and exit"; + ] in + + let anon_fun _ = raise (Arg.Bad "unknown command line argument") in + + let usage_msg = "\ +Usage: + whenjobsd [--options] + +For documentation see the whenjobs(1) and whenjobsd(8) man pages. + +Options: +" in + + Arg.parse argspec anon_fun usage_msg; + + let debug = !debug in + let do_fork = !do_fork in + + (* Make the $HOME/.whenjobs directory if it doesn't exist. *) + let jobsdir = sprintf "%s/.whenjobs" home in + (try mkdir jobsdir 0o700 with Unix_error _ -> ()); + + (* Create the socket. *) + Daemon.init jobsdir debug; + + (* Fork into background. *) + if do_fork then ( + let pid = fork () in + if pid > 0 then exit 0; + + (* chdir / so we don't prevent filesystems from being unmounted. *) + chdir "/"; + + (* Close file descriptors. *) + close stdin; + close stdout; + close stderr; + + (* Create a new session. *) + ignore (setsid ()); + + (* Ignore SIGHUP. *) + Sys.set_signal Sys.sighup Sys.Signal_ignore; + + (* Update the PID file since we just forked. *) + Whenlock.update_pid (); + ); + + (* Start syslog. *) + Syslog.notice "daemon started: uid=%d home=%s" euid home; + + (* If there is a jobs.cmo file, load it. *) + let () = + let file = sprintf "%s/jobs.cmo" jobsdir in + if Sys.file_exists file then + try Daemon.reload_file () with Failure _ -> () in + + (* Go into main loop. *) + Daemon.main_loop () diff --git a/daemon/whenjobsd.pod b/daemon/whenjobsd.pod new file mode 100644 index 0000000..938358b --- /dev/null +++ b/daemon/whenjobsd.pod @@ -0,0 +1,130 @@ +=encoding utf8 + +=head1 NAME + +whenjobsd - whenjobs per-user daemon + +=head1 SYNOPSIS + + whenjobsd + +To start the daemon as a user, do: + + whenjobs --daemon-start + +To start the daemon as root (eg. from C) for a +particular user called C do: + + su username -c /usr/sbin/whenjobsd + +=head1 DESCRIPTION + +C is the daemon that runs whenjobs. Normally users do not +need to run this program directly. You can start and stop the daemon +using the L tool: + + whenjobs --daemon-start + whenjobs --daemon-stop + whenjobs --daemon-status + whenjobs --daemon-restart + +All documentation on the whenjobs cron replacement system can be found +in the L man page. This man page documents the daemon +only. + +Unlike cron, each user that wants to use whenjobs runs their own +whenjobsd. They operate completely separately. + +The daemon sends log messages to syslog using the "cron" facility. +Where these end up depends on the configuration of your syslog system, +which can vary from Linux distro to Linux distro. Typically the file +to look at might be one of: + + /var/log/cron + /var/log/syslog + /var/log/messages + +=head1 OPTIONS + +=over 4 + +=item B<-d> + +Enable extra debugging messages. These are sent to syslog. + +=item B<-f> + +Don't fork into the background. + +=item B<-V> + +=item B<--version> + +Display the name and version of the program and exit. + +=item B<-help> + +=item B<--help> + +Display brief usage and exit. + +=back + +=head1 FILES + +=over 4 + +=item C<$HOME/.whenjobs/daemon_pid> + +This contains the process ID of the daemon. The daemon also holds an +advisory (L-style) exclusive lock on this file while it is +running. + +=item C<$HOME/.whenjobs/jobs.cmo> + +This is the compiled jobs specification which the daemon loads on +start up, or reloads when instructed to by the L tool. + +=item C<$HOME/.whenjobs/socket> + +The daemon creates this socket and listens for incoming connections +from the L tool. + +=back + +=head1 ENVIRONMENT VARIABLES + +=over 4 + +=item C<$HOME> + +The user's home directory. This directory must exist and must be +owned by the same user as the daemon. + +=back + +=head1 SEE ALSO + +L + +=head1 AUTHOR + +Richard W.M. Jones L + +=head1 COPYRIGHT + +Copyright (C) 2012 Red Hat 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 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, write to the Free Software +Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. diff --git a/lib/Makefile.am b/lib/Makefile.am new file mode 100644 index 0000000..47285cd --- /dev/null +++ b/lib/Makefile.am @@ -0,0 +1,87 @@ +# whenjobs +# Copyright (C) 2012 Red Hat 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 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, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +libwhenjobsdir = $(libdir)/$(PACKAGE_NAME) +libwhenjobs_SCRIPTS = whenlib.cma pa_when.cmo + +OCAMLPACKAGES = -package unix,num,camlp4.lib,rpc + +OCAMLCFLAGS = -g -warn-error CDEFLMPSUVYZX $(OCAMLPACKAGES) +OCAMLOPTFLAGS = $(OCAMLCFLAGS) + +# These should be in alphabetical order. +SOURCES = \ + config.ml \ + whenfile.mli \ + whenfile.ml \ + whenlock.ml \ + whenlock.mli \ + whenproto_aux.ml \ + whenproto_aux.mli \ + whenutils.mli \ + whenutils.ml + +# In dependency order. +OBJECTS = \ + config.cmo \ + whenproto_aux.cmo \ + whenutils.cmo \ + whenfile.cmo \ + whenlock.cmo + +# Library. +noinst_LIBRARIES = liblibrary.a +liblibrary_a_SOURCES = flock.c +liblibrary_a_CFLAGS = -I$(shell $(OCAMLC) -where) + +whenlib.cma: $(OBJECTS) liblibrary.a + $(OCAMLFIND) c -a $(OCAMLCFLAGS) $(OBJECTS) -cclib -llibrary -o $@ + +whenproto_aux.ml whenproto_aux.mli: whenproto.x + $(OCAMLRPCGEN) -int int32 -hyper int64 -aux $< + +# Preprocessor for whenjobs files. +pa_when.cmo: pa_when.ml whenlib.cma + $(OCAMLFIND) c $(OCAMLCFLAGS) \ + -linkpkg whenlib.cma -pp $(CAMLP4OF) -c $< -o $@ + +# Rules for all OCaml files. +%.cmi: %.mli + $(OCAMLFIND) ocamlc $(OCAMLCFLAGS) -c $< -o $@ +%.cmo: %.ml + $(OCAMLFIND) ocamlc $(OCAMLCFLAGS) -c $< -o $@ +%.cmx: %.ml + $(OCAMLFIND) ocamlopt $(OCAMLOPTFLAGS) -c $< -o $@ + +SUFFIXES = .cmo .cmi .cmx .ml .mli .mll .mly + +# OCaml dependencies. +depend: .depend + +.depend: $(SOURCES) + rm -f $@ $@-t + $(OCAMLFIND) ocamldep $^ | \ + $(SED) -e 's/ *$$//' | \ + $(SED) -e :a -e '/ *\\$$/N; s/ *\\\n */ /; ta' | \ + LANG=C sort > $@-t + mv $@-t $@ + +-include .depend + +CLEANFILES = \ + *.cmi *.cmo *.cmx *.cma *.cmxa *~ \ + config.ml whenproto_aux.ml whenproto_aux.mli diff --git a/lib/config.ml.in b/lib/config.ml.in new file mode 100644 index 0000000..f892549 --- /dev/null +++ b/lib/config.ml.in @@ -0,0 +1,20 @@ +(* whenjobs + * Copyright (C) 2012 Red Hat 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 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, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +let package_name = "@PACKAGE_NAME@" +let package_version = "@PACKAGE_VERSION@" diff --git a/lib/flock.c b/lib/flock.c new file mode 100644 index 0000000..735e8f8 --- /dev/null +++ b/lib/flock.c @@ -0,0 +1,50 @@ +/* whenjobs + * (C) Copyright 2012 Red Hat 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 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, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + */ + +#include + +#include +#include +#include +#include +#include + +#include +#include +#include + +/* flock_exclusive_nonblocking : file_descr -> unit + * + * The reason we need this function is that OCaml only gives us access + * to the 'fcntl'-style of locking. These locks are not preserved + * over fork(2) (WTF POSIX?) making them pretty much useless. + * Therefore use BSD-style flock instead. + */ +value +whenjobs_flock_exclusive_nonblocking (value fdv) +{ + CAMLparam1 (fdv); + + /* file_descr is opaque, but on un*x-like platforms it's an integer */ + int fd = Int_val (fdv); + + if (flock (fd, LOCK_EX|LOCK_NB) == -1) + caml_failwith (strerror (errno)); + + CAMLreturn (Val_unit); +} diff --git a/lib/pa_when.ml b/lib/pa_when.ml new file mode 100644 index 0000000..d646822 --- /dev/null +++ b/lib/pa_when.ml @@ -0,0 +1,210 @@ +(* whenjobs + * Copyright (C) 2012 Red Hat 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 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, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +(* For general information about camlp4, see: + * http://brion.inria.fr/gallium/index.php/Camlp4 + * + * For information about quotations, see: + * http://brion.inria.fr/gallium/index.php/Quotation + *) + +open Printf + +open Camlp4.PreCast +open Syntax +open Ast + +open Whenutils + +let unique = let i = ref 0 in fun () -> incr i; !i + +let unique_job_name () = sprintf "job$%d" (unique ()) + +(* Convert a _loc to an AST. *) +let expr_of_loc _loc loc = + let file_name, + start_line, start_bol, start_off, + stop_line, stop_bol, stop_off, + ghost = Loc.to_tuple loc in + <:expr< Camlp4.PreCast.Loc.of_tuple + ($str:file_name$, + $`int:start_line$, $`int:start_bol$, $`int:start_off$, + $`int:stop_line$, $`int:stop_bol$, $`int:stop_off$, + $`bool:ghost$) >> + +(* "Lift" an expression, turning it from an expression into an OCaml + * abstract syntax tree in the output. This is pretty obscure. + * http://caml.inria.fr/pub/ml-archives/caml-list/2008/09/591f7c4a8df9295d675a5adcb6802748.en.html + *) +module M = Ast.Meta.Make (Ast.Meta.MetaGhostLoc) +let lift_expr = M.Expr.meta_expr + +(* Handle a top level statement. *) +let rec call_stmt name (_loc, stmt, sh) = + let name = if name <> "" then name else unique_job_name () in + let name = <:expr< $str:name$ >> in + match stmt with + | `When e -> when_stmt _loc name e sh + | `Every p -> every_stmt _loc name p sh + +(* Handle a top level "when" statement. + * e -> when expression + * sh -> the shell script to run + * Returns a top level statement (str_item) which when executed just + * adds the statement to a global list. + *) +and when_stmt _loc name e sh = + let loc = expr_of_loc _loc _loc in + let e = lift_expr _loc e in + <:str_item< + open Camlp4.PreCast + Whenfile.add_when_job $loc$ $name$ $e$ $sh$ + >> + +(* Handle a top level "every" statement. *) +and every_stmt _loc name period sh = + let loc = expr_of_loc _loc _loc in + <:str_item< + open Camlp4.PreCast + Whenfile.add_every_job $loc$ $name$ $period$ $sh$ + >> + +let () = + (* Quotation expander for shell script. *) + let sh_quotation_expander _loc _ sh = + let loc = expr_of_loc _loc _loc in + + (* XXX Expand %- or $- expressions in code. *) + (* XXX Escape >> in code. *) + + <:expr< { Whenutils.sh_loc = $loc$; + sh_script = $str:sh$ } >> + in + Quotation.add "sh" Quotation.DynAst.expr_tag sh_quotation_expander; + + (* Default quotation expander (<< .. >>) should be shell script ("sh"). *) + Quotation.default := "sh" + +(* For period expressions " (secs|mins|hours|...)" we cannot use + * the ordinary camlp4 parser since it only looks ahead by 1 symbol, so + * it gets "stuck" on the integer. Write a custom parser instead. + * + * Note the EXTEND macro implicitly reserves KEYWORDs. + *) +let period_parser = + Gram.Entry.of_parser "period" + (fun stream -> + match Stream.peek stream with + | Some (INT (_, i), info) -> + let i = int_of_string i in + let _loc = Gram.token_location info in + Stream.junk stream; + (match Stream.next stream with + | KEYWORD ("sec"|"secs"|"second"|"seconds"), _ -> + <:expr< Whenutils.Every_seconds $`int:i$ >> + | KEYWORD ("min"|"mins"|"minute"|"minutes"), _ -> + let i = 60 * i in + <:expr< Whenutils.Every_seconds $`int:i$ >> + | KEYWORD ("hour"|"hours"), _ -> + let i = 3600 * i in + <:expr< Whenutils.Every_seconds $`int:i$ >> + | KEYWORD ("day"|"days"), _ -> + <:expr< Whenutils.Every_days $`int:i$ >> + | KEYWORD ("week"|"weeks"), _ -> + let i = 7 * i in + <:expr< Whenutils.Every_days $`int:i$ >> + | KEYWORD ("month"|"months"), _ -> + <:expr< Whenutils.Every_months $`int:i$ >> + | KEYWORD ("year"|"years"), _ -> + <:expr< Whenutils.Every_years $`int:i$ >> + | KEYWORD ("decade"|"decades"), _ -> + let i = 10 * i in + <:expr< Whenutils.Every_years $`int:i$ >> + | KEYWORD ("century"|"centuries"|"centurys"), _ -> + let i = 100 * i in + <:expr< Whenutils.Every_years $`int:i$ >> + | KEYWORD ("millenium"|"millenia"|"milleniums"), _ -> + let i = 1000 * i in + <:expr< Whenutils.Every_years $`int:i$ >> + | (KEYWORD s | LIDENT s), _ -> + eprintf "period: failed to parse %d %s\n%!" i s; + raise Stream.Failure + | _ -> + raise Stream.Failure + ) + | _ -> raise Stream.Failure + ) + +(* +(* This hand-written parser looks for "job " before a statement. *) +let optjob = + Gram.Entry.of_parser "optjob" + (fun stream -> + let info, name = + match Stream.npeek 2 stream with + | [ LIDENT "job", info; STRING (_,name), _ ] -> + Stream.junk stream; + Stream.junk stream; + info, name + | (_, info) :: _ -> + (* Job is unnamed so generate a unique internal name. *) + info, unique_job_name () + | _ -> assert false in + let _loc = Gram.token_location info in + <:expr< $str:name$ >> + ) +*) +;; + +EXTEND Gram + GLOBAL: str_item; + + (* A period expression (used in "every"). *) + periodexpr: [ + [ ["sec"|"secs"|"second"|"seconds"] -> + <:expr< Whenutils.Every_seconds 1 >> ] + | [ ["min"|"mins"|"minute"|"minutes"] -> + <:expr< Whenutils.Every_seconds 60 >> ] + | [ ["hour"|"hours"] -> <:expr< Whenutils.Every_seconds 3600 >> ] + | [ ["day"|"days"] -> <:expr< Whenutils.Every_days 1 >> ] + | [ ["week"|"weeks"] -> <:expr< Whenutils.Every_days 7 >> ] + | [ ["month"|"months"] -> <:expr< Whenutils.Every_months 1 >> ] + | [ ["year"|"years"] -> <:expr< Whenutils.Every_years 1 >> ] + | [ ["decade"|"decades"] -> <:expr< Whenutils.Every_years 10 >> ] + | [ ["century"|"centuries"|"centurys"] -> + <:expr< Whenutils.Every_years 100 >> ] + | [ ["millenium"|"millenia"|"milleniums"] -> + <:expr< Whenutils.Every_years 1000 >> ] + | [ e = period_parser -> e ] + ]; + + (* Top level statements. *) + statement: [ + [ "when"; e = expr; ":"; sh = expr -> + (_loc, `When e, sh) ] + | [ "every"; p = periodexpr; ":"; sh = expr -> + (_loc, `Every p, sh) ] + ]; + + (* "str_item" is a top level statement in an OCaml program. *) + str_item: LEVEL "top" [ + [ s = statement -> call_stmt "" s ] + | [ "job"; name = STRING; s = statement -> call_stmt name s ] + ]; + +END diff --git a/lib/whenfile.ml b/lib/whenfile.ml new file mode 100644 index 0000000..8fdca1e --- /dev/null +++ b/lib/whenfile.ml @@ -0,0 +1,42 @@ +(* whenjobs + * Copyright (C) 2012 Red Hat 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 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, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +open Whenutils + +open Printf + +(* The list of jobs in this file. *) +let jobs = ref [] + +let init () = jobs := [] + +let add_when_job _loc name e sh = + let e = expr_of_ast _loc e in + let job = { job_loc = _loc; job_name = name; + job_cond = When_job e; job_script = sh; + job_private = no_job_private } in + jobs := job :: !jobs + +let add_every_job _loc name e sh = + let job = { job_loc = _loc; job_name = name; + job_cond = Every_job e; job_script = sh; + job_private = no_job_private } in + jobs := job :: !jobs + +let get_jobs () = + List.rev !jobs diff --git a/lib/whenfile.mli b/lib/whenfile.mli new file mode 100644 index 0000000..345c758 --- /dev/null +++ b/lib/whenfile.mli @@ -0,0 +1,50 @@ +(* whenjobs + * Copyright (C) 2012 Red Hat 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 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, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +(** This module is used when compiling whenjobs input files. *) + +val init : unit -> unit +(** "Initialize" the module. Clear the list of jobs and other + internal variables so we are ready to parse a new file. *) + +val get_jobs : unit -> Whenutils.job list +(** Get the jobs added since {!init} was called. *) + +val add_when_job : Camlp4.PreCast.Loc.t -> string -> Camlp4.PreCast.Ast.expr -> Whenutils.shell_script -> unit +(** When a 'when' macro appears as a toplevel statement in an + input file, it causes this function to be called. + + [loc] is the location in the input file. + + [name] is the name of the job. + + [expr] is the expression, as an OCaml abstract syntax tree. + + [sh] is the shell script fragment (basically location + a big string). *) + +val add_every_job : Camlp4.PreCast.Loc.t -> string -> Whenutils.periodexpr -> Whenutils.shell_script -> unit +(** When an 'every' macro appears as a toplevel statement in an + input file, it causes this function to be called. + + [loc] is the location in the input file. + + [name] is the name of the job. + + [periodexpr] is the period, eg. 30 seconds. + + [sh] is the shell script fragment. *) diff --git a/lib/whenlock.ml b/lib/whenlock.ml new file mode 100644 index 0000000..2e77cc5 --- /dev/null +++ b/lib/whenlock.ml @@ -0,0 +1,67 @@ +(* whenjobs + * Copyright (C) 2012 Red Hat 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 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, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +open Unix +open Printf + +(* See [flock.c]. *) +external flock_exclusive_nonblocking : file_descr -> unit = + "whenjobs_flock_exclusive_nonblocking" + +(* Global fd open on daemon_pid file. fd is closed and the lock is + * released implicitly when the program exits. + *) +let pid_fd = ref stdin + +let rec create_lock jobsdir = + let pid_file = get_pid_file jobsdir in + pid_fd := openfile pid_file [ O_CREAT; O_RDWR ] 0o600; + (try flock_exclusive_nonblocking !pid_fd + with Failure _ -> + eprintf "whenjobsd: PID file (%s) exists and cannot be locked\n" + pid_file; + eprintf "Another instance of the daemon may be running.\n"; + exit 1 + ); + + update_pid () + +and update_pid () = + let pid = sprintf "%d\n" (getpid ()) in + ignore (lseek !pid_fd 0 SEEK_SET); + ftruncate !pid_fd 0; + ignore (write !pid_fd pid 0 (String.length pid)) + +and test_locked jobsdir = + let pid_file = get_pid_file jobsdir in + let fd = openfile pid_file [ O_CREAT; O_RDWR ] 0o600 in + let r = ref false in + (try flock_exclusive_nonblocking fd with Failure _ -> r := true); + close fd; + !r + +and kill_daemon jobsdir = + let pid_file = get_pid_file jobsdir in + let chan = open_in pid_file in + let pid = input_line chan in + close_in chan; + let pid = int_of_string pid in + kill pid 15 + +and get_pid_file jobsdir = + sprintf "%s/daemon_pid" jobsdir diff --git a/lib/whenlock.mli b/lib/whenlock.mli new file mode 100644 index 0000000..e1bd763 --- /dev/null +++ b/lib/whenlock.mli @@ -0,0 +1,34 @@ +(* whenjobs + * Copyright (C) 2012 Red Hat 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 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, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +(** Handle the locking that ensures only one instance of the + daemon can run per user. *) + +val create_lock : string -> unit +(** [create_lock jobsdir] creates the lock file (called [daemon_pid]) + in the [jobsdir] directory. The lock is automatically released + when the process exits. *) + +val update_pid : unit -> unit +(** Call this if the PID of the program changes, ie. after fork. *) + +val test_locked : string -> bool +(** Test if there is a lock file and the lock is held by another process. *) + +val kill_daemon : string -> unit +(** If there is a daemon holding the lock, kill it. *) diff --git a/lib/whenproto.x b/lib/whenproto.x new file mode 100644 index 0000000..faa120d --- /dev/null +++ b/lib/whenproto.x @@ -0,0 +1,72 @@ +/* whenjobs -*- c -*- + * (C) Copyright 2012 Red Hat 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 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, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + */ + +/* This is the protocol used to talk between the client (whenjobs) and + * the daemon (whenjobsd). Communication happens over a Unix domain + * socket '$HOME/.whenjobs/socket'. The wire protocol is SunRPC. + */ + +/* Maximum length of a variable name and string value. */ +const MAX_VARIABLE_NAME_LENGTH = 256; +const MAX_VARIABLE_VALUE_LENGTH = 65536; + +typedef string variable_name; +typedef string string_value; + +typedef variable_name variable_name_list<>; + +/* Status code (OK or error) returned by most calls. */ +enum status_code { + OK = 1, + ERROR = 2 +}; + +union status switch (status_code s) { + case OK: + void; + case ERROR: + string error<>; +}; + +enum variable_type { + BOOL_T = 0, + STRING_T = 1, + INT_T = 2, + FLOAT_T = 3 +}; + +union variable switch (variable_type t) { + case BOOL_T: + bool b; + case STRING_T: + string_value s; + case INT_T: + string i<64>; /* OCaml [big_int], as a string. */ + case FLOAT_T: + double f; /* C 'double' maps to an OCaml 'float' */ +}; + +/* The API of the daemon. */ +program When { + version V1 { + status reload_file (void) = 1; + void set_variable (variable_name, variable) = 2; + variable get_variable (variable_name) = 3; + variable_name_list get_variable_names (void) = 4; + } = 1; +} = 0x20008081; diff --git a/lib/whenutils.ml b/lib/whenutils.ml new file mode 100644 index 0000000..1fbb1c6 --- /dev/null +++ b/lib/whenutils.ml @@ -0,0 +1,353 @@ +(* whenjobs + * Copyright (C) 2012 Red Hat 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 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, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +open Camlp4.PreCast +open Ast + +open Big_int +open Printf + +module StringMap = struct + include Map.Make (String) + let keys m = fold (fun k _ ks -> k :: ks) m [] + let values m = fold (fun _ v vs -> v :: vs) m [] +end + +module StringSet = Set.Make (String) + +type whenexpr = + | Expr_bool of bool + | Expr_str of string + | Expr_int of Big_int.big_int + | Expr_float of float + | Expr_var of string + | Expr_and of whenexpr * whenexpr + | Expr_or of whenexpr * whenexpr + | Expr_eq of whenexpr * whenexpr + | Expr_not of whenexpr + | Expr_changes of string + +(* This internal type is used during conversion of the OCaml AST + * to the whenexpr type. + *) +type whenexpr_int = + | IExpr_bool of bool + | IExpr_str of string + | IExpr_int of Big_int.big_int + | IExpr_float of float + | IExpr_var of string + | IExpr_app of string * whenexpr_int list + +(* Note that days are not necessarily expressible in seconds (because + * of leap seconds), months are not expressible in days (because months + * have different lengths), and years are not expressible in days + * (because of leap days) although we could save a case here by + * expressing years in months. + *) +type periodexpr = + | Every_seconds of int + | Every_days of int + | Every_months of int + | Every_years of int + +type shell_script = { + sh_loc : Loc.t; + sh_script : string; +} + +type variable = + | T_bool of bool + | T_string of string + | T_int of big_int + | T_float of float + +let variable_of_rpc = function + | `bool_t b -> T_bool b + | `string_t s -> T_string s + | `int_t i -> T_int (big_int_of_string i) + | `float_t f -> T_float f + +let rpc_of_variable = function + | T_bool b -> `bool_t b + | T_string s -> `string_t s + | T_int i -> `int_t (string_of_big_int i) + | T_float f -> `float_t f + +type variables = variable StringMap.t + +type job_private = { + (* The result of the previous evaluation. This is used for + * implementing edge-triggering, since we only trigger the job to run + * when the state changes from false -> true. + *) + job_prev_eval_state : bool; + + (* When the job {i ran} last time, we take a copy of the variables. + * This allows us to implement the 'changes' operator. + *) + job_prev_variables : variables; +} + +let no_job_private = + { job_prev_eval_state = false; job_prev_variables = StringMap.empty } + +type job_cond = + | When_job of whenexpr + | Every_job of periodexpr + +type job = { + job_loc : Loc.t; + job_name : string; + job_cond : job_cond; + job_script : shell_script; + job_private : job_private; +} + +let rec expr_of_ast _loc ast = + expr_of_iexpr _loc (iexpr_of_ast _loc ast) + +and iexpr_of_ast _loc = function + | ExId (_, IdLid (_, "true")) -> IExpr_bool true + | ExId (_, IdLid (_, "false")) -> IExpr_bool false + | ExStr (_, str) -> IExpr_str str + | ExInt (_, i) -> IExpr_int (big_int_of_string i) (* XXX too large? *) + | ExFlo (_, f) -> IExpr_float (float_of_string f) + | ExId (_, IdLid (_, id)) -> IExpr_var id + + (* In the OCaml AST, functions are curried right to left, so we + * must uncurry to get the list of arguments. + *) + | ExApp (_, left_tree, right_arg) -> + let f, left_args = uncurry_app_tree _loc left_tree in + IExpr_app (f, List.rev_map (iexpr_of_ast _loc) (right_arg :: left_args)) + + | e -> + (* https://groups.google.com/group/fa.caml/browse_thread/thread/f35452d085654bd6 *) + eprintf "expr_of_ast: invalid expression: %!"; + let e = Ast.StExp (_loc, e) in + Printers.OCaml.print_implem ~output_file:"/dev/stderr" e; + + invalid_arg (sprintf "%s: invalid expression" (Loc.to_string _loc)) + +and uncurry_app_tree _loc = function + | ExId (_, IdLid (_, f)) -> f, [] + | ExApp (_, left_tree, right_arg) -> + let f, left_args = uncurry_app_tree _loc left_tree in + f, (right_arg :: left_args) + | e -> + eprintf "uncurry_app_tree: invalid expression: %!"; + let e = Ast.StExp (_loc, e) in + Printers.OCaml.print_implem ~output_file:"/dev/stderr" e; + + invalid_arg (sprintf "%s: invalid expression" (Loc.to_string _loc)) + +and expr_of_iexpr _loc = function + | IExpr_bool b -> Expr_bool b + | IExpr_str s -> Expr_str s + | IExpr_int i -> Expr_int i + | IExpr_float f -> Expr_float f + | IExpr_var v -> Expr_var v + + | IExpr_app ("&&", exprs) -> + (match exprs with + | [e1; e2] -> Expr_and (expr_of_iexpr _loc e1, expr_of_iexpr _loc e2) + | _ -> + invalid_arg (sprintf "%s: && operator must be applied to two parameters" + (Loc.to_string _loc)) + ) + + | IExpr_app ("||", exprs) -> + (match exprs with + | [e1; e2] -> Expr_or (expr_of_iexpr _loc e1, expr_of_iexpr _loc e2) + | _ -> + invalid_arg (sprintf "%s: || operator must be applied to two parameters" + (Loc.to_string _loc)) + ) + + | IExpr_app (("="|"=="), exprs) -> + (match exprs with + | [e1; e2] -> Expr_eq (expr_of_iexpr _loc e1, expr_of_iexpr _loc e2) + | _ -> + invalid_arg (sprintf "%s: = operator must be applied to two parameters" + (Loc.to_string _loc)) + ) + + | IExpr_app ("!", exprs) -> + (match exprs with + | [e1] -> Expr_not (expr_of_iexpr _loc e1) + | _ -> + invalid_arg (sprintf "%s: ! operator must be applied to one parameter" + (Loc.to_string _loc)) + ) + + | IExpr_app (("change"|"changes"|"changed"), [IExpr_var v]) -> + Expr_changes v + + | IExpr_app (("change"|"changes"|"changed"), _) -> + invalid_arg (sprintf "%s: 'changes' operator must be followed by a variable name" + (Loc.to_string _loc)) + + | IExpr_app (op, _) -> + invalid_arg (sprintf "%s: unknown operator in expression: %s" + (Loc.to_string _loc) op) + +let rec string_of_whenexpr = function + | Expr_bool b -> sprintf "%b" b + | Expr_str s -> sprintf "%S" s + | Expr_int i -> sprintf "%s" (string_of_big_int i) + | Expr_float f -> sprintf "%f" f + | Expr_var v -> sprintf "%s" v + | Expr_and (e1, e2) -> + sprintf "%s && %s" (string_of_whenexpr e1) (string_of_whenexpr e2) + | Expr_or (e1, e2) -> + sprintf "%s || %s" (string_of_whenexpr e1) (string_of_whenexpr e2) + | Expr_eq (e1, e2) -> + sprintf "%s == %s" (string_of_whenexpr e1) (string_of_whenexpr e2) + | Expr_not e -> sprintf "! %s" (string_of_whenexpr e) + | Expr_changes v -> sprintf "changes %s" v + +let string_of_periodexpr = function + | Every_seconds 1 -> "1 second" + | Every_seconds i -> sprintf "%d seconds" i + | Every_days 1 -> "1 day" + | Every_days i -> sprintf "%d days" i + | Every_months 1 -> "1 month" + | Every_months i -> sprintf "%d months" i + | Every_years 1 -> "1 year" + | Every_years i -> sprintf "%d years" i + +let rec dependencies_of_whenexpr = function + | Expr_bool _ -> [] + | Expr_str _ -> [] + | Expr_int _ -> [] + | Expr_float _ -> [] + | Expr_var v -> [v] + | Expr_and (e1, e2) -> + dependencies_of_whenexpr e1 @ dependencies_of_whenexpr e2 + | Expr_or (e1, e2) -> + dependencies_of_whenexpr e1 @ dependencies_of_whenexpr e2 + | Expr_eq (e1, e2) -> + dependencies_of_whenexpr e1 @ dependencies_of_whenexpr e2 + | Expr_not e -> dependencies_of_whenexpr e + | Expr_changes v -> [v] + +let dependencies_of_job = function + | { job_cond = When_job whenexpr } -> dependencies_of_whenexpr whenexpr + | { job_cond = Every_job _ } -> [] + +let rec eval_whenexpr job variables = function + | Expr_bool b -> T_bool b + | Expr_str s -> T_string s + | Expr_int i -> T_int i + | Expr_float f -> T_float f + + | Expr_var v -> + (try StringMap.find v variables with Not_found -> T_string "") + + | Expr_and (e1, e2) -> + if eval_whenexpr_as_bool job variables e1 && + eval_whenexpr_as_bool job variables e2 then + T_bool true + else + T_bool false + + | Expr_or (e1, e2) -> + if eval_whenexpr_as_bool job variables e1 || + eval_whenexpr_as_bool job variables e2 then + T_bool true + else + T_bool false + + | Expr_eq (e1, e2) -> + let e1 = eval_whenexpr job variables e1 + and e2 = eval_whenexpr job variables e2 in + if 0 = compare_values e1 e2 then + T_bool true + else + T_bool false + + | Expr_not e -> + if not (eval_whenexpr_as_bool job variables e) then + T_bool true + else + T_bool false + + | Expr_changes v -> + let prev_value = + try StringMap.find v job.job_private.job_prev_variables + with Not_found -> T_string "" in + let curr_value = + try StringMap.find v variables + with Not_found -> T_string "" in + + if 0 <> compare_values prev_value curr_value then + T_bool true + else + T_bool false + +(* Call {!eval_whenexpr} and cast the result to a boolean. *) +and eval_whenexpr_as_bool job variables expr = + match eval_whenexpr job variables expr with + | T_bool r -> r + | T_string s -> s <> "" + | T_int i -> sign_big_int i <> 0 + | T_float f -> f <> 0. + +(* Do a comparison on two typed values and return -1/0/+1. If the + * types are different then we compare the values as strings. The user + * can avoid this by specifying types. + *) +and compare_values value1 value2 = + match value1, value2 with + | T_bool b1, T_bool b2 -> compare b1 b2 + | T_string s1, T_string s2 -> compare s1 s2 + | T_int i1, T_int i2 -> compare_big_int i1 i2 + | T_float f1, T_float f2 -> compare f1 f2 + | _ -> + let value1 = value_as_string value1 + and value2 = value_as_string value2 in + compare value1 value2 + +and value_as_string = function + | T_bool b -> string_of_bool b + | T_string s -> s + | T_int i -> string_of_big_int i + | T_float f -> string_of_float f + +let job_evaluate job variables = + match job with + | { job_cond = Every_job _ } -> false, job + | { job_cond = When_job whenexpr } -> + let state = eval_whenexpr_as_bool job variables whenexpr in + + (* Because jobs are edge-triggered, we're only interested in the + * case where the evaluation state changes from false -> true. + *) + match job.job_private.job_prev_eval_state, state with + | false, false + | true, true + | true, false -> + let jobp = { job.job_private with job_prev_eval_state = state } in + let job = { job with job_private = jobp } in + false, job + + | false, true -> + let jobp = { job_prev_eval_state = true; + job_prev_variables = variables } in + let job = { job with job_private = jobp } in + true, job diff --git a/lib/whenutils.mli b/lib/whenutils.mli new file mode 100644 index 0000000..b2a8878 --- /dev/null +++ b/lib/whenutils.mli @@ -0,0 +1,165 @@ +(* whenjobs + * Copyright (C) 2012 Red Hat 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 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, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +(** Types and utility functions. *) + +module StringMap : sig + type key = String.t + type 'a t = 'a Map.Make(String).t + val empty : 'a t + val is_empty : 'a t -> bool + val mem : key -> 'a t -> bool + val add : key -> 'a -> 'a t -> 'a t + (*val singleton : key -> 'a -> 'a t*) + val remove : key -> 'a t -> 'a t + (*val merge : + (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t*) + val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int + val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool + val iter : (key -> 'a -> unit) -> 'a t -> unit + val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b + (*val for_all : (key -> 'a -> bool) -> 'a t -> bool + val exists : (key -> 'a -> bool) -> 'a t -> bool + val filter : (key -> 'a -> bool) -> 'a t -> 'a t + val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t + val cardinal : 'a t -> int + val bindings : 'a t -> (key * 'a) list + val min_binding : 'a t -> key * 'a + val max_binding : 'a t -> key * 'a + val choose : 'a t -> key * 'a + val split : key -> 'a t -> 'a t * 'a option * 'a t*) + val find : key -> 'a t -> 'a + val map : ('a -> 'b) -> 'a t -> 'b t + val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t + val keys : 'a t -> key list + val values : 'a t -> 'a list +end +(** A map from string to any type. *) + +module StringSet : sig + type elt = String.t + type t = Set.Make(String).t + val empty : t + val is_empty : t -> bool + val mem : elt -> t -> bool + val add : elt -> t -> t + val singleton : elt -> t + val remove : elt -> t -> t + val union : t -> t -> t + val inter : t -> t -> t + val diff : t -> t -> t + val compare : t -> t -> int + val equal : t -> t -> bool + val subset : t -> t -> bool + val iter : (elt -> unit) -> t -> unit + val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a + val for_all : (elt -> bool) -> t -> bool + val exists : (elt -> bool) -> t -> bool + val filter : (elt -> bool) -> t -> t + val partition : (elt -> bool) -> t -> t * t + val cardinal : t -> int + val elements : t -> elt list + val min_elt : t -> elt + val max_elt : t -> elt + val choose : t -> elt + val split : elt -> t -> t * bool * t +end +(** A set of strings. *) + +type whenexpr = + | Expr_bool of bool (** A boolean constant. *) + | Expr_str of string (** A string constant. *) + | Expr_int of Big_int.big_int (** An integer constant. *) + | Expr_float of float (** A float constant. *) + | Expr_var of string (** A variable name. *) + | Expr_and of whenexpr * whenexpr (** && *) + | Expr_or of whenexpr * whenexpr (** || *) + | Expr_eq of whenexpr * whenexpr (** == *) + | Expr_not of whenexpr (** ! *) + | Expr_changes of string (** changes var *) +(** Internal type used to represent 'when' expressions. *) + +type periodexpr = + | Every_seconds of int + | Every_days of int + | Every_months of int + | Every_years of int +(** Internal type used to represent 'every' expressions. *) + +type shell_script = { + sh_loc : Camlp4.PreCast.Loc.t; + sh_script : string; +} +(** A shell script. *) + +type variable = + | T_bool of bool + | T_string of string + | T_int of Big_int.big_int + | T_float of float +(** Typed variable (see also [whenproto.x]) *) + +val variable_of_rpc : Whenproto_aux.variable -> variable +val rpc_of_variable : variable -> Whenproto_aux.variable + +type variables = variable StringMap.t +(** A set of variables. *) + +type job_private +(** Private state associated with a job, used for evaluation. *) + +val no_job_private : job_private +(* XXX any use of no_job_private is wrong XXX *) + +type job_cond = + | When_job of whenexpr (** when ... : << >> *) + | Every_job of periodexpr (** every ... : << >> *) + +type job = { + job_loc : Camlp4.PreCast.Loc.t; + job_name : string; + job_cond : job_cond; + job_script : shell_script; + job_private : job_private; +} +(** A job. *) + +val expr_of_ast : Camlp4.PreCast.Ast.Loc.t -> Camlp4.PreCast.Ast.expr -> whenexpr +(** Convert OCaml AST to an expression. Since OCaml ASTs are much + more general than the expressions we can use, this can raise + [Invalid_argument] in many different situations. *) + +val string_of_whenexpr : whenexpr -> string +(** Pretty-print an expression to a string. *) + +val string_of_periodexpr : periodexpr -> string +(** Pretty-print a period expression to a string. *) + +val dependencies_of_whenexpr : whenexpr -> string list +(** Return list of variables that an expression depends on. This is + used to work out when an expression needs to be reevaluated. *) + +val dependencies_of_job : job -> string list +(** Which variables does this job depend on? *) + +val job_evaluate : job -> variables -> bool * job +(** Evaluate [job]'s condition in the context of the [variables], and + return [true] iff it should be run now. Note that this returns a + possibly-updated [job] structure. + + This is a no-op for 'every' jobs. *) diff --git a/tests/parsing/Makefile.am b/tests/parsing/Makefile.am new file mode 100644 index 0000000..9a693a6 --- /dev/null +++ b/tests/parsing/Makefile.am @@ -0,0 +1,69 @@ +# whenjobs +# Copyright (C) 2012 Red Hat 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 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, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +tests = t010_load.cmo t020_simple.cmo t030_jobnames.cmo + +check_SCRIPTS = test_load $(tests) + +TESTS_ENVIRONMENT = ./test_load +TESTS = $(tests) + +OCAMLPACKAGES = -package unix,camlp4.lib + +OCAMLCFLAGS = \ + -g -warn-error CDEFLMPSUVYZX \ + -I +camlp4 -I ../../daemon \ + $(OCAMLPACKAGES) +OCAMLOPTFLAGS = $(OCAMLCFLAGS) + +PP = -pp '$(CAMLP4O) ../../daemon/pa_when.cmo' + +test_load: test_load.cmo + $(OCAMLFIND) ocamlc $(OCAMLCFLAGS) -linkpkg whenlib.cma $< -o $@ + +# Rules for all OCaml files. +%.cmi: %.mli ../../daemon/pa_when.cmo + $(OCAMLFIND) ocamlc $(OCAMLCFLAGS) $(PP) -c $< -o $@ +%.cmo: %.ml ../../daemon/pa_when.cmo + $(OCAMLFIND) ocamlc $(OCAMLCFLAGS) $(PP) -c $< -o $@ +#%.cmx: %.ml ../../daemon/pa_when.cmo +# $(OCAMLFIND) ocamlopt $(OCAMLOPTFLAGS) $(PP) -c $< -o $@ + +SUFFIXES = .cmo .cmi .cmx .ml .mli .mll .mly + +# OCaml dependencies. +depend: .depend + +.depend: $(SOURCES) + rm -f $@ $@-t + $(OCAMLFIND) ocamldep $(PP) $^ | \ + $(SED) -e 's/ *$$//' | \ + $(SED) -e :a -e '/ *\\$$/N; s/ *\\\n */ /; ta' | \ + LANG=C sort > $@-t + mv $@-t $@ + +-include .depend + +# Useful for debugging: print the generated AST for the tests. +print: + @for f in $(check_SCRIPTS); do \ + b=`basename $$f .cmo`; \ + echo "Test: $$b.ml"; \ + camlp4o ../../daemon/pa_when.cmo -printer pr_o.cmo $$b.ml; \ + done + +CLEANFILES = *.cmi *.cmo *.cmx *.cma *.cmxa *~ test_load diff --git a/tests/parsing/t010_load.ml b/tests/parsing/t010_load.ml new file mode 100644 index 0000000..7bcc0eb --- /dev/null +++ b/tests/parsing/t010_load.ml @@ -0,0 +1,19 @@ +(* whenjobs + * Copyright (C) 2012 Red Hat 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 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, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +(* empty *) diff --git a/tests/parsing/t020_simple.ml b/tests/parsing/t020_simple.ml new file mode 100644 index 0000000..8a3d666 --- /dev/null +++ b/tests/parsing/t020_simple.ml @@ -0,0 +1,56 @@ +(* whenjobs + * Copyright (C) 2012 Red Hat 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 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, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +(* Simple when and every statements. This is just a test of parsing, + * not of semantics or execution. + *) + +every second : +<< + # nothing +>> + +every 10 seconds : +<< + # nothing +>> + +every 30 minutes : +<< + # nothing +>> + +when changes foo : +<< + # nothing +>> + +when foo = "value" && (bar = "value") : +<< + # nothing +>> + +when 1 = 0 : +<< + # nothing +>> + +when false == true : +<< + # nothing +>> diff --git a/tests/parsing/t030_jobnames.ml b/tests/parsing/t030_jobnames.ml new file mode 100644 index 0000000..49d3e28 --- /dev/null +++ b/tests/parsing/t030_jobnames.ml @@ -0,0 +1,37 @@ +(* whenjobs + * Copyright (C) 2012 Red Hat 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 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, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +(* Named jobs. *) + +job "check" +when foo = "value" : +<< + # nothing +>> + +job "poll" +every minute : +<< + # nothing +>> + +(* no job name *) +when bar = "value" : +<< + # nothing +>> diff --git a/tests/parsing/test_load.ml b/tests/parsing/test_load.ml new file mode 100644 index 0000000..6cb9f9e --- /dev/null +++ b/tests/parsing/test_load.ml @@ -0,0 +1,43 @@ +(* whenjobs + * Copyright (C) 2012 Red Hat 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 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, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +open Printf + +(* This program is passed a single argument, which is the .cmo file to + * dynamically load. + *) +let file = + if Array.length Sys.argv != 2 then ( + eprintf "test_load test.cmo\n"; + exit 1 + ); + Sys.argv.(1) + +let () = + Whenfile.init (); + + (try + Dynlink.loadfile file + with + Dynlink.Error err -> + eprintf "test_load: %s: %s\n" file (Dynlink.error_message err); + exit 1 + ); + + let jobs = Whenfile.get_jobs () in + printf "test_load: %s: %d jobs parsed from file\n" file (List.length jobs) diff --git a/tools/Makefile.am b/tools/Makefile.am index 057074c..1941e22 100644 --- a/tools/Makefile.am +++ b/tools/Makefile.am @@ -15,4 +15,80 @@ # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -CLEANFILES = *~ +bin_SCRIPTS = whenjobs + +OCAMLPACKAGES = -package unix,num,camlp4.lib,rpc + +OCAMLCFLAGS = -g -warn-error CDEFLMPSUVYZX $(OCAMLPACKAGES) -I ../lib +OCAMLOPTFLAGS = $(OCAMLCFLAGS) + +# These should be in alphabetical order. +SOURCES = \ + libdir.ml \ + tutorial.ml \ + whenproto_clnt.ml \ + whenproto_clnt.mli \ + whenjobs.ml + +# In dependency order. +OBJECTS = \ + libdir.cmo \ + tutorial.cmo \ + whenproto_clnt.cmo \ + whenjobs.cmo + +libdir.ml: Makefile + rm -f $@ $@-t + echo 'let libdir = "$(libdir)/$(PACKAGE_NAME)"' > $@-t + mv $@-t $@ + +whenproto_clnt.ml whenproto_clnt.mli: whenproto.x + $(OCAMLRPCGEN) -int int32 -hyper int64 -clnt $< + +whenproto.x: ../lib/whenproto.x + ln -f $< $@ + +whenjobs: ../lib/whenlib.cma $(OBJECTS) + $(OCAMLFIND) ocamlc -custom $(OCAMLCFLAGS) -ccopt -L../lib \ + -linkpkg whenlib.cma $(OBJECTS) -o $@ + +# Rules for all OCaml files. +%.cmi: %.mli ../lib/whenlib.cma + $(OCAMLFIND) ocamlc $(OCAMLCFLAGS) -c $< -o $@ +%.cmo: %.ml ../lib/whenlib.cma + $(OCAMLFIND) ocamlc $(OCAMLCFLAGS) -c $< -o $@ +%.cmx: %.ml ../lib/whenlib.cma + $(OCAMLFIND) ocamlopt $(OCAMLOPTFLAGS) -c $< -o $@ + +SUFFIXES = .cmo .cmi .cmx .ml .mli .mll .mly + +# OCaml dependencies. +depend: .depend + +.depend: $(SOURCES) + rm -f $@ $@-t + $(OCAMLFIND) ocamldep $^ | \ + $(SED) -e 's/ *$$//' | \ + $(SED) -e :a -e '/ *\\$$/N; s/ *\\\n */ /; ta' | \ + LANG=C sort > $@-t + mv $@-t $@ + +-include .depend + +# Manual page. +man_MANS = whenjobs.1 + +whenjobs.1: whenjobs.pod + pod2man \ + -c "Job scheduling" \ + --release "$(PACKAGE)-$(VERSION)" \ + --section 1 \ + --stderr --utf8 \ + $< > $@ + +CLEANFILES = \ + *.cmi *.cmo *.cmx *.cma *.cmxa *~ \ + libdir.ml \ + whenproto.x \ + whenproto_clnt.ml whenproto_clnt.mli \ + whenjobs diff --git a/tools/tutorial.ml b/tools/tutorial.ml new file mode 100644 index 0000000..b0df108 --- /dev/null +++ b/tools/tutorial.ml @@ -0,0 +1,47 @@ +(* whenjobs daemon + * Copyright (C) 2012 Red Hat 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 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, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +let tutorial = "\ +(* Everything in (* ... *) is a comment. + Everything in << ... >> is a shell script. Use >\\> to escape >> in script. + + This is just a quick start. For full documentation read the + whenjobs(1) man page by typing 'man 1 whenjobs' + + Use 'every : << >>' to run a shell script periodically + (like cron). Don't forget the colon! + +every 10 minutes : +<< + # Get free blocks in /home + free=`stat -f -c %b /home` + # Set the variable 'free_space' + whenjobs --type int --set free_space $free +>> + + Use 'when : << >>' runs the shell script only when + the expression is true. 'changes' is a function that monitors + a variable and returns true when it changes value. + +when changes free_space && free_space < 100000 : +<< + mail -s \"ALERT: only $free_space blocks left on /home\" $LOGNAME > + +*) +" diff --git a/tools/whenjobs.ml b/tools/whenjobs.ml new file mode 100644 index 0000000..dade6c2 --- /dev/null +++ b/tools/whenjobs.ml @@ -0,0 +1,394 @@ +(* whenjobs daemon + * Copyright (C) 2012 Red Hat 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 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, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +open Big_int +open Unix +open Printf + +let libdir = ref Libdir.libdir + +let jobsdir = + (* Running the program as root is a mistake. It must be run as a + * non-root user. + *) + let euid = geteuid () in + if euid = 0 then ( + eprintf "whenjobs: this program must not be run as root\n"; + exit 1 + ); + + (* $HOME must be defined and must exist and be a directory and must be + * owned by the current user. + *) + let home = + try getenv "HOME" + with Not_found -> + eprintf "whenjobs: $HOME environment variable must be defined\n"; + exit 1 in + + let stat = + try lstat home + with Unix_error (err, fn, _) -> + eprintf "whenjobs: %s: %s ($HOME): %s\n" fn home (error_message err); + exit 1 in + if stat.st_kind != S_DIR then ( + eprintf "whenjobs: %s ($HOME): not a directory\n" home; + exit 1 + ); + + if stat.st_uid != euid then ( + eprintf "whenjobs: %s ($HOME): not owned by the current user (uid %d)\n" + home euid; + exit 1 + ); + + (* Make the $HOME/.whenjobs directory if it doesn't exist. *) + let jobsdir = sprintf "%s/.whenjobs" home in + (try mkdir jobsdir 0o700 with Unix_error _ -> ()); + + jobsdir + +let rec main () = + (* Parse the command line arguments. *) + let mode = ref None in + let typ = ref "string" in + + let set_mode m () = mode := Some m in + + let display_version () = + printf "%s %s\n" Config.package_name Config.package_version; + exit 0 + in + + let argspec = Arg.align [ + "--daemon-start", Arg.Unit (set_mode `Daemon_start), " Start the daemon"; + "--daemon-status", Arg.Unit (set_mode `Daemon_status), " Display the status of the daemon"; + "--daemon-stop", Arg.Unit (set_mode `Daemon_stop), " Stop the daemon"; + "--daemon-restart", Arg.Unit (set_mode `Daemon_restart), " Restart the daemon"; + "-e", Arg.Unit (set_mode `Edit), " Edit and upload the script"; + "--edit", Arg.Unit (set_mode `Edit), " Edit and upload the script"; + "--get", Arg.Unit (set_mode `Get), " Display the variable"; + "-l", Arg.Unit (set_mode `List), " List the script"; + "--list", Arg.Unit (set_mode `List), " List the script"; + "--lib", Arg.Set_string libdir, "dir Specify directory that contains pa_when.cmo"; + "--set", Arg.Unit (set_mode `Set), " Set the variable"; + "--type", Arg.Set_string typ, "bool|int|float|string Set the variable type"; + "--upload", Arg.Unit (set_mode `Upload), " Upload the script"; + "--variables", Arg.Unit (set_mode `Variables), " Display all variables and values"; + "-V", Arg.Unit display_version, " Display version number and exit"; + "--version", Arg.Unit display_version, " Display version number and exit"; + ] in + + let args = ref [] in + let anon_fun str = args := str :: !args in + + let usage_msg = "\ +Whenjobs is a powerful but simple cron replacement. +Whenjobs copyright (C) 2012 Red Hat Inc. + +Editing the script: + + whenjobs -e | --edit + whenjobs -l | --list + +Get and set variables: + + whenjobs --get variable + whenjobs --set variable value + +Start and stop the per-user daemon: + + whenjobs --daemon-start | --daemon-stop | --daemon-status + +For documentation see the whenjobs(1) man page. + +Options: +" in + + Arg.parse argspec anon_fun usage_msg; + + let mode = !mode in + let args = List.rev !args in + + let typ = match !typ with + | "bool"|"boolean" -> `Bool + | "string" -> `String + | "int" -> `Int + | "float"|"double" -> `Float + | t -> + eprintf "whenjobs: --type: unknown type (%s)\n" t; + exit 1 in + + (* Depending on the selected mode, perform a different action. *) + match mode with + | None -> + eprintf "whenjobs: no operation selected.\n"; + suggest_help (); + exit 1 + + | Some `Edit -> + unused_error args "-e"; + edit_file () + + | Some `List -> + unused_error args "-l"; + list_file () + + | Some `Upload -> + unused_error args "--upload"; + upload_file () + + | Some `Set -> + if List.length args != 2 then ( + eprintf "whenjobs --set variable value\n"; + eprintf "If 'value' contains spaces, you may need to quote it.\n"; + suggest_help (); + exit 1 + ); + set_variable (List.hd args) (List.hd (List.tl args)) typ + + | Some `Get -> + if List.length args != 1 then ( + eprintf "whenjobs --get variable\n"; + suggest_help (); + exit 1 + ); + get_variable (List.hd args) + + | Some `Variables -> + unused_error args "--variables"; + list_variables () + + | Some `Daemon_start -> + unused_error args "--daemon-start"; + daemon_start () + + | Some `Daemon_stop -> + unused_error args "--daemon-stop"; + daemon_stop () + + | Some `Daemon_restart -> + unused_error args "--daemon-restart"; + daemon_restart () + + | Some `Daemon_status -> + unused_error args "--daemon-status"; + daemon_status () + +and edit_file () = + (* If there is no initial file, create an empty one containing the + * tutorial. + *) + let file = get_jobs_filename () in + if not (Sys.file_exists file) then + create_tutorial file; + + (* Is $EDITOR set? If not, use a default. *) + let editor = try getenv "EDITOR" with Not_found -> "vi" in + + (* Get the (size, MD5) of the file to tell if it changed. *) + let file_stamp () = + try (lstat file).st_size, Digest.file file + with Unix_error (err, fn, _) -> + eprintf "whenjobs: %s: %s: %s\n" fn file (error_message err); + exit 1 + in + let old_stamp = file_stamp () in + + let cmd = sprintf "%s %s" editor file in + if Sys.command cmd != 0 then ( + eprintf "whenjobs: error editing file (is $EDITOR set correctly?)\n"; + exit 1 + ); + + let new_stamp = file_stamp () in + + if old_stamp <> new_stamp then + upload_file () + +and list_file () = + let file = get_jobs_filename () in + if not (Sys.file_exists file) then ( + eprintf "whenjobs: there is no jobs file, use 'whenjobs -e' to create one\n"; + exit 1 + ); + let chan = open_in file in + let rec loop () = + printf "%s\n" (input_line chan); + loop () + in + (try loop () with End_of_file -> ()); + close_in chan + +and upload_file () = + (* Recompile the jobs file. *) + let file = get_jobs_filename () in + let cmo_file = sprintf "%s/jobs.cmo" jobsdir in + let cmd = sprintf "ocamlfind ocamlc -I +camlp4 -I %s -package unix,camlp4.lib -pp 'camlp4o %s/pa_when.cmo' -c %s -o %s" + !libdir !libdir file cmo_file in + if Sys.command cmd <> 0 then ( + eprintf "whenjobs: could not compile jobs script, see earlier error messages\n"; + eprintf "compile command was:\n%s\n" cmd; + exit 1 + ); + + (* Test-load the jobs file to ensure it makes sense. *) + Whenfile.init (); + (try + Dynlink.loadfile cmo_file + with + Dynlink.Error err -> + eprintf "whenjobs: %s\n" (Dynlink.error_message err); + (* Since it failed, unlink it. *) + (try unlink cmo_file with Unix_error _ -> ()); + exit 1 + ); + + (* OK now let's tell the daemon to reload it. *) + let client = start_client () in + (match Whenproto_clnt.When.V1.reload_file client () with + | `ok -> () + | `error msg -> + eprintf "whenjobs: reload: %s\n" msg; + suggest_check_server_logs (); + exit 1 + ); + stop_client client + +and set_variable name value typ = + let value = match typ with + | `Bool -> + (match value with + | "true"|"t"|"yes"|"y"|"on"|"1" -> `bool_t true + | "false"|"f"|"no"|"n"|"off"|"0" -> `bool_t false + | _ -> + eprintf "whenjobs: variable does not have a boolean value\n"; + exit 1 + ) + | `String -> `string_t value + | `Int -> + (try ignore (big_int_of_string value) + with Failure _ -> + eprintf "whenjobs: variable is not an integer\n"; + exit 1 + ); + `int_t value (* the string is what we pass over the wire *) + | `Float -> + (try `float_t (float_of_string value) + with Failure _ -> + eprintf "whenjobs: variable is not a floating point number\n"; + exit 1 + ) in + + let client = start_client () in + Whenproto_clnt.When.V1.set_variable client (name, value); + stop_client client + +and get_variable name = + let client = start_client () in + let value = Whenproto_clnt.When.V1.get_variable client name in + print_endline (string_of_variable value); + stop_client client + +and list_variables () = + let client = start_client () in + let names = Whenproto_clnt.When.V1.get_variable_names client () in + Array.iter ( + fun name -> + let value = Whenproto_clnt.When.V1.get_variable client name in + printf "%s=%s\n" name (string_of_variable value) + ) names; + stop_client client + +and daemon_start () = + assert false + +and daemon_stop () = + assert false + +and daemon_restart () = + assert false + +and daemon_status () = + assert false + +and unused_error args op = + if args <> [] then ( + eprintf "whenjobs %s: unused parameters on the command line.\n" op; + suggest_help (); + exit 1 + ) + +and suggest_help () = + eprintf "Use 'whenjobs --help' for a summary of options or read whenjobs(1) man page.\n" + +and suggest_check_server_logs () = + eprintf "Look at the server logs (/var/log/cron or /var/log/syslog usually) for\n"; + eprintf "further information on why this daemon operation failed.\n" + +and get_jobs_filename () = + sprintf "%s/jobs.ml" jobsdir + +and create_tutorial file = + let chan = open_out file in + output_string chan Tutorial.tutorial; + close_out chan + +and start_client () = + let addr = sprintf "%s/socket" jobsdir in + let client = + try + Whenproto_clnt.When.V1.create_client + (Rpc_client.Unix addr) + Rpc.Tcp (* not TCP, this is the same as SOCK_STREAM *) + with + | Unix_error ((ECONNREFUSED|ENOENT), _, _) -> + eprintf "whenjobs: error: the daemon ('whenjobsd') is not running\n"; + eprintf "Use 'whenjobs --daemon-start' to start the daemon.\n"; + exit 1 + | Unix_error (err, fn, _) -> + eprintf "whenjobs: %s: %s: %s\n" fn addr (error_message err); + exit 1 in + client + +and stop_client client = + Rpc_client.shut_down client + +and string_of_variable = function + | `bool_t b -> string_of_bool b + | `string_t s -> s + | `int_t i -> i (* passed on the wire as a string *) + | `float_t f -> string_of_float f + +let () = + try main () + with + (* Pretty print some of the exceptions that main can throw. *) + | Rpc.Rpc_server err -> + eprintf "whenjobs: rpc error: %s\n" (Rpc.string_of_server_error err); + suggest_check_server_logs (); + exit 1 + | Failure msg -> + eprintf "whenjobs: error: %s\n" msg; + exit 1 + | Invalid_argument msg -> + eprintf "whenjobs: invalid argument: %s\n" msg; + exit 1 + | exn -> + eprintf "whenjobs: error: %s\n" (Printexc.to_string exn); + exit 1 diff --git a/tools/whenjobs.pod b/tools/whenjobs.pod new file mode 100644 index 0000000..99c38cf --- /dev/null +++ b/tools/whenjobs.pod @@ -0,0 +1,215 @@ +=encoding utf8 + +=head1 NAME + +whenjobs - A powerful but simple cron replacement + +=head1 SYNOPSIS + +Editing the jobs script: + + whenjobs -e | --edit + whenjobs -l | --list + +Get and set variables: + + whenjobs --get variable + whenjobs --set variable value [--type bool|int|float|string] + whenjobs --variables + +Start and stop the per-user daemon: + + whenjobs --daemon-start + whenjobs --daemon-stop + whenjobs --daemon-status + whenjobs --daemon-restart + +=head1 DESCRIPTION + +Whenjobs is a powerful but simple replacement for cron. It lets you +run jobs periodically like cron, but it also lets you trigger jobs to +run when user-defined variables are set or change value. + +Periodic jobs are written like this: + + every 10 minutes : + << + # Get the current load average. + load=`awk '{print $1}' /proc/loadavg` + whenjobs --set load $load --type float + >> + +When-statements let you create jobs that run based on variables set +elsewhere: + + when load >= 6 : + << + mail -s "ALERT: high load average: $load" $LOGNAME < /dev/null + >> + +(When statements are "edge-triggered", meaning that this job will only +run when the load goes from under 6 to E 6). + +Like L, whenjobs are controlled by a jobs file which can +be edited from the command line: + + $ whenjobs -e + +Whenjobs uses a daemon called L. Unlike crond, this +daemon runs as the same user. Each user who wants to use whenjobs +starts their own daemon: + + $ whenjobs --daemon-start + +You can also have the daemon start as you when the machine boots by +adding the following line to a boot file such as C. +Replace C with your username: + + su username -c /usr/sbin/whenjobsd + +Variables are the key to expressing dependencies between whenjobs. +Variables are stored (per-user) in the daemon. You can use the +command line tool to examine and set variables: + + $ whenjobs --variables + load=0.9 + $ whenjobs --set cat sushi + $ whenjobs --get cat + sushi + +The act of setting a variable (using I<--set>) can trigger jobs to run. + +=head1 OPTIONS + +=over 4 + +=item B<--daemon-start> + +=item B<--daemon-stop> + +Start and stop the per-user daemon. + +=item B<--daemon-status> + +Prints the status of the daemon: C or C. + +=item B<--daemon-restart> + +Restart the daemon. (If it is not running, then this command +starts it). + +=item B<-e> + +=item B<--edit> + +Edit the jobs script. If you make changes to the jobs script, then it +is automatically uploaded to the daemon. + +The C<$EDITOR> environment variable is used for editing. If not set, +C is used. + +=item B<--get> variable + +Print the value of a variable. + +=item B<-l> + +=item B<--list> + +List the jobs script. + +=item B<--lib> directory + +Set the library directory which needs to contain the auxiliary files +C and C. Normally you do not need to +specify this. However if you are running whenjobs without installing +it, then you need to point this to the C directory from the +source, eg: + + whenjobs --lib $builddir/lib -e + +=item B<--set> variable value + +=item B<--type> bool|int|float|string + +I<--set> sets the variable named C to the new C. The +variable is created if it does not already exist. Note that setting a +variable can cause jobs to run immediately. + +To unset a variable, set it to the empty string: + + whenjobs --set var "" + +By default variables are untyped (more precisely, they are treated as +strings). You can also set the type of a variable when setting it by +adding the optional I<--type> parameter: + + whenjobs --set free_space 10000 --type int + +See the discussion of variable types in the L section +below. + +=item B<--upload> + +Compile the jobs script and upload it to the daemon, without editing. +Note that the I<--edit> option does this automatically. Furthermore, +when the daemon is started it checks for a jobs script and loads it if +found. + +=item B<--variables> + +Display all the variables and their values, in the format C. + +=item B<-V> + +=item B<--version> + +Display the name and version of the program and exit. + +=item B<-help> + +=item B<--help> + +Display brief usage and exit. + +=back + +=head1 REFERENCE + + + + + +=head1 FILES + + + +=head1 ENVIRONMENT VARIABLES + + + +=head1 SEE ALSO + +L + +=head1 AUTHOR + +Richard W.M. Jones L + +=head1 COPYRIGHT + +Copyright (C) 2012 Red Hat 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 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, write to the Free Software +Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. diff --git a/whenjobs.spec.in b/whenjobs.spec.in new file mode 100644 index 0000000..70b85fb --- /dev/null +++ b/whenjobs.spec.in @@ -0,0 +1,75 @@ +%define opt %(test -x %{_bindir}/ocamlopt && echo 1 || echo 0) +%define debug_package %{nil} + +Name: @PACKAGE_NAME@ +Version: @PACKAGE_VERSION@ +Release: 1 +Summary: Replacement for cron with dependencies + +Group: Development/Libraries +License: GPLv2+ +URL: http://people.redhat.com/~rjones/whenjobs +Source0: http://people.redhat.com/~rjones/whenjobs/files/%{name}-%{version}.tar.gz + +BuildRequires: ocaml >= 3.12.0 +BuildRequires: ocaml-ocamldoc +BuildRequires: ocaml-findlib-devel +BuildRequires: ocaml-calendar-devel >= 2 +BuildRequires: ocaml-ocamlnet-devel >= 3 +BuildRequires: ocaml-camlp4-devel + +# For building manual pages. +BuildRequires: /usr/bin/perldoc + +# Requires camlp4 and ocamlfind at runtime. +Requires: /usr/bin/ocamlc +Requires: ocaml-camlp4-devel +Requires: ocaml-findlib-devel + + +%description +Whenjobs is a powerful but simple cron replacement. + +Two key advantages over cron are a simpler syntax for writing rules +and a powerful dependency system that lets one job depend on variables +set when other jobs run (allowing, for example, one job to run only +when another job has finished successfully). + + +%prep +%setup -q + + +%build +%configure +make %{?_smp_mflags} + + +%check +make check + + +%install +rm -rf $RPM_BUILD_ROOT + +make DESTDIR=$RPM_BUILD_ROOT install + + +%clean +rm -rf $RPM_BUILD_ROOT + + +%files +%defattr(-,root,root,-) +%doc COPYING README +%{_bindir}/whenjobs +%{_sbindir}/whenjobsd +%{_libdir}/whenjobs/pa_when.cmo +%{_libdir}/whenjobs/whenlib.cma +%{_mandir}/man1/*.1* +%{_mandir}/man8/*.8* + + +%changelog +* Fri Feb 17 2012 Richard W.M. Jones - @PACKAGE_VERSION@-1 +- Initial release. -- 1.8.3.1