From 95a58dc711df2649cce21239b2c6b77200d00513 Mon Sep 17 00:00:00 2001 From: Thomas Leonard Date: Thu, 27 Jul 2023 08:58:53 +0100 Subject: [PATCH 1/2] Fix compiler warning --- lib_eio_linux/eio_stubs.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib_eio_linux/eio_stubs.c b/lib_eio_linux/eio_stubs.c index 3e986c531..0c61cb5aa 100644 --- a/lib_eio_linux/eio_stubs.c +++ b/lib_eio_linux/eio_stubs.c @@ -101,7 +101,7 @@ CAMLprim value caml_eio_getrandom(value v_ba, value v_off, value v_len) { ssize_t off = (ssize_t)Long_val(v_off); ssize_t len = (ssize_t)Long_val(v_len); do { - void *buf = Caml_ba_data_val(v_ba) + off; + void *buf = (char *)Caml_ba_data_val(v_ba) + off; caml_enter_blocking_section(); #if __GLIBC__ > 2 || __GLIBC_MINOR__ > 24 ret = getrandom(buf, len, 0); From 5d8a48c20d3905c39cd990b7bf8bf3d78e6faa1c Mon Sep 17 00:00:00 2001 From: Thomas Leonard Date: Thu, 27 Jul 2023 07:20:18 +0100 Subject: [PATCH 2/2] Fork actions must not allocate The `execve` action allocated the arrays in the forked child process. However, in a multi-threaded program we might have forked while another thread had the malloc lock. In that case, the child would wait forever because it inherited the locked mutex but not the thread that would unlock it. e.g. #0 futex_wait (private=0, expected=2, futex_word=0xffff9509cb10 ) at ../sysdeps/nptl/futex-internal.h:146 #1 __GI___lll_lock_wait_private (futex=futex@entry=0xffff9509cb10 ) at ./nptl/lowlevellock.c:34 #2 0x0000ffff94f8e780 in __libc_calloc (n=, elem_size=) at ./malloc/malloc.c:3650 #3 0x0000aaaac67cfa68 in make_string_array (errors=errors@entry=37, v_array=281472912006504) at fork_action.c:47 #4 0x0000aaaac67cfaf4 in action_execve (errors=37, v_config=281472912003024) at fork_action.c:61 #5 0x0000aaaac67cf93c in eio_unix_run_fork_actions (errors=errors@entry=37, v_actions=281472912002960) at fork_action.c:19 --- lib_eio/unix/fork_action.c | 68 +++++++++++++++++++++++++----- lib_eio/unix/fork_action.ml | 7 ++- lib_eio/unix/include/fork_action.h | 3 +- stress/stress_proc.ml | 37 ++++++++++------ 4 files changed, 88 insertions(+), 27 deletions(-) diff --git a/lib_eio/unix/fork_action.c b/lib_eio/unix/fork_action.c index 7f6ef0c33..f6bb3d294 100644 --- a/lib_eio/unix/fork_action.c +++ b/lib_eio/unix/fork_action.c @@ -1,3 +1,9 @@ +/* Note: fork actions MUST NOT allocate (either on the OCaml heap or with C malloc). + * This is because e.g. we might have forked while another thread in the parent had a lock. + * In the child, we inherit a copy of the locked mutex, but no corresponding thread to + * release it. + */ + #include #include #include @@ -6,6 +12,9 @@ #include #include +#include +#include +#include #include "fork_action.h" @@ -42,24 +51,61 @@ void eio_unix_fork_error(int fd, char *fn, char *buf) { try_write_all(fd, buf); } -static char **make_string_array(int errors, value v_array) { - int n = Wosize_val(v_array); - char **c = calloc(sizeof(char *), (n + 1)); - if (!c) { - eio_unix_fork_error(errors, "make_string_array", "out of memory"); - _exit(1); - } +#define String_array_val(v) *((char ***)Data_custom_val(v)) + +static void finalize_string_array(value v) { + free(String_array_val(v)); + String_array_val(v) = NULL; +} + +static struct custom_operations string_array_ops = { + "string.array", + finalize_string_array, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default, + custom_compare_ext_default, + custom_fixed_length_default +}; + +CAMLprim value eio_unix_make_string_array(value v_len) { + CAMLparam0(); + CAMLlocal1(v_str_array); + int n = Int_val(v_len); + uintnat total; + + if (caml_umul_overflow(sizeof(char *), n + 1, &total)) + caml_raise_out_of_memory(); + + v_str_array = caml_alloc_custom_mem(&string_array_ops, sizeof(char ***), total); + + char **c = calloc(sizeof(char *), n + 1); + String_array_val(v_str_array) = c; + if (!c) + caml_raise_out_of_memory(); + + CAMLreturn(v_str_array); +} + +static void fill_string_array(char **c, value v_ocaml_array) { + int n = Wosize_val(v_ocaml_array); + for (int i = 0; i < n; i++) { - c[i] = (char *) String_val(Field(v_array, i)); + c[i] = (char *) String_val(Field(v_ocaml_array, i)); } + c[n] = NULL; - return c; } static void action_execve(int errors, value v_config) { value v_exe = Field(v_config, 1); - char **argv = make_string_array(errors, Field(v_config, 2)); - char **envp = make_string_array(errors, Field(v_config, 3)); + char **argv = String_array_val(Field(v_config, 2)); + char **envp = String_array_val(Field(v_config, 4)); + + fill_string_array(argv, Field(v_config, 3)); + fill_string_array(envp, Field(v_config, 5)); + execve(String_val(v_exe), argv, envp); eio_unix_fork_error(errors, "execve", strerror(errno)); _exit(1); diff --git a/lib_eio/unix/fork_action.ml b/lib_eio/unix/fork_action.ml index 820dbc232..c04413630 100644 --- a/lib_eio/unix/fork_action.ml +++ b/lib_eio/unix/fork_action.ml @@ -17,9 +17,14 @@ let rec with_actions actions fn = with_actions xs @@ fun c_actions -> fn (c_action :: c_actions) +type c_array +external make_string_array : int -> c_array = "eio_unix_make_string_array" external action_execve : unit -> fork_fn = "eio_unix_fork_execve" let action_execve = action_execve () -let execve path ~argv ~env = { run = fun k -> k (Obj.repr (action_execve, path, argv, env)) } +let execve path ~argv ~env = + let argv_c_array = make_string_array (Array.length argv) in + let env_c_array = make_string_array (Array.length env) in + { run = fun k -> k (Obj.repr (action_execve, path, argv_c_array, argv, env_c_array, env)) } external action_chdir : unit -> fork_fn = "eio_unix_fork_chdir" let action_chdir = action_chdir () diff --git a/lib_eio/unix/include/fork_action.h b/lib_eio/unix/include/fork_action.h index 7f9627bdb..ab15a39bd 100644 --- a/lib_eio/unix/include/fork_action.h +++ b/lib_eio/unix/include/fork_action.h @@ -1,7 +1,8 @@ #include #include -/* A function that runs in the forked child process. It must not run any OCaml code or invoke the GC. +/* A function that runs in the forked child process. + * It must not run any OCaml code, invoke the GC, or even call [malloc]. * If the action fails then it writes an error message to the FD [errors] and calls [_exit]. * v_args is the c_action tuple (where field 0 is the function itself). */ diff --git a/stress/stress_proc.ml b/stress/stress_proc.ml index 44814d231..0720058d4 100644 --- a/stress/stress_proc.ml +++ b/stress/stress_proc.ml @@ -1,26 +1,35 @@ open Eio.Std +let n_domains = 4 let n_rounds = 100 -let n_procs_per_round = 100 +let n_procs_per_round_per_domain = 100 / n_domains -let main mgr = +let run_in_domain mgr = let echo n = Eio.Process.parse_out mgr Eio.Buf_read.line ["sh"; "-c"; "echo " ^ string_of_int n] in + Switch.run @@ fun sw -> + for j = 1 to n_procs_per_round_per_domain do + Fiber.fork ~sw (fun () -> + let result = echo j in + assert (int_of_string result = j); + (* traceln "OK: %d" j *) + ) + done + +let main ~dm mgr = let t0 = Unix.gettimeofday () in for i = 1 to n_rounds do - Switch.run @@ fun sw -> - for j = 1 to n_procs_per_round do - Fiber.fork ~sw (fun () -> - let result = echo j in - assert (int_of_string result = j); - (* traceln "OK: %d" j *) - ) - done; - if false then traceln "Finished round %d/%d" i n_rounds + Switch.run (fun sw -> + for _ = 1 to n_domains - 1 do + Fiber.fork ~sw (fun () -> Eio.Domain_manager.run dm (fun () -> run_in_domain mgr)) + done; + Fiber.fork ~sw (fun () -> run_in_domain mgr); + ); + if true then traceln "Finished round %d/%d" i n_rounds done; let t1 = Unix.gettimeofday () in - let n_procs = n_rounds * n_procs_per_round in - traceln "Finished process stress test: ran %d processes in %.2fs" n_procs (t1 -. t0) + let n_procs = n_rounds * n_procs_per_round_per_domain * n_domains in + traceln "Finished process stress test: ran %d processes in %.2fs (using %d domains)" n_procs (t1 -. t0) n_domains let () = Eio_main.run @@ fun env -> - main env#process_mgr + main ~dm:env#domain_mgr env#process_mgr