From c7179fd19db2a7f1018f1427bac901aaf28dab65 Mon Sep 17 00:00:00 2001 From: Etienne Millon Date: Tue, 5 Mar 2024 13:23:15 +0100 Subject: [PATCH] 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 --- vendor/spawn/src/spawn.ml | 16 +++++---- vendor/spawn/src/spawn_stubs.c | 63 ++++++++++++++++++++++++++-------- vendor/update-spawn.sh | 2 +- 3 files changed, 58 insertions(+), 23 deletions(-) diff --git a/vendor/spawn/src/spawn.ml b/vendor/spawn/src/spawn.ml index c7dcee07d0aa..0a15565004a4 100644 --- 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 index 2b025075879e..099ba51d69d4 100644 --- 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 + +/* Prior to OCaml 5.0, the function was called win_multi_byte_to_wide_char */ +#include +#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 + +#undef CAML_INTERNALS + #include #include #include @@ -8,9 +28,6 @@ #include -#include -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 index faec2e536438..7e1476c2b90b 100755 --- a/vendor/update-spawn.sh +++ b/vendor/update-spawn.sh @@ -1,6 +1,6 @@ #!/bin/bash -version=e184beb298d9abe0c524a4839bb0bec3d2571282 +version=324974fdc06f57461faf4e1320d56eeb8523d7eb set -e -o pipefail