The unpac monorepo manager self-hosting as a monorepo using unpac
`natdynlink`: `dlclose` on error (#14391)
* Add test
* natdynlink: dlclose on error
* Promote test
* Only dlclose if unit has not initialized, fix test
* Accept
* Call ndl_register after CRC check
* Accept
* Simplify
* Accept
* Changes
* Fix test script
* Fix test script
* Accept
* Disable test on Windows
authored by
Nicolás Ojeda Bär
and committed by
GitHub
19c757bc
1e05f341
+157
-48
+4
Changes
+4
Changes
···
210
210
and socklen_param_type for socklen_t.
211
211
(Antonin Décimo, review by Nicolás Ojeda Bär, David Allsopp and Samuel Hym)
212
212
213
+
- #14391: unload native dynlinked objects when an error occurs and it is safe to
214
+
do so. (Fixes #14323)
215
+
(Nicolás Ojeda Bär, review by Vincent Laviron)
216
+
213
217
### Tools:
214
218
215
219
- #14055: Invert BUILD_PATH_PREFIX_MAP in directories loaded at startup
-2
otherlibs/dynlink/byte/dynlink.ml
-2
otherlibs/dynlink/byte/dynlink.ml
+1
-2
otherlibs/dynlink/dynlink_common.ml
+1
-2
otherlibs/dynlink/dynlink_common.ml
-1
otherlibs/dynlink/dynlink_platform_intf.ml
-1
otherlibs/dynlink/dynlink_platform_intf.ml
+33
-12
otherlibs/dynlink/native/dynlink.ml
+33
-12
otherlibs/dynlink/native/dynlink.ml
···
32
32
}
33
33
34
34
module Native = struct
35
-
type handle
35
+
type ndl_handle
36
+
type initialized =
37
+
| Initialized
38
+
| Not_yet_initialized of string list
39
+
type handle = {
40
+
ndl_handle : ndl_handle;
41
+
mutable initialized : initialized;
42
+
}
36
43
37
-
external ndl_open : string -> bool -> handle * dynheader
44
+
external ndl_open : string -> bool -> ndl_handle * dynheader
38
45
= "caml_natdynlink_open"
39
-
external ndl_register : handle -> string array -> unit
46
+
external ndl_close : ndl_handle -> unit
47
+
= "caml_natdynlink_close"
48
+
external ndl_register : ndl_handle -> string array -> unit
40
49
= "caml_natdynlink_register"
41
-
external ndl_run : handle -> string -> unit = "caml_natdynlink_run"
50
+
external ndl_run : ndl_handle -> string -> unit = "caml_natdynlink_run"
42
51
external ndl_getmap : unit -> global_map list = "caml_natdynlink_getmap"
43
52
external ndl_globals_inited : unit -> int = "caml_natdynlink_globals_inited"
44
53
external ndl_loadsym : string -> Obj.t = "caml_natdynlink_loadsym"
···
78
87
(ndl_getmap ())
79
88
80
89
let run_shared_startup handle =
81
-
ndl_run handle "_shared_startup"
90
+
match handle.initialized with
91
+
| Initialized -> ()
92
+
| Not_yet_initialized syms ->
93
+
handle.initialized <- Initialized;
94
+
begin try
95
+
ndl_register handle.ndl_handle (Array.of_list syms);
96
+
with exn ->
97
+
raise (DT.Error (Cannot_open_dynamic_library exn))
98
+
end;
99
+
ndl_run handle.ndl_handle "_shared_startup"
82
100
83
101
let run _lock handle ~unit_header ~priv:_ =
102
+
run_shared_startup handle;
84
103
List.iter (fun cu ->
85
-
try ndl_run handle cu
104
+
try ndl_run handle.ndl_handle cu
86
105
with exn ->
87
106
Printexc.raise_with_backtrace
88
107
(DT.Error (Library's_module_initializers_failed exn))
···
90
109
(Unit_header.defined_symbols unit_header)
91
110
92
111
let load ~filename ~priv =
93
-
let handle, header =
112
+
let ndl_handle, header =
94
113
try ndl_open filename (not priv)
95
114
with exn -> raise (DT.Error (Cannot_open_dynamic_library exn))
96
115
in
97
116
if header.dynu_magic <> Config.cmxs_magic_number then begin
117
+
ndl_close ndl_handle;
98
118
raise (DT.Error (Not_a_bytecode_file filename))
99
119
end;
100
120
let syms =
101
121
"_shared_startup" ::
102
122
List.concat_map Unit_header.defined_symbols header.dynu_units
103
123
in
104
-
try
105
-
ndl_register handle (Array.of_list syms);
106
-
handle, header.dynu_units
107
-
with exn -> raise (DT.Error (Cannot_open_dynamic_library exn))
124
+
let handle = { ndl_handle; initialized = Not_yet_initialized syms } in
125
+
handle, header.dynu_units
108
126
109
127
let unsafe_get_global_value ~bytecode_or_asm_symbol =
110
128
match ndl_loadsym bytecode_or_asm_symbol with
111
129
| exception _ -> None
112
130
| obj -> Some obj
113
131
114
-
let finish _handle = ()
132
+
let finish handle =
133
+
match handle.initialized with
134
+
| Initialized -> ()
135
+
| Not_yet_initialized _ -> ndl_close handle.ndl_handle
115
136
end
116
137
117
138
include DC.Make (Native)
+10
-3
runtime/dynlink_nat.c
+10
-3
runtime/dynlink_nat.c
···
83
83
char_os *p;
84
84
int global_dup;
85
85
86
-
/* TODO: dlclose in case of error... */
87
-
88
86
p = caml_stat_strdup_to_os(String_val(filename));
89
87
global_dup = Int_val(global);
90
88
caml_enter_blocking_section();
···
96
94
caml_failwith(caml_dlerror());
97
95
98
96
sym = caml_dlsym(dlhandle, "caml_plugin_header");
99
-
if (NULL == sym)
97
+
if (NULL == sym) {
98
+
caml_dlclose(dlhandle);
100
99
caml_failwith("not an OCaml plugin");
100
+
}
101
101
102
102
handle = Val_handle(dlhandle);
103
103
header = caml_input_value_from_block(sym, INT_MAX);
···
106
106
Field(res, 0) = handle;
107
107
Field(res, 1) = header;
108
108
CAMLreturn(res);
109
+
}
110
+
111
+
CAMLprim value caml_natdynlink_close(value handle)
112
+
{
113
+
CAMLparam1(handle);
114
+
caml_dlclose(Handle_val(handle));
115
+
CAMLreturn(Val_unit);
109
116
}
110
117
111
118
CAMLprim value caml_natdynlink_register(value handle_v, value symbols) {
+14
-14
testsuite/tests/backtrace/backtrace_dynlink.flambda.reference
+14
-14
testsuite/tests/backtrace/backtrace_dynlink.flambda.reference
···
1
1
Raised by primitive operation at Backtrace_dynlink_plugin in file "backtrace_dynlink_plugin.ml", line 6, characters 13-38
2
-
Called from Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 85, characters 12-29
2
+
Called from Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 104, characters 12-40
3
3
Called from Stdlib__List.iter in file "list.ml" (inlined), line 114, characters 12-15
4
-
Called from Dynlink.Native.run in file "otherlibs/dynlink/native/dynlink.ml", lines 84-90, characters 4-47
5
-
Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 356, characters 11-54
4
+
Called from Dynlink.Native.run in file "otherlibs/dynlink/native/dynlink.ml", lines 103-109, characters 4-47
5
+
Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 355, characters 11-54
6
6
Called from Stdlib__List.iter in file "list.ml" (inlined), line 114, characters 12-15
7
-
Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml" (inlined), lines 352-361, characters 6-13
7
+
Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml" (inlined), lines 351-360, characters 6-13
8
8
Called from Stdlib__Fun.protect in file "fun.ml" (inlined), line 34, characters 8-15
9
-
Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", lines 345-362, characters 4-7
10
-
Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 364, characters 26-45
9
+
Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", lines 345-361, characters 4-7
10
+
Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 363, characters 26-45
11
11
Called from Backtrace_dynlink in file "backtrace_dynlink.ml", line 39, characters 4-52
12
12
execution of module initializers in the shared library failed: Failure("SUCCESS")
13
-
Raised by primitive operation at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 85, characters 12-29
14
-
Re-raised at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", lines 87-89, characters 10-43
13
+
Raised by primitive operation at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 104, characters 12-40
14
+
Re-raised at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", lines 106-108, characters 10-43
15
15
Called from Stdlib__List.iter in file "list.ml" (inlined), line 114, characters 12-15
16
-
Called from Dynlink.Native.run in file "otherlibs/dynlink/native/dynlink.ml", lines 84-90, characters 4-47
17
-
Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 356, characters 11-54
16
+
Called from Dynlink.Native.run in file "otherlibs/dynlink/native/dynlink.ml", lines 103-109, characters 4-47
17
+
Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 355, characters 11-54
18
18
Called from Stdlib__List.iter in file "list.ml" (inlined), line 114, characters 12-15
19
-
Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml" (inlined), lines 352-361, characters 6-13
19
+
Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml" (inlined), lines 351-360, characters 6-13
20
20
Called from Stdlib__Fun.protect in file "fun.ml" (inlined), line 34, characters 8-15
21
-
Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", lines 345-362, characters 4-7
21
+
Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", lines 345-361, characters 4-7
22
22
Re-raised at Stdlib__Fun.protect in file "fun.ml" (inlined), line 39, characters 6-52
23
-
Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", lines 345-362, characters 4-7
24
-
Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 364, characters 26-45
23
+
Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", lines 345-361, characters 4-7
24
+
Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 363, characters 26-45
25
25
Called from Backtrace_dynlink in file "backtrace_dynlink.ml", line 39, characters 4-52
+7
-7
testsuite/tests/backtrace/backtrace_dynlink.reference
+7
-7
testsuite/tests/backtrace/backtrace_dynlink.reference
···
1
1
Raised by primitive operation at Backtrace_dynlink_plugin in file "backtrace_dynlink_plugin.ml", line 6, characters 13-38
2
-
Called from Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 85, characters 12-29
2
+
Called from Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 104, characters 12-40
3
3
Called from Stdlib__List.iter in file "list.ml", line 114, characters 12-15
4
-
Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 356, characters 11-54
4
+
Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 355, characters 11-54
5
5
Called from Stdlib__List.iter in file "list.ml", line 114, characters 12-15
6
6
Called from Stdlib__Fun.protect in file "fun.ml", line 34, characters 8-15
7
-
Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 364, characters 26-45
7
+
Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 363, characters 26-45
8
8
Called from Backtrace_dynlink in file "backtrace_dynlink.ml", line 39, characters 4-52
9
9
execution of module initializers in the shared library failed: Failure("SUCCESS")
10
-
Raised by primitive operation at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 85, characters 12-29
11
-
Re-raised at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", lines 87-89, characters 10-43
10
+
Raised by primitive operation at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 104, characters 12-40
11
+
Re-raised at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", lines 106-108, characters 10-43
12
12
Called from Stdlib__List.iter in file "list.ml", line 114, characters 12-15
13
-
Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 356, characters 11-54
13
+
Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 355, characters 11-54
14
14
Called from Stdlib__List.iter in file "list.ml", line 114, characters 12-15
15
15
Called from Stdlib__Fun.protect in file "fun.ml", line 34, characters 8-15
16
16
Re-raised at Stdlib__Fun.protect in file "fun.ml", line 39, characters 6-52
17
-
Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 364, characters 26-45
17
+
Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 363, characters 26-45
18
18
Called from Backtrace_dynlink in file "backtrace_dynlink.ml", line 39, characters 4-52
+3
-3
testsuite/tests/lib-dynlink-initializers/test10_main.byte.reference
+3
-3
testsuite/tests/lib-dynlink-initializers/test10_main.byte.reference
···
3
3
Called from Test10_plugin.g in file "test10_plugin.ml", line 3, characters 2-21
4
4
Called from Test10_plugin.f in file "test10_plugin.ml", line 6, characters 2-6
5
5
Called from Test10_plugin in file "test10_plugin.ml", line 10, characters 2-6
6
-
Called from Dynlink.Bytecode.run in file "otherlibs/dynlink/byte/dynlink.ml", line 170, characters 16-25
7
-
Re-raised at Dynlink.Bytecode.run in file "otherlibs/dynlink/byte/dynlink.ml", lines 172-174, characters 6-39
8
-
Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 356, characters 11-54
6
+
Called from Dynlink.Bytecode.run in file "otherlibs/dynlink/byte/dynlink.ml", line 168, characters 16-25
7
+
Re-raised at Dynlink.Bytecode.run in file "otherlibs/dynlink/byte/dynlink.ml", lines 170-172, characters 6-39
8
+
Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 355, characters 11-54
9
9
Called from Stdlib__List.iter in file "list.ml", line 114, characters 12-15
10
10
Called from Stdlib__Fun.protect in file "fun.ml", line 34, characters 8-15
11
11
Re-raised at Stdlib__Fun.protect in file "fun.ml", line 39, characters 6-52
+4
-4
testsuite/tests/lib-dynlink-initializers/test10_main.native.reference
+4
-4
testsuite/tests/lib-dynlink-initializers/test10_main.native.reference
···
1
1
Error: Failure("Plugin error")
2
-
Raised by primitive operation at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 85, characters 12-29
3
-
Re-raised at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", lines 87-89, characters 10-43
2
+
Raised by primitive operation at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 104, characters 12-40
3
+
Re-raised at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", lines 106-108, characters 10-43
4
4
Called from Stdlib__List.iter in file "list.ml", line 114, characters 12-15
5
-
Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 356, characters 11-54
5
+
Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 355, characters 11-54
6
6
Called from Stdlib__List.iter in file "list.ml", line 114, characters 12-15
7
7
Called from Stdlib__Fun.protect in file "fun.ml", line 34, characters 8-15
8
8
Re-raised at Stdlib__Fun.protect in file "fun.ml", line 39, characters 6-52
9
-
Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 364, characters 26-45
9
+
Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 363, characters 26-45
10
10
Called from Test10_main in file "test10_main.ml", lines 49-51, characters 30-7
+11
testsuite/tests/lib-dynlink-pr14323/test.ml
+11
testsuite/tests/lib-dynlink-pr14323/test.ml
+3
testsuite/tests/lib-dynlink-pr14323/test.reference
+3
testsuite/tests/lib-dynlink-pr14323/test.reference
+67
testsuite/tests/lib-dynlink-pr14323/test.sh
+67
testsuite/tests/lib-dynlink-pr14323/test.sh
···
1
+
#!/bin/bash
2
+
3
+
set -euo pipefail
4
+
5
+
ocamlsrcdir="$1"
6
+
7
+
ocamlopt=(
8
+
"$ocamlsrcdir"/ocamlopt.opt
9
+
-nostdlib
10
+
-I "$ocamlsrcdir"/stdlib
11
+
-I "$ocamlsrcdir"/otherlibs/dynlink
12
+
-I "$ocamlsrcdir"/otherlibs/unix
13
+
)
14
+
15
+
ocamlopt="${ocamlopt[@]}"
16
+
17
+
cat >lib.ml <<EOF
18
+
let s = "Hello natdynlink!"
19
+
EOF
20
+
21
+
cat >toto.ml <<EOF
22
+
let () =
23
+
print_endline Lib.s
24
+
EOF
25
+
26
+
cat >main.ml <<EOF
27
+
let () =
28
+
let rec loop failed i =
29
+
if i > 5 then begin
30
+
print_endline "Too many failures.";
31
+
exit 1
32
+
end else
33
+
match Dynlink.loadfile "toto.cmxs" with
34
+
| _ ->
35
+
print_endline "OK";
36
+
exit 0
37
+
| exception exn ->
38
+
if not failed then print_endline "Dynlink.loadfile failed. Retrying.";
39
+
Unix.sleep 1;
40
+
loop true (i + 1)
41
+
in
42
+
loop false 0
43
+
EOF
44
+
45
+
# Build toto.cmxs against the original lib.cmi
46
+
47
+
$ocamlopt -c lib.ml
48
+
$ocamlopt -shared -o toto.cmxs toto.ml
49
+
50
+
# Update lib.cmi
51
+
52
+
echo 'let x = 42' >>lib.ml
53
+
$ocamlopt -c lib.ml
54
+
$ocamlopt -o main.exe dynlink.cmxa unix.cmxa lib.cmx main.ml
55
+
56
+
# At this point, toto.cmxs no longer loads as the lib.cmi that has been recorded
57
+
# in main.exe does not match the one used when building toto.cmxs
58
+
59
+
./main.exe &
60
+
PID=$!
61
+
62
+
# Rebuild toto.cmxs against the updated lib.cmi
63
+
64
+
sleep 1
65
+
$ocamlopt -shared -o toto.cmxs toto.ml
66
+
67
+
wait $PID || :