From c4c582dad5435d404490f13acb5ddb706b020f07 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Tue, 17 Sep 2013 12:17:03 +0100
Subject: [PATCH] Run sh/shout/shlines in a temporary directory.

---
 examples/compile-c/compile.ml |  4 ++--
 goaljobs.ml                   | 56 +++++++++++++++++++++++++++++++++++--------
 goaljobs.mli                  | 19 ++++++++-------
 3 files changed, 58 insertions(+), 21 deletions(-)

diff --git a/examples/compile-c/compile.ml b/examples/compile-c/compile.ml
index 043bc9a..8e43948 100644
--- a/examples/compile-c/compile.ml
+++ b/examples/compile-c/compile.ml
@@ -9,14 +9,14 @@ and built program sources =
   List.iter (fun s -> require (compiled s)) sources;
 
   let objects = List.map (change_file_extension "o") sources in
-  sh "cc %s -o %s" (String.concat " " objects) program
+  sh "cd $builddir && cc %s -o %s" (String.concat " " objects) program
 
 (* Goal: Make sure a C file is compiled (to an object file). *)
 and compiled c_file =
   let o_file = change_file_extension "o" c_file in
   target (more_recent [o_file] [c_file]);
   require (file_exists c_file);
-  sh "cc -c %s -o %s" c_file o_file
+  sh "cd $builddir && cc -c %s -o %s" c_file o_file
 
 (* XXX IMPLICIT *)
 let () =
diff --git a/goaljobs.ml b/goaljobs.ml
index 1aa8c0d..39c9007 100644
--- a/goaljobs.ml
+++ b/goaljobs.ml
@@ -103,11 +103,47 @@ let url_contains_string url str =
   unlink tmp;
   r
 
+(* Create a temporary directory.  It is *not* deleted on exit. *)
+let 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 "goaljobstmp%s" data in
+  mkdir dir 0o700;
+  dir
+
+(* Recursively remove directory. *)
+let rm_rf dir =
+  let cmd = sprintf "rm -rf %s" (quote dir) in
+  ignore (Sys.command cmd)
+
+let shell = ref "/bin/sh"
+
+(* Used by sh, shout etc.  Create a temporary directory and a
+ * 'script.sh' inside it containing the script to run.  Returns the
+ * temporary directory and command to run.
+ *)
+let create_script script =
+  let dir = tmpdir () in
+  let script_file = dir // "script.sh" in
+  let chan = open_out script_file in
+  fprintf chan "#!%s\n" !shell;
+  fprintf chan "set -e\n"; (* so that job exits on error *)
+  fprintf chan "set -x\n"; (* echo commands (must be last) *)
+  fprintf chan "\n";
+  output_string chan script;
+  close_out chan;
+  chmod script_file 0o700;
+  let cmd = sprintf "cd %s && exec %s" (quote dir) (quote script_file) in
+  dir, cmd
 
 let sh fs =
-  let do_sh cmd =
-    let cmd = "set -e\nset -x\n\n" ^ cmd in
+  let do_sh script =
+    let dir, cmd = create_script script in
     let r = Sys.command cmd in
+    rm_rf dir;
     if r <> 0 then (
       let msg = sprintf "external command failed with code %d" r in
       goal_failed msg
@@ -115,8 +151,8 @@ let sh fs =
   in
   ksprintf do_sh fs
 
-let do_shlines cmd =
-  let cmd = "set -e\nset -x\n\n" ^ cmd in
+let do_shlines script =
+  let dir, cmd = create_script script in
   let chan = open_process_in cmd in
   let lines = ref [] in
   let rec loop () =
@@ -126,6 +162,7 @@ let do_shlines cmd =
   in
   (try loop () with End_of_file -> ());
   let r = close_process_in chan in
+  rm_rf dir;
   match r with
   | WEXITED 0 -> List.rev !lines
   | WEXITED i ->
@@ -139,16 +176,12 @@ let do_shlines cmd =
     goal_failed msg
 let shlines fs = ksprintf do_shlines fs
 
-let do_shout cmd =
-  let lines = do_shlines cmd in
+let do_shout script =
+  let lines = do_shlines script in
   String.concat "\n" lines
 let shout fs = ksprintf do_shout fs
 
 (*
-val shell : string ref
-*)
-
-(*
 val replace_substring : string -> string -> string -> string
 *)
 
@@ -217,6 +250,9 @@ let init () =
   let prog = Sys.executable_name in
   let prog = Filename.basename prog in
 
+  (* Save the current working directory when the program started. *)
+  putenv "builddir" (getcwd ());
+
   let args = ref [] in
 
   let display_version () =
diff --git a/goaljobs.mli b/goaljobs.mli
index 072fcef..bc47f6d 100644
--- a/goaljobs.mli
+++ b/goaljobs.mli
@@ -37,7 +37,7 @@
         let o_file = change_file_extension "o" c_file in
         target (more_recent [o_file] [c_file]);
 
-        sh "cc -c %s -o %s" c_file o_file
+        sh "cd $builddir && cc -c %s -o %s" c_file o_file
     }
 
     In the second example, the rule requires that several files
@@ -51,7 +51,7 @@
         require (compiled source);
 
         let object = change_file_extension "o" source in
-        sh "cc %s -o %s" object program
+        sh "cd $builddir && cc %s -o %s" object program
     }
 
 *)
@@ -211,11 +211,14 @@ val quote : string -> string
     {v command ||: }
     to ignore the result of a command.
 
-    Each shell runs in a new temporary directory.  The temporary directory
-    and all its contents is deleted after the shell exits.  If you
-    want to save any data, [cd] somewhere.  For example you could start
-    the command sequence with:
-    {v cd $HOME/data/ }
+    Each shell runs in a new temporary directory.  The temporary
+    directory and all its contents is deleted after the shell exits.
+    If you want to save any data, [cd] somewhere.  The environment
+    variable [$builddir] is exported to the script.  This is the
+    current directory when the goaljobs program was started.
+
+    For example you could start the command sequence with
+    [cd $HOME/data/] or [cd $builddir].
 *)
 
 val sh : ('a, unit, string, unit) format4 -> 'a
@@ -233,10 +236,8 @@ val shlines : ('a, unit, string, string list) format4 -> 'a
       Any lines printed to stdout is returned as a list of strings.
       Trailing [\n] characters are not returned. *)
 
-(*
 val shell : string ref
   (** Set this variable to override the default shell ([/bin/sh]). *)
-*)
 
 (** {2 String functions}
 
-- 
1.8.3.1