X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=goaljobs.ml;h=39c90071e796b0ea69b698dcdaebb34053366879;hb=c4c582dad5435d404490f13acb5ddb706b020f07;hp=1aa8c0d9fd9562ba52aa04a3ea7d540c15248ccf;hpb=12f53f74a2e9858887a5f23c44c320f6321de82b;p=goaljobs.git 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 () =