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 x86_arch_misc_flags =
52  | X86_MSR_RELAXED
53
54type xen_x86_arch_domainconfig =
55  {
56    emulation_flags: x86_arch_emulation_flags list;
57    misc_flags: x86_arch_misc_flags list;
58  }
59
60type arch_domainconfig =
61  | ARM of xen_arm_arch_domainconfig
62  | X86 of xen_x86_arch_domainconfig
63
64type domain_create_flag =
65  | CDF_HVM
66  | CDF_HAP
67  | CDF_S3_INTEGRITY
68  | CDF_OOS_OFF
69  | CDF_XS_DOMAIN
70  | CDF_IOMMU
71  | CDF_NESTED_VIRT
72  | CDF_VPMU
73  | CDF_TRAP_UNMAPPED_ACCESSES
74
75type domain_create_iommu_opts =
76  | IOMMU_NO_SHAREPT
77
78type domctl_create_config =
79  {
80    ssidref: int32;
81    handle: string;
82    flags: domain_create_flag list;
83    iommu_opts: domain_create_iommu_opts list;
84    max_vcpus: int;
85    max_evtchn_port: int;
86    max_grant_frames: int;
87    max_maptrack_frames: int;
88    max_grant_version: int;
89    altp2m_opts: int32;
90    vmtrace_buf_kb: int32;
91    cpupool_id: int32;
92    arch: arch_domainconfig;
93  }
94
95type domaininfo =
96  {
97    domid             : domid;
98    dying             : bool;
99    shutdown          : bool;
100    paused            : bool;
101    blocked           : bool;
102    running           : bool;
103    hvm_guest         : bool;
104    shutdown_code     : int;
105    total_memory_pages: nativeint;
106    max_memory_pages  : nativeint;
107    shared_info_frame : int64;
108    cpu_time          : int64;
109    nr_online_vcpus   : int;
110    max_vcpu_id       : int;
111    ssidref           : int32;
112    handle            : int array;
113    arch_config       : arch_domainconfig;
114  }
115
116type sched_control =
117  {
118    weight : int;
119    cap    : int;
120  }
121
122type physinfo_cap_flag =
123  | CAP_HVM
124  | CAP_PV
125  | CAP_DirectIO
126  | CAP_HAP
127  | CAP_Shadow
128  | CAP_IOMMU_HAP_PT_SHARE
129  | CAP_Vmtrace
130  | CAP_Vpmu
131  | CAP_Gnttab_v1
132  | CAP_Gnttab_v2
133
134type arm_physinfo_caps =
135  {
136    sve_vl: int;
137  }
138
139type x86_physinfo_cap_flag
140
141type arch_physinfo_cap_flags =
142  | ARM of arm_physinfo_caps
143  | X86 of x86_physinfo_cap_flag list
144
145type physinfo =
146  {
147    threads_per_core : int;
148    cores_per_socket : int;
149    nr_cpus          : int;
150    max_node_id      : int;
151    cpu_khz          : int;
152    total_pages      : nativeint;
153    free_pages       : nativeint;
154    scrub_pages      : nativeint;
155    (* XXX hw_cap *)
156    capabilities     : physinfo_cap_flag list;
157    max_nr_cpus      : int;
158    arch_capabilities : arch_physinfo_cap_flags;
159  }
160
161type version =
162  {
163    major : int;
164    minor : int;
165    extra : string;
166  }
167
168
169type compile_info =
170  {
171    compiler : string;
172    compile_by : string;
173    compile_domain : string;
174    compile_date : string;
175  }
176
177type shutdown_reason = Poweroff | Reboot | Suspend | Crash | Watchdog | Soft_reset
178
179exception Error of string
180
181type handle
182
183external interface_open: unit -> handle = "stub_xc_interface_open"
184
185let handle = ref None
186
187let get_handle () = !handle
188
189let close_handle () =
190  match !handle with
191  | Some _ -> handle := None
192  | None -> ()
193
194let with_intf f =
195  match !handle with
196  | Some h -> f h
197  | None ->
198    let h =
199      try interface_open () with
200      | e ->
201        let msg = Printexc.to_string e in
202        failwith ("failed to open xenctrl: "^msg)
203    in
204    handle := Some h;
205    f h
206
207external domain_create_stub: handle -> domid -> domctl_create_config -> domid
208  = "stub_xc_domain_create"
209
210let domain_create handle ?(domid=0) config =
211  domain_create_stub handle domid config
212
213external domain_sethandle: handle -> domid -> string -> unit
214  = "stub_xc_domain_sethandle"
215
216external domain_max_vcpus: handle -> domid -> int -> unit
217  = "stub_xc_domain_max_vcpus"
218
219external domain_pause: handle -> domid -> unit = "stub_xc_domain_pause"
220external domain_unpause: handle -> domid -> unit = "stub_xc_domain_unpause"
221external domain_resume_fast: handle -> domid -> unit = "stub_xc_domain_resume_fast"
222external domain_destroy: handle -> domid -> unit = "stub_xc_domain_destroy"
223
224external domain_shutdown: handle -> domid -> shutdown_reason -> unit
225  = "stub_xc_domain_shutdown"
226
227external _domain_getinfolist: handle -> domid -> int -> domaininfo list
228  = "stub_xc_domain_getinfolist"
229
230let rev_append_fold acc e = List.rev_append e acc
231
232(**
233 * [rev_concat lst] is equivalent to [lst |> List.concat |> List.rev]
234 * except it is tail recursive, whereas [List.concat] isn't.
235 * Example:
236 * rev_concat [[10;9;8];[7;6];[5]]] = [5; 6; 7; 8; 9; 10]
237*)
238let rev_concat lst = List.fold_left rev_append_fold [] lst
239
240let domain_getinfolist handle first_domain =
241  let nb = 1024 in
242  let rec __getlist lst from =
243    (* _domain_getinfolist returns domains in reverse order, largest first *)
244    match _domain_getinfolist handle from nb with
245    | [] -> rev_concat lst
246    | (hd :: _) as l -> __getlist (l :: lst) (hd.domid + 1)
247  in
248  __getlist [] first_domain
249
250external domain_getinfo: handle -> domid -> domaininfo= "stub_xc_domain_getinfo"
251
252external domain_get_vcpuinfo: handle -> int -> int -> vcpuinfo
253  = "stub_xc_vcpu_getinfo"
254
255external domain_ioport_permission: handle -> domid -> int -> int -> bool -> unit
256  = "stub_xc_domain_ioport_permission"
257external domain_iomem_permission: handle -> domid -> nativeint -> nativeint -> bool -> unit
258  = "stub_xc_domain_iomem_permission"
259external domain_irq_permission: handle -> domid -> int -> bool -> unit
260  = "stub_xc_domain_irq_permission"
261
262external vcpu_affinity_set: handle -> domid -> int -> bool array -> unit
263  = "stub_xc_vcpu_setaffinity"
264external vcpu_affinity_get: handle -> domid -> int -> bool array
265  = "stub_xc_vcpu_getaffinity"
266
267external vcpu_context_get: handle -> domid -> int -> string
268  = "stub_xc_vcpu_context_get"
269
270external sched_id: handle -> int = "stub_xc_sched_id"
271
272external sched_credit_domain_set: handle -> domid -> sched_control -> unit
273  = "stub_sched_credit_domain_set"
274external sched_credit_domain_get: handle -> domid -> sched_control
275  = "stub_sched_credit_domain_get"
276
277external shadow_allocation_set: handle -> domid -> int -> unit
278  = "stub_shadow_allocation_set"
279external shadow_allocation_get: handle -> domid -> int
280  = "stub_shadow_allocation_get"
281
282external evtchn_alloc_unbound: handle -> domid -> domid -> int
283  = "stub_xc_evtchn_alloc_unbound"
284external evtchn_reset: handle -> domid -> unit = "stub_xc_evtchn_reset"
285
286(* FIFO has theoretical maximum of 2^28 ports, fits in an int *)
287type evtchn_interdomain = { dom: domid; port: int }
288
289type evtchn_stat =
290  | EVTCHNSTAT_unbound of domid
291  | EVTCHNSTAT_interdomain of evtchn_interdomain
292  | EVTCHNSTAT_pirq of int
293  | EVTCHNSTAT_virq of Xeneventchn.virq_t
294  | EVTCHNSTAT_ipi
295
296type evtchn_status = { vcpu: int; status: evtchn_stat }
297
298external evtchn_status: handle -> domid -> int -> evtchn_status option =
299  "stub_xc_evtchn_status"
300
301external readconsolering: handle -> string = "stub_xc_readconsolering"
302
303external send_debug_keys: handle -> string -> unit = "stub_xc_send_debug_keys"
304external physinfo: handle -> physinfo = "stub_xc_physinfo"
305external pcpu_info: handle -> int -> int64 array = "stub_xc_pcpu_info"
306
307external domain_setmaxmem: handle -> domid -> int64 -> unit
308  = "stub_xc_domain_setmaxmem"
309external domain_set_memmap_limit: handle -> domid -> int64 -> unit
310  = "stub_xc_domain_set_memmap_limit"
311external domain_memory_increase_reservation: handle -> domid -> int64 -> unit
312  = "stub_xc_domain_memory_increase_reservation"
313
314external map_foreign_range: handle -> domid -> int
315  -> nativeint -> Xenmmap.mmap_interface
316  = "stub_map_foreign_range"
317
318type hvm_param =
319  | HVM_PARAM_CALLBACK_IRQ
320  | HVM_PARAM_STORE_PFN
321  | HVM_PARAM_STORE_EVTCHN
322  | HVM_PARAM_UNDEF_3
323  | HVM_PARAM_PAE_ENABLED
324  | HVM_PARAM_IOREQ_PFN
325  | HVM_PARAM_BUFIOREQ_PFN
326  | HVM_PARAM_UNDEF_7
327  | HVM_PARAM_UNDEF_8
328  | HVM_PARAM_VIRIDIAN
329  | HVM_PARAM_TIMER_MODE
330  | HVM_PARAM_HPET_ENABLED
331  | HVM_PARAM_IDENT_PT
332  | HVM_PARAM_UNDEF_13
333  | HVM_PARAM_ACPI_S_STATE
334  | HVM_PARAM_VM86_TSS
335  | HVM_PARAM_VPT_ALIGN
336  | HVM_PARAM_CONSOLE_PFN
337  | HVM_PARAM_CONSOLE_EVTCHN
338  | HVM_PARAM_ACPI_IOPORTS_LOCATION
339  | HVM_PARAM_MEMORY_EVENT_CR0
340  | HVM_PARAM_MEMORY_EVENT_CR3
341  | HVM_PARAM_MEMORY_EVENT_CR4
342  | HVM_PARAM_MEMORY_EVENT_INT3
343  | HVM_PARAM_NESTEDHVM
344  | HVM_PARAM_MEMORY_EVENT_SINGLE_STEP
345  | HVM_PARAM_UNDEF_26
346  | HVM_PARAM_PAGING_RING_PFN
347  | HVM_PARAM_MONITOR_RING_PFN
348  | HVM_PARAM_SHARING_RING_PFN
349  | HVM_PARAM_MEMORY_EVENT_MSR
350  | HVM_PARAM_TRIPLE_FAULT_REASON
351  | HVM_PARAM_IOREQ_SERVER_PFN
352  | HVM_PARAM_NR_IOREQ_SERVER_PAGES
353  | HVM_PARAM_VM_GENERATION_ID_ADDR
354  | HVM_PARAM_ALTP2M
355  | HVM_PARAM_X87_FIP_WIDTH
356  | HVM_PARAM_VM86_TSS_SIZED
357  | HVM_PARAM_MCA_CAP
358
359external hvm_param_get: handle -> domid -> hvm_param -> int64
360  = "stub_xc_hvm_param_get"
361
362external hvm_param_set: handle -> domid -> hvm_param -> int64 -> unit
363  = "stub_xc_hvm_param_set"
364
365external domain_assign_device: handle -> domid -> (int * int * int * int) -> unit
366  = "stub_xc_domain_assign_device"
367external domain_deassign_device: handle -> domid -> (int * int * int * int) -> unit
368  = "stub_xc_domain_deassign_device"
369external domain_test_assign_device: handle -> domid -> (int * int * int * int) -> bool
370  = "stub_xc_domain_test_assign_device"
371
372external version: handle -> version = "stub_xc_version_version"
373external version_compile_info: handle -> compile_info
374  = "stub_xc_version_compile_info"
375external version_changeset: handle -> string = "stub_xc_version_changeset"
376external version_capabilities: handle -> string =
377  "stub_xc_version_capabilities"
378
379type featureset_index =
380  | Featureset_raw
381  | Featureset_host
382  | Featureset_pv
383  | Featureset_hvm
384  | Featureset_pv_max
385  | Featureset_hvm_max
386external get_cpu_featureset : handle -> featureset_index -> int64 array = "stub_xc_get_cpu_featureset"
387
388external watchdog : handle -> int -> int32 -> int
389  = "stub_xc_watchdog"
390
391(* ** Misc ** *)
392
393(**
394   Convert the given number of pages to an amount in KiB, rounded up.
395*)
396external pages_to_kib : int64 -> int64 = "stub_pages_to_kib"
397let pages_to_mib pages = Int64.div (pages_to_kib pages) 1024L
398
399let _ = Callback.register_exception "xc.error" (Error "register_callback")
400