fix(windows): use unicode version of CreateProcess

This updates our spawn vendored version to include janestreet/spawn#58. Fixes #10180 Signed-off-by: Etienne Millon <[email protected]>
ocaml · Mar 5, 2024 · c7179fd · c7179fd
1 parent edd1192
commit c7179fd
Show file tree

Hide file tree

Showing 3 changed files with 58 additions and 23 deletions.
diff --git a/vendor/spawn/src/spawn.ml b/vendor/spawn/src/spawn.ml
@@ -44,15 +44,17 @@ module Env_win32 : Env = struct
   type t = string
 
   let of_list env =
-    let len =
-      List.fold_left env ~init:1 ~f:(fun acc s -> acc + String.length s + 1)
-    in
-    let buf = Buffer.create len in
-    List.iter env ~f:(fun s ->
+    if env = [] then
+      "\000\000"
+    else
+      let len = List.fold_left env ~init:1 ~f:(fun acc s -> acc + String.length s + 1) in
+      let buf = Buffer.create (len + 1) in
+      List.iter env ~f:(fun s ->
         Buffer.add_string buf s;
         Buffer.add_char buf '\000');
-    Buffer.add_char buf '\000';
-    Buffer.contents buf
+      Buffer.add_char buf '\000';
+      Buffer.contents buf
+  ;;
 end
 
 module Env_unix : Env = struct

diff --git a/vendor/spawn/src/spawn_stubs.c b/vendor/spawn/src/spawn_stubs.c
@@ -1,5 +1,25 @@
 #define _GNU_SOURCE
 
+/* Must come before any other caml/ headers are included */
+#define CAML_INTERNALS
+
+#ifdef _WIN32
+/* for [caml_win32_multi_byte_to_wide_char] */
+#include <caml/osdeps.h>
+
+/* Prior to OCaml 5.0, the function was called win_multi_byte_to_wide_char */
+#include <caml/version.h>
+#if OCAML_VERSION_MAJOR < 5
+#define caml_win32_multi_byte_to_wide_char win_multi_byte_to_wide_char
+#define caml_win32_maperr win32_maperr
+#endif
+#endif
+
+/* for [caml_convert_signal_number] */
+#include <caml/signals.h>
+
+#undef CAML_INTERNALS
+
 #include <caml/mlvalues.h>
 #include <caml/memory.h>
 #include <caml/alloc.h>
@@ -8,9 +28,6 @@
 
 #include <errno.h>
 
-#include <caml/signals.h>
-CAMLextern int caml_convert_signal_number(int);
-
 #if defined(__APPLE__)
 
 # if defined(__MAC_OS_X_VERSION_MAX_ALLOWED)
@@ -846,6 +863,22 @@ CAMLprim value spawn_windows(value v_env,
 {
   STARTUPINFO si;
   PROCESS_INFORMATION pi;
+  WCHAR *prog = caml_stat_strdup_to_utf16(String_val(v_prog));
+  WCHAR *cmdline = caml_stat_strdup_to_utf16(String_val(v_cmdline));
+  WCHAR *env = NULL;
+  WCHAR *cwd = NULL;
+  BOOL result;
+
+  if (Is_block(v_env)) {
+    v_env = Field(v_env, 0);
+    mlsize_t len = caml_string_length(v_env);
+    int size = caml_win32_multi_byte_to_wide_char(String_val(v_env), len, NULL, 0);
+    env = caml_stat_alloc((size + 1) * sizeof(WCHAR));
+    caml_win32_multi_byte_to_wide_char(String_val(v_env), len, env, size);
+  }
+
+  if (Is_block(v_cwd))
+    cwd = caml_stat_strdup_to_utf16(String_val(Field(v_cwd, 0)));
 
   ZeroMemory(&si, sizeof(si));
   ZeroMemory(&pi, sizeof(pi));
@@ -855,22 +888,22 @@ CAMLprim value spawn_windows(value v_env,
   if (!dup2_and_clear_close_on_exec(v_stdin , &si.hStdInput ) ||
       !dup2_and_clear_close_on_exec(v_stdout, &si.hStdOutput) ||
       !dup2_and_clear_close_on_exec(v_stderr, &si.hStdError )) {
-    win32_maperr(GetLastError());
+    caml_win32_maperr(GetLastError());
     close_std_handles(&si);
     uerror("DuplicateHandle", Nothing);
   }
 
-  if (!CreateProcess(String_val(v_prog),
-                     Bytes_val(v_cmdline),
-                     NULL,
-                     NULL,
-                     TRUE,
-                     0,
-                     Is_block(v_env) ? Bytes_val(Field(v_env, 0)) : NULL,
-                     Is_block(v_cwd) ? String_val(Field(v_cwd, 0)) : NULL,
-                     &si,
-                     &pi)) {
-    win32_maperr(GetLastError());
+  result =
+    CreateProcess(prog, cmdline, NULL, NULL, TRUE, CREATE_UNICODE_ENVIRONMENT,
+                  env, cwd, &si, &pi);
+
+  caml_stat_free(prog);
+  caml_stat_free(cmdline);
+  caml_stat_free(env);
+  caml_stat_free(cwd);
+
+  if (!result) {
+    caml_win32_maperr(GetLastError());
     close_std_handles(&si);
     uerror("CreateProcess", Nothing);
   }

diff --git a/vendor/update-spawn.sh b/vendor/update-spawn.sh
@@ -1,6 +1,6 @@
 #!/bin/bash
 
-version=e184beb298d9abe0c524a4839bb0bec3d2571282
+version=324974fdc06f57461faf4e1320d56eeb8523d7eb
 
 set -e -o pipefail