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;
let set = loop StringSet.empty jobnames in
let jobnames = StringSet.elements set in
(* Ensure the jobs always run in predictable (name) order. *)
- let jobnames = List.sort compare jobnames in
+ let jobnames = List.sort compare_jobnames jobnames in
List.iter run_job
(List.map (fun jobname -> StringMap.find jobname !jobs) jobnames)
if jobs <> [] then (
(* Ensure the jobs always run in predictable (name) order. *)
let jobs =
- List.sort (fun { job_name = a } { job_name = b } -> compare a b) jobs in
+ List.sort (fun {job_name = a} {job_name = b} -> compare_jobnames a b)
+ jobs in
if !debug then
Syslog.notice "scheduling job(s) %s to run at %s"
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
let cmd = sprintf "rm -rf '%s'" dir in
ignore (Sys.command cmd)
+(* Intelligent comparison of job names. *)
+and compare_jobnames name1 name2 =
+ try
+ let len1 = String.length name1
+ and len2 = String.length name2 in
+ if len1 > 4 && len2 > 4 &&
+ String.sub name1 0 4 = "job$" && String.sub name2 0 4 = "job$"
+ then (
+ let i1 = int_of_string (String.sub name1 4 (len1-4)) in
+ let i2 = int_of_string (String.sub name2 4 (len2-4)) in
+ compare i1 i2
+ )
+ else raise Not_found
+ with _ ->
+ compare name1 name2
+
let main_loop () =
Unixqueue.run esys