From aa32ee4513449868d5c47a31df66a9ffabd26cba Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Thu, 26 Sep 2013 14:33:54 +0100 Subject: [PATCH] Implement: onfail, onsuccess, onrun, log_program_output, mailto. These allow comprehensive error handling and logging. --- TODO | 7 +++--- configure.ac | 6 +++++ goaljobs-reference.pod | 64 ++++++++++++++++++++++++++++++++++++++++++++++++++ goaljobs.ml | 21 +++++++++++++++++ goaljobs.mli | 22 +++++++++++++++++ goaljobs.spec.in | 4 ++++ goaljobs_config.ml.in | 2 ++ pa_goal.ml | 39 +++++++++++++++++++++++++++++- 8 files changed, 160 insertions(+), 5 deletions(-) diff --git a/TODO b/TODO index f0dfa93..f68c098 100644 --- a/TODO +++ b/TODO @@ -1,12 +1,11 @@ Enhancements to pa_goal: - - Include the goal name, source file location in the generated - rule so we can improve error messages. + - Include the source file location in the generated goal code so we + can improve error messages. - Implement some sort of tracing based on the above. -It should be possible to register goal "atexit [of goal]" handlers. -These only run when the goal successfully exits, allowing: +Now that we have 'onrun' handlers, can we do the following on goal exit: - implicit memory_set diff --git a/configure.ac b/configure.ac index ebc5cfd..9754b5b 100644 --- a/configure.ac +++ b/configure.ac @@ -106,6 +106,12 @@ fi AM_CONDITIONAL([HAVE_POD2MAN], [test "x$POD2MAN" != "xno"]) +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([goaljobs_config.ml goaljobs.spec diff --git a/goaljobs-reference.pod b/goaljobs-reference.pod index 7912568..393e4b5 100644 --- a/goaljobs-reference.pod +++ b/goaljobs-reference.pod @@ -180,6 +180,70 @@ program: cc %s -o %s " object program +=head1 SPECIAL VALUES INSIDE GOALS + +=head2 goalname + +Inside goals, you can use C to get the name of the goal, ie: + + let goal foo () = + printf "my name is %s\n" goalname + +would print: + + my name is foo + +=head2 onfail, onsuccess, onrun + +Inside goals you can register function(s) which run if the goal +completes successfully (C), if the goal completes +successfully after running to the end (C), or if the goal fails +(C). + +For example: + + let goal built () = + onfail (fun _ -> eprintf "goal '%s' failed\n" goalname); + sh " + cc -o program main.o + " + +If the shell command (or another part of the goal) fails, then this +would print out: + + goal 'built' failed + +The single parameter passed to C is the exception that was +thrown. + +Note that the helper function C is a useful function +to call from an C handler: + + let from = "me@example.com" + let to_ = "you@example.com" + let logfile = log_program_output () + + let goal built () = + onfail (fun _ -> + let subject = sprintf "goal: %s: BUILD FAILED" goalname in + mailto ~from ~subject ~attach:[logfile] to_); + sh " + cc -o program main.o + " + +C and C are slightly different from C and +from each other: + +C functions can be called if a C condition is met +and the rest of the goal is short-circuited. C will only be +called if all the instructions in the goal actually run and succeed. + +The single unit C<()> parameter is passed to the C and +C functions. + +You can register as many functions as you want for each handler. The +order in which the functions are called is not defined. + =head1 PERIODIC JOBS If you want to have a goal that runs when some outside event happens diff --git a/goaljobs.ml b/goaljobs.ml index 489f387..9688a9c 100644 --- a/goaljobs.ml +++ b/goaljobs.ml @@ -403,6 +403,27 @@ let publish name fn = published_goals := (name, fn) :: !published_goals let get_goal name = try Some (List.assoc name !published_goals) with Not_found -> None +let log_program_output () = + let filename = Filename.temp_file "goaljobslog" ".txt" in + let cmd = "tee " ^ quote filename in + let chan = open_process_out cmd in + let fd = descr_of_out_channel chan in + dup2 fd stdout; + dup2 fd stderr; + filename + +let mailto ?from ~subject ?(attach = []) to_ = + let cmd = ref (sprintf "%s -s %s" mailx (quote subject)) in + (match from with + | None -> () + | Some f -> cmd := !cmd ^ " -r " ^ quote f + ); + List.iter ( + fun a -> cmd := !cmd ^ " -a " ^ quote a + ) attach; + if Sys.command !cmd <> 0 then + goal_failed "mailto: could not send email" + let goal_file_exists filename = if not (file_exists filename) then ( let msg = sprintf "file '%s' required but not found" filename in diff --git a/goaljobs.mli b/goaljobs.mli index c1dff52..a6361c5 100644 --- a/goaljobs.mli +++ b/goaljobs.mli @@ -296,6 +296,28 @@ val publish : string -> (string list -> unit) -> unit the place to perform string to int conversion, checks, and so on (remember that OCaml is strongly typed). *) +(** {2 Logging script output} *) + +val log_program_output : unit -> string + (** [log_program_output] should be called at most once, usually at + the top-level of the script. It creates a temporary file + and redirects stdout and stderr into this file (they are still + sent to the ordinary output, so it acts like [tee]). The + filename of the temporary file is returned. *) + +(** {2 Sending email} *) + +val mailto : ?from:string -> subject:string -> ?attach:string list-> string -> unit + (** Send email. + + Optional [?from] is the sender email address. + + Required [~subject] is the subject line. + + Optional [?attach] is a list of attachments (filenames). + + The bare argument is the destination email address. *) + (**/**) (* Goal versions of some common functions. You are using these diff --git a/goaljobs.spec.in b/goaljobs.spec.in index 04ed74c..af8db09 100644 --- a/goaljobs.spec.in +++ b/goaljobs.spec.in @@ -19,6 +19,9 @@ BuildRequires: ocaml-calendar-devel # For building manual pages. BuildRequires: perl-podlators +# For sending email. +BuildRequires: mailx + # Requires camlp4 and ocamlfind and libraries at runtime. Requires: /usr/bin/ocamlc Requires: ocaml-camlp4-devel @@ -26,6 +29,7 @@ Requires: ocaml-findlib-devel Requires: ocaml-calendar-devel Requires: curl +Requires: mailx %description Goaljobs is make & cron replacement and business rules manager. diff --git a/goaljobs_config.ml.in b/goaljobs_config.ml.in index 38f8146..812fa42 100644 --- a/goaljobs_config.ml.in +++ b/goaljobs_config.ml.in @@ -19,3 +19,5 @@ let package_name = "@PACKAGE_NAME@" let package_version = "@PACKAGE_VERSION@" + +let mailx = "@MAILX" diff --git a/pa_goal.ml b/pa_goal.ml index 86f67db..e795233 100644 --- a/pa_goal.ml +++ b/pa_goal.ml @@ -84,7 +84,44 @@ let generate_let_goal _loc (r : rec_flag) (lets : binding) = ); (* Put a try-clause around the body. *) - let body = <:expr< try $body$ with Goal_result Goal_OK -> () >> in + let body = <:expr< + (* Define a goal name which the body may use. *) + let goalname = $str:name$ in + (* Define onsuccess, onrun, onfail functions that the body may call. *) + let _on, _call_on = + let _on fns f = fns := f :: !fns in + let _call_on fns a = List.iter (fun f -> f a) !fns in + _on, _call_on + in + let onfail, _call_onfails = + let fns = ref [] in (_on fns), (_call_on fns) + in + let onrun, _call_onruns = + let fns = ref [] in (_on fns), (_call_on fns) + in + let onsuccess, _call_onsuccesses = + let fns = ref [] in (_on fns), (_call_on fns) + in + + try + $body$ ; + _call_onruns (); + _call_onsuccesses (); + + (* Avoid a compiler warning: *) + ignore (goalname) + with + (* target() within the body may raise Goal_OK meaning that the + * goal should be short-circuited. We return as if it's an + * ordinary function exit. + *) + | Goal_result Goal_OK -> + _call_onsuccesses (); + () + | exn -> + _call_onfails exn; + raise exn + >> in (* Recreate the function with parameters. *) let expr = -- 1.8.3.1