let goal_failed msg = raise (Goal_result (Goal_failed msg))
+let depth = ref 0
+let indent fs =
+ let do_indent str =
+ prerr_string "| ";
+ for i = 0 to !depth-1 do prerr_string " " done;
+ prerr_string str;
+ Pervasives.flush Pervasives.stderr
+ in
+ ksprintf do_indent fs
+
let target v =
if v then raise (Goal_result Goal_OK)
let target_all vs = target (List.fold_left (&&) true vs)
let target_exists vs = target (List.fold_left (||) false vs)
-let require f = f ()
+let require name f =
+ indent "require: %s\n" name;
+ incr depth;
+ let r = (try Either (f ()) with exn -> Or exn) in
+ decr depth;
+ match r with
+ | Either x -> x
+ | Or exn -> raise exn
+
+let _enter_goal name = indent "enter goal: %s\n" name
+let _leave_goal name = indent "leave goal: %s\n" name
type period_t = Seconds | Days | Months | Years
let seconds = (1, Seconds)
goal_failed msg
let file_contains_string filename str =
- let cmd = sprintf "grep -q %s %s" (quote str) (quote filename) in
+ let cmd = sprintf "grep -q -F %s %s" (quote str) (quote filename) in
match Sys.command cmd with
| 0 -> true
| 1 -> false
let shell = ref "/bin/sh"
(* Used by sh, shout, shlines to handle the script and temporary dir. *)
-let with_script ?(tmpdir = false) script f =
+let with_script ?(tmpdir = true) script f =
let dir = if tmpdir then Some (make_tmpdir ()) else None in
let script_file, chan =
match dir with
let filename = getenv "HOME" // ".goaljobs-memory" in
let fd = openfile filename [O_RDWR; O_CREAT] 0o644 in
lockf fd (if write then F_LOCK else F_RLOCK) 0;
+
(* If the file is newly created with zero size, write an
* empty hash table.
*)
(* Run the function. *)
let r = try Either (f fd) with exn -> Or exn in
lockf fd F_ULOCK 0;
+ close fd;
match r with
| Either x -> x
| Or exn -> raise exn
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;
+ cmd := !cmd ^ " " ^ quote to_;
+ 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