tools/ocaml: Re-introduce Xenctrl.with_intf wrapper

Commit 81946a73dc removed
Xenctrl.with_intf based on its undesirable behaviour of opening and
closing a Xenctrl connection with every invocation. This commit
re-introduces with_intf but with an updated behaviour: it maintains a
global Xenctrl connection which is opened upon first usage and kept
open. This handle can be obtained by clients using new functions
get_handle() and close_handle().

The main motivation of re-introducing with_intf is that otherwise
clients will have to implement this functionality individually.

Signed-off-by: Christian Lindig <christian.lindig@citrix.com>
Reviewed-by: Ian Jackson <ian.jackson@eu.citrix.com>

tools/ocaml/libs/xc/xenctrl.ml

@@ -141,6 +141,28 @@ type handle
 external interface_open: unit -> handle = "stub_xc_interface_open"
 external interface_close: handle -> unit = "stub_xc_interface_close"
 
+let handle = ref None
+
+let get_handle () = !handle
+
+let close_handle () =
+	match !handle with
+	| Some h -> handle := None; interface_close h
+	| None -> ()
+
+let with_intf f =
+	match !handle with
+	| Some h -> f h
+	| None ->
+		let h =
+			try interface_open () with
+			| e ->
+				let msg = Printexc.to_string e in
+				failwith ("failed to open xenctrl: "^msg)
+		in
+		handle := Some h;
+		f h
+
 external domain_create: handle -> domctl_create_config -> domid
        = "stub_xc_domain_create"
 

tools/ocaml/libs/xc/xenctrl.mli

@@ -109,6 +109,19 @@ type handle
 external interface_open : unit -> handle = "stub_xc_interface_open"
 external interface_close : handle -> unit = "stub_xc_interface_close"
 
+(** [with_intf f] runs [f] with a global handle that is opened on demand
+ * and kept open. Conceptually, a client should use either
+ * interface_open and interface_close or with_intf although mixing both
+ * is possible *)
+val with_intf : (handle -> 'a) -> 'a
+(** [get_handle] returns the global handle used by [with_intf] *)
+val get_handle: unit -> handle option
+(** [close handle] closes the handle maintained by [with_intf]. This
+ * should only be closed before process exit. It must not be called from
+ * a function called directly or indirectly by with_intf as this
+ * would invalidate the handle that with_intf passes to its argument. *)
+val close_handle: unit -> unit
+
 external domain_create : handle -> domctl_create_config -> domid
   = "stub_xc_domain_create"
 external domain_sethandle : handle -> domid -> string -> unit = "stub_xc_domain_sethandle"