+ (* Increment JOBSERIAL. *)
+ let serial =
+ match Whenstate.get_variable !state "JOBSERIAL" with
+ | T_int serial ->
+ let serial = succ_big_int serial in
+ state := Whenstate.set_variable !state "JOBSERIAL" (T_int serial);
+ serial
+ | _ -> assert false in
+
+ (* Call the pre-condition script. Note this may decide not to run
+ * the job by returning false.
+ *)
+ let pre_condition () =
+ match job.job_pre with
+ | None -> true
+ | Some pre ->
+ let rs = ref [] in
+ IntMap.iter (
+ fun pid (job, _, serial, start_time) ->
+ let r = { pirun_job_name = job.job_name;
+ pirun_serial = serial;
+ pirun_start_time = start_time;
+ pirun_pid = pid } in
+ rs := r :: !rs
+ ) !runningmap;
+ let preinfo = {
+ pi_job_name = job.job_name;
+ pi_serial = serial;
+ pi_variables = Whenstate.get_variables !state;
+ pi_running = !rs;
+ } in
+ pre preinfo
+ in
+ if pre_condition () then (
+ Syslog.notice "running %s (JOBSERIAL=%s)"
+ job.job_name (string_of_big_int serial);
+
+ (* Create a temporary directory. The current directory of the job
+ * will be in this directory. The directory is removed when the
+ * child process exits.
+ *)
+ let dir = tmpdir () in
+
+ let pid = fork () in
+ if pid = 0 then ( (* child process running the job *)
+ chdir dir;
+
+ (* Set environment variables corresponding to each variable. *)
+ List.iter
+ (fun (name, value) -> putenv name (string_of_variable value))
+ (Whenstate.get_variables !state);
+
+ (* Set the $JOBNAME environment variable. *)
+ putenv "JOBNAME" job.job_name;
+
+ (* Create a temporary file containing the shell script fragment. *)
+ 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;
+ close_out chan;
+ chmod script 0o700;
+
+ 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, _) ->
+ Syslog.error "%s failed: %s: %s" fn script (error_message err)
+ );
+ _exit 1
+ );
+
+ (* Remember this PID, the job and the temporary directory, so we
+ * can clean up when the child exits.
+ *)
+ runningmap := IntMap.add pid (job, dir, serial, time ()) !runningmap;
+ serialmap := BigIntMap.add serial pid !serialmap
+ )
+ else (
+ Syslog.notice "not running %s (JOBSERIAL=%s) because pre() condition returned false"
+ job.job_name (string_of_big_int serial);
+ )
+
+and tmpdir () =
+ let chan = open_in "/dev/urandom" in
+ let data = String.create 16 in
+ really_input chan data 0 (String.length data);
+ close_in chan;
+ let data = Digest.to_hex (Digest.string data) in
+ let dir = Filename.temp_dir_name // sprintf "whenjobs%s" data in
+ mkdir dir 0o700;
+ dir
+
+(* This is called when a job (child process) exits. *)
+and handle_sigchld _ =
+ try
+ let pid, status = waitpid [WNOHANG] 0 in
+ if pid > 0 then (
+ (* Look up the PID in the running jobs map. *)
+ let job, dir, serial, time = IntMap.find pid !runningmap in
+ runningmap := IntMap.remove pid !runningmap;
+ serialmap := BigIntMap.remove serial !serialmap;
+ post_job job dir serial time status
+ )
+ with Unix_error _ | Not_found -> ()
+
+and post_job job dir serial time status =
+ (* If there is a post function, run it. *)
+ (match job.job_post with
+ | None -> ()
+ | Some post ->
+ let code =
+ match status with
+ | WEXITED c -> c
+ | WSIGNALED s | WSTOPPED s -> 1 in
+ let result = {
+ res_job_name = job.job_name;
+ res_serial = serial;
+ res_code = code;
+ res_tmpdir = dir;
+ res_output = dir // "output.txt";
+ res_start_time = time
+ } in
+ try post result
+ with
+ | Failure msg ->
+ Syslog.error "job %s post function failed: %s" job.job_name msg
+ | exn ->
+ Syslog.error "job %s post 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)
+
+(* 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