Avoid calling external processes through the system shell

src/compiler/haxe.ml

@@ -100,11 +100,12 @@ let add_libs com libs =
 	let global_repo = List.exists (fun a -> a = "--haxelib-global") com.args in
 	let call_haxelib() =
 		let t = Timer.timer ["haxelib"] in
-		let cmd = "haxelib" ^ (if global_repo then " --global" else "") ^ " path " ^ String.concat " " libs in
-		let pin, pout, perr = Unix.open_process_full cmd (Unix.environment()) in
+		let cmd = "haxelib" in
+		let args = Array.of_list ("haxelib"::(if global_repo then "--global"::"path"::libs else "path"::libs)) in
+		let pin, pout, perr, pid = Process_helper.open_process_args_full_pid cmd args (Unix.environment()) in
 		let lines = Std.input_list pin in
 		let err = Std.input_list perr in
-		let ret = Unix.close_process_full (pin,pout,perr) in
+		let ret = Process_helper.close_process_full_pid (pin,pout,perr,pid) in
 		if ret <> Unix.WEXITED 0 then failwith (match lines, err with
 			| [], [] -> "Failed to call haxelib (command not found ?)"
 			| [], [s] when ExtString.String.ends_with (ExtString.String.strip s) "Module not found: path" -> "The haxelib command has been strip'ed, please install it again"

src/compiler/process_helper.ml

@@ -0,0 +1,154 @@
+open Unix
+
+(* path helpers *)
+let as_exe name =
+	if Sys.unix then name else name ^ ".exe"
+
+let find_program name =
+	let name = as_exe name in
+	let pathKey = try Sys.getenv "Path" with Not_found -> "PATH" in
+	let path = try Sys.getenv pathKey with Not_found -> "" in
+	let pathComponents = Str.split (Str.regexp (if Sys.unix then ":" else ";")) path in
+	let sep = if Sys.unix then "/" else "\\" in
+	if Sys.file_exists (Sys.getcwd() ^ sep ^ name) then
+		Sys.getcwd() ^ sep ^ name
+	else
+		let indir = List.find (fun dir -> Sys.file_exists (dir ^ sep ^ name)) pathComponents in
+		indir ^ sep ^ name
+(* end path helpers *)
+
+(*
+	ocaml<4.08/4.12 compat
+	https://github.com/ocaml/ocaml/blob/4.08/otherlibs/unix/unix.ml
+
+	open_process_args_in
+	open_process_args_out
+	open_process_args
+	open_process_args_full
+
+	The _pid part of the function names, as well as the pid argument,
+	are not needed in the real Unix functions present in 4.08
+
+	If ocaml >=4.08 but <4.12 is used, the path lookup should still be
+	performed, as this isn't performed by the ocaml function until 4.12.
+*)
+let open_process_args_in_pid prog args =
+	let prog = try find_program prog with Not_found -> prog in
+	let (in_read, in_write) = pipe ~cloexec:true () in
+	let inchan = in_channel_of_descr in_read in
+	let pid =
+	begin
+		try
+			create_process prog args stdin in_write stderr
+		with e ->
+			close_in inchan;
+			close in_write;
+			raise e
+	end in
+	close in_write;
+	(inchan, pid)
+
+let open_process_args_out_pid prog args =
+	let prog = try find_program prog with Not_found -> prog in
+	let (out_read, out_write) = pipe ~cloexec:true () in
+	let outchan = out_channel_of_descr out_write in
+	let pid =
+	begin
+		try
+			create_process prog args out_read stdout stderr
+		with e ->
+			close_out outchan;
+			close out_read;
+			raise e
+	end in
+	close out_read;
+	(outchan, pid)
+
+let open_process_args_pid prog args =
+	let prog = try find_program prog with Not_found -> prog in
+	let (in_read, in_write) = pipe ~cloexec:true () in
+	let (out_read, out_write) =
+		try pipe ~cloexec:true ()
+		with e ->
+			close in_read; close in_write;
+			raise e in
+	let inchan = in_channel_of_descr in_read in
+	let outchan = out_channel_of_descr out_write in
+	let pid =
+	begin
+		try
+			create_process prog args out_read in_write stderr
+		with e ->
+			close out_read; close out_write;
+			close in_read; close in_write;
+			raise e
+	end in
+	close out_read;
+	close in_write;
+	(inchan, outchan, pid)
+
+let open_process_args_full_pid prog args env =
+	let prog = try find_program prog with Not_found -> prog in
+	let (in_read, in_write) = pipe ~cloexec:true () in
+	let (out_read, out_write) =
+		try pipe ~cloexec:true ()
+		with e ->
+			close in_read; close in_write;
+			raise e in
+	let (err_read, err_write) =
+		try pipe ~cloexec:true ()
+		with e ->
+			close in_read; close in_write;
+			close out_read; close out_write;
+			raise e in
+	let inchan = in_channel_of_descr in_read in
+	let outchan = out_channel_of_descr out_write in
+	let errchan = in_channel_of_descr err_read in
+	let pid =
+	begin
+		try
+			create_process_env prog args env out_read in_write err_write
+		with e ->
+			close out_read; close out_write;
+			close in_read; close in_write;
+			close err_read; close err_write;
+			raise e
+	end in
+	close out_read;
+	close in_write;
+	close err_write;
+	(inchan, outchan, errchan, pid)
+
+let rec waitpid_non_intr pid =
+	try waitpid [] pid
+	with Unix_error (EINTR, _, _) -> waitpid_non_intr pid
+
+let close_process_in_pid (inchan, pid) =
+	close_in inchan;
+	snd(waitpid_non_intr pid)
+
+let close_process_out_pid (outchan, pid) =
+	(* The application may have closed [outchan] already to signal
+	   end-of-input to the process.  *)
+	begin try close_out outchan with Sys_error _ -> () end;
+	snd(waitpid_non_intr pid)
+
+let close_process_pid (inchan, outchan, pid) =
+	close_in inchan;
+	begin try close_out outchan with Sys_error _ -> () end;
+	snd(waitpid_non_intr pid)
+
+let close_process_full_pid (inchan, outchan, errchan, pid) =
+	close_in inchan;
+	begin try close_out outchan with Sys_error _ -> () end;
+	close_in errchan;
+	snd(waitpid_non_intr pid)
+(* end ocaml<4.08/4.12 compat *)
+
+let command cmd args =
+	let args = Array.of_list (cmd::args) in
+	let pin, pout, pid = open_process_args_pid cmd args in
+	let ret = close_process_pid (pin,pout,pid) in
+	match ret with
+	| Unix.WEXITED code -> code
+	| _ -> 255

src/context/common.ml

@@ -311,6 +311,7 @@ type context = {
 	mutable print : string -> unit;
 	mutable get_macros : unit -> context option;
 	mutable run_command : string -> int;
+	mutable run_command_args : string -> string list -> int;
 	file_lookup_cache : (string,string option) Hashtbl.t;
 	file_keys : file_keys;
 	readdir_cache : (string * string,(string array) option) Hashtbl.t;
@@ -715,6 +716,7 @@ let create version args =
 		config = default_config;
 		print = (fun s -> print_string s; flush stdout);
 		run_command = Sys.command;
+		run_command_args = Process_helper.command;
 		std_path = [];
 		class_path = [];
 		main_class = None;

src/generators/gencpp.ml

@@ -6943,9 +6943,9 @@ let write_build_options common_ctx filename defines =
    PMap.iter ( fun name value -> match name with
       | "true" | "sys" | "dce" | "cpp" | "debug" -> ()
       | _ ->  writer#write (Printf.sprintf "%s=%s\n" name (escape_command value))) defines;
-   let cmd = Unix.open_process_in "haxelib path hxcpp" in
-   writer#write (Printf.sprintf "hxcpp=%s\n" (Pervasives.input_line cmd));
-   Pervasives.ignore (Unix.close_process_in cmd);
+   let pin,pid = Process_helper.open_process_args_in_pid "haxelib" [|"haxelib"; "path"; "hxcpp"|] in
+   writer#write (Printf.sprintf "hxcpp=%s\n" (Pervasives.input_line pin));
+   Pervasives.ignore (Process_helper.close_process_in_pid (pin,pid));
    writer#close;;
 
 let create_member_types common_ctx =
@@ -8558,18 +8558,15 @@ let generate_source ctx =
       let t = Timer.timer ["generate";"cpp";"native compilation"] in
       let old_dir = Sys.getcwd() in
       Sys.chdir common_ctx.file;
-      let cmd_buffer = Buffer.create 128 in
-      Buffer.add_string cmd_buffer "haxelib run hxcpp Build.xml haxe";
-      if (common_ctx.debug) then Buffer.add_string cmd_buffer " -Ddebug";
+      let cmd = ref ["run"; "hxcpp"; "Build.xml"; "haxe"] in
+      if (common_ctx.debug) then cmd := !cmd @ ["-Ddebug"];
       PMap.iter ( fun name value -> match name with
          | "true" | "sys" | "dce" | "cpp" | "debug" -> ();
-         | _ -> Printf.bprintf cmd_buffer " -D%s=\"%s\"" name (escape_command value);
+         | _ -> cmd := !cmd @ [Printf.sprintf "-D%s=%s" name value];
       ) common_ctx.defines.values;
-      List.iter (fun path -> Printf.bprintf cmd_buffer " -I\"%s\"" (escape_command path)) common_ctx.class_path;
-      Buffer.add_char cmd_buffer '\n';
-      let cmd = Buffer.contents cmd_buffer in
-      common_ctx.print cmd;
-      if common_ctx.run_command cmd <> 0 then failwith "Build failed";
+      List.iter (fun path -> cmd := !cmd @ [Printf.sprintf "-I%s" path]) common_ctx.class_path;
+      common_ctx.print ("haxelib " ^ (String.concat " " !cmd) ^ "\n");
+      if common_ctx.run_command_args "haxelib" !cmd <> 0 then failwith "Build failed";
       Sys.chdir old_dir;
       t()
    end

src/generators/gencs.ml

@@ -3547,17 +3547,18 @@ let generate con =
 		if ( not (Common.defined gen.gcon Define.NoCompilation) ) then begin
 			let old_dir = Sys.getcwd() in
 			Sys.chdir gen.gcon.file;
-			let cmd = "haxelib run hxcs hxcs_build.txt --haxe-version " ^ (string_of_int gen.gcon.version) ^ " --feature-level 1" in
-			let cmd =
+			let cmd = "haxelib" in
+			let args = ["run"; "hxcs"; "hxcs_build.txt"; "--haxe-version"; (string_of_int gen.gcon.version); "--feature-level"; "1"] in
+			let args =
 				match gen.gentry_point with
 				| Some (name,_,_) ->
 					let name = if gen.gcon.debug then name ^ "-Debug" else name in
-					cmd ^ " --out " ^ gen.gcon.file ^ "/bin/" ^ name
+					args@["--out"; gen.gcon.file ^ "/bin/" ^ name]
 				| _ ->
-					cmd
+					args
 			in
-			print_endline cmd;
-			if gen.gcon.run_command cmd <> 0 then failwith "Build failed";
+			print_endline (cmd ^ " " ^ (String.concat " " args));
+			if gen.gcon.run_command_args cmd args <> 0 then failwith "Build failed";
 			Sys.chdir old_dir;
 		end
 

src/generators/genhl.ml

@@ -4126,12 +4126,6 @@ let generate com =
 	end;
 	let t = Timer.timer ["generate";"hl";"write"] in
 
-	let escape_command s =
-		let b = Buffer.create 0 in
-		String.iter (fun ch -> if (ch=='"' || ch=='\\' ) then Buffer.add_string b "\\";  Buffer.add_char b ch) s;
-		"\"" ^ Buffer.contents b ^ "\""
-	in
-
 	if file_extension com.file = "c" then begin
 		let gnames = Array.create (Array.length code.globals) "" in
 		PMap.iter (fun n i -> gnames.(i) <- n) ctx.cglobals.map;
@@ -4143,7 +4137,7 @@ let generate com =
 		end;
 		Hl2c.write_c com com.file code gnames;
 		let t = Timer.timer ["nativecompile";"hl"] in
-		if not (Common.defined com Define.NoCompilation) && com.run_command ("haxelib run hashlink build " ^ escape_command com.file) <> 0 then failwith "Build failed";
+		if not (Common.defined com Define.NoCompilation) && com.run_command_args "haxelib" ["run"; "hashlink"; "build"; com.file] <> 0 then failwith "Build failed";
 		t();
 	end else begin
 		let ch = IO.output_string() in
@@ -4158,7 +4152,7 @@ let generate com =
 	Hlopt.clean_cache();
 	t();
 	if Common.raw_defined com "run" then begin
-		if com.run_command ("haxelib run hashlink run " ^ escape_command com.file) <> 0 then failwith "Failed to run HL";
+		if com.run_command_args "haxelib" ["run"; "hashlink"; "run"; com.file] <> 0 then failwith "Failed to run HL";
 	end;
 	if Common.defined com Define.Interp then
 		try

src/generators/genjava.ml

@@ -2702,17 +2702,18 @@ let generate con =
 	if ( not (Common.defined gen.gcon Define.NoCompilation) ) then begin
 		let old_dir = Sys.getcwd() in
 		Sys.chdir gen.gcon.file;
-		let cmd = "haxelib run hxjava hxjava_build.txt --haxe-version " ^ (string_of_int gen.gcon.version) ^ " --feature-level 1" in
-		let cmd =
+		let cmd = "haxelib" in
+		let args = ["run"; "hxjava"; "hxjava_build.txt"; "--haxe-version"; (string_of_int gen.gcon.version); "--feature-level"; "1"] in
+		let args =
 			match gen.gentry_point with
 			| Some (name,_,_) ->
 				let name = if gen.gcon.debug then name ^ "-Debug" else name in
-				cmd ^ " --out " ^ gen.gcon.file ^ "/" ^ name
+				args@["--out"; gen.gcon.file ^ "/" ^ name]
 			| _ ->
-				cmd
+				args
 		in
-		print_endline cmd;
-		if gen.gcon.run_command cmd <> 0 then failwith "Build failed";
+		print_endline (cmd ^ " " ^ (String.concat " " args));
+		if gen.gcon.run_command_args cmd args <> 0 then failwith "Build failed";
 		Sys.chdir old_dir;
 	end
 

src/generators/genneko.ml

@@ -810,16 +810,16 @@ let generate com =
 			in
 			abort msg (loop 0)
 	end;
-	let command cmd = try com.run_command cmd with _ -> -1 in
+	let command cmd args = try com.run_command_args cmd args with _ -> -1 in
 	let neko_file = (try Filename.chop_extension com.file with _ -> com.file) ^ ".neko" in
 	if source || use_nekoc then begin
 		let ch = IO.output_channel (open_out_bin neko_file) in
 		Binast.write ch e;
 		IO.close_out ch;
 	end;
-	if use_nekoc && command ("nekoc" ^ (if ctx.version > 1 then " -version " ^ string_of_int ctx.version else "") ^ " \"" ^ neko_file ^ "\"") <> 0 then failwith "Neko compilation failure";
+	if use_nekoc && command "nekoc" (if ctx.version > 1 then ["-version"; (string_of_int ctx.version); neko_file] else [neko_file]) <> 0 then failwith "Neko compilation failure";
 	if source then begin
-		if command ("nekoc -p \"" ^ neko_file ^ "\"") <> 0 then failwith "Failed to print neko code";
+		if command "nekoc" ["-p"; neko_file] <> 0 then failwith "Failed to print neko code";
 		Sys.remove neko_file;
 		Sys.rename ((try Filename.chop_extension com.file with _ -> com.file) ^ "2.neko") neko_file;
 	end

src/generators/hlinterp.ml

@@ -1533,12 +1533,12 @@ let load_native ctx lib name t =
 					(match !cached_sys_name with
 					| Some n -> n
 					| None ->
-						let ic = Unix.open_process_in "uname" in
+						let ic, pid = Process_helper.open_process_args_in_pid "uname" [| "uname" |] in
 						let uname = (match input_line ic with
 							| "Darwin" -> "Mac"
 							| n -> n
 						) in
-						close_in ic;
+						Pervasives.ignore (Process_helper.close_process_in_pid (ic, pid));
 						cached_sys_name := Some uname;
 						uname)
 				| "Win32" | "Cygwin" -> "Windows"

src/macro/eval/evalStdLib.ml

@@ -2679,12 +2679,12 @@ module StdSys = struct
 					(match !cached_sys_name with
 					| Some n -> n
 					| None ->
-						let ic = catch_unix_error Unix.open_process_in "uname" in
+						let ic, pid = catch_unix_error Process_helper.open_process_args_in_pid "uname" [| "uname" |] in
 						let uname = (match input_line ic with
 							| "Darwin" -> "Mac"
 							| n -> n
 						) in
-						close_in ic;
+						Pervasives.ignore (Process_helper.close_process_in_pid (ic, pid));
 						cached_sys_name := Some uname;
 						uname)
 				| "Win32" | "Cygwin" -> "Windows"
@@ -3834,4 +3834,4 @@ let init_standard_library builtins =
 	init_fields builtins (["eval";"luv";"_Prepare"], "Prepare_Impl_") EvalLuv.prepare_fields [];
 	init_fields builtins (["eval";"luv";"_Check"], "Check_Impl_") EvalLuv.check_fields [];
 	init_fields builtins (["eval";"luv"], "Version") EvalLuv.version_fields [];
-	EvalSsl.init_fields init_fields builtins
+	EvalSsl.init_fields init_fields builtins