Implement cleanup functions, including 'mailto'.

[whenjobs.git] / daemon / daemon.ml

diff --git a/daemon/daemon.ml b/daemon/daemon.ml
index 6c3799c..9e972ac 100644 (file)
--- a/daemon/daemon.ml
+++ b/daemon/daemon.ml
@@ -94,23 +94,7 @@ and proc_set_variable (name, value) =
   if !debug then Syslog.notice "remote call: set_variable %s" name;
 
   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;
+    check_valid_variable_name name;
 
     let value = variable_of_rpc value in
     state := Whenstate.set_variable !state name value;
@@ -340,7 +324,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;
@@ -349,6 +333,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, _) ->
@@ -380,11 +371,34 @@ and handle_sigchld _ =
       (* Look up the PID in the running jobs map. *)
       let job, dir = IntMap.find pid !running in
       running := IntMap.remove pid !running;
-      cleanup_job job dir
+      cleanup_job job dir status
     )
   with Unix_error _ | Not_found -> ()
 
-and cleanup_job job dir =
+and cleanup_job job dir 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_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)