Pass JOBSERIAL through to the cleanup function.

[whenjobs.git] / daemon / daemon.ml

diff --git a/daemon/daemon.ml b/daemon/daemon.ml
index 542c7a4..42c32de 100644 (file)
--- a/daemon/daemon.ml
+++ b/daemon/daemon.ml
@@ -32,8 +32,8 @@ let jobsdir = ref ""
 (* The state. *)
 let state = ref Whenstate.empty
 
-(* Jobs that are running; map of PID -> (job, other data).  Note that
- * the job may no longer exist *OR* it may have been renamed,
+(* Jobs that are running: a map of PID -> (job, tmpdir, serial).
+ * Note that the job may no longer exist *OR* it may have been renamed,
  * eg. if the jobs file was reloaded.
  *)
 let running = ref IntMap.empty
@@ -292,18 +292,17 @@ and string_of_time_t t =
     tm.tm_hour tm.tm_min tm.tm_sec
 
 and run_job job =
-  let () =
-    (* 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
-
-    Syslog.notice "running %s (JOBSERIAL=%s)"
-      job.job_name (string_of_big_int serial) in
+  (* 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
+
+  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
@@ -324,7 +323,7 @@ and run_job job =
     putenv "JOBNAME" job.job_name;
 
     (* Create a temporary file containing the shell script fragment. *)
-    let script = dir // "script" in
+    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;
@@ -333,6 +332,13 @@ and run_job job =
 
     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, _) ->
@@ -344,7 +350,7 @@ and run_job job =
   (* Remember this PID, the job and the temporary directory, so we
    * can clean up when the child exits.
    *)
-  running := IntMap.add pid (job, dir) !running
+  running := IntMap.add pid (job, dir, serial) !running
 
 and tmpdir () =
   let chan = open_in "/dev/urandom" in
@@ -362,13 +368,37 @@ and handle_sigchld _ =
     let pid, status = waitpid [WNOHANG] 0 in
     if pid > 0 then (
       (* Look up the PID in the running jobs map. *)
-      let job, dir = IntMap.find pid !running in
+      let job, dir, serial = IntMap.find pid !running in
       running := IntMap.remove pid !running;
-      cleanup_job job dir
+      cleanup_job job dir serial status
     )
   with Unix_error _ | Not_found -> ()
 
-and cleanup_job job dir =
+and cleanup_job job dir serial status =
+  (* If there is a cleanup function, run it. *)
+  (match job.job_cleanup with
+  | None -> ()
+  | Some cleanup ->
+    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"
+    } in
+    try cleanup result
+    with
+    | Failure msg ->
+      Syslog.error "job %s cleanup function failed: %s" job.job_name msg
+    | exn ->
+      Syslog.error "job %s cleanup 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)