process stdlib

libs/uv/uv.ml

@@ -232,6 +232,13 @@ external timer_stop : t_timer -> unit_cb -> unit uv_result = "w_timer_stop"
 
 (* ------------- PROCESS -------------------------------------------- *)
 
-external spawn : t_loop -> unit_cb -> string -> string array -> string array -> string -> int -> int -> int -> t_process uv_result = "w_spawn_bytecode" "w_spawn"
+type process_cb = (int * int) uv_result -> unit
+
+type process_io =
+	| UvIoPipe of bool * bool
+	| UvIoIgnore
+	| UvIoInherit
+
+external spawn : t_loop -> process_cb -> string -> string array -> string array -> string -> int -> process_io array -> int -> int -> t_process uv_result = "w_spawn_bytecode" "w_spawn"
 external process_kill : t_process -> int -> unit uv_result = "w_process_kill"
 external process_get_pid : t_process -> int = "w_process_get_pid"

libs/uv/uv_stubs.c

@@ -77,6 +77,10 @@
 	CAMLprim value name ## _bytecode(value *argv, int argc) { \
 		return name(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6], argv[7], argv[8]); \
 	}
+#define BC_WRAP10(name) \
+	CAMLprim value name ## _bytecode(value *argv, int argc) { \
+		return name(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6], argv[7], argv[8], argv[9]); \
+	}
 
 // ------------- ERROR HANDLING -------------------------------------
 
@@ -1074,15 +1078,20 @@ CAMLprim value w_timer_stop(value handle, value cb) {
 
 static void handle_process_cb(uv_process_t *handle, int64_t exit_status, int term_signal) {
 	CAMLparam0();
-	CAMLlocal1(cb);
+	CAMLlocal3(cb, res, status);
 	cb = UV_HANDLE_DATA_SUB(handle, process).cb_exit;
-	caml_callback(cb, Val_unit);
+	res = caml_alloc(1, 1);
+	status = caml_alloc(2, 0);
+	Store_field(status, 0, Val_int(exit_status)); // FIXME: int64 -> int conversion
+	Store_field(status, 1, Val_int(term_signal));
+	Store_field(res, 0, status);
+	caml_callback(cb, res);
 	CAMLreturn0;
 }
 
-CAMLprim value w_spawn(value loop, value cb, value file, value args, value env, value cwd, value flags, value uid, value gid) {
+CAMLprim value w_spawn(value loop, value cb, value file, value args, value env, value cwd, value flags, value stdio, value uid, value gid) {
 	CAMLparam5(loop, cb, file, args, env);
-	CAMLxparam4(cwd, flags, uid, gid);
+	CAMLxparam5(cwd, flags, stdio, uid, gid);
 	UV_ALLOC_CHECK(handle, uv_process_t);
 	UV_HANDLE_DATA(Process_val(handle)) = alloc_data_process(cb);
 	if (UV_HANDLE_DATA(Process_val(handle)) == NULL)
@@ -1095,11 +1104,29 @@ CAMLprim value w_spawn(value loop, value cb, value file, value args, value env,
 	for (int i = 0; i < Wosize_val(env); i++)
 		env_u[i] = strdup(String_val(Field(env, i)));
 	env_u[Wosize_val(env)] = NULL;
-	uv_stdio_container_t stdio_u[3] = {
-		{.flags = UV_INHERIT_FD, .data = {.fd = 0}},
-		{.flags = UV_INHERIT_FD, .data = {.fd = 1}},
-		{.flags = UV_INHERIT_FD, .data = {.fd = 2}}
-	};
+	uv_stdio_container_t *stdio_u = malloc(sizeof(uv_stdio_container_t) * Wosize_val(stdio));
+	CAMLlocal1(stdio_entry);
+	for (int i = 0; i < Wosize_val(stdio); i++) {
+		stdio_entry = Field(stdio, i);
+		if (Is_long(stdio_entry)) {
+			switch (Int_val(stdio_entry)) {
+				case 0: // Ignore
+					stdio_u[i].flags = UV_IGNORE;
+					break;
+				default: // 1, Inherit
+					stdio_u[i].flags = UV_INHERIT_FD;
+					stdio_u[i].data.fd = i;
+					break;
+			}
+		} else {
+			stdio_u[i].flags = UV_CREATE_PIPE;
+			// TODO: probably need to give a stream in data.stream?
+			if (Bool_val(Field(stdio_entry, 0)))
+				stdio_u[i].flags = UV_READABLE_PIPE;
+			if (Bool_val(Field(stdio_entry, 1)))
+				stdio_u[i].flags = UV_WRITABLE_PIPE;
+		}
+	}
 	uv_process_options_t options = {
 		.exit_cb = handle_process_cb,
 		.file = String_val(file),
@@ -1107,7 +1134,7 @@ CAMLprim value w_spawn(value loop, value cb, value file, value args, value env,
 		.env = env_u,
 		.cwd = String_val(cwd),
 		.flags = Int_val(flags),
-		.stdio_count = 3,
+		.stdio_count = Wosize_val(stdio),
 		.stdio = stdio_u,
 		.uid = Int_val(uid),
 		.gid = Int_val(gid)
@@ -1116,9 +1143,10 @@ CAMLprim value w_spawn(value loop, value cb, value file, value args, value env,
 		uv_spawn(Loop_val(loop), Process_val(handle), &options),
 		{ unalloc_data(UV_HANDLE_DATA(Process_val(handle))); free(Process_val(handle)); }
 		);
+	free(stdio_u);
 	UV_SUCCESS(handle);
 }
-BC_WRAP9(w_spawn);
+BC_WRAP10(w_spawn);
 
 CAMLprim value w_process_kill(value handle, value signum) {
 	CAMLparam2(handle, signum);
@@ -1128,5 +1156,5 @@ CAMLprim value w_process_kill(value handle, value signum) {
 
 CAMLprim value w_process_get_pid(value handle) {
 	CAMLparam1(handle);
-	CAMLreturn(Process_val(handle)->pid);
+	CAMLreturn(Val_int(Process_val(handle)->pid));
 }

src/macro/eval/evalHash.ml

@@ -47,6 +47,8 @@ let key_family = hash "family"
 let key_hints = hash "hints"
 let key_data = hash "data"
 let key_address = hash "address"
+let key_code = hash "code"
+let key_signal = hash "signal"
 let key_Array = hash "Array"
 let key_eval_Vector = hash "eval.Vector"
 let key_String = hash "String"
@@ -151,3 +153,4 @@ let key_nusys_net_Dns = hash "nusys.net.Dns"
 let key_nusys_net_Address = hash "nusys.net.Address"
 let key_nusys_net_SocketAddress = hash "nusys.net.SocketAddress"
 let key_eval_uv_Timer = hash "eval.uv.Timer"
+let key_eval_uv_Process = hash "eval.uv.Process"

src/macro/eval/evalStdLib.ml

@@ -3753,6 +3753,47 @@ module StdUv = struct
 		)
 	end
 
+	module Process = struct
+		let this vthis = match vthis with
+			| VInstance {ikind = IUv (UvProcess t)} -> t
+			| v -> unexpected_value v "UvProcess"
+		let new_ = (fun vl ->
+			match vl with
+				| [exitCb; file; args; env; cwd; flags; stdio; uid; gid] ->
+					let file = decode_string file in
+					let args = Array.of_list (List.map decode_string (decode_array args)) in
+					let env = Array.of_list (List.map decode_string (decode_array env)) in
+					let cwd = decode_string cwd in
+					let flags = decode_int flags in
+					let stdio = Array.of_list (List.map (function
+							| VEnumValue {eindex = 0; eargs = [|readable; writable|]} ->
+								let readable = decode_bool readable in
+								let writable = decode_bool writable in
+								Uv.UvIoPipe (readable, writable)
+							| VEnumValue {eindex = 1} -> Uv.UvIoIgnore
+							| VEnumValue {eindex = 2} -> Uv.UvIoInherit
+							| _ -> assert false
+						) (decode_array stdio)) in
+					let uid = decode_int uid in
+					let gid = decode_int gid in
+					let process = wrap_sync (Uv.spawn (loop ()) (wrap_cb exitCb (fun res -> match res with
+							| code, signal -> encode_obj [key_code, vint code; key_signal, vint signal]
+						)) file args env cwd flags stdio uid gid) in
+					encode_instance key_eval_uv_Process ~kind:(IUv (UvProcess process))
+				| _ -> assert false
+		)
+		let kill = vifun1 (fun vthis signum ->
+			let this = this vthis in
+			let signum = decode_int signum in
+			wrap_sync (Uv.process_kill this signum);
+			vnull
+		)
+		let getPid = vifun0 (fun vthis ->
+			let this = this vthis in
+			vint (Uv.process_get_pid this)
+		)
+	end
+
 	let init = vfun0 (fun () ->
 		loop_ref := Some (wrap_sync (Uv.loop_init ()));
 		vnull
@@ -3941,7 +3982,8 @@ let init_constructors builtins =
 		);
 	add key_eval_uv_Socket StdUv.Socket.new_;
 	add key_eval_uv_UdpSocket StdUv.UdpSocket.new_;
-	add key_eval_uv_Timer StdUv.Timer.new_
+	add key_eval_uv_Timer StdUv.Timer.new_;
+	add key_eval_uv_Process StdUv.Process.new_
 
 let init_empty_constructors builtins =
 	let h = builtins.empty_constructor_builtins in
@@ -4492,4 +4534,8 @@ let init_standard_library builtins =
 	] [];
 	init_fields builtins (["eval";"uv"],"Timer") [] [
 		"close",StdUv.Timer.close;
+	];
+	init_fields builtins (["eval";"uv"],"Process") [] [
+		"kill",StdUv.Process.kill;
+		"getPid",StdUv.Process.getPid;
 	]

src/macro/eval/evalValue.ml

@@ -102,6 +102,7 @@ type vuv_value =
 	| UvTcp of Uv.t_tcp
 	| UvUdp of Uv.t_udp
 	| UvTimer of Uv.t_timer
+	| UvProcess of Uv.t_process
 
 type value =
 	| VNull