.deps
*~
+*.cmi
+*.cmo
+*.cmx
+*.cma
+*.cmxa
*.o
Makefile.in
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
--- /dev/null
+ 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.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) <year> <name of author>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 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.
+
+ <signature of Ty Coon>, 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.
ACLOCAL_AMFLAGS = -I m4
-SUBDIRS = daemon tools
+EXTRA_DIST = COPYING README whenjobs.spec whenjobs.spec.in
+
+SUBDIRS = lib daemon tools tests/parsing
CLEANFILES = *~
--- /dev/null
+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 <rjones@redhat.com>.
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
# 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
--- /dev/null
+(* 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
--- /dev/null
+(* 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. *)
--- /dev/null
+(* 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
--- /dev/null
+(* 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
--- /dev/null
+/* 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 <config.h>
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <syslog.h>
+
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
+
+#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);
+}
--- /dev/null
+(* 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 ()
--- /dev/null
+=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</etc/rc.local>) for a
+particular user called C<username> do:
+
+ su username -c /usr/sbin/whenjobsd
+
+=head1 DESCRIPTION
+
+C<whenjobsd> 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<whenjobs(1)> 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<whenjobs(1)> 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<flock(2)>-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<whenjobs(1)> tool.
+
+=item C<$HOME/.whenjobs/socket>
+
+The daemon creates this socket and listens for incoming connections
+from the L<whenjobs(1)> 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<whenjobs(1)>
+
+=head1 AUTHOR
+
+Richard W.M. Jones L<http://people.redhat.com/~rjones/>
+
+=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.
--- /dev/null
+# 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
--- /dev/null
+(* 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@"
--- /dev/null
+/* 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 <config.h>
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <errno.h>
+#include <sys/file.h>
+
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
+#include <caml/fail.h>
+
+/* 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);
+}
--- /dev/null
+(* 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 "<NN> (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 <name>" 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
--- /dev/null
+(* 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
--- /dev/null
+(* 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. *)
--- /dev/null
+(* 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
--- /dev/null
+(* 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. *)
--- /dev/null
+/* 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<MAX_VARIABLE_NAME_LENGTH>;
+typedef string string_value<MAX_VARIABLE_VALUE_LENGTH>;
+
+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;
--- /dev/null
+(* 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
--- /dev/null
+(* 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. *)
--- /dev/null
+# 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
--- /dev/null
+(* 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 *)
--- /dev/null
+(* 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
+>>
--- /dev/null
+(* 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
+>>
--- /dev/null
+(* 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)
# 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
--- /dev/null
+(* 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 <period> : << >>' 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 <expr> : << >>' 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 </dev/null
+>>
+
+*)
+"
--- /dev/null
+(* 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
--- /dev/null
+=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<ge> 6).
+
+Like L<crontab(5)>, whenjobs are controlled by a jobs file which can
+be edited from the command line:
+
+ $ whenjobs -e
+
+Whenjobs uses a daemon called L<whenjobsd(8)>. 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</etc/rc.local>.
+Replace C<username> 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<up> or C<down>.
+
+=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<vi> 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<pa_when.cmo> and C<whenlib.cma>. 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<lib/> 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<variable> to the new C<value>. 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</REFERENCE> 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<name=value>.
+
+=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<whenjobsd(8)>
+
+=head1 AUTHOR
+
+Richard W.M. Jones L<http://people.redhat.com/~rjones/>
+
+=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.
--- /dev/null
+%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 <rjones@redhat.com> - @PACKAGE_VERSION@-1
+- Initial release.
git.annexia.org / whenjobs.git / commitdiff