open Whenutils
+open Big_int
open Unix
open Printf
);
(* Handle SIGCHLD to clean up jobs. *)
- Sys.set_signal Sys.sigchld (Sys.Signal_handle handle_sigchld)
+ Sys.set_signal Sys.sigchld (Sys.Signal_handle handle_sigchld);
+
+ (* Initialize the variables. XXX Eventually this will be saved
+ * and loaded from a persistent store.
+ *)
+ variables := StringMap.add "JOBSERIAL" (T_int zero_big_int) !variables
and proc_reload_file () =
if !debug then Syslog.notice "remote call: reload_file";
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;
+ try
+ (* Don't permit certain names. *)
+ if name = "JOBSERIAL" then
+ failwith "JOBSERIAL variable cannot be set";
+
+ let len = String.length name in
+ if len = 0 then
+ failwith "variable name is an empty string";
+ if name.[0] <> '_' && not (isalpha name.[0]) then
+ failwith "variable name must start with alphabetic character or underscore";
+
+ let rec loop i =
+ if i >= len then ()
+ else if name.[i] <> '_' && not (isalnum name.[i]) then
+ failwith "variable name contains non-alphanumeric non-underscore character"
+ else loop (i+1)
+ in
+ loop 1;
+
+ 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
+ reevaluate_whenjobs jobnames;
- (* Which jobs need to be re-evaluated? *)
- let jobnames = try StringMap.find name !dependencies with Not_found -> [] in
- reevaluate_whenjobs jobnames
+ `ok
+ with
+ Failure msg -> `error msg
and proc_get_variable name =
if !debug then Syslog.notice "remote call: get_variable %s" name;
dependencies := map in
(* Re-evaluate all when jobs. *)
- reevaluate_whenjobs (StringMap.keys !jobs);
+ reevaluate_whenjobs ~onload:true (StringMap.keys !jobs);
(* Schedule the next every job to run. *)
schedule_next_everyjob ()
* a fixpoint. Run those that need to be run. every-statement jobs
* are ignored here.
*)
-and reevaluate_whenjobs jobnames =
+and reevaluate_whenjobs ?(onload=false) jobnames =
let rec loop set jobnames =
let set' =
List.fold_left (
assert (jobname = job.job_name);
let r, job' =
- try job_evaluate job !variables
+ try job_evaluate job !variables onload
with Invalid_argument err | Failure err ->
Syslog.error "error evaluating job %s (at %s): %s"
jobname (Camlp4.PreCast.Ast.Loc.to_string job.job_loc) err;
tm.tm_hour tm.tm_min tm.tm_sec
and run_job job =
- Syslog.notice "running %s" job.job_name;
+ let () =
+ (* Increment JOBSERIAL. *)
+ let serial =
+ match StringMap.find "JOBSERIAL" !variables with
+ | T_int serial ->
+ let serial = succ_big_int serial in
+ variables := StringMap.add "JOBSERIAL" (T_int serial) !variables;
+ serial
+ | _ -> assert false in
+
+ Syslog.notice "running %s (JOBSERIAL=%s)"
+ job.job_name (string_of_big_int serial) in
(* Create a temporary directory. The current directory of the job
* will be in this directory. The directory is removed when the
close_out chan;
chmod script 0o700;
+ let shell = try getenv "SHELL" with Not_found -> "/bin/sh" in
+
(* Execute the shell script. *)
- (try execvp "bash" [| "bash"; "-c"; script |];
+ (try execvp shell [| shell; "-c"; script |];
with Unix_error (err, fn, _) ->
Syslog.error "%s failed: %s: %s" fn script (error_message err)
);