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
16type ctx
17type domid = int
18type devid = int
19
20(* @@LIBXL_TYPES@@ *)
21
22exception Error of (error * string)
23
24external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc"
25
26external test_raise_exception: unit -> unit = "stub_raise_exception"
27
28type event =
29	| POLLIN (* There is data to read *)
30	| POLLPRI (* There is urgent data to read *)
31	| POLLOUT (* Writing now will not block *)
32	| POLLERR (* Error condition (revents only) *)
33	| POLLHUP (* Device has been disconnected (revents only) *)
34	| POLLNVAL (* Invalid request: fd not open (revents only). *)
35
36module Domain = struct
37	external create_new : ctx -> Domain_config.t -> ?async:'a -> unit -> domid = "stub_libxl_domain_create_new"
38	external create_restore : ctx -> Domain_config.t -> (Unix.file_descr * Domain_restore_params.t) ->
39		?async:'a -> unit -> domid = "stub_libxl_domain_create_restore"
40	external shutdown : ctx -> domid -> ?async:'a -> unit -> unit = "stub_libxl_domain_shutdown"
41	external reboot : ctx -> domid -> ?async:'a -> unit -> unit = "stub_libxl_domain_reboot"
42	external destroy : ctx -> domid -> ?async:'a -> unit -> unit = "stub_libxl_domain_destroy"
43	external suspend : ctx -> domid -> Unix.file_descr -> ?async:'a -> unit -> unit = "stub_libxl_domain_suspend"
44	external pause : ctx -> domid -> ?async:'a -> unit = "stub_libxl_domain_pause"
45	external unpause : ctx -> domid -> ?async:'a -> unit = "stub_libxl_domain_unpause"
46
47	external send_trigger : ctx -> domid -> trigger -> int -> ?async:'a -> unit = "stub_xl_send_trigger"
48	external send_sysrq : ctx -> domid -> char -> unit = "stub_xl_send_sysrq"
49end
50
51module Host = struct
52	type console_reader
53	exception End_of_file
54
55	external xen_console_read_start : ctx -> int -> console_reader  = "stub_libxl_xen_console_read_start"
56	external xen_console_read_line : ctx -> console_reader -> string = "stub_libxl_xen_console_read_line"
57	external xen_console_read_finish : ctx -> console_reader -> unit = "stub_libxl_xen_console_read_finish"
58
59	external send_debug_keys : ctx -> string -> unit = "stub_xl_send_debug_keys"
60end
61
62module Async = struct
63	type for_libxl
64	type event_hooks
65	type osevent_hooks
66
67	external osevent_register_hooks' : ctx -> 'a -> osevent_hooks = "stub_libxl_osevent_register_hooks"
68	external osevent_occurred_fd : ctx -> for_libxl -> Unix.file_descr -> event list -> event list -> unit = "stub_libxl_osevent_occurred_fd"
69	external osevent_occurred_timeout : ctx -> for_libxl -> unit = "stub_libxl_osevent_occurred_timeout"
70
71	let osevent_register_hooks ctx ~user ~fd_register ~fd_modify ~fd_deregister ~timeout_register ~timeout_fire_now =
72		Callback.register "libxl_fd_register" fd_register;
73		Callback.register "libxl_fd_modify" fd_modify;
74		Callback.register "libxl_fd_deregister" fd_deregister;
75		Callback.register "libxl_timeout_register" timeout_register;
76		Callback.register "libxl_timeout_fire_now" timeout_fire_now;
77		osevent_register_hooks' ctx user
78
79	let async_register_callback ~async_callback =
80		Callback.register "libxl_async_callback" async_callback
81
82	external evenable_domain_death : ctx -> domid -> int -> unit = "stub_libxl_evenable_domain_death"
83	external event_register_callbacks' : ctx -> 'a -> event_hooks = "stub_libxl_event_register_callbacks"
84
85	let event_register_callbacks ctx ~user ~event_occurs_callback ~event_disaster_callback =
86		Callback.register "libxl_event_occurs_callback" event_occurs_callback;
87		Callback.register "libxl_event_disaster_callback" event_disaster_callback;
88		event_register_callbacks' ctx user
89end
90
91let register_exceptions () =
92	Callback.register_exception "Xenlight.Error" (Error(ERROR_FAIL, ""));
93	Callback.register_exception "Xenlight.Host.End_of_file" (Host.End_of_file)
94
95