summaryrefslogtreecommitdiff
blob: 8e1c860f6e93dccfd0eec55f67084a9ba6465029 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
From e18faeb91e620624106b94c8821f8c9574eddb17 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= <edwin.torok@cloud.com>
Date: Thu, 12 Jan 2023 17:48:29 +0000
Subject: [PATCH 18/61] tools/ocaml/evtchn: Don't reference Custom objects with
 the GC lock released
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

The modification to the _H() macro for Ocaml 5 support introduced a subtle
bug.  From the manual:

  https://ocaml.org/manual/intfc.html#ss:parallel-execution-long-running-c-code

"After caml_release_runtime_system() was called and until
caml_acquire_runtime_system() is called, the C code must not access any OCaml
data, nor call any function of the run-time system, nor call back into OCaml
code."

Previously, the value was a naked C pointer, so dereferencing it wasn't
"accessing any Ocaml data", but the fix to avoid naked C pointers added a
layer of indirection through an Ocaml Custom object, meaning that the common
pattern of using _H() in a blocking section is unsafe.

In order to fix:

 * Drop the _H() macro and replace it with a static inline xce_of_val().
 * Opencode the assignment into Data_custom_val() in the two constructors.
 * Rename "value xce" parameters to "value xce_val" so we can consistently
   have "xenevtchn_handle *xce" on the stack, and obtain the pointer with the
   GC lock still held.

Fixes: 22d5affdf0ce ("tools/ocaml/evtchn: OCaml 5 support, fix potential resource leak")
Signed-off-by: Edwin Török <edwin.torok@cloud.com>
Signed-off-by: Andrew Cooper <andrew.cooper3@citrix.com>
Acked-by: Christian Lindig <christian.lindig@citrix.com>
(cherry picked from commit 2636d8ff7a670c4d2485757dbe966e36c259a960)
---
 tools/ocaml/libs/eventchn/xeneventchn_stubs.c | 60 +++++++++++--------
 1 file changed, 35 insertions(+), 25 deletions(-)

diff --git a/tools/ocaml/libs/eventchn/xeneventchn_stubs.c b/tools/ocaml/libs/eventchn/xeneventchn_stubs.c
index aa8a69cc1e..d7881ca95f 100644
--- a/tools/ocaml/libs/eventchn/xeneventchn_stubs.c
+++ b/tools/ocaml/libs/eventchn/xeneventchn_stubs.c
@@ -33,11 +33,14 @@
 #include <caml/fail.h>
 #include <caml/signals.h>
 
-#define _H(__h) (*((xenevtchn_handle **)Data_custom_val(__h)))
+static inline xenevtchn_handle *xce_of_val(value v)
+{
+	return *(xenevtchn_handle **)Data_custom_val(v);
+}
 
 static void stub_evtchn_finalize(value v)
 {
-	xenevtchn_close(_H(v));
+	xenevtchn_close(xce_of_val(v));
 }
 
 static struct custom_operations xenevtchn_ops = {
@@ -68,7 +71,7 @@ CAMLprim value stub_eventchn_init(value cloexec)
 		caml_failwith("open failed");
 
 	result = caml_alloc_custom(&xenevtchn_ops, sizeof(xce), 0, 1);
-	_H(result) = xce;
+	*(xenevtchn_handle **)Data_custom_val(result) = xce;
 
 	CAMLreturn(result);
 }
@@ -87,18 +90,19 @@ CAMLprim value stub_eventchn_fdopen(value fdval)
 		caml_failwith("evtchn fdopen failed");
 
 	result = caml_alloc_custom(&xenevtchn_ops, sizeof(xce), 0, 1);
-	_H(result) = xce;
+	*(xenevtchn_handle **)Data_custom_val(result) = xce;
 
 	CAMLreturn(result);
 }
 
-CAMLprim value stub_eventchn_fd(value xce)
+CAMLprim value stub_eventchn_fd(value xce_val)
 {
-	CAMLparam1(xce);
+	CAMLparam1(xce_val);
 	CAMLlocal1(result);
+	xenevtchn_handle *xce = xce_of_val(xce_val);
 	int fd;
 
-	fd = xenevtchn_fd(_H(xce));
+	fd = xenevtchn_fd(xce);
 	if (fd == -1)
 		caml_failwith("evtchn fd failed");
 
@@ -107,13 +111,14 @@ CAMLprim value stub_eventchn_fd(value xce)
 	CAMLreturn(result);
 }
 
-CAMLprim value stub_eventchn_notify(value xce, value port)
+CAMLprim value stub_eventchn_notify(value xce_val, value port)
 {
-	CAMLparam2(xce, port);
+	CAMLparam2(xce_val, port);
+	xenevtchn_handle *xce = xce_of_val(xce_val);
 	int rc;
 
 	caml_enter_blocking_section();
-	rc = xenevtchn_notify(_H(xce), Int_val(port));
+	rc = xenevtchn_notify(xce, Int_val(port));
 	caml_leave_blocking_section();
 
 	if (rc == -1)
@@ -122,15 +127,16 @@ CAMLprim value stub_eventchn_notify(value xce, value port)
 	CAMLreturn(Val_unit);
 }
 
-CAMLprim value stub_eventchn_bind_interdomain(value xce, value domid,
+CAMLprim value stub_eventchn_bind_interdomain(value xce_val, value domid,
                                               value remote_port)
 {
-	CAMLparam3(xce, domid, remote_port);
+	CAMLparam3(xce_val, domid, remote_port);
 	CAMLlocal1(port);
+	xenevtchn_handle *xce = xce_of_val(xce_val);
 	xenevtchn_port_or_error_t rc;
 
 	caml_enter_blocking_section();
-	rc = xenevtchn_bind_interdomain(_H(xce), Int_val(domid), Int_val(remote_port));
+	rc = xenevtchn_bind_interdomain(xce, Int_val(domid), Int_val(remote_port));
 	caml_leave_blocking_section();
 
 	if (rc == -1)
@@ -140,14 +146,15 @@ CAMLprim value stub_eventchn_bind_interdomain(value xce, value domid,
 	CAMLreturn(port);
 }
 
-CAMLprim value stub_eventchn_bind_virq(value xce, value virq_type)
+CAMLprim value stub_eventchn_bind_virq(value xce_val, value virq_type)
 {
-	CAMLparam2(xce, virq_type);
+	CAMLparam2(xce_val, virq_type);
 	CAMLlocal1(port);
+	xenevtchn_handle *xce = xce_of_val(xce_val);
 	xenevtchn_port_or_error_t rc;
 
 	caml_enter_blocking_section();
-	rc = xenevtchn_bind_virq(_H(xce), Int_val(virq_type));
+	rc = xenevtchn_bind_virq(xce, Int_val(virq_type));
 	caml_leave_blocking_section();
 
 	if (rc == -1)
@@ -157,13 +164,14 @@ CAMLprim value stub_eventchn_bind_virq(value xce, value virq_type)
 	CAMLreturn(port);
 }
 
-CAMLprim value stub_eventchn_unbind(value xce, value port)
+CAMLprim value stub_eventchn_unbind(value xce_val, value port)
 {
-	CAMLparam2(xce, port);
+	CAMLparam2(xce_val, port);
+	xenevtchn_handle *xce = xce_of_val(xce_val);
 	int rc;
 
 	caml_enter_blocking_section();
-	rc = xenevtchn_unbind(_H(xce), Int_val(port));
+	rc = xenevtchn_unbind(xce, Int_val(port));
 	caml_leave_blocking_section();
 
 	if (rc == -1)
@@ -172,14 +180,15 @@ CAMLprim value stub_eventchn_unbind(value xce, value port)
 	CAMLreturn(Val_unit);
 }
 
-CAMLprim value stub_eventchn_pending(value xce)
+CAMLprim value stub_eventchn_pending(value xce_val)
 {
-	CAMLparam1(xce);
+	CAMLparam1(xce_val);
 	CAMLlocal1(result);
+	xenevtchn_handle *xce = xce_of_val(xce_val);
 	xenevtchn_port_or_error_t port;
 
 	caml_enter_blocking_section();
-	port = xenevtchn_pending(_H(xce));
+	port = xenevtchn_pending(xce);
 	caml_leave_blocking_section();
 
 	if (port == -1)
@@ -189,16 +198,17 @@ CAMLprim value stub_eventchn_pending(value xce)
 	CAMLreturn(result);
 }
 
-CAMLprim value stub_eventchn_unmask(value xce, value _port)
+CAMLprim value stub_eventchn_unmask(value xce_val, value _port)
 {
-	CAMLparam2(xce, _port);
+	CAMLparam2(xce_val, _port);
+	xenevtchn_handle *xce = xce_of_val(xce_val);
 	evtchn_port_t port;
 	int rc;
 
 	port = Int_val(_port);
 
 	caml_enter_blocking_section();
-	rc = xenevtchn_unmask(_H(xce), port);
+	rc = xenevtchn_unmask(xce, port);
 	caml_leave_blocking_section();
 
 	if (rc)
-- 
2.40.0