1 /*
2 * Copyright (C) 2009-2011 Citrix Ltd.
3 * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
4 *
5 * This program is free software; you can redistribute it and/or modify
6 * it under the terms of the GNU Lesser General Public License as published
7 * by the Free Software Foundation; version 2.1 only. with the special
8 * exception on linking described in file LICENSE.
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 Lesser General Public License for more details.
14 */
15
16 #include <stdlib.h>
17
18 #define CAML_NAME_SPACE
19 #include <caml/alloc.h>
20 #include <caml/memory.h>
21 #include <caml/signals.h>
22 #include <caml/fail.h>
23 #include <caml/callback.h>
24 #include <caml/custom.h>
25
26 #include <sys/mman.h>
27 #include <stdint.h>
28 #include <string.h>
29
30 #include <libxl.h>
31 #include <libxl_utils.h>
32
33 #include <unistd.h>
34 #include <assert.h>
35
36 #include "caml_xentoollog.h"
37
38 /*
39 * Starting with ocaml-3.09.3, CAMLreturn can only be used for ``value''
40 * types. CAMLreturnT was only added in 3.09.4, so we define our own
41 * version here if needed.
42 */
43 #ifndef CAMLreturnT
44 #define CAMLreturnT(type, result) do { \
45 type caml__temp_result = (result); \
46 caml_local_roots = caml__frame; \
47 return (caml__temp_result); \
48 } while (0)
49 #endif
50
51 /* The following is equal to the CAMLreturn macro, but without the return */
52 #define CAMLdone do{ \
53 caml_local_roots = caml__frame; \
54 }while (0)
55
56 #define Ctx_val(x)(*((libxl_ctx **) Data_custom_val(x)))
57 #define CTX ((libxl_ctx *) Ctx_val(ctx))
58
dup_String_val(value s)59 static char * dup_String_val(value s)
60 {
61 int len;
62 char *c;
63 len = caml_string_length(s);
64 c = calloc(len + 1, sizeof(char));
65 if (!c)
66 caml_raise_out_of_memory();
67 memcpy(c, String_val(s), len);
68 return c;
69 }
70
71 /* Forward reference: this is defined in the auto-generated include file below. */
72 static value Val_error (libxl_error error_c);
73
failwith_xl(int error,char * fname)74 static void failwith_xl(int error, char *fname)
75 {
76 CAMLparam0();
77 CAMLlocal1(arg);
78 static const value *exc = NULL;
79
80 /* First time around, lookup by name */
81 if (!exc)
82 exc = caml_named_value("Xenlight.Error");
83
84 if (!exc)
85 caml_invalid_argument("Exception Xenlight.Error not initialized, please link xenlight.cma");
86
87 arg = caml_alloc(2, 0);
88
89 Store_field(arg, 0, Val_error(error));
90 Store_field(arg, 1, caml_copy_string(fname));
91
92 caml_raise_with_arg(*exc, arg);
93 CAMLreturn0;
94 }
95
stub_raise_exception(value unit)96 CAMLprim value stub_raise_exception(value unit)
97 {
98 CAMLparam1(unit);
99 failwith_xl(ERROR_FAIL, "test exception");
100 CAMLreturn(Val_unit);
101 }
102
ctx_finalize(value ctx)103 void ctx_finalize(value ctx)
104 {
105 libxl_ctx_free(CTX);
106 }
107
108 static struct custom_operations libxl_ctx_custom_operations = {
109 "libxl_ctx_custom_operations",
110 ctx_finalize /* custom_finalize_default */,
111 custom_compare_default,
112 custom_hash_default,
113 custom_serialize_default,
114 custom_deserialize_default
115 };
116
stub_libxl_ctx_alloc(value logger)117 CAMLprim value stub_libxl_ctx_alloc(value logger)
118 {
119 CAMLparam1(logger);
120 CAMLlocal1(handle);
121 libxl_ctx *ctx;
122 int ret;
123
124 ret = libxl_ctx_alloc(&ctx, LIBXL_VERSION, 0, (xentoollog_logger *) Xtl_val(logger));
125 if (ret != 0) \
126 failwith_xl(ERROR_FAIL, "cannot init context");
127
128 handle = caml_alloc_custom(&libxl_ctx_custom_operations, sizeof(ctx), 0, 1);
129 Ctx_val(handle) = ctx;
130
131 CAMLreturn(handle);
132 }
133
list_len(value v)134 static int list_len(value v)
135 {
136 int len = 0;
137 while ( v != Val_emptylist ) {
138 len++;
139 v = Field(v, 1);
140 }
141 return len;
142 }
143
libxl_key_value_list_val(libxl_key_value_list * c_val,value v)144 static int libxl_key_value_list_val(libxl_key_value_list *c_val,
145 value v)
146 {
147 CAMLparam1(v);
148 CAMLlocal1(elem);
149 int nr, i;
150 libxl_key_value_list array;
151
152 nr = list_len(v);
153
154 array = calloc((nr + 1) * 2, sizeof(char *));
155 if (!array)
156 caml_raise_out_of_memory();
157
158 for (i=0; v != Val_emptylist; i++, v = Field(v, 1) ) {
159 elem = Field(v, 0);
160
161 array[i * 2] = dup_String_val(Field(elem, 0));
162 array[i * 2 + 1] = dup_String_val(Field(elem, 1));
163 }
164
165 *c_val = array;
166 CAMLreturn(0);
167 }
168
Val_key_value_list(libxl_key_value_list * c_val)169 static value Val_key_value_list(libxl_key_value_list *c_val)
170 {
171 CAMLparam0();
172 CAMLlocal5(list, cons, key, val, kv);
173 int i;
174
175 list = Val_emptylist;
176 for (i = libxl_string_list_length((libxl_string_list *) c_val) - 1; i >= 0; i -= 2) {
177 val = caml_copy_string((*c_val)[i]);
178 key = caml_copy_string((*c_val)[i - 1]);
179 kv = caml_alloc_tuple(2);
180 Store_field(kv, 0, key);
181 Store_field(kv, 1, val);
182
183 cons = caml_alloc(2, 0);
184 Store_field(cons, 0, kv); // head
185 Store_field(cons, 1, list); // tail
186 list = cons;
187 }
188
189 CAMLreturn(list);
190 }
191
libxl_string_list_val(libxl_string_list * c_val,value v)192 static int libxl_string_list_val(libxl_string_list *c_val, value v)
193 {
194 CAMLparam1(v);
195 int nr, i;
196 libxl_string_list array;
197
198 nr = list_len(v);
199
200 array = calloc(nr + 1, sizeof(char *));
201 if (!array)
202 caml_raise_out_of_memory();
203
204 for (i=0; v != Val_emptylist; i++, v = Field(v, 1) )
205 array[i] = dup_String_val(Field(v, 0));
206
207 *c_val = array;
208 CAMLreturn(0);
209 }
210
Val_string_list(libxl_string_list * c_val)211 static value Val_string_list(libxl_string_list *c_val)
212 {
213 CAMLparam0();
214 CAMLlocal3(list, cons, string);
215 int i;
216
217 list = Val_emptylist;
218 for (i = libxl_string_list_length(c_val) - 1; i >= 0; i--) {
219 string = caml_copy_string((*c_val)[i]);
220 cons = caml_alloc(2, 0);
221 Store_field(cons, 0, string); // head
222 Store_field(cons, 1, list); // tail
223 list = cons;
224 }
225
226 CAMLreturn(list);
227 }
228
229 /* Option type support as per http://www.linux-nantes.org/~fmonnier/ocaml/ocaml-wrapping-c.php */
230 #define Val_none Val_int(0)
231 #define Some_val(v) Field(v,0)
232
Val_some(value v)233 static value Val_some(value v)
234 {
235 CAMLparam1(v);
236 CAMLlocal1(some);
237 some = caml_alloc(1, 0);
238 Store_field(some, 0, v);
239 CAMLreturn(some);
240 }
241
Val_mac(libxl_mac * c_val)242 static value Val_mac (libxl_mac *c_val)
243 {
244 CAMLparam0();
245 CAMLlocal1(v);
246 int i;
247
248 v = caml_alloc_tuple(6);
249
250 for(i=0; i<6; i++)
251 Store_field(v, i, Val_int((*c_val)[i]));
252
253 CAMLreturn(v);
254 }
255
Mac_val(libxl_mac * c_val,value v)256 static int Mac_val(libxl_mac *c_val, value v)
257 {
258 CAMLparam1(v);
259 int i;
260
261 for(i=0; i<6; i++)
262 (*c_val)[i] = Int_val(Field(v, i));
263
264 CAMLreturn(0);
265 }
266
Val_bitmap(libxl_bitmap * c_val)267 static value Val_bitmap (libxl_bitmap *c_val)
268 {
269 CAMLparam0();
270 CAMLlocal1(v);
271 int i;
272
273 if (c_val->size == 0)
274 v = Atom(0);
275 else {
276 v = caml_alloc(8 * (c_val->size), 0);
277 libxl_for_each_bit(i, *c_val) {
278 if (libxl_bitmap_test(c_val, i))
279 Store_field(v, i, Val_true);
280 else
281 Store_field(v, i, Val_false);
282 }
283 }
284 CAMLreturn(v);
285 }
286
Bitmap_val(libxl_ctx * ctx,libxl_bitmap * c_val,value v)287 static int Bitmap_val(libxl_ctx *ctx, libxl_bitmap *c_val, value v)
288 {
289 CAMLparam1(v);
290 int i, len = Wosize_val(v);
291
292 c_val->size = 0;
293 if (len > 0 && libxl_bitmap_alloc(ctx, c_val, len))
294 failwith_xl(ERROR_NOMEM, "cannot allocate bitmap");
295 for (i=0; i<len; i++) {
296 if (Int_val(Field(v, i)))
297 libxl_bitmap_set(c_val, i);
298 else
299 libxl_bitmap_reset(c_val, i);
300 }
301 CAMLreturn(0);
302 }
303
Val_uuid(libxl_uuid * c_val)304 static value Val_uuid (libxl_uuid *c_val)
305 {
306 CAMLparam0();
307 CAMLlocal1(v);
308 uint8_t *uuid = libxl_uuid_bytearray(c_val);
309 int i;
310
311 v = caml_alloc_tuple(16);
312
313 for(i=0; i<16; i++)
314 Store_field(v, i, Val_int(uuid[i]));
315
316 CAMLreturn(v);
317 }
318
Uuid_val(libxl_uuid * c_val,value v)319 static int Uuid_val(libxl_uuid *c_val, value v)
320 {
321 CAMLparam1(v);
322 int i;
323 uint8_t *uuid = libxl_uuid_bytearray(c_val);
324
325 for(i=0; i<16; i++)
326 uuid[i] = Int_val(Field(v, i));
327
328 CAMLreturn(0);
329 }
330
Val_defbool(libxl_defbool c_val)331 static value Val_defbool(libxl_defbool c_val)
332 {
333 CAMLparam0();
334 CAMLlocal2(v1, v2);
335 bool b;
336
337 if (libxl_defbool_is_default(c_val))
338 v2 = Val_none;
339 else {
340 b = libxl_defbool_val(c_val);
341 v1 = b ? Val_bool(true) : Val_bool(false);
342 v2 = Val_some(v1);
343 }
344 CAMLreturn(v2);
345 }
346
Defbool_val(value v)347 static libxl_defbool Defbool_val(value v)
348 {
349 CAMLparam1(v);
350 libxl_defbool db;
351 if (v == Val_none)
352 libxl_defbool_unset(&db);
353 else {
354 bool b = Bool_val(Some_val(v));
355 libxl_defbool_set(&db, b);
356 }
357 CAMLreturnT(libxl_defbool, db);
358 }
359
Val_hwcap(libxl_hwcap * c_val)360 static value Val_hwcap(libxl_hwcap *c_val)
361 {
362 CAMLparam0();
363 CAMLlocal1(hwcap);
364 int i;
365
366 hwcap = caml_alloc_tuple(8);
367 for (i = 0; i < 8; i++)
368 Store_field(hwcap, i, caml_copy_int32((*c_val)[i]));
369
370 CAMLreturn(hwcap);
371 }
372
Val_ms_vm_genid(libxl_ms_vm_genid * c_val)373 static value Val_ms_vm_genid (libxl_ms_vm_genid *c_val)
374 {
375 CAMLparam0();
376 CAMLlocal1(v);
377 int i;
378
379 v = caml_alloc_tuple(LIBXL_MS_VM_GENID_LEN);
380
381 for(i=0; i<LIBXL_MS_VM_GENID_LEN; i++)
382 Store_field(v, i, Val_int(c_val->bytes[i]));
383
384 CAMLreturn(v);
385 }
386
Ms_vm_genid_val(libxl_ms_vm_genid * c_val,value v)387 static int Ms_vm_genid_val(libxl_ms_vm_genid *c_val, value v)
388 {
389 CAMLparam1(v);
390 int i;
391
392 for(i=0; i<LIBXL_MS_VM_GENID_LEN; i++)
393 c_val->bytes[i] = Int_val(Field(v, i));
394
395 CAMLreturn(0);
396 }
397
Val_string_option(const char * c_val)398 static value Val_string_option(const char *c_val)
399 {
400 CAMLparam0();
401 CAMLlocal2(tmp1, tmp2);
402 if (c_val) {
403 tmp1 = caml_copy_string(c_val);
404 tmp2 = Val_some(tmp1);
405 CAMLreturn(tmp2);
406 }
407 else
408 CAMLreturn(Val_none);
409 }
410
String_option_val(value v)411 static char *String_option_val(value v)
412 {
413 CAMLparam1(v);
414 char *s = NULL;
415 if (v != Val_none)
416 s = dup_String_val(Some_val(v));
417 CAMLreturnT(char *, s);
418 }
419
420 #include "_libxl_types.inc"
421
async_callback(libxl_ctx * ctx,int rc,void * for_callback)422 void async_callback(libxl_ctx *ctx, int rc, void *for_callback)
423 {
424 caml_leave_blocking_section();
425 CAMLparam0();
426 CAMLlocal2(error, tmp);
427 static const value *func = NULL;
428 value *p = (value *) for_callback;
429
430 if (func == NULL) {
431 /* First time around, lookup by name */
432 func = caml_named_value("libxl_async_callback");
433 }
434
435 if (rc == 0)
436 error = Val_none;
437 else {
438 tmp = Val_error(rc);
439 error = Val_some(tmp);
440 }
441
442 /* for_callback is a pointer to a "value" that was malloc'ed and
443 * registered with the OCaml GC. The value is handed back to OCaml
444 * in the following callback, after which the pointer is unregistered
445 * and freed. */
446 caml_callback2(*func, error, *p);
447
448 caml_remove_global_root(p);
449 free(p);
450
451 CAMLdone;
452 caml_enter_blocking_section();
453 }
454
aohow_val(value async)455 static libxl_asyncop_how *aohow_val(value async)
456 {
457 CAMLparam1(async);
458 libxl_asyncop_how *ao_how = NULL;
459 value *p;
460
461 if (async != Val_none) {
462 /* for_callback must be a pointer to a "value" that is malloc'ed and
463 * registered with the OCaml GC. This ensures that the GC does not remove
464 * the corresponding OCaml heap blocks, and allows the GC to update the value
465 * when blocks are moved around, while libxl is free to copy the pointer if
466 * it needs to.
467 * The for_callback pointer must always be non-NULL. */
468 p = malloc(sizeof(value));
469 if (!p)
470 failwith_xl(ERROR_NOMEM, "cannot allocate value");
471 *p = Some_val(async);
472 caml_register_global_root(p);
473 ao_how = malloc(sizeof(*ao_how));
474 ao_how->callback = async_callback;
475 ao_how->u.for_callback = (void *) p;
476 }
477
478 CAMLreturnT(libxl_asyncop_how *, ao_how);
479 }
480
stub_libxl_domain_create_new(value ctx,value domain_config,value async,value unit)481 value stub_libxl_domain_create_new(value ctx, value domain_config, value async, value unit)
482 {
483 CAMLparam4(ctx, async, domain_config, unit);
484 int ret;
485 libxl_domain_config c_dconfig;
486 uint32_t c_domid;
487 libxl_asyncop_how *ao_how;
488
489 libxl_domain_config_init(&c_dconfig);
490 ret = domain_config_val(CTX, &c_dconfig, domain_config);
491 if (ret != 0) {
492 libxl_domain_config_dispose(&c_dconfig);
493 failwith_xl(ret, "domain_create_new");
494 }
495
496 ao_how = aohow_val(async);
497
498 caml_enter_blocking_section();
499 ret = libxl_domain_create_new(CTX, &c_dconfig, &c_domid, ao_how, NULL);
500 caml_leave_blocking_section();
501
502 free(ao_how);
503 libxl_domain_config_dispose(&c_dconfig);
504
505 if (ret != 0)
506 failwith_xl(ret, "domain_create_new");
507
508 CAMLreturn(Val_int(c_domid));
509 }
510
stub_libxl_domain_create_restore(value ctx,value domain_config,value params,value async,value unit)511 value stub_libxl_domain_create_restore(value ctx, value domain_config, value params,
512 value async, value unit)
513 {
514 CAMLparam5(ctx, domain_config, params, async, unit);
515 int ret;
516 libxl_domain_config c_dconfig;
517 libxl_domain_restore_params c_params;
518 uint32_t c_domid;
519 libxl_asyncop_how *ao_how;
520 int restore_fd;
521
522 libxl_domain_config_init(&c_dconfig);
523 ret = domain_config_val(CTX, &c_dconfig, domain_config);
524 if (ret != 0) {
525 libxl_domain_config_dispose(&c_dconfig);
526 failwith_xl(ret, "domain_create_restore");
527 }
528
529 libxl_domain_restore_params_init(&c_params);
530 ret = domain_restore_params_val(CTX, &c_params, Field(params, 1));
531 if (ret != 0) {
532 libxl_domain_restore_params_dispose(&c_params);
533 failwith_xl(ret, "domain_create_restore");
534 }
535
536 ao_how = aohow_val(async);
537 restore_fd = Int_val(Field(params, 0));
538
539 caml_enter_blocking_section();
540 ret = libxl_domain_create_restore(CTX, &c_dconfig, &c_domid, restore_fd,
541 -1, &c_params, ao_how, NULL);
542 caml_leave_blocking_section();
543
544 free(ao_how);
545 libxl_domain_config_dispose(&c_dconfig);
546 libxl_domain_restore_params_dispose(&c_params);
547
548 if (ret != 0)
549 failwith_xl(ret, "domain_create_restore");
550
551 CAMLreturn(Val_int(c_domid));
552 }
553
stub_libxl_domain_shutdown(value ctx,value domid,value async,value unit)554 value stub_libxl_domain_shutdown(value ctx, value domid, value async, value unit)
555 {
556 CAMLparam4(ctx, domid, async, unit);
557 int ret;
558 uint32_t c_domid = Int_val(domid);
559 libxl_asyncop_how *ao_how = aohow_val(async);
560
561 caml_enter_blocking_section();
562 ret = libxl_domain_shutdown(CTX, c_domid, ao_how);
563 caml_leave_blocking_section();
564
565 free(ao_how);
566
567 if (ret != 0)
568 failwith_xl(ret, "domain_shutdown");
569
570 CAMLreturn(Val_unit);
571 }
572
stub_libxl_domain_reboot(value ctx,value domid,value async,value unit)573 value stub_libxl_domain_reboot(value ctx, value domid, value async, value unit)
574 {
575 CAMLparam4(ctx, domid, async, unit);
576 int ret;
577 uint32_t c_domid = Int_val(domid);
578 libxl_asyncop_how *ao_how = aohow_val(async);
579
580 caml_enter_blocking_section();
581 ret = libxl_domain_reboot(CTX, c_domid, ao_how);
582 caml_leave_blocking_section();
583
584 free(ao_how);
585
586 if (ret != 0)
587 failwith_xl(ret, "domain_reboot");
588
589 CAMLreturn(Val_unit);
590 }
591
stub_libxl_domain_destroy(value ctx,value domid,value async,value unit)592 value stub_libxl_domain_destroy(value ctx, value domid, value async, value unit)
593 {
594 CAMLparam4(ctx, domid, async, unit);
595 int ret;
596 uint32_t c_domid = Int_val(domid);
597 libxl_asyncop_how *ao_how = aohow_val(async);
598
599 caml_enter_blocking_section();
600 ret = libxl_domain_destroy(CTX, c_domid, ao_how);
601 caml_leave_blocking_section();
602
603 free(ao_how);
604
605 if (ret != 0)
606 failwith_xl(ret, "domain_destroy");
607
608 CAMLreturn(Val_unit);
609 }
610
stub_libxl_domain_suspend(value ctx,value domid,value fd,value async,value unit)611 value stub_libxl_domain_suspend(value ctx, value domid, value fd, value async, value unit)
612 {
613 CAMLparam5(ctx, domid, fd, async, unit);
614 int ret;
615 uint32_t c_domid = Int_val(domid);
616 int c_fd = Int_val(fd);
617 libxl_asyncop_how *ao_how = aohow_val(async);
618
619 caml_enter_blocking_section();
620 ret = libxl_domain_suspend(CTX, c_domid, c_fd, 0, ao_how);
621 caml_leave_blocking_section();
622
623 free(ao_how);
624
625 if (ret != 0)
626 failwith_xl(ret, "domain_suspend");
627
628 CAMLreturn(Val_unit);
629 }
630
stub_libxl_domain_pause(value ctx,value domid,value async)631 value stub_libxl_domain_pause(value ctx, value domid, value async)
632 {
633 CAMLparam3(ctx, domid, async);
634 int ret;
635 uint32_t c_domid = Int_val(domid);
636 libxl_asyncop_how *ao_how = aohow_val(async);
637
638 caml_enter_blocking_section();
639 ret = libxl_domain_pause(CTX, c_domid, ao_how);
640 caml_leave_blocking_section();
641
642 free(ao_how);
643
644 if (ret != 0)
645 failwith_xl(ret, "domain_pause");
646
647 CAMLreturn(Val_unit);
648 }
649
stub_libxl_domain_unpause(value ctx,value domid,value async)650 value stub_libxl_domain_unpause(value ctx, value domid, value async)
651 {
652 CAMLparam3(ctx, domid, async);
653 int ret;
654 uint32_t c_domid = Int_val(domid);
655 libxl_asyncop_how *ao_how = aohow_val(async);
656
657 caml_enter_blocking_section();
658 ret = libxl_domain_unpause(CTX, c_domid, ao_how);
659 caml_leave_blocking_section();
660
661 free(ao_how);
662
663 if (ret != 0)
664 failwith_xl(ret, "domain_unpause");
665
666 CAMLreturn(Val_unit);
667 }
668
669 #define _STRINGIFY(x) #x
670 #define STRINGIFY(x) _STRINGIFY(x)
671
672 #define _DEVICE_ADDREMOVE(type,fn,op) \
673 value stub_xl_device_##type##_##op(value ctx, value info, value domid, \
674 value async, value unit) \
675 { \
676 CAMLparam5(ctx, info, domid, async, unit); \
677 libxl_device_##type c_info; \
678 int ret, marker_var; \
679 uint32_t c_domid = Int_val(domid); \
680 libxl_asyncop_how *ao_how = aohow_val(async); \
681 \
682 device_##type##_val(CTX, &c_info, info); \
683 \
684 caml_enter_blocking_section(); \
685 ret = libxl_##fn##_##op(CTX, c_domid, &c_info, ao_how); \
686 caml_leave_blocking_section(); \
687 \
688 free(ao_how); \
689 libxl_device_##type##_dispose(&c_info); \
690 \
691 if (ret != 0) \
692 failwith_xl(ret, STRINGIFY(type) "_" STRINGIFY(op)); \
693 \
694 CAMLreturn(Val_unit); \
695 }
696
697 #define DEVICE_ADDREMOVE(type) \
698 _DEVICE_ADDREMOVE(type, device_##type, add) \
699 _DEVICE_ADDREMOVE(type, device_##type, remove) \
700 _DEVICE_ADDREMOVE(type, device_##type, destroy)
701
702 DEVICE_ADDREMOVE(disk)
DEVICE_ADDREMOVE(nic)703 DEVICE_ADDREMOVE(nic)
704 DEVICE_ADDREMOVE(vfb)
705 DEVICE_ADDREMOVE(vkb)
706 DEVICE_ADDREMOVE(pci)
707 _DEVICE_ADDREMOVE(disk, cdrom, insert)
708
709 value stub_xl_device_nic_of_devid(value ctx, value domid, value devid)
710 {
711 CAMLparam3(ctx, domid, devid);
712 CAMLlocal1(nic);
713 libxl_device_nic c_nic;
714 uint32_t c_domid = Int_val(domid);
715 int c_devid = Int_val(devid);
716
717 caml_enter_blocking_section();
718 libxl_devid_to_device_nic(CTX, c_domid, c_devid, &c_nic);
719 caml_leave_blocking_section();
720
721 nic = Val_device_nic(&c_nic);
722 libxl_device_nic_dispose(&c_nic);
723
724 CAMLreturn(nic);
725 }
726
stub_xl_device_nic_list(value ctx,value domid)727 value stub_xl_device_nic_list(value ctx, value domid)
728 {
729 CAMLparam2(ctx, domid);
730 CAMLlocal2(list, temp);
731 libxl_device_nic *c_list;
732 int i, nb;
733 uint32_t c_domid = Int_val(domid);
734
735 caml_enter_blocking_section();
736 c_list = libxl_device_nic_list(CTX, c_domid, &nb);
737 caml_leave_blocking_section();
738
739 if (!c_list)
740 failwith_xl(ERROR_FAIL, "nic_list");
741
742 list = temp = Val_emptylist;
743 for (i = 0; i < nb; i++) {
744 list = caml_alloc_small(2, Tag_cons);
745 Field(list, 0) = Val_int(0);
746 Field(list, 1) = temp;
747 temp = list;
748 Store_field(list, 0, Val_device_nic(&c_list[i]));
749 }
750 libxl_device_nic_list_free(c_list, nb);
751
752 CAMLreturn(list);
753 }
754
stub_xl_device_disk_list(value ctx,value domid)755 value stub_xl_device_disk_list(value ctx, value domid)
756 {
757 CAMLparam2(ctx, domid);
758 CAMLlocal2(list, temp);
759 libxl_device_disk *c_list;
760 int i, nb;
761 uint32_t c_domid = Int_val(domid);
762
763 caml_enter_blocking_section();
764 c_list = libxl_device_disk_list(CTX, c_domid, &nb);
765 caml_leave_blocking_section();
766
767 if (!c_list)
768 failwith_xl(ERROR_FAIL, "disk_list");
769
770 list = temp = Val_emptylist;
771 for (i = 0; i < nb; i++) {
772 list = caml_alloc_small(2, Tag_cons);
773 Field(list, 0) = Val_int(0);
774 Field(list, 1) = temp;
775 temp = list;
776 Store_field(list, 0, Val_device_disk(&c_list[i]));
777 }
778 libxl_device_disk_list_free(c_list, nb);
779
780 CAMLreturn(list);
781 }
782
stub_xl_device_disk_of_vdev(value ctx,value domid,value vdev)783 value stub_xl_device_disk_of_vdev(value ctx, value domid, value vdev)
784 {
785 CAMLparam3(ctx, domid, vdev);
786 CAMLlocal1(disk);
787 libxl_device_disk c_disk;
788 char *c_vdev;
789 uint32_t c_domid = Int_val(domid);
790
791 c_vdev = strdup(String_val(vdev));
792
793 caml_enter_blocking_section();
794 libxl_vdev_to_device_disk(CTX, c_domid, c_vdev, &c_disk);
795 caml_leave_blocking_section();
796
797 disk = Val_device_disk(&c_disk);
798 libxl_device_disk_dispose(&c_disk);
799 free(c_vdev);
800
801 CAMLreturn(disk);
802 }
803
stub_xl_device_pci_list(value ctx,value domid)804 value stub_xl_device_pci_list(value ctx, value domid)
805 {
806 CAMLparam2(ctx, domid);
807 CAMLlocal2(list, temp);
808 libxl_device_pci *c_list;
809 int i, nb;
810 uint32_t c_domid = Int_val(domid);
811
812 caml_enter_blocking_section();
813 c_list = libxl_device_pci_list(CTX, c_domid, &nb);
814 caml_leave_blocking_section();
815
816 if (!c_list)
817 failwith_xl(ERROR_FAIL, "pci_list");
818
819 list = temp = Val_emptylist;
820 for (i = 0; i < nb; i++) {
821 list = caml_alloc_small(2, Tag_cons);
822 Field(list, 0) = Val_int(0);
823 Field(list, 1) = temp;
824 temp = list;
825 Store_field(list, 0, Val_device_pci(&c_list[i]));
826 libxl_device_pci_dispose(&c_list[i]);
827 }
828 free(c_list);
829
830 CAMLreturn(list);
831 }
832
stub_xl_device_pci_assignable_add(value ctx,value info,value rebind)833 value stub_xl_device_pci_assignable_add(value ctx, value info, value rebind)
834 {
835 CAMLparam3(ctx, info, rebind);
836 libxl_device_pci c_info;
837 int ret, marker_var;
838 int c_rebind = (int) Bool_val(rebind);
839
840 device_pci_val(CTX, &c_info, info);
841
842 caml_enter_blocking_section();
843 ret = libxl_device_pci_assignable_add(CTX, &c_info, c_rebind);
844 caml_leave_blocking_section();
845
846 libxl_device_pci_dispose(&c_info);
847
848 if (ret != 0)
849 failwith_xl(ret, "pci_assignable_add");
850
851 CAMLreturn(Val_unit);
852 }
853
stub_xl_device_pci_assignable_remove(value ctx,value info,value rebind)854 value stub_xl_device_pci_assignable_remove(value ctx, value info, value rebind)
855 {
856 CAMLparam3(ctx, info, rebind);
857 libxl_device_pci c_info;
858 int ret, marker_var;
859 int c_rebind = (int) Bool_val(rebind);
860
861 device_pci_val(CTX, &c_info, info);
862
863 caml_enter_blocking_section();
864 ret = libxl_device_pci_assignable_remove(CTX, &c_info, c_rebind);
865 caml_leave_blocking_section();
866
867 libxl_device_pci_dispose(&c_info);
868
869 if (ret != 0)
870 failwith_xl(ret, "pci_assignable_remove");
871
872 CAMLreturn(Val_unit);
873 }
874
stub_xl_device_pci_assignable_list(value ctx)875 value stub_xl_device_pci_assignable_list(value ctx)
876 {
877 CAMLparam1(ctx);
878 CAMLlocal2(list, temp);
879 libxl_device_pci *c_list;
880 int i, nb;
881 uint32_t c_domid;
882
883 caml_enter_blocking_section();
884 c_list = libxl_device_pci_assignable_list(CTX, &nb);
885 caml_leave_blocking_section();
886
887 if (!c_list)
888 failwith_xl(ERROR_FAIL, "pci_assignable_list");
889
890 list = temp = Val_emptylist;
891 for (i = 0; i < nb; i++) {
892 list = caml_alloc_small(2, Tag_cons);
893 Field(list, 0) = Val_int(0);
894 Field(list, 1) = temp;
895 temp = list;
896 Store_field(list, 0, Val_device_pci(&c_list[i]));
897 libxl_device_pci_dispose(&c_list[i]);
898 }
899 free(c_list);
900
901 CAMLreturn(list);
902 }
903
stub_xl_physinfo_get(value ctx)904 value stub_xl_physinfo_get(value ctx)
905 {
906 CAMLparam1(ctx);
907 CAMLlocal1(physinfo);
908 libxl_physinfo c_physinfo;
909 int ret;
910
911 caml_enter_blocking_section();
912 ret = libxl_get_physinfo(CTX, &c_physinfo);
913 caml_leave_blocking_section();
914
915 if (ret != 0)
916 failwith_xl(ret, "get_physinfo");
917
918 physinfo = Val_physinfo(&c_physinfo);
919
920 libxl_physinfo_dispose(&c_physinfo);
921
922 CAMLreturn(physinfo);
923 }
924
stub_xl_cputopology_get(value ctx)925 value stub_xl_cputopology_get(value ctx)
926 {
927 CAMLparam1(ctx);
928 CAMLlocal3(topology, v, v0);
929 libxl_cputopology *c_topology;
930 int i, nr;
931
932 caml_enter_blocking_section();
933 c_topology = libxl_get_cpu_topology(CTX, &nr);
934 caml_leave_blocking_section();
935
936 if (!c_topology)
937 failwith_xl(ERROR_FAIL, "get_cpu_topologyinfo");
938
939 topology = caml_alloc_tuple(nr);
940 for (i = 0; i < nr; i++) {
941 if (c_topology[i].core != LIBXL_CPUTOPOLOGY_INVALID_ENTRY) {
942 v0 = Val_cputopology(&c_topology[i]);
943 v = Val_some(v0);
944 }
945 else
946 v = Val_none;
947 Store_field(topology, i, v);
948 }
949
950 libxl_cputopology_list_free(c_topology, nr);
951
952 CAMLreturn(topology);
953 }
954
stub_xl_dominfo_list(value ctx)955 value stub_xl_dominfo_list(value ctx)
956 {
957 CAMLparam1(ctx);
958 CAMLlocal2(domlist, temp);
959 libxl_dominfo *c_domlist;
960 int i, nb;
961
962 caml_enter_blocking_section();
963 c_domlist = libxl_list_domain(CTX, &nb);
964 caml_leave_blocking_section();
965
966 if (!c_domlist)
967 failwith_xl(ERROR_FAIL, "dominfo_list");
968
969 domlist = temp = Val_emptylist;
970 for (i = nb - 1; i >= 0; i--) {
971 domlist = caml_alloc_small(2, Tag_cons);
972 Field(domlist, 0) = Val_int(0);
973 Field(domlist, 1) = temp;
974 temp = domlist;
975
976 Store_field(domlist, 0, Val_dominfo(&c_domlist[i]));
977 }
978
979 libxl_dominfo_list_free(c_domlist, nb);
980
981 CAMLreturn(domlist);
982 }
983
stub_xl_dominfo_get(value ctx,value domid)984 value stub_xl_dominfo_get(value ctx, value domid)
985 {
986 CAMLparam2(ctx, domid);
987 CAMLlocal1(dominfo);
988 libxl_dominfo c_dominfo;
989 int ret;
990 uint32_t c_domid = Int_val(domid);
991
992 caml_enter_blocking_section();
993 ret = libxl_domain_info(CTX, &c_dominfo, c_domid);
994 caml_leave_blocking_section();
995
996 if (ret != 0)
997 failwith_xl(ERROR_FAIL, "domain_info");
998 dominfo = Val_dominfo(&c_dominfo);
999
1000 CAMLreturn(dominfo);
1001 }
1002
stub_xl_domain_sched_params_get(value ctx,value domid)1003 value stub_xl_domain_sched_params_get(value ctx, value domid)
1004 {
1005 CAMLparam2(ctx, domid);
1006 CAMLlocal1(scinfo);
1007 libxl_domain_sched_params c_scinfo;
1008 int ret;
1009 uint32_t c_domid = Int_val(domid);
1010
1011 caml_enter_blocking_section();
1012 ret = libxl_domain_sched_params_get(CTX, c_domid, &c_scinfo);
1013 caml_leave_blocking_section();
1014
1015 if (ret != 0)
1016 failwith_xl(ret, "domain_sched_params_get");
1017
1018 scinfo = Val_domain_sched_params(&c_scinfo);
1019
1020 libxl_domain_sched_params_dispose(&c_scinfo);
1021
1022 CAMLreturn(scinfo);
1023 }
1024
stub_xl_domain_sched_params_set(value ctx,value domid,value scinfo)1025 value stub_xl_domain_sched_params_set(value ctx, value domid, value scinfo)
1026 {
1027 CAMLparam3(ctx, domid, scinfo);
1028 libxl_domain_sched_params c_scinfo;
1029 int ret;
1030 uint32_t c_domid = Int_val(domid);
1031
1032 domain_sched_params_val(CTX, &c_scinfo, scinfo);
1033
1034 caml_enter_blocking_section();
1035 ret = libxl_domain_sched_params_set(CTX, c_domid, &c_scinfo);
1036 caml_leave_blocking_section();
1037
1038 libxl_domain_sched_params_dispose(&c_scinfo);
1039
1040 if (ret != 0)
1041 failwith_xl(ret, "domain_sched_params_set");
1042
1043 CAMLreturn(Val_unit);
1044 }
1045
stub_xl_send_trigger(value ctx,value domid,value trigger,value vcpuid,value async)1046 value stub_xl_send_trigger(value ctx, value domid, value trigger, value vcpuid, value async)
1047 {
1048 CAMLparam5(ctx, domid, trigger, vcpuid, async);
1049 int ret;
1050 uint32_t c_domid = Int_val(domid);
1051 libxl_trigger c_trigger = LIBXL_TRIGGER_UNKNOWN;
1052 int c_vcpuid = Int_val(vcpuid);
1053 libxl_asyncop_how *ao_how = aohow_val(async);
1054
1055 trigger_val(CTX, &c_trigger, trigger);
1056
1057 caml_enter_blocking_section();
1058 ret = libxl_send_trigger(CTX, c_domid, c_trigger, c_vcpuid, ao_how);
1059 caml_leave_blocking_section();
1060
1061 free(ao_how);
1062
1063 if (ret != 0)
1064 failwith_xl(ret, "send_trigger");
1065
1066 CAMLreturn(Val_unit);
1067 }
1068
stub_xl_send_sysrq(value ctx,value domid,value sysrq)1069 value stub_xl_send_sysrq(value ctx, value domid, value sysrq)
1070 {
1071 CAMLparam3(ctx, domid, sysrq);
1072 int ret;
1073 uint32_t c_domid = Int_val(domid);
1074 int c_sysrq = Int_val(sysrq);
1075
1076 caml_enter_blocking_section();
1077 ret = libxl_send_sysrq(CTX, c_domid, c_sysrq);
1078 caml_leave_blocking_section();
1079
1080 if (ret != 0)
1081 failwith_xl(ret, "send_sysrq");
1082
1083 CAMLreturn(Val_unit);
1084 }
1085
stub_xl_send_debug_keys(value ctx,value keys)1086 value stub_xl_send_debug_keys(value ctx, value keys)
1087 {
1088 CAMLparam2(ctx, keys);
1089 int ret;
1090 char *c_keys;
1091
1092 c_keys = dup_String_val(keys);
1093
1094 caml_enter_blocking_section();
1095 ret = libxl_send_debug_keys(CTX, c_keys);
1096 caml_leave_blocking_section();
1097
1098 free(c_keys);
1099
1100 if (ret != 0)
1101 failwith_xl(ret, "send_debug_keys");
1102
1103 CAMLreturn(Val_unit);
1104 }
1105
1106 static struct custom_operations libxl_console_reader_custom_operations = {
1107 "libxl_console_reader_custom_operations",
1108 custom_finalize_default,
1109 custom_compare_default,
1110 custom_hash_default,
1111 custom_serialize_default,
1112 custom_deserialize_default
1113 };
1114
1115 #define Console_reader_val(x)(*((libxl_xen_console_reader **) Data_custom_val(x)))
1116
stub_libxl_xen_console_read_start(value ctx,value clear)1117 value stub_libxl_xen_console_read_start(value ctx, value clear)
1118 {
1119 CAMLparam2(ctx, clear);
1120 CAMLlocal1(handle);
1121 int c_clear = Int_val(clear);
1122 libxl_xen_console_reader *cr;
1123
1124 caml_enter_blocking_section();
1125 cr = libxl_xen_console_read_start(CTX, c_clear);
1126 caml_leave_blocking_section();
1127
1128 handle = caml_alloc_custom(&libxl_console_reader_custom_operations, sizeof(cr), 0, 1);
1129 Console_reader_val(handle) = cr;
1130
1131 CAMLreturn(handle);
1132 }
1133
raise_eof(void)1134 static void raise_eof(void)
1135 {
1136 static const value *exc = NULL;
1137
1138 /* First time around, lookup by name */
1139 if (!exc)
1140 exc = caml_named_value("Xenlight.Host.End_of_file");
1141
1142 if (!exc)
1143 caml_invalid_argument("Exception Xenlight.Host.End_of_file not initialized, please link xenlight.cma");
1144
1145 caml_raise_constant(*exc);
1146 }
1147
stub_libxl_xen_console_read_line(value ctx,value reader)1148 value stub_libxl_xen_console_read_line(value ctx, value reader)
1149 {
1150 CAMLparam2(ctx, reader);
1151 CAMLlocal1(line);
1152 int ret;
1153 char *c_line;
1154 libxl_xen_console_reader *cr = (libxl_xen_console_reader *) Console_reader_val(reader);
1155
1156 caml_enter_blocking_section();
1157 ret = libxl_xen_console_read_line(CTX, cr, &c_line);
1158 caml_leave_blocking_section();
1159
1160 if (ret < 0)
1161 failwith_xl(ret, "xen_console_read_line");
1162 if (ret == 0)
1163 raise_eof();
1164
1165 line = caml_copy_string(c_line);
1166
1167 CAMLreturn(line);
1168 }
1169
stub_libxl_xen_console_read_finish(value ctx,value reader)1170 value stub_libxl_xen_console_read_finish(value ctx, value reader)
1171 {
1172 CAMLparam2(ctx, reader);
1173 libxl_xen_console_reader *cr = (libxl_xen_console_reader *) Console_reader_val(reader);
1174
1175 caml_enter_blocking_section();
1176 libxl_xen_console_read_finish(CTX, cr);
1177 caml_leave_blocking_section();
1178
1179 CAMLreturn(Val_unit);
1180 }
1181
1182 /* Event handling */
1183
Poll_val(value event)1184 short Poll_val(value event)
1185 {
1186 CAMLparam1(event);
1187 short res = -1;
1188
1189 switch (Int_val(event)) {
1190 case 0: res = POLLIN; break;
1191 case 1: res = POLLPRI; break;
1192 case 2: res = POLLOUT; break;
1193 case 3: res = POLLERR; break;
1194 case 4: res = POLLHUP; break;
1195 case 5: res = POLLNVAL; break;
1196 }
1197
1198 CAMLreturn(res);
1199 }
1200
Poll_events_val(value event_list)1201 short Poll_events_val(value event_list)
1202 {
1203 CAMLparam1(event_list);
1204 short events = 0;
1205
1206 while (event_list != Val_emptylist) {
1207 events |= Poll_val(Field(event_list, 0));
1208 event_list = Field(event_list, 1);
1209 }
1210
1211 CAMLreturn(events);
1212 }
1213
Val_poll(short event)1214 value Val_poll(short event)
1215 {
1216 CAMLparam0();
1217 CAMLlocal1(res);
1218
1219 switch (event) {
1220 case POLLIN: res = Val_int(0); break;
1221 case POLLPRI: res = Val_int(1); break;
1222 case POLLOUT: res = Val_int(2); break;
1223 case POLLERR: res = Val_int(3); break;
1224 case POLLHUP: res = Val_int(4); break;
1225 case POLLNVAL: res = Val_int(5); break;
1226 default: failwith_xl(ERROR_FAIL, "cannot convert poll event value"); break;
1227 }
1228
1229 CAMLreturn(res);
1230 }
1231
add_event(value event_list,short event)1232 value add_event(value event_list, short event)
1233 {
1234 CAMLparam1(event_list);
1235 CAMLlocal1(new_list);
1236
1237 new_list = caml_alloc(2, 0);
1238 Store_field(new_list, 0, Val_poll(event));
1239 Store_field(new_list, 1, event_list);
1240
1241 CAMLreturn(new_list);
1242 }
1243
Val_poll_events(short events)1244 value Val_poll_events(short events)
1245 {
1246 CAMLparam0();
1247 CAMLlocal1(event_list);
1248
1249 event_list = Val_emptylist;
1250 if (events & POLLIN)
1251 event_list = add_event(event_list, POLLIN);
1252 if (events & POLLPRI)
1253 event_list = add_event(event_list, POLLPRI);
1254 if (events & POLLOUT)
1255 event_list = add_event(event_list, POLLOUT);
1256 if (events & POLLERR)
1257 event_list = add_event(event_list, POLLERR);
1258 if (events & POLLHUP)
1259 event_list = add_event(event_list, POLLHUP);
1260 if (events & POLLNVAL)
1261 event_list = add_event(event_list, POLLNVAL);
1262
1263 CAMLreturn(event_list);
1264 }
1265
1266 /* The process for dealing with the for_app_registration_ values in the
1267 * callbacks below (GC registrations etc) is similar to the way for_callback is
1268 * handled in the asynchronous operations above. */
1269
fd_register(void * user,int fd,void ** for_app_registration_out,short events,void * for_libxl)1270 int fd_register(void *user, int fd, void **for_app_registration_out,
1271 short events, void *for_libxl)
1272 {
1273 caml_leave_blocking_section();
1274 CAMLparam0();
1275 CAMLlocalN(args, 4);
1276 int ret = 0;
1277 static const value *func = NULL;
1278 value *p = (value *) user;
1279 value *for_app;
1280
1281 if (func == NULL) {
1282 /* First time around, lookup by name */
1283 func = caml_named_value("libxl_fd_register");
1284 }
1285
1286 args[0] = *p;
1287 args[1] = Val_int(fd);
1288 args[2] = Val_poll_events(events);
1289 args[3] = (value) for_libxl;
1290
1291 for_app = malloc(sizeof(value));
1292 if (!for_app) {
1293 ret = ERROR_OSEVENT_REG_FAIL;
1294 goto err;
1295 }
1296
1297 *for_app = caml_callbackN_exn(*func, 4, args);
1298 if (Is_exception_result(*for_app)) {
1299 ret = ERROR_OSEVENT_REG_FAIL;
1300 free(for_app);
1301 goto err;
1302 }
1303
1304 caml_register_global_root(for_app);
1305 *for_app_registration_out = for_app;
1306
1307 err:
1308 CAMLdone;
1309 caml_enter_blocking_section();
1310 return ret;
1311 }
1312
fd_modify(void * user,int fd,void ** for_app_registration_update,short events)1313 int fd_modify(void *user, int fd, void **for_app_registration_update,
1314 short events)
1315 {
1316 caml_leave_blocking_section();
1317 CAMLparam0();
1318 CAMLlocalN(args, 4);
1319 int ret = 0;
1320 static const value *func = NULL;
1321 value *p = (value *) user;
1322 value *for_app = *for_app_registration_update;
1323
1324 /* If for_app == NULL, then something is very wrong */
1325 assert(for_app);
1326
1327 if (func == NULL) {
1328 /* First time around, lookup by name */
1329 func = caml_named_value("libxl_fd_modify");
1330 }
1331
1332 args[0] = *p;
1333 args[1] = Val_int(fd);
1334 args[2] = *for_app;
1335 args[3] = Val_poll_events(events);
1336
1337 *for_app = caml_callbackN_exn(*func, 4, args);
1338 if (Is_exception_result(*for_app)) {
1339 /* If an exception is caught, *for_app_registration_update is not
1340 * changed. It remains a valid pointer to a value that is registered
1341 * with the GC. */
1342 ret = ERROR_OSEVENT_REG_FAIL;
1343 goto err;
1344 }
1345
1346 *for_app_registration_update = for_app;
1347
1348 err:
1349 CAMLdone;
1350 caml_enter_blocking_section();
1351 return ret;
1352 }
1353
fd_deregister(void * user,int fd,void * for_app_registration)1354 void fd_deregister(void *user, int fd, void *for_app_registration)
1355 {
1356 caml_leave_blocking_section();
1357 CAMLparam0();
1358 CAMLlocalN(args, 3);
1359 static const value *func = NULL;
1360 value *p = (value *) user;
1361 value *for_app = for_app_registration;
1362
1363 /* If for_app == NULL, then something is very wrong */
1364 assert(for_app);
1365
1366 if (func == NULL) {
1367 /* First time around, lookup by name */
1368 func = caml_named_value("libxl_fd_deregister");
1369 }
1370
1371 args[0] = *p;
1372 args[1] = Val_int(fd);
1373 args[2] = *for_app;
1374
1375 caml_callbackN_exn(*func, 3, args);
1376 /* This hook does not return error codes, so the best thing we can do
1377 * to avoid trouble, if we catch an exception from the app, is abort. */
1378 if (Is_exception_result(*for_app))
1379 abort();
1380
1381 caml_remove_global_root(for_app);
1382 free(for_app);
1383
1384 CAMLdone;
1385 caml_enter_blocking_section();
1386 }
1387
1388 struct timeout_handles {
1389 void *for_libxl;
1390 value for_app;
1391 };
1392
timeout_register(void * user,void ** for_app_registration_out,struct timeval abs,void * for_libxl)1393 int timeout_register(void *user, void **for_app_registration_out,
1394 struct timeval abs, void *for_libxl)
1395 {
1396 caml_leave_blocking_section();
1397 CAMLparam0();
1398 CAMLlocal2(sec, usec);
1399 CAMLlocalN(args, 4);
1400 int ret = 0;
1401 static const value *func = NULL;
1402 value *p = (value *) user;
1403 struct timeout_handles *handles;
1404
1405 if (func == NULL) {
1406 /* First time around, lookup by name */
1407 func = caml_named_value("libxl_timeout_register");
1408 }
1409
1410 sec = caml_copy_int64(abs.tv_sec);
1411 usec = caml_copy_int64(abs.tv_usec);
1412
1413 /* This struct of "handles" will contain "for_libxl" as well as "for_app".
1414 * We'll give a pointer to the struct to the app, and get it back in
1415 * occurred_timeout, where we can clean it all up. */
1416 handles = malloc(sizeof(*handles));
1417 if (!handles) {
1418 ret = ERROR_OSEVENT_REG_FAIL;
1419 goto err;
1420 }
1421
1422 handles->for_libxl = for_libxl;
1423
1424 args[0] = *p;
1425 args[1] = sec;
1426 args[2] = usec;
1427 args[3] = (value) handles;
1428
1429 handles->for_app = caml_callbackN_exn(*func, 4, args);
1430 if (Is_exception_result(handles->for_app)) {
1431 ret = ERROR_OSEVENT_REG_FAIL;
1432 free(handles);
1433 goto err;
1434 }
1435
1436 caml_register_global_root(&handles->for_app);
1437 *for_app_registration_out = handles;
1438
1439 err:
1440 CAMLdone;
1441 caml_enter_blocking_section();
1442 return ret;
1443 }
1444
timeout_modify(void * user,void ** for_app_registration_update,struct timeval abs)1445 int timeout_modify(void *user, void **for_app_registration_update,
1446 struct timeval abs)
1447 {
1448 caml_leave_blocking_section();
1449 CAMLparam0();
1450 CAMLlocal1(for_app_update);
1451 CAMLlocalN(args, 2);
1452 int ret = 0;
1453 static const value *func = NULL;
1454 value *p = (value *) user;
1455 struct timeout_handles *handles = *for_app_registration_update;
1456
1457 /* If for_app == NULL, then something is very wrong */
1458 assert(handles->for_app);
1459
1460 /* Libxl currently promises that timeout_modify is only ever called with
1461 * abs={0,0}, meaning "right away". We cannot deal with other values. */
1462 assert(abs.tv_sec == 0 && abs.tv_usec == 0);
1463
1464 if (func == NULL) {
1465 /* First time around, lookup by name */
1466 func = caml_named_value("libxl_timeout_fire_now");
1467 }
1468
1469 args[0] = *p;
1470 args[1] = handles->for_app;
1471
1472 for_app_update = caml_callbackN_exn(*func, 2, args);
1473 if (Is_exception_result(for_app_update)) {
1474 /* If an exception is caught, *for_app_registration_update is not
1475 * changed. It remains a valid pointer to a value that is registered
1476 * with the GC. */
1477 ret = ERROR_OSEVENT_REG_FAIL;
1478 goto err;
1479 }
1480
1481 handles->for_app = for_app_update;
1482
1483 err:
1484 CAMLdone;
1485 caml_enter_blocking_section();
1486 return ret;
1487 }
1488
timeout_deregister(void * user,void * for_app_registration)1489 void timeout_deregister(void *user, void *for_app_registration)
1490 {
1491 /* This hook will never be called by libxl. */
1492 abort();
1493 }
1494
stub_libxl_osevent_register_hooks(value ctx,value user)1495 value stub_libxl_osevent_register_hooks(value ctx, value user)
1496 {
1497 CAMLparam2(ctx, user);
1498 CAMLlocal1(result);
1499 libxl_osevent_hooks *hooks;
1500 value *p;
1501
1502 hooks = malloc(sizeof(*hooks));
1503 if (!hooks)
1504 failwith_xl(ERROR_NOMEM, "cannot allocate osevent hooks");
1505 hooks->fd_register = fd_register;
1506 hooks->fd_modify = fd_modify;
1507 hooks->fd_deregister = fd_deregister;
1508 hooks->timeout_register = timeout_register;
1509 hooks->timeout_modify = timeout_modify;
1510 hooks->timeout_deregister = timeout_deregister;
1511
1512 p = malloc(sizeof(value));
1513 if (!p)
1514 failwith_xl(ERROR_NOMEM, "cannot allocate value");
1515 *p = user;
1516 caml_register_global_root(p);
1517
1518 caml_enter_blocking_section();
1519 libxl_osevent_register_hooks(CTX, hooks, (void *) p);
1520 caml_leave_blocking_section();
1521
1522 result = caml_alloc(1, Abstract_tag);
1523 *((libxl_osevent_hooks **) result) = hooks;
1524
1525 CAMLreturn(result);
1526 }
1527
stub_libxl_osevent_occurred_fd(value ctx,value for_libxl,value fd,value events,value revents)1528 value stub_libxl_osevent_occurred_fd(value ctx, value for_libxl, value fd,
1529 value events, value revents)
1530 {
1531 CAMLparam5(ctx, for_libxl, fd, events, revents);
1532 int c_fd = Int_val(fd);
1533 short c_events = Poll_events_val(events);
1534 short c_revents = Poll_events_val(revents);
1535
1536 caml_enter_blocking_section();
1537 libxl_osevent_occurred_fd(CTX, (void *) for_libxl, c_fd, c_events, c_revents);
1538 caml_leave_blocking_section();
1539
1540 CAMLreturn(Val_unit);
1541 }
1542
stub_libxl_osevent_occurred_timeout(value ctx,value handles)1543 value stub_libxl_osevent_occurred_timeout(value ctx, value handles)
1544 {
1545 CAMLparam1(ctx);
1546 struct timeout_handles *c_handles = (struct timeout_handles *) handles;
1547
1548 caml_enter_blocking_section();
1549 libxl_osevent_occurred_timeout(CTX, (void *) c_handles->for_libxl);
1550 caml_leave_blocking_section();
1551
1552 caml_remove_global_root(&c_handles->for_app);
1553 free(c_handles);
1554
1555 CAMLreturn(Val_unit);
1556 }
1557
1558 struct user_with_ctx {
1559 libxl_ctx *ctx;
1560 value user;
1561 };
1562
event_occurs(void * user,libxl_event * event)1563 void event_occurs(void *user, libxl_event *event)
1564 {
1565 caml_leave_blocking_section();
1566 CAMLparam0();
1567 CAMLlocalN(args, 2);
1568 struct user_with_ctx *c_user = (struct user_with_ctx *) user;
1569 static const value *func = NULL;
1570
1571 if (func == NULL) {
1572 /* First time around, lookup by name */
1573 func = caml_named_value("libxl_event_occurs_callback");
1574 }
1575
1576 args[0] = c_user->user;
1577 args[1] = Val_event(event);
1578 libxl_event_free(c_user->ctx, event);
1579
1580 caml_callbackN(*func, 2, args);
1581 CAMLdone;
1582 caml_enter_blocking_section();
1583 }
1584
disaster(void * user,libxl_event_type type,const char * msg,int errnoval)1585 void disaster(void *user, libxl_event_type type,
1586 const char *msg, int errnoval)
1587 {
1588 caml_leave_blocking_section();
1589 CAMLparam0();
1590 CAMLlocalN(args, 4);
1591 struct user_with_ctx *c_user = (struct user_with_ctx *) user;
1592 static const value *func = NULL;
1593
1594 if (func == NULL) {
1595 /* First time around, lookup by name */
1596 func = caml_named_value("libxl_event_disaster_callback");
1597 }
1598
1599 args[0] = c_user->user;
1600 args[1] = Val_event_type(type);
1601 args[2] = caml_copy_string(msg);
1602 args[3] = Val_int(errnoval);
1603
1604 caml_callbackN(*func, 4, args);
1605 CAMLdone;
1606 caml_enter_blocking_section();
1607 }
1608
stub_libxl_event_register_callbacks(value ctx,value user)1609 value stub_libxl_event_register_callbacks(value ctx, value user)
1610 {
1611 CAMLparam2(ctx, user);
1612 CAMLlocal1(result);
1613 struct user_with_ctx *c_user = NULL;
1614 libxl_event_hooks *hooks;
1615
1616 c_user = malloc(sizeof(*c_user));
1617 if (!c_user)
1618 failwith_xl(ERROR_NOMEM, "cannot allocate user value");
1619 c_user->user = user;
1620 c_user->ctx = CTX;
1621 caml_register_global_root(&c_user->user);
1622
1623 hooks = malloc(sizeof(*hooks));
1624 if (!hooks)
1625 failwith_xl(ERROR_NOMEM, "cannot allocate event hooks");
1626 hooks->event_occurs_mask = LIBXL_EVENTMASK_ALL;
1627 hooks->event_occurs = event_occurs;
1628 hooks->disaster = disaster;
1629
1630 caml_enter_blocking_section();
1631 libxl_event_register_callbacks(CTX, hooks, (void *) c_user);
1632 caml_leave_blocking_section();
1633
1634 result = caml_alloc(1, Abstract_tag);
1635 *((libxl_event_hooks **) result) = hooks;
1636
1637 CAMLreturn(result);
1638 }
1639
stub_libxl_evenable_domain_death(value ctx,value domid,value user)1640 value stub_libxl_evenable_domain_death(value ctx, value domid, value user)
1641 {
1642 CAMLparam3(ctx, domid, user);
1643 uint32_t c_domid = Int_val(domid);
1644 int c_user = Int_val(user);
1645 libxl_evgen_domain_death *evgen_out;
1646
1647 caml_enter_blocking_section();
1648 libxl_evenable_domain_death(CTX, c_domid, c_user, &evgen_out);
1649 caml_leave_blocking_section();
1650
1651 CAMLreturn(Val_unit);
1652 }
1653
1654 /*
1655 * Local variables:
1656 * indent-tabs-mode: t
1657 * c-basic-offset: 8
1658 * tab-width: 8
1659 * End:
1660 */
1661