Skip to content

Commit ddf1aaa

Browse files
CopilotSimn
Copilot
and
Simn
authored
Replace process_stubs.c with pure OCaml implementation for OCaml 5 multi-domain safety (#12757)
* Initial plan * Use run_in_new_pool for filter phases to avoid idle domains during eval execution The persistent pool (via run_with_pool) kept domain workers alive during eval interpretation and callbacks, causing subprocess/IPC failures in eval tests. Revert to run_in_new_pool which tears down the pool after each parallel section, matching the pattern that works on development. The sctx.pool and run_with_pool remain available for generators (e.g. genjvm) that use them during code generation. Also restore the EnableParallelAnalyzer guard since the analyzer was specifically identified as leaking when run in parallel (#12414). Co-authored-by: Simn <634365+Simn@users.noreply.github.com> * Revert filters.ml to base branch state Co-authored-by: Simn <634365+Simn@users.noreply.github.com> * Make process_stubs.c safe for OCaml 5 multi-domain programs Two changes to fix eval subprocess failures when domainslib pool domains are alive: 1. Add caml_enter_blocking_section/caml_leave_blocking_section to all blocking process operations (read, write, waitpid, WaitForSingleObject, ReadFile, WriteFile). Without these, the calling domain holds its runtime lock during blocking I/O, preventing stop-the-world GC from proceeding when worker domains need it. This causes GC stalls that lead to pipe I/O corruption and timing issues. 2. Replace fork()+exec() with posix_spawn() on Unix. OCaml 5's Unix.fork explicitly refuses to fork when domains are spawned (caml_domain_is_multicore check). process_stubs.c bypassed this safety check by calling fork() directly. In multi-threaded programs, fork() can deadlock when worker threads hold internal locks (malloc arenas, glibc internals). posix_spawn() avoids this by using clone(CLONE_VM|CLONE_VFORK) internally on Linux. Co-authored-by: Simn <634365+Simn@users.noreply.github.com> * Replace process_stubs.c with pure OCaml implementation Remove the C stubs entirely and implement Process using Unix.create_process, which is domain-safe under OCaml 5. This also refactors PipeThings.run_command to use Process.run instead of duplicating the pipe+spawn logic. The old C stubs had two issues in OCaml 5: 1. Missing caml_enter_blocking_section around blocking I/O 2. Direct fork() which is unsafe with multiple domains Unix.create_process handles both correctly (it uses posix_spawn internally on modern systems and properly releases the runtime lock). Co-authored-by: Simn <634365+Simn@users.noreply.github.com> * Fix error handling: convert Unix.Unix_error to Failure for eval compatibility The old C stubs used caml_failwith for all errors, which eval catches as Dynamic. Unix.create_process raises Unix.Unix_error instead, which eval couldn't catch. Convert all Unix errors to Failure to preserve backward compatibility. Co-authored-by: Simn <634365+Simn@users.noreply.github.com> * catch Unix_error in callers instead * don't turn exit status into exceptions * make Eof extend Exception * catch constructor exception too * back to running everything * hmm * Handle non-existent commands in Process.run without throwing When Unix.create_process fails (e.g. command not found), return a process with pre-closed pipes (reads return EOF) and exit code 127, matching the old fork+exec behavior where fork always succeeded and exec failure manifested as a non-zero exit code. Add misc test to verify non-existent commands don't throw exceptions. Co-authored-by: Simn <634365+Simn@users.noreply.github.com> * Assert output in process-nonexistent misc test, guard kill against pid=0 The test now prints stdout_empty, stderr_empty, and exit_code values and asserts them via compile.hxml.stdout (expected: empty pipes, code 127). Also add pid > 0 guard in Process.kill as defense-in-depth against sending signals to process group 0 for failed process objects. Co-authored-by: Simn <634365+Simn@users.noreply.github.com> * Preserve Unix.Unix_error info in all Process operations - run: writes error message to stderr pipe so callers can read it - read_stdout/read_stderr/write_stdin/close_stdin: include the Unix error details (function, arg, message) in Failure exceptions - Add unix_error_msg helper shared by all operations - Test checks stderr is non-empty (not a specific message string) for cross-platform compatibility Co-authored-by: Simn <634365+Simn@users.noreply.github.com> * reformat * avoid some code duplication --------- Co-authored-by: copilot-swe-agent[bot] <198982749+Copilot@users.noreply.github.com> Co-authored-by: Simn <634365+Simn@users.noreply.github.com> Co-authored-by: Simon Krajewski <simon@haxe.org>
1 parent 3caa538 commit ddf1aaa

File tree

10 files changed

+205
-672
lines changed

10 files changed

+205
-672
lines changed

‎.github/workflows/main.yml‎

Lines changed: 25 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -154,8 +154,23 @@ jobs:
154154
strategy:
155155
fail-fast: false
156156
matrix:
157-
target: [macro]
157+
target: [macro, js, hl, cpp, jvm, php, python, lua, flash, neko]
158158
arch: [x86, arm64]
159+
include:
160+
- target: hl
161+
arch: x86
162+
APT_PACKAGES: cmake ninja-build libturbojpeg-dev
163+
- target: hl
164+
arch: arm64
165+
APT_PACKAGES: cmake ninja-build libturbojpeg-dev
166+
runci-args: --skip-hl-jit
167+
- target: cpp
168+
arch: x86
169+
APT_PACKAGES: gcc-multilib g++-multilib
170+
- target: lua
171+
APT_PACKAGES: ncurses-dev
172+
- target: flash
173+
APT_PACKAGES: libglib2.0-0 libgtk2.0-0 libfreetype6 xvfb
159174
exclude:
160175
- target: flash
161176
arch: arm64
@@ -388,7 +403,7 @@ jobs:
388403
strategy:
389404
fail-fast: false
390405
matrix:
391-
target: [macro]
406+
target: [macro, js, hl, cpp, jvm, php, python, lua, flash, neko]
392407
steps:
393408
- uses: actions/checkout@main
394409
with:
@@ -520,8 +535,15 @@ jobs:
520535
strategy:
521536
fail-fast: false
522537
matrix:
523-
target: [macro]
538+
target: [macro, js, hl, cpp, jvm, php, python, lua, flash, neko]
524539
arch: [arm64]
540+
include:
541+
- target: hl
542+
arch: arm64
543+
runci-args: --skip-hl-jit
544+
- target: hl
545+
arch: x86_64
546+
runner: macos-15-intel
525547

526548
runs-on: ${{ matrix.runner || 'macos-latest' }}
527549
steps:

‎libs/extc/dune‎

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -12,9 +12,7 @@
1212

1313
(library
1414
(name extproc)
15-
(foreign_stubs
16-
(language c)
17-
(names process_stubs))
15+
(libraries unix)
1816
(modules process)
1917
(wrapped false)
2018
)

‎libs/extc/process.ml‎

Lines changed: 135 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -1,31 +1,136 @@
1-
(*
2-
* Extc : C common OCaml bindings
3-
* Copyright (c)2004-2015 Nicolas Cannasse
4-
*
5-
* This program is free software; you can redistribute it and/or modify
6-
* it under the terms of the GNU General Public License as published by
7-
* the Free Software Foundation; either version 2 of the License, or
8-
* (at your option) any later version.
9-
*
10-
* This program is distributed in the hope that it will be useful,
11-
* but WITHOUT ANY WARRANTY; without even the implied warranty of
12-
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13-
* GNU General Public License for more details.
14-
*
15-
* You should have received a copy of the GNU General Public License
16-
* along with this program; if not, write to the Free Software
17-
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
18-
*)
19-
20-
type process
21-
22-
external run : string -> string array option -> process = "process_run"
23-
external read_stdout : process -> string -> int -> int -> int = "process_stdout_read"
24-
external read_stderr : process -> string -> int -> int -> int = "process_stderr_read"
25-
external write_stdin : process -> string -> int -> int -> int = "process_stdin_write"
26-
external close_stdin : process -> unit = "process_stdin_close"
27-
external exit : process -> int = "process_exit"
28-
external pid : process -> int = "process_pid"
29-
external close : process -> unit = "process_close"
30-
external kill : process -> unit = "process_kill"
1+
(** Pure OCaml implementation of subprocess management.
312
3+
Replaces the former C stubs (process_stubs.c) which were unsafe under
4+
OCaml 5 multi-domain execution (missing [caml_enter_blocking_section],
5+
direct [fork()] in multi-threaded processes).
6+
7+
Uses [Unix.create_process] which is domain-safe and handles
8+
[posix_spawn] on modern systems.
9+
10+
When the command is not found, [run] returns a process whose pipes
11+
immediately return EOF and whose [exit] returns code 127 (matching
12+
the POSIX shell convention and the old fork+exec behavior where
13+
fork always succeeded). *)
14+
15+
type process = {
16+
pid : int;
17+
stdin_fd : Unix.file_descr;
18+
stdout_fd : Unix.file_descr;
19+
stderr_fd : Unix.file_descr;
20+
mutable exit_code : int option;
21+
}
22+
23+
(** Returns a readable file_descr that immediately yields EOF. *)
24+
let make_eof_fd () =
25+
let (r, w) = Unix.pipe ~cloexec:true () in
26+
Unix.close w;
27+
r
28+
29+
(** Returns a writable file_descr where writes fail with EPIPE. *)
30+
let make_null_fd () =
31+
let (r, w) = Unix.pipe ~cloexec:true () in
32+
Unix.close r;
33+
w
34+
35+
let unix_error_msg err fn arg =
36+
Printf.sprintf "%s(%s): %s" fn arg (Unix.error_message err)
37+
38+
let run cmd args =
39+
let (child_stdin_r, child_stdin_w) = Unix.pipe ~cloexec:true () in
40+
let (child_stdout_r, child_stdout_w) = Unix.pipe ~cloexec:true () in
41+
let (child_stderr_r, child_stderr_w) = Unix.pipe ~cloexec:true () in
42+
let shell, argv = match args with
43+
| None ->
44+
if Sys.win32 then
45+
let comspec = try Sys.getenv "COMSPEC" with Not_found -> "cmd.exe" in
46+
comspec, [|comspec; "/C"; cmd|]
47+
else
48+
"/bin/sh", [|"/bin/sh"; "-c"; cmd|]
49+
| Some a ->
50+
cmd, Array.append [|cmd|] a
51+
in
52+
match
53+
try Ok (Unix.create_process shell argv child_stdin_r child_stdout_w child_stderr_w)
54+
with Unix.Unix_error _ as e -> Error e
55+
with
56+
| Ok pid ->
57+
Unix.close child_stdin_r;
58+
Unix.close child_stdout_w;
59+
Unix.close child_stderr_w;
60+
{ pid; stdin_fd = child_stdin_w; stdout_fd = child_stdout_r; stderr_fd = child_stderr_r; exit_code = None }
61+
| Error err ->
62+
Unix.close child_stdin_r;
63+
Unix.close child_stdin_w;
64+
Unix.close child_stdout_r;
65+
Unix.close child_stdout_w;
66+
Unix.close child_stderr_r;
67+
let stderr_r = match err with
68+
| (Unix.Unix_error (err, fn, arg)) ->
69+
(* Process creation failed (e.g. command not found).
70+
Match the old fork+exec behavior: return a process whose pipes
71+
immediately return EOF and whose exit code is 127.
72+
Write the error message to the stderr pipe so callers can read it. *)
73+
let errmsg = unix_error_msg err fn arg ^ "\n" in
74+
let (stderr_r, stderr_w) = Unix.pipe ~cloexec:true () in
75+
begin try
76+
ignore (Unix.write_substring stderr_w errmsg 0 (String.length errmsg))
77+
with Unix.Unix_error _ ->
78+
()
79+
end;
80+
Unix.close stderr_w;
81+
stderr_r
82+
| _ ->
83+
Unix.close child_stderr_w;
84+
make_eof_fd ()
85+
in
86+
{ pid = 0; stdin_fd = make_null_fd (); stdout_fd = make_eof_fd (); stderr_fd = stderr_r; exit_code = Some 127 }
87+
88+
let read_stdout p buf pos len =
89+
let n = try
90+
Unix.read p.stdout_fd (Bytes.unsafe_of_string buf) pos len
91+
with Unix.Unix_error (err, fn, arg) ->
92+
failwith (unix_error_msg err fn arg)
93+
in
94+
if n = 0 then failwith "process_stdout_read";
95+
n
96+
97+
let read_stderr p buf pos len =
98+
let n = try
99+
Unix.read p.stderr_fd (Bytes.unsafe_of_string buf) pos len
100+
with Unix.Unix_error (err, fn, arg) ->
101+
failwith (unix_error_msg err fn arg)
102+
in
103+
if n = 0 then failwith "process_stderr_read";
104+
n
105+
106+
let write_stdin p buf pos len =
107+
try Unix.write_substring p.stdin_fd buf pos len
108+
with Unix.Unix_error (err, fn, arg) -> failwith (unix_error_msg err fn arg)
109+
110+
let close_stdin p =
111+
try Unix.close p.stdin_fd
112+
with Unix.Unix_error (err, fn, arg) -> failwith (unix_error_msg err fn arg)
113+
114+
let exit p =
115+
match p.exit_code with
116+
| Some c -> c
117+
| None ->
118+
let _, status = Unix.waitpid [] p.pid in
119+
let c = match status with
120+
| Unix.WEXITED c -> c
121+
| Unix.WSIGNALED c -> c
122+
| Unix.WSTOPPED c -> c
123+
in
124+
p.exit_code <- Some c;
125+
c
126+
127+
let pid p = p.pid
128+
129+
let close p =
130+
(try Unix.close p.stdout_fd with Unix.Unix_error _ -> ());
131+
(try Unix.close p.stderr_fd with Unix.Unix_error _ -> ());
132+
(try Unix.close p.stdin_fd with Unix.Unix_error _ -> ())
133+
134+
let kill p =
135+
if p.exit_code = None && p.pid > 0 then
136+
(try Unix.kill p.pid Sys.sigkill with Unix.Unix_error _ -> ())

0 commit comments

Comments
 (0)