Implement cleanup functions, including 'mailto'.

diff --git a/configure.ac b/configure.ac
index 0185eba..6124e51 100644 (file)
--- a/configure.ac
+++ b/configure.ac
@@ -105,6 +105,12 @@ if test "x$PERLDOC" = "x"; then
     AC_MSG_ERROR([You must install the perldoc program])
 fi
 
     AC_MSG_ERROR([You must install the perldoc program])
 fi
 

+dnl Check for mailx (for sending email).
+AC_CHECK_PROG(MAILX,mailx,mailx)
+if test "x$MAILX" = "x"; then
+    AC_MSG_ERROR([You must install the mailx program])
+fi
+

 AC_CONFIG_HEADERS([config.h])
 AC_CONFIG_FILES([Makefile
                  daemon/Makefile
 AC_CONFIG_HEADERS([config.h])
 AC_CONFIG_FILES([Makefile
                  daemon/Makefile

diff --git a/daemon/daemon.ml b/daemon/daemon.ml
index 542c7a4..9e972ac 100644 (file)
--- a/daemon/daemon.ml
+++ b/daemon/daemon.ml
@@ -324,7 +324,7 @@ and run_job job =
     putenv "JOBNAME" job.job_name;
 
     (* Create a temporary file containing the shell script fragment. *)
     putenv "JOBNAME" job.job_name;
 
     (* Create a temporary file containing the shell script fragment. *)

-    let script = dir // "script" in
+    let script = dir // "script.sh" in

     let chan = open_out script in
     fprintf chan "set -e\n"; (* So that jobs exit on error. *)
     output_string chan job.job_script.sh_script;
     let chan = open_out script in
     fprintf chan "set -e\n"; (* So that jobs exit on error. *)
     output_string chan job.job_script.sh_script;


@@ -333,6 +333,13 @@ and run_job job =
 
     let shell = try getenv "SHELL" with Not_found -> "/bin/sh" in
 
 
     let shell = try getenv "SHELL" with Not_found -> "/bin/sh" in
 

+    (* Set output to file. *)
+    let output = dir // "output.txt" in
+    let fd = openfile output [O_WRONLY; O_CREAT; O_TRUNC; O_NOCTTY] 0o600 in
+    dup2 fd stdout;
+    dup2 fd stderr;
+    close fd;
+

     (* Execute the shell script. *)
     (try execvp shell [| shell; "-c"; script |];
      with Unix_error (err, fn, _) ->
     (* Execute the shell script. *)
     (try execvp shell [| shell; "-c"; script |];
      with Unix_error (err, fn, _) ->


@@ -364,11 +371,34 @@ and handle_sigchld _ =
       (* Look up the PID in the running jobs map. *)
       let job, dir = IntMap.find pid !running in
       running := IntMap.remove pid !running;
       (* Look up the PID in the running jobs map. *)
       let job, dir = IntMap.find pid !running in
       running := IntMap.remove pid !running;

-      cleanup_job job dir
+      cleanup_job job dir status

     )
   with Unix_error _ | Not_found -> ()
 
     )
   with Unix_error _ | Not_found -> ()
 

-and cleanup_job job dir =
+and cleanup_job job dir status =
+  (* If there is a cleanup function, run it. *)
+  (match job.job_cleanup with
+  | None -> ()
+  | Some cleanup ->
+    let code =
+      match status with
+      | WEXITED c -> c
+      | WSIGNALED s | WSTOPPED s -> 1 in
+    let result = {
+      res_job_name = job.job_name;
+      res_code = code;
+      res_tmpdir = dir;
+      res_output = dir // "output.txt"
+    } in
+    try cleanup result
+    with
+    | Failure msg ->
+      Syslog.error "job %s cleanup function failed: %s" job.job_name msg
+    | exn ->
+      Syslog.error "job %s cleanup function exception: %s"
+        job.job_name (Printexc.to_string exn)
+  );
+

   (* This should be safe because the path cannot contain shell metachars. *)
   let cmd = sprintf "rm -rf '%s'" dir in
   ignore (Sys.command cmd)
   (* This should be safe because the path cannot contain shell metachars. *)
   let cmd = sprintf "rm -rf '%s'" dir in
   ignore (Sys.command cmd)

diff --git a/lib/config.ml.in b/lib/config.ml.in
index f892549..4ecc3a4 100644 (file)
--- a/lib/config.ml.in
+++ b/lib/config.ml.in
@@ -18,3 +18,5 @@
 
 let package_name = "@PACKAGE_NAME@"
 let package_version = "@PACKAGE_VERSION@"
 
 let package_name = "@PACKAGE_NAME@"
 let package_version = "@PACKAGE_VERSION@"

+
+let mailx = "@MAILX@"

diff --git a/lib/config.mli b/lib/config.mli
index 54b98db..79fb955 100644 (file)
--- a/lib/config.mli
+++ b/lib/config.mli
@@ -18,3 +18,5 @@
 
 val package_name : string
 val package_version : string
 
 val package_name : string
 val package_version : string

+
+val mailx : string

diff --git a/lib/pa_when.ml b/lib/pa_when.ml
index 6e0592d..2d82cb3 100644 (file)
--- a/lib/pa_when.ml
+++ b/lib/pa_when.ml
@@ -75,6 +75,11 @@ let expr_of_loc _loc loc =
      $`int:stop_line$, $`int:stop_bol$, $`int:stop_off$,
      $`bool:ghost$) >>
 
      $`int:stop_line$, $`int:stop_bol$, $`int:stop_off$,
      $`bool:ghost$) >>
 

+(* Convert 'expr option' to an expression that contains the option inside. *)
+let expr_of_option _loc = function
+  | None -> <:expr< None >>
+  | Some e -> <:expr< Some $e$ >>
+

 (* "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
 (* "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


@@ -83,14 +88,15 @@ module M = Ast.Meta.Make (Ast.Meta.MetaGhostLoc)
 let lift_expr = M.Expr.meta_expr
 
 (* Handle a top level statement. *)
 let lift_expr = M.Expr.meta_expr
 
 (* Handle a top level statement. *)

-let rec call_stmt name (_loc, stmt, sh) =
+let rec call_stmt name cleanup (_loc, stmt, sh) =

   let name =
     match name with
     | None -> let name = unique_job_name () in <:expr< $str:name$ >>
     | Some name -> name in
   let name =
     match name with
     | None -> let name = unique_job_name () in <:expr< $str:name$ >>
     | Some name -> name in

+  let cleanup = expr_of_option _loc cleanup in

   match stmt with
   match stmt with

-  | `When e -> when_stmt _loc name e sh
-  | `Every p -> every_stmt _loc name p sh
+  | `When e -> when_stmt _loc name cleanup e sh
+  | `Every p -> every_stmt _loc name cleanup p sh

 
 (* Handle a top level "when" statement.
  * e -> when expression
 
 (* Handle a top level "when" statement.
  * e -> when expression


@@ -98,20 +104,20 @@ let rec call_stmt name (_loc, stmt, sh) =
  * Returns a top level statement (str_item) which when executed just
  * adds the statement to a global list.
  *)
  * 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 =
+and when_stmt _loc name cleanup e sh =

   let loc = expr_of_loc _loc _loc in
   let e = lift_expr _loc e in
   <:str_item<
     open Camlp4.PreCast
   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$
+    Whenfile.add_when_job $loc$ $name$ $cleanup$ $e$ $sh$

   >>
 
 (* Handle a top level "every" statement. *)
   >>
 
 (* Handle a top level "every" statement. *)

-and every_stmt _loc name period sh =
+and every_stmt _loc name cleanup period sh =

   let loc = expr_of_loc _loc _loc in
   <:str_item<
     open Camlp4.PreCast
   let loc = expr_of_loc _loc _loc in
   <:str_item<
     open Camlp4.PreCast

-    Whenfile.add_every_job $loc$ $name$ $period$ $sh$
+    Whenfile.add_every_job $loc$ $name$ $cleanup$ $period$ $sh$

   >>
 
 let () =
   >>
 
 let () =


@@ -203,6 +209,11 @@ EXTEND Gram
   | [ e = period_parser -> e ]
   ];
 
   | [ e = period_parser -> e ]
   ];
 

+  (* Cleanup function. *)
+  cleanup: [
+    [ "cleanup"; f = expr -> f ]
+  ];
+

   (* Top level statements. *)
   statement: [
     [ "when"; e = expr; ":"; sh = expr ->
   (* Top level statements. *)
   statement: [
     [ "when"; e = expr; ":"; sh = expr ->


@@ -213,8 +224,11 @@ EXTEND Gram
 
   (* "str_item" is a top level statement in an OCaml program. *)
   str_item: LEVEL "top" [
 
   (* "str_item" is a top level statement in an OCaml program. *)
   str_item: LEVEL "top" [

-    [ s = statement -> call_stmt None s ]
-  | [ "job"; name = expr; s = statement -> call_stmt (Some name) s ]
+    [ s = statement -> call_stmt None None s ]
+  | [ "job"; name = expr;
+      cleanup = OPT cleanup;
+      s = statement ->
+        call_stmt (Some name) cleanup s ]

   ];
 
 END
   ];
 
 END

diff --git a/lib/whenexpr.ml b/lib/whenexpr.ml
index 4e46968..f1f2a89 100644 (file)
--- a/lib/whenexpr.ml
+++ b/lib/whenexpr.ml
@@ -83,6 +83,15 @@ type shell_script = {
   sh_script : string;
 }
 
   sh_script : string;
 }
 

+type result = {
+  res_job_name : string;
+  res_code : int;
+  res_tmpdir : string;
+  res_output : string;
+}
+
+type cleanup = result -> unit
+

 type variable =
   | T_unit
   | T_bool of bool
 type variable =
   | T_unit
   | T_bool of bool


@@ -113,6 +122,7 @@ type job_cond =
 type job = {
   job_loc : Loc.t;
   job_name : string;
 type job = {
   job_loc : Loc.t;
   job_name : string;

+  job_cleanup : cleanup option;

   job_cond : job_cond;
   job_script : shell_script;
 }
   job_cond : job_cond;
   job_script : shell_script;
 }

diff --git a/lib/whenexpr.mli b/lib/whenexpr.mli
index 7d1c2de..437192f 100644 (file)
--- a/lib/whenexpr.mli
+++ b/lib/whenexpr.mli
@@ -60,6 +60,17 @@ type shell_script = {
 }
 (** A shell script. *)
 
 }
 (** A shell script. *)
 

+type result = {
+  res_job_name : string;                (** Job name. *)
+  res_code : int;                       (** Return code from the script. *)
+  res_tmpdir : string;                  (** Temporary directory. *)
+  res_output : string;                  (** Filename of output from job. *)
+}
+(** Result of the run of a job. *)
+
+type cleanup = result -> unit
+(** A cleanup function. *)
+

 type variable =
   | T_unit
   | T_bool of bool
 type variable =
   | T_unit
   | T_bool of bool


@@ -83,6 +94,7 @@ type job_cond =
 type job = {
   job_loc : Camlp4.PreCast.Loc.t;
   job_name : string;
 type job = {
   job_loc : Camlp4.PreCast.Loc.t;
   job_name : string;

+  job_cleanup : cleanup option;

   job_cond : job_cond;
   job_script : shell_script;
 }
   job_cond : job_cond;
   job_script : shell_script;
 }

diff --git a/lib/whenfile.ml b/lib/whenfile.ml
index 1617c29..83e0a07 100644 (file)
--- a/lib/whenfile.ml
+++ b/lib/whenfile.ml
@@ -25,14 +25,14 @@ let state = ref Whenstate.empty
 
 let init s = state := s
 
 
 let init s = state := s
 

-let add_when_job _loc name e sh =
+let add_when_job _loc name cleanup e sh =

   let e = expr_of_ast _loc e in
   let e = expr_of_ast _loc e in

-  let job = { job_loc = _loc; job_name = name;
+  let job = { job_loc = _loc; job_name = name; job_cleanup = cleanup;

               job_cond = When_job e; job_script = sh } in
   state := Whenstate.add_job !state job
 
               job_cond = When_job e; job_script = sh } in
   state := Whenstate.add_job !state job
 

-let add_every_job _loc name e sh =
-  let job = { job_loc = _loc; job_name = name;
+let add_every_job _loc name cleanup e sh =
+  let job = { job_loc = _loc; job_name = name; job_cleanup = cleanup;

               job_cond = Every_job e; job_script = sh } in
   state := Whenstate.add_job !state job
 
               job_cond = Every_job e; job_script = sh } in
   state := Whenstate.add_job !state job
 

diff --git a/lib/whenfile.mli b/lib/whenfile.mli
index a66f865..7883fa7 100644 (file)
--- a/lib/whenfile.mli
+++ b/lib/whenfile.mli
@@ -25,7 +25,7 @@ val init : Whenstate.t -> unit
 val get_state : unit -> Whenstate.t
 (** Return the updated state.  Call this after parsing the file. *)
 
 val get_state : unit -> Whenstate.t
 (** Return the updated state.  Call this after parsing the file. *)
 

-val add_when_job : Camlp4.PreCast.Loc.t -> string -> Camlp4.PreCast.Ast.expr -> Whenexpr.shell_script -> unit
+val add_when_job : Camlp4.PreCast.Loc.t -> string -> Whenexpr.cleanup option -> Camlp4.PreCast.Ast.expr -> Whenexpr.shell_script -> unit

 (** When a 'when' macro appears as a toplevel statement in an
     input file, it causes this function to be called.
 
 (** When a 'when' macro appears as a toplevel statement in an
     input file, it causes this function to be called.
 


@@ -33,11 +33,13 @@ val add_when_job : Camlp4.PreCast.Loc.t -> string -> Camlp4.PreCast.Ast.expr ->
 
     [name] is the name of the job.
 
 
     [name] is the name of the job.
 

+    [cleanup] is the optional cleanup function.
+

     [expr] is the expression, as an OCaml abstract syntax tree.
 
     [sh] is the shell script fragment (basically location + a big string). *)
 
     [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 -> Whenexpr.periodexpr -> Whenexpr.shell_script -> unit
+val add_every_job : Camlp4.PreCast.Loc.t -> string -> Whenexpr.cleanup option -> Whenexpr.periodexpr -> Whenexpr.shell_script -> unit

 (** When an 'every' macro appears as a toplevel statement in an
     input file, it causes this function to be called.
 
 (** When an 'every' macro appears as a toplevel statement in an
     input file, it causes this function to be called.
 


@@ -45,6 +47,8 @@ val add_every_job : Camlp4.PreCast.Loc.t -> string -> Whenexpr.periodexpr -> Whe
 
     [name] is the name of the job.
 
 
     [name] is the name of the job.
 

+    [cleanup] is the optional cleanup function.
+

     [periodexpr] is the period, eg. 30 seconds.
 
     [sh] is the shell script fragment. *)
     [periodexpr] is the period, eg. 30 seconds.
 
     [sh] is the shell script fragment. *)

diff --git a/lib/whentools.ml b/lib/whentools.ml
index 979124f..cac698a 100644 (file)
--- a/lib/whentools.ml
+++ b/lib/whentools.ml
@@ -16,9 +16,11 @@
  * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  *)
 
  * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  *)
 

-open Big_int

 open Whenexpr
 
 open Whenexpr
 

+open Big_int
+open Printf
+

 let set_variable name value =
   check_valid_variable_name name;
   Whenfile.set_variable name (T_string value)
 let set_variable name value =
   check_valid_variable_name name;
   Whenfile.set_variable name (T_string value)


@@ -36,3 +38,30 @@ let set_variable_string = set_variable
 let set_variable_float name value =
   check_valid_variable_name name;
   Whenfile.set_variable name (T_float value)
 let set_variable_float name value =
   check_valid_variable_name name;
   Whenfile.set_variable name (T_float value)

+
+type result = Whenexpr.result
+
+let mailto ?(only_on_failure = false) ?from email result =
+  if result.res_code <> 0 || not only_on_failure then (
+    let subject =
+      sprintf "%s: %s (return code %d)"
+        result.res_job_name
+        (if result.res_code = 0 then "successful" else "FAILED")
+        result.res_code in
+
+    let cmd = sprintf "%s -s %s -a %s"
+      Config.mailx
+      (Filename.quote subject)
+      (Filename.quote result.res_output) in
+
+    let cmd =
+      match from with
+      | None -> cmd
+      | Some from -> sprintf "%s -r %s" cmd from in
+
+    let cmd =
+      sprintf "%s %s </dev/null" cmd (Filename.quote email) in
+
+    if Sys.command cmd <> 0 then
+      failwith "Whentools.mailto: mailx command failed";
+  )

diff --git a/lib/whentools.mli b/lib/whentools.mli
index 8dd88cd..f2cefb6 100644 (file)
--- a/lib/whentools.mli
+++ b/lib/whentools.mli
@@ -33,3 +33,8 @@ val set_variable_string : string -> string -> unit
 
 val set_variable_float : string -> float -> unit
 (** Set variable (just a wrapper around {!Whenfile.set_variable}). *)
 
 val set_variable_float : string -> float -> unit
 (** Set variable (just a wrapper around {!Whenfile.set_variable}). *)

+
+type result = Whenexpr.result
+
+val mailto : ?only_on_failure:bool -> ?from:string -> string -> result -> unit
+(** Cleanup function to send mail. *)

diff --git a/tests/parsing/Makefile.am b/tests/parsing/Makefile.am
index cfc85cb..3f4f17c 100644 (file)
--- a/tests/parsing/Makefile.am
+++ b/tests/parsing/Makefile.am
@@ -17,7 +17,12 @@
 
 EXTRA_DIST = $(SOURCES) test_load.ml
 
 
 EXTRA_DIST = $(SOURCES) test_load.ml
 

-SOURCES = t010_load.ml t020_simple.ml t030_jobnames.ml t040_ocaml_jobnames.ml
+SOURCES = \
+       t010_load.ml \
+       t020_simple.ml \
+       t030_jobnames.ml \
+       t040_ocaml_jobnames.ml \
+       t050_cleanups.ml

 
 tests = $(SOURCES:.ml=.cmo)
 
 
 tests = $(SOURCES:.ml=.cmo)
 

diff --git a/tests/parsing/t050_cleanups.ml b/tests/parsing/t050_cleanups.ml
new file mode 100644 (file)
index 0000000..c88ee9e
--- /dev/null
+++ b/tests/parsing/t050_cleanups.ml
@@ -0,0 +1,26 @@
+(* 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.
+ *)
+
+(* Test cleanup functions. *)
+
+job "with cleanup"
+cleanup (Whentools.mailto "you@example.com")
+when true :
+<<
+  # nothing
+>>

diff --git a/tools/whenjobs.pod b/tools/whenjobs.pod
index 368f413..fd0a6e7 100644 (file)
--- a/tools/whenjobs.pod
+++ b/tools/whenjobs.pod
@@ -564,10 +564,73 @@ this example:
    Whentools.set_variable "name" "Richard";
    Whentools.set_variable_int "counter" 0
 
    Whentools.set_variable "name" "Richard";
    Whentools.set_variable_int "counter" 0
 

+=head3 CLEANUP FUNCTIONS
+
+After a job runs, you can control what happens to its output by
+writing a cleanup function.  To write a cleanup function you have to
+name the job (ie. have an explicit C<job> statement).  Put C<cleanup ...>
+after the job name like this:
+
+ job "poll source"
+ cleanup (Whentools.mailto "you@example.com")
+ every 10 seconds :
+ <<
+   # ...
+ >>
+
+A number of cleanup functions are available in the library; see below.
+
+You can also write your own cleanup functions (in OCaml).  The
+function is passed one argument which is a C<Whentools.result> struct,
+defined below.
+

 =head3 WHENTOOLS LIBRARY
 
 =head3 WHENTOOLS LIBRARY
 

+=head4 Functions
+

 =over 4
 
 =over 4
 

+=item B<Whentools.mailto> [I<~only_on_failure:true>]
+[I<~from:from_address>] I<email_address> I<result>
+
+Send the result of the script by email to the given email address.
+
+If the optional C<~only_on_failure:true> flag is set, then it is only
+sent out if the script failed.
+
+If the optional C<~from> flag is set, then the from address is set
+accordingly.  This is sometimes needed when sending mail.
+
+Note the C<result> parameter is passed implicitly by the daemon.  You
+do not need to add it.
+
+Here are some examples of using the mailto function:
+
+ job "ex.1"
+ cleanup (Whentools.mailto "you@example.com")
+ every 10 seconds :
+ <<
+   # do something
+ >>
+
+ job "ex.2"
+ cleanup (Whentools.mailto ~only_on_failure:true
+                           "you@example.com")
+ every 10 seconds :
+ <<
+   # do something
+ >>
+
+ let from = "me@example.com"
+ let to_addr = "you@example.com"
+ 
+ job "ex.3"
+ cleanup (Whentools.mailto ~from to_addr)
+ every 10 seconds :
+ <<
+   # do something
+ >>
+

 =item B<Whentools.set_variable> I<name> I<string>
 
 Set variable I<name> to the string.
 =item B<Whentools.set_variable> I<name> I<string>
 
 Set variable I<name> to the string.


@@ -591,6 +654,24 @@ Set variable I<name> to the floating point value I<f>.
 
 =back
 
 
 =back
 

+=head4 Structures
+
+=over 4
+
+=item B<Whentools.result>
+
+This structure is passed to cleanup functions.  It has the following
+fields:
+
+ type result = {
+   res_job_name : string; # job name
+   res_code : int;        # return code from the shell script
+   res_tmpdir : string;   # temporary directory script ran in
+   res_output : string;   # filename of stdout/stderr output
+ }
+
+=back
+

 =head1 FILES
 
 
 =head1 FILES
 
 

diff --git a/whenjobs.spec.in b/whenjobs.spec.in
index e94e69b..f9ee961 100644 (file)
--- a/whenjobs.spec.in
+++ b/whenjobs.spec.in
@@ -29,6 +29,9 @@ Requires:        /usr/bin/ocamlc
 Requires:        ocaml-camlp4-devel
 Requires:        ocaml-findlib-devel
 
 Requires:        ocaml-camlp4-devel
 Requires:        ocaml-findlib-devel
 

+# Requires mailx for sending email.
+Requires:        /usr/bin/mailx
+

 
 %description
 Whenjobs is a powerful but simple cron replacement.
 
 %description
 Whenjobs is a powerful but simple cron replacement.