From f3db678247d4ccc04c6ca1655e2eeec17e1bc169 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Thu, 23 Feb 2012 16:08:53 +0000 Subject: [PATCH 1/1] Implement cleanup functions, including 'mailto'. --- configure.ac | 6 ++++ daemon/daemon.ml | 36 +++++++++++++++++-- lib/config.ml.in | 2 ++ lib/config.mli | 2 ++ lib/pa_when.ml | 32 ++++++++++++----- lib/whenexpr.ml | 10 ++++++ lib/whenexpr.mli | 12 +++++++ lib/whenfile.ml | 8 ++--- lib/whenfile.mli | 8 +++-- lib/whentools.ml | 31 +++++++++++++++- lib/whentools.mli | 5 +++ tests/parsing/Makefile.am | 7 +++- tests/parsing/t050_cleanups.ml | 26 ++++++++++++++ tools/whenjobs.pod | 81 ++++++++++++++++++++++++++++++++++++++++++ whenjobs.spec.in | 3 ++ 15 files changed, 249 insertions(+), 20 deletions(-) create mode 100644 tests/parsing/t050_cleanups.ml diff --git a/configure.ac b/configure.ac index 0185eba..6124e51 100644 --- 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 +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 diff --git a/daemon/daemon.ml b/daemon/daemon.ml index 542c7a4..9e972ac 100644 --- 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. *) - 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; @@ -333,6 +333,13 @@ and run_job job = 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, _) -> @@ -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; - cleanup_job job dir + cleanup_job job dir status ) 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) diff --git a/lib/config.ml.in b/lib/config.ml.in index f892549..4ecc3a4 100644 --- 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 mailx = "@MAILX@" diff --git a/lib/config.mli b/lib/config.mli index 54b98db..79fb955 100644 --- a/lib/config.mli +++ b/lib/config.mli @@ -18,3 +18,5 @@ 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 --- 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$) >> +(* 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 @@ -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 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 cleanup = expr_of_option _loc cleanup in 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 @@ -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. *) -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 - Whenfile.add_when_job $loc$ $name$ $e$ $sh$ + Whenfile.add_when_job $loc$ $name$ $cleanup$ $e$ $sh$ >> (* 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 - Whenfile.add_every_job $loc$ $name$ $period$ $sh$ + Whenfile.add_every_job $loc$ $name$ $cleanup$ $period$ $sh$ >> let () = @@ -203,6 +209,11 @@ EXTEND Gram | [ e = period_parser -> e ] ]; + (* Cleanup function. *) + cleanup: [ + [ "cleanup"; f = expr -> f ] + ]; + (* 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" [ - [ 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 diff --git a/lib/whenexpr.ml b/lib/whenexpr.ml index 4e46968..f1f2a89 100644 --- a/lib/whenexpr.ml +++ b/lib/whenexpr.ml @@ -83,6 +83,15 @@ type shell_script = { 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 @@ -113,6 +122,7 @@ type job_cond = type job = { job_loc : Loc.t; job_name : string; + job_cleanup : cleanup option; job_cond : job_cond; job_script : shell_script; } diff --git a/lib/whenexpr.mli b/lib/whenexpr.mli index 7d1c2de..437192f 100644 --- a/lib/whenexpr.mli +++ b/lib/whenexpr.mli @@ -60,6 +60,17 @@ type 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 @@ -83,6 +94,7 @@ type job_cond = type job = { job_loc : Camlp4.PreCast.Loc.t; job_name : string; + job_cleanup : cleanup option; job_cond : job_cond; job_script : shell_script; } diff --git a/lib/whenfile.ml b/lib/whenfile.ml index 1617c29..83e0a07 100644 --- a/lib/whenfile.ml +++ b/lib/whenfile.ml @@ -25,14 +25,14 @@ let state = ref Whenstate.empty 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 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 -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 diff --git a/lib/whenfile.mli b/lib/whenfile.mli index a66f865..7883fa7 100644 --- 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 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. @@ -33,11 +33,13 @@ val add_when_job : Camlp4.PreCast.Loc.t -> string -> Camlp4.PreCast.Ast.expr -> [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). *) -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. @@ -45,6 +47,8 @@ val add_every_job : Camlp4.PreCast.Loc.t -> string -> Whenexpr.periodexpr -> Whe [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. *) diff --git a/lib/whentools.ml b/lib/whentools.ml index 979124f..cac698a 100644 --- a/lib/whentools.ml +++ b/lib/whentools.ml @@ -16,9 +16,11 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) -open Big_int open Whenexpr +open Big_int +open Printf + 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) + +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 0 then + failwith "Whentools.mailto: mailx command failed"; + ) diff --git a/lib/whentools.mli b/lib/whentools.mli index 8dd88cd..f2cefb6 100644 --- 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}). *) + +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 --- a/tests/parsing/Makefile.am +++ b/tests/parsing/Makefile.am @@ -17,7 +17,12 @@ 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) diff --git a/tests/parsing/t050_cleanups.ml b/tests/parsing/t050_cleanups.ml new file mode 100644 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 --- 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 +=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 statement). Put C +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 struct, +defined below. + =head3 WHENTOOLS LIBRARY +=head4 Functions + =over 4 +=item B [I<~only_on_failure:true>] +[I<~from:from_address>] I I + +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 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 I I Set variable I to the string. @@ -591,6 +654,24 @@ Set variable I to the floating point value I. =back +=head4 Structures + +=over 4 + +=item B + +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 diff --git a/whenjobs.spec.in b/whenjobs.spec.in index e94e69b..f9ee961 100644 --- 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 mailx for sending email. +Requires: /usr/bin/mailx + %description Whenjobs is a powerful but simple cron replacement. -- 1.8.3.1