1(*
2 * Copyright (C) 2006-2007 XenSource Ltd.
3 * Copyright (C) 2008      Citrix Ltd.
4 * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
5 *
6 * This program is free software; you can redistribute it and/or modify
7 * it under the terms of the GNU Lesser General Public License as published
8 * by the Free Software Foundation; version 2.1 only. with the special
9 * exception on linking described in file LICENSE.
10 *
11 * This program is distributed in the hope that it will be useful,
12 * but WITHOUT ANY WARRANTY; without even the implied warranty of
13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14 * GNU Lesser General Public License for more details.
15 *)
16
17(** *)
18type domid = int
19
20(* ** xenctrl.h ** *)
21
22type vcpuinfo =
23{
24	online: bool;
25	blocked: bool;
26	running: bool;
27	cputime: int64;
28	cpumap: int32;
29}
30
31type xen_arm_arch_domainconfig =
32{
33	gic_version: int;
34	nr_spis: int;
35	clock_frequency: int32;
36}
37
38type x86_arch_emulation_flags =
39	| X86_EMU_LAPIC
40	| X86_EMU_HPET
41	| X86_EMU_PM
42	| X86_EMU_RTC
43	| X86_EMU_IOAPIC
44	| X86_EMU_PIC
45	| X86_EMU_VGA
46	| X86_EMU_IOMMU
47	| X86_EMU_PIT
48	| X86_EMU_USE_PIRQ
49	| X86_EMU_VPCI
50
51type xen_x86_arch_domainconfig =
52{
53	emulation_flags: x86_arch_emulation_flags list;
54}
55
56type arch_domainconfig =
57	| ARM of xen_arm_arch_domainconfig
58	| X86 of xen_x86_arch_domainconfig
59
60type domain_create_flag =
61	| CDF_HVM
62	| CDF_HAP
63	| CDF_S3_INTEGRITY
64	| CDF_OOS_OFF
65	| CDF_XS_DOMAIN
66	| CDF_IOMMU
67
68type domain_create_iommu_opts =
69	| IOMMU_NO_SHAREPT
70
71type domctl_create_config =
72{
73	ssidref: int32;
74	handle: string;
75	flags: domain_create_flag list;
76	iommu_opts: domain_create_iommu_opts list;
77	max_vcpus: int;
78	max_evtchn_port: int;
79	max_grant_frames: int;
80	max_maptrack_frames: int;
81	arch: arch_domainconfig;
82}
83
84type domaininfo =
85{
86	domid             : domid;
87	dying             : bool;
88	shutdown          : bool;
89	paused            : bool;
90	blocked           : bool;
91	running           : bool;
92	hvm_guest         : bool;
93	shutdown_code     : int;
94	total_memory_pages: nativeint;
95	max_memory_pages  : nativeint;
96	shared_info_frame : int64;
97	cpu_time          : int64;
98	nr_online_vcpus   : int;
99	max_vcpu_id       : int;
100	ssidref           : int32;
101	handle            : int array;
102	arch_config       : arch_domainconfig;
103}
104
105type sched_control =
106{
107	weight : int;
108	cap    : int;
109}
110
111type physinfo_cap_flag =
112	| CAP_HVM
113	| CAP_PV
114	| CAP_DirectIO
115	| CAP_HAP
116	| CAP_Shadow
117	| CAP_IOMMU_HAP_PT_SHARE
118
119type physinfo =
120{
121	threads_per_core : int;
122	cores_per_socket : int;
123	nr_cpus          : int;
124	max_node_id      : int;
125	cpu_khz          : int;
126	total_pages      : nativeint;
127	free_pages       : nativeint;
128	scrub_pages      : nativeint;
129	(* XXX hw_cap *)
130	capabilities     : physinfo_cap_flag list;
131	max_nr_cpus      : int;
132}
133
134type version =
135{
136	major : int;
137	minor : int;
138	extra : string;
139}
140
141
142type compile_info =
143{
144	compiler : string;
145	compile_by : string;
146	compile_domain : string;
147	compile_date : string;
148}
149
150type shutdown_reason = Poweroff | Reboot | Suspend | Crash | Watchdog | Soft_reset
151
152exception Error of string
153
154type handle
155
156external interface_open: unit -> handle = "stub_xc_interface_open"
157external interface_close: handle -> unit = "stub_xc_interface_close"
158
159let handle = ref None
160
161let get_handle () = !handle
162
163let close_handle () =
164	match !handle with
165	| Some h -> handle := None; interface_close h
166	| None -> ()
167
168let with_intf f =
169	match !handle with
170	| Some h -> f h
171	| None ->
172		let h =
173			try interface_open () with
174			| e ->
175				let msg = Printexc.to_string e in
176				failwith ("failed to open xenctrl: "^msg)
177		in
178		handle := Some h;
179		f h
180
181external domain_create: handle -> domctl_create_config -> domid
182       = "stub_xc_domain_create"
183
184external domain_sethandle: handle -> domid -> string -> unit
185       = "stub_xc_domain_sethandle"
186
187external domain_max_vcpus: handle -> domid -> int -> unit
188       = "stub_xc_domain_max_vcpus"
189
190external domain_pause: handle -> domid -> unit = "stub_xc_domain_pause"
191external domain_unpause: handle -> domid -> unit = "stub_xc_domain_unpause"
192external domain_resume_fast: handle -> domid -> unit = "stub_xc_domain_resume_fast"
193external domain_destroy: handle -> domid -> unit = "stub_xc_domain_destroy"
194
195external domain_shutdown: handle -> domid -> shutdown_reason -> unit
196       = "stub_xc_domain_shutdown"
197
198external _domain_getinfolist: handle -> domid -> int -> domaininfo list
199       = "stub_xc_domain_getinfolist"
200
201let domain_getinfolist handle first_domain =
202	let nb = 2 in
203	let last_domid l = (List.hd l).domid + 1 in
204	let rec __getlist from =
205		let l = _domain_getinfolist handle from nb in
206		(if List.length l = nb then __getlist (last_domid l) else []) @ l
207		in
208	List.rev (__getlist first_domain)
209
210external domain_getinfo: handle -> domid -> domaininfo= "stub_xc_domain_getinfo"
211
212external domain_get_vcpuinfo: handle -> int -> int -> vcpuinfo
213       = "stub_xc_vcpu_getinfo"
214
215external domain_ioport_permission: handle -> domid -> int -> int -> bool -> unit
216       = "stub_xc_domain_ioport_permission"
217external domain_iomem_permission: handle -> domid -> nativeint -> nativeint -> bool -> unit
218       = "stub_xc_domain_iomem_permission"
219external domain_irq_permission: handle -> domid -> int -> bool -> unit
220       = "stub_xc_domain_irq_permission"
221
222external vcpu_affinity_set: handle -> domid -> int -> bool array -> unit
223       = "stub_xc_vcpu_setaffinity"
224external vcpu_affinity_get: handle -> domid -> int -> bool array
225       = "stub_xc_vcpu_getaffinity"
226
227external vcpu_context_get: handle -> domid -> int -> string
228       = "stub_xc_vcpu_context_get"
229
230external sched_id: handle -> int = "stub_xc_sched_id"
231
232external sched_credit_domain_set: handle -> domid -> sched_control -> unit
233       = "stub_sched_credit_domain_set"
234external sched_credit_domain_get: handle -> domid -> sched_control
235       = "stub_sched_credit_domain_get"
236
237external shadow_allocation_set: handle -> domid -> int -> unit
238       = "stub_shadow_allocation_set"
239external shadow_allocation_get: handle -> domid -> int
240       = "stub_shadow_allocation_get"
241
242external evtchn_alloc_unbound: handle -> domid -> domid -> int
243       = "stub_xc_evtchn_alloc_unbound"
244external evtchn_reset: handle -> domid -> unit = "stub_xc_evtchn_reset"
245
246external readconsolering: handle -> string = "stub_xc_readconsolering"
247
248external send_debug_keys: handle -> string -> unit = "stub_xc_send_debug_keys"
249external physinfo: handle -> physinfo = "stub_xc_physinfo"
250external pcpu_info: handle -> int -> int64 array = "stub_xc_pcpu_info"
251
252external domain_setmaxmem: handle -> domid -> int64 -> unit
253       = "stub_xc_domain_setmaxmem"
254external domain_set_memmap_limit: handle -> domid -> int64 -> unit
255       = "stub_xc_domain_set_memmap_limit"
256external domain_memory_increase_reservation: handle -> domid -> int64 -> unit
257       = "stub_xc_domain_memory_increase_reservation"
258
259external map_foreign_range: handle -> domid -> int
260                         -> nativeint -> Xenmmap.mmap_interface
261       = "stub_map_foreign_range"
262
263external domain_assign_device: handle -> domid -> (int * int * int * int) -> unit
264       = "stub_xc_domain_assign_device"
265external domain_deassign_device: handle -> domid -> (int * int * int * int) -> unit
266       = "stub_xc_domain_deassign_device"
267external domain_test_assign_device: handle -> domid -> (int * int * int * int) -> bool
268       = "stub_xc_domain_test_assign_device"
269
270external version: handle -> version = "stub_xc_version_version"
271external version_compile_info: handle -> compile_info
272       = "stub_xc_version_compile_info"
273external version_changeset: handle -> string = "stub_xc_version_changeset"
274external version_capabilities: handle -> string =
275  "stub_xc_version_capabilities"
276
277type featureset_index = Featureset_raw | Featureset_host | Featureset_pv | Featureset_hvm
278external get_cpu_featureset : handle -> featureset_index -> int64 array = "stub_xc_get_cpu_featureset"
279
280external watchdog : handle -> int -> int32 -> int
281  = "stub_xc_watchdog"
282
283(* ** Misc ** *)
284
285(**
286   Convert the given number of pages to an amount in KiB, rounded up.
287 *)
288external pages_to_kib : int64 -> int64 = "stub_pages_to_kib"
289let pages_to_mib pages = Int64.div (pages_to_kib pages) 1024L
290
291let _ = Callback.register_exception "xc.error" (Error "register_callback")
292