From a8b837d5018c488a130fcbea425904817a862210 Mon Sep 17 00:00:00 2001 From: "rjones@localhost" Date: Thu, 30 Aug 2007 17:38:09 +0100 Subject: Initial import from CVS. --- libvirt/.cvsignore | 7 + libvirt/.depend | 4 + libvirt/Makefile | 44 + libvirt/Makefile.in | 44 + libvirt/libvirt.ml | 379 ++++++++ libvirt/libvirt.mli | 416 +++++++++ libvirt/libvirt_c.c | 1953 +++++++++++++++++++++++++++++++++++++++++ libvirt/libvirt_version.ml | 6 + libvirt/libvirt_version.ml.in | 6 + libvirt/libvirt_version.mli | 12 + 10 files changed, 2871 insertions(+) create mode 100644 libvirt/.cvsignore create mode 100644 libvirt/.depend create mode 100644 libvirt/Makefile create mode 100644 libvirt/Makefile.in create mode 100644 libvirt/libvirt.ml create mode 100644 libvirt/libvirt.mli create mode 100644 libvirt/libvirt_c.c create mode 100644 libvirt/libvirt_version.ml create mode 100644 libvirt/libvirt_version.ml.in create mode 100644 libvirt/libvirt_version.mli (limited to 'libvirt') diff --git a/libvirt/.cvsignore b/libvirt/.cvsignore new file mode 100644 index 0000000..beb49ff --- /dev/null +++ b/libvirt/.cvsignore @@ -0,0 +1,7 @@ +*.cmi +*.cmo +*.cmx +*.cma +*.cmxa +Makefile +libvirt_version.ml \ No newline at end of file diff --git a/libvirt/.depend b/libvirt/.depend new file mode 100644 index 0000000..5556d96 --- /dev/null +++ b/libvirt/.depend @@ -0,0 +1,4 @@ +libvirt.cmo: libvirt.cmi +libvirt.cmx: libvirt.cmi +libvirt_version.cmo: libvirt_version.cmi +libvirt_version.cmx: libvirt_version.cmi diff --git a/libvirt/Makefile b/libvirt/Makefile new file mode 100644 index 0000000..e22d9f7 --- /dev/null +++ b/libvirt/Makefile @@ -0,0 +1,44 @@ +# $Id: Makefile.in,v 1.2 2007/08/21 13:24:08 rjones Exp $ + +CFLAGS := -g -O2 -I/home/rjones/local/include \ + -I.. \ + -I$(shell ocamlc -where) \ + -Wall -Werror \ + -fPIC \ + -g +LDFLAGS := -L/home/rjones/local/lib + +OCAMLCPACKAGES := -package extlib,unix +OCAMLCFLAGS := -g +OCAMLCLIBS := -linkpkg + +OCAMLOPTPACKAGES := $(OCAMLCPACKAGES) +OCAMLOPTFLAGS := +OCAMLOPTLIBS := $(OCAMLCLIBS) + +export LIBRARY_PATH=. +export LD_LIBRARY_PATH=. + +BYTE_TARGETS := libvirt.cma +OPT_TARGETS := libvirt.cmxa + +all: $(BYTE_TARGETS) + +opt: $(OPT_TARGETS) + +libvirt.cma: libvirt_c.o libvirt.cmo libvirt_version.cmo + ocamlmklib -o mllibvirt $^ $(LDFLAGS) -lvirt + +libvirt.cmxa: libvirt_c.o libvirt.cmx libvirt_version.cmx + ocamlmklib -o mllibvirt $^ $(LDFLAGS) -lvirt + +libvirt.cmo: libvirt.cmi +libvirt.cmi: libvirt.mli + +libvirt_version.cmo: libvirt_version.cmi +libvirt_version.cmi: libvirt_version.mli + +install: + ocamlfind install libvirt ../META *.so *.a *.cmx *.cma *.cmxa *.mli + +include ../Make.rules diff --git a/libvirt/Makefile.in b/libvirt/Makefile.in new file mode 100644 index 0000000..ff90d72 --- /dev/null +++ b/libvirt/Makefile.in @@ -0,0 +1,44 @@ +# $Id: Makefile.in,v 1.2 2007/08/21 13:24:08 rjones Exp $ + +CFLAGS := @CFLAGS@ \ + -I.. \ + -I$(shell ocamlc -where) \ + -Wall -Werror \ + -fPIC \ + -g +LDFLAGS := @LDFLAGS@ + +OCAMLCPACKAGES := -package extlib,unix +OCAMLCFLAGS := -g +OCAMLCLIBS := -linkpkg + +OCAMLOPTPACKAGES := $(OCAMLCPACKAGES) +OCAMLOPTFLAGS := +OCAMLOPTLIBS := $(OCAMLCLIBS) + +export LIBRARY_PATH=. +export LD_LIBRARY_PATH=. + +BYTE_TARGETS := libvirt.cma +OPT_TARGETS := libvirt.cmxa + +all: $(BYTE_TARGETS) + +opt: $(OPT_TARGETS) + +libvirt.cma: libvirt_c.o libvirt.cmo libvirt_version.cmo + ocamlmklib -o mllibvirt $^ $(LDFLAGS) -lvirt + +libvirt.cmxa: libvirt_c.o libvirt.cmx libvirt_version.cmx + ocamlmklib -o mllibvirt $^ $(LDFLAGS) -lvirt + +libvirt.cmo: libvirt.cmi +libvirt.cmi: libvirt.mli + +libvirt_version.cmo: libvirt_version.cmi +libvirt_version.cmi: libvirt_version.mli + +install: + ocamlfind install libvirt ../META *.so *.a *.cmx *.cma *.cmxa *.mli + +include ../Make.rules diff --git a/libvirt/libvirt.ml b/libvirt/libvirt.ml new file mode 100644 index 0000000..14dca54 --- /dev/null +++ b/libvirt/libvirt.ml @@ -0,0 +1,379 @@ +(* OCaml bindings for libvirt. + (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc. + http://libvirt.org/ + $Id: libvirt.ml,v 1.2 2007/08/21 13:24:08 rjones Exp $ +*) + +type uuid = string + +type xml = string + +external get_version : ?driver:string -> unit -> int * int = "ocaml_libvirt_get_version" + +let uuid_length = 16 +let uuid_string_length = 36 + +(* http://caml.inria.fr/pub/ml-archives/caml-list/2004/07/80683af867cce6bf8fff273973f70c95.en.html *) +type rw = [`R|`W] +type ro = [`R] + +module Connect = +struct + type 'rw t + + type node_info = { + model : string; + memory : int64; + cpus : int; + mhz : int; + nodes : int; + sockets : int; + cores : int; + threads : int; + } + + external connect : ?name:string -> unit -> rw t = "ocaml_libvirt_connect_open" + external connect_readonly : ?name:string -> unit -> ro t = "ocaml_libvirt_connect_open_readonly" + external close : [>`R] t -> unit = "ocaml_libvirt_connect_close" + external get_type : [>`R] t -> string = "ocaml_libvirt_connect_get_type" + external get_version : [>`R] t -> int = "ocaml_libvirt_connect_get_version" + external get_hostname : [>`R] t -> string = "ocaml_libvirt_connect_get_hostname" + external get_uri : [>`R] t -> string = "ocaml_libvirt_connect_get_uri" + external get_max_vcpus : [>`R] t -> ?type_:string -> unit -> int = "ocaml_libvirt_connect_get_max_vcpus" + external list_domains : [>`R] t -> int -> int array = "ocaml_libvirt_connect_list_domains" + external num_of_domains : [>`R] t -> int = "ocaml_libvirt_connect_num_of_domains" + external get_capabilities : [>`R] t -> string = "ocaml_libvirt_connect_get_capabilities" + external num_of_defined_domains : [>`R] t -> int = "ocaml_libvirt_connect_num_of_defined_domains" + external list_defined_domains : [>`R] t -> int -> string array = "ocaml_libvirt_connect_list_defined_domains" + external num_of_networks : [>`R] t -> int = "ocaml_libvirt_connect_num_of_networks" + external list_networks : [>`R] t -> int -> string array = "ocaml_libvirt_connect_list_networks" + external num_of_defined_networks : [>`R] t -> int = "ocaml_libvirt_connect_num_of_defined_networks" + external list_defined_networks : [>`R] t -> int -> string array = "ocaml_libvirt_connect_list_defined_networks" + external get_node_info : [>`R] t -> node_info = "ocaml_libvirt_connect_get_node_info" + + (* See VIR_NODEINFO_MAXCPUS macro defined in . *) + let maxcpus_of_node_info { nodes = nodes; sockets = sockets; + cores = cores; threads = threads } = + nodes * sockets * cores * threads + + (* See VIR_CPU_MAPLEN macro defined in . *) + let cpumaplen nr_cpus = + (nr_cpus + 7) / 8 + + (* See VIR_USE_CPU, VIR_UNUSE_CPU, VIR_CPU_USABLE macros defined in . *) + let use_cpu cpumap cpu = + cpumap.[cpu/8] <- + Char.chr (Char.code cpumap.[cpu/8] lor (1 lsl (cpu mod 8))) + let unuse_cpu cpumap cpu = + cpumap.[cpu/8] <- + Char.chr (Char.code cpumap.[cpu/8] land (lnot (1 lsl (cpu mod 8)))) + let cpu_usable cpumaps maplen vcpu cpu = + Char.code cpumaps.[vcpu*maplen + cpu/8] land (1 lsl (cpu mod 8)) <> 0 + + external const : [>`R] t -> ro t = "%identity" +end + +module Domain = +struct + type 'rw dom + type 'rw t = 'rw dom * 'rw Connect.t + + type state = + | InfoNoState | InfoRunning | InfoBlocked | InfoPaused + | InfoShutdown | InfoShutoff | InfoCrashed + + type info = { + state : state; + max_mem : int64; + memory : int64; + nr_virt_cpu : int; + cpu_time : int64; + } + + type vcpu_state = VcpuOffline | VcpuRunning | VcpuBlocked + + type vcpu_info = { + number : int; + vcpu_state : vcpu_state; + vcpu_time : int64; + cpu : int; + } + + type sched_param = string * sched_param_value + and sched_param_value = + | SchedFieldInt32 of int32 | SchedFieldUInt32 of int32 + | SchedFieldInt64 of int64 | SchedFieldUInt64 of int64 + | SchedFieldFloat of float | SchedFieldBool of bool + + type migrate_flag = Live + + type block_stats = { + rd_req : int64; + rd_bytes : int64; + wr_req : int64; + wr_bytes : int64; + errs : int64; + } + + type interface_stats = { + rx_bytes : int64; + rx_packets : int64; + rx_errs : int64; + rx_drop : int64; + tx_bytes : int64; + tx_packets : int64; + tx_errs : int64; + tx_drop : int64; + } + + external create_linux : [>`W] Connect.t -> xml -> rw t = "ocaml_libvirt_domain_create_linux" + external lookup_by_id : 'a Connect.t -> int -> 'a t = "ocaml_libvirt_domain_lookup_by_id" + external lookup_by_uuid : 'a Connect.t -> uuid -> 'a t = "ocaml_libvirt_domain_lookup_by_uuid" + external lookup_by_uuid_string : 'a Connect.t -> string -> 'a t = "ocaml_libvirt_domain_lookup_by_uuid_string" + external lookup_by_name : 'a Connect.t -> string -> 'a t = "ocaml_libvirt_domain_lookup_by_name" + external destroy : [>`W] t -> unit = "ocaml_libvirt_domain_destroy" + external free : [>`R] t -> unit = "ocaml_libvirt_domain_free" + external suspend : [>`W] t -> unit = "ocaml_libvirt_domain_suspend" + external resume : [>`W] t -> unit = "ocaml_libvirt_domain_resume" + external save : [>`W] t -> string -> unit = "ocaml_libvirt_domain_save" + external restore : [>`W] Connect.t -> string -> unit = "ocaml_libvirt_domain_restore" + external core_dump : [>`W] t -> string -> unit = "ocaml_libvirt_domain_core_dump" + external shutdown : [>`W] t -> unit = "ocaml_libvirt_domain_shutdown" + external reboot : [>`W] t -> unit = "ocaml_libvirt_domain_reboot" + external get_name : [>`R] t -> string = "ocaml_libvirt_domain_get_name" + external get_uuid : [>`R] t -> uuid = "ocaml_libvirt_domain_get_uuid" + external get_uuid_string : [>`R] t -> string = "ocaml_libvirt_domain_get_uuid_string" + external get_id : [>`R] t -> int = "ocaml_libvirt_domain_get_id" + external get_os_type : [>`R] t -> string = "ocaml_libvirt_domain_get_os_type" + external get_max_memory : [>`R] t -> int64 = "ocaml_libvirt_domain_get_max_memory" + external set_max_memory : [>`W] t -> int64 -> unit = "ocaml_libvirt_domain_set_max_memory" + external set_memory : [>`W] t -> int64 -> unit = "ocaml_libvirt_domain_set_memory" + external get_info : [>`R] t -> info = "ocaml_libvirt_domain_get_info" + external get_xml_desc : [>`R] t -> xml = "ocaml_libvirt_domain_get_xml_desc" + external get_scheduler_type : [>`R] t -> string * int = "ocaml_libvirt_domain_get_scheduler_type" + external get_scheduler_parameters : [>`R] t -> int -> sched_param array = "ocaml_libvirt_domain_get_scheduler_parameters" + external set_scheduler_parameters : [>`W] t -> sched_param array -> unit = "ocaml_libvirt_domain_set_scheduler_parameters" + external define_xml : [>`W] Connect.t -> xml -> rw t = "ocaml_libvirt_domain_define_xml" + external undefine : [>`W] t -> unit = "ocaml_libvirt_domain_undefine" + external create : [>`W] t -> unit = "ocaml_libvirt_domain_create" + external get_autostart : [>`R] t -> bool = "ocaml_libvirt_domain_get_autostart" + external set_autostart : [>`W] t -> bool -> unit = "ocaml_libvirt_domain_set_autostart" + external set_vcpus : [>`W] t -> int -> unit = "ocaml_libvirt_domain_set_vcpus" + external pin_vcpu : [>`W] t -> int -> string -> unit = "ocaml_libvirt_domain_pin_vcpu" + external get_vcpus : [>`R] t -> int -> int -> int * vcpu_info array * string = "ocaml_libvirt_domain_get_vcpus" + external get_max_vcpus : [>`R] t -> int = "ocaml_libvirt_domain_get_max_vcpus" + external attach_device : [>`W] t -> xml -> unit = "ocaml_libvirt_domain_attach_device" + external detach_device : [>`W] t -> xml -> unit = "ocaml_libvirt_domain_detach_device" + external migrate : [>`W] t -> [>`W] Connect.t -> migrate_flag list -> ?dname:string -> ?uri:string -> ?bandwidth:int -> unit -> rw t = "ocaml_libvirt_domain_migrate_bytecode" "ocaml_libvirt_domain_migrate_native" + external block_stats : [>`R] t -> string -> block_stats = "ocaml_libvirt_domain_block_stats" + external interface_stats : [>`R] t -> string -> interface_stats = "ocaml_libvirt_domain_interface_stats" + + external const : [>`R] t -> ro t = "%identity" +end + +module Network = +struct + type 'rw net + type 'rw t = 'rw net * 'rw Connect.t + + external lookup_by_name : 'a Connect.t -> string -> 'a t = "ocaml_libvirt_network_lookup_by_name" + external lookup_by_uuid : 'a Connect.t -> uuid -> 'a t = "ocaml_libvirt_network_lookup_by_uuid" + external lookup_by_uuid_string : 'a Connect.t -> string -> 'a t = "ocaml_libvirt_network_lookup_by_uuid_string" + external create_xml : [>`W] Connect.t -> xml -> rw t = "ocaml_libvirt_network_create_xml" + external define_xml : [>`W] Connect.t -> xml -> rw t = "ocaml_libvirt_network_define_xml" + external undefine : [>`W] t -> unit = "ocaml_libvirt_network_undefine" + external create : [>`W] t -> unit = "ocaml_libvirt_network_create" + external destroy : [>`W] t -> unit = "ocaml_libvirt_network_destroy" + external free : [>`R] t -> unit = "ocaml_libvirt_network_free" + external get_name : [>`R] t -> string = "ocaml_libvirt_network_get_name" + external get_uuid : [>`R] t -> uuid = "ocaml_libvirt_network_get_uuid" + external get_uuid_string : [>`R] t -> string = "ocaml_libvirt_network_get_uuid_string" + external get_xml_desc : [>`R] t -> xml = "ocaml_libvirt_network_get_xml_desc" + external get_bridge_name : [>`R] t -> string = "ocaml_libvirt_network_get_bridge_name" + external get_autostart : [>`R] t -> bool = "ocaml_libvirt_network_get_autostart" + external set_autostart : [>`W] t -> bool -> unit = "ocaml_libvirt_network_set_autostart" + + external const : [>`R] t -> ro t = "%identity" +end + +module Virterror = +struct + type code = + | VIR_ERR_OK + | VIR_ERR_INTERNAL_ERROR + | VIR_ERR_NO_MEMORY + | VIR_ERR_NO_SUPPORT + | VIR_ERR_UNKNOWN_HOST + | VIR_ERR_NO_CONNECT + | VIR_ERR_INVALID_CONN + | VIR_ERR_INVALID_DOMAIN + | VIR_ERR_INVALID_ARG + | VIR_ERR_OPERATION_FAILED + | VIR_ERR_GET_FAILED + | VIR_ERR_POST_FAILED + | VIR_ERR_HTTP_ERROR + | VIR_ERR_SEXPR_SERIAL + | VIR_ERR_NO_XEN + | VIR_ERR_XEN_CALL + | VIR_ERR_OS_TYPE + | VIR_ERR_NO_KERNEL + | VIR_ERR_NO_ROOT + | VIR_ERR_NO_SOURCE + | VIR_ERR_NO_TARGET + | VIR_ERR_NO_NAME + | VIR_ERR_NO_OS + | VIR_ERR_NO_DEVICE + | VIR_ERR_NO_XENSTORE + | VIR_ERR_DRIVER_FULL + | VIR_ERR_CALL_FAILED + | VIR_ERR_XML_ERROR + | VIR_ERR_DOM_EXIST + | VIR_ERR_OPERATION_DENIED + | VIR_ERR_OPEN_FAILED + | VIR_ERR_READ_FAILED + | VIR_ERR_PARSE_FAILED + | VIR_ERR_CONF_SYNTAX + | VIR_ERR_WRITE_FAILED + | VIR_ERR_XML_DETAIL + | VIR_ERR_INVALID_NETWORK + | VIR_ERR_NETWORK_EXIST + | VIR_ERR_SYSTEM_ERROR + | VIR_ERR_RPC + | VIR_ERR_GNUTLS_ERROR + | VIR_WAR_NO_NETWORK + | VIR_ERR_NO_DOMAIN + | VIR_ERR_NO_NETWORK + + let string_of_code = function + | VIR_ERR_OK -> "VIR_ERR_OK" + | VIR_ERR_INTERNAL_ERROR -> "VIR_ERR_INTERNAL_ERROR" + | VIR_ERR_NO_MEMORY -> "VIR_ERR_NO_MEMORY" + | VIR_ERR_NO_SUPPORT -> "VIR_ERR_NO_SUPPORT" + | VIR_ERR_UNKNOWN_HOST -> "VIR_ERR_UNKNOWN_HOST" + | VIR_ERR_NO_CONNECT -> "VIR_ERR_NO_CONNECT" + | VIR_ERR_INVALID_CONN -> "VIR_ERR_INVALID_CONN" + | VIR_ERR_INVALID_DOMAIN -> "VIR_ERR_INVALID_DOMAIN" + | VIR_ERR_INVALID_ARG -> "VIR_ERR_INVALID_ARG" + | VIR_ERR_OPERATION_FAILED -> "VIR_ERR_OPERATION_FAILED" + | VIR_ERR_GET_FAILED -> "VIR_ERR_GET_FAILED" + | VIR_ERR_POST_FAILED -> "VIR_ERR_POST_FAILED" + | VIR_ERR_HTTP_ERROR -> "VIR_ERR_HTTP_ERROR" + | VIR_ERR_SEXPR_SERIAL -> "VIR_ERR_SEXPR_SERIAL" + | VIR_ERR_NO_XEN -> "VIR_ERR_NO_XEN" + | VIR_ERR_XEN_CALL -> "VIR_ERR_XEN_CALL" + | VIR_ERR_OS_TYPE -> "VIR_ERR_OS_TYPE" + | VIR_ERR_NO_KERNEL -> "VIR_ERR_NO_KERNEL" + | VIR_ERR_NO_ROOT -> "VIR_ERR_NO_ROOT" + | VIR_ERR_NO_SOURCE -> "VIR_ERR_NO_SOURCE" + | VIR_ERR_NO_TARGET -> "VIR_ERR_NO_TARGET" + | VIR_ERR_NO_NAME -> "VIR_ERR_NO_NAME" + | VIR_ERR_NO_OS -> "VIR_ERR_NO_OS" + | VIR_ERR_NO_DEVICE -> "VIR_ERR_NO_DEVICE" + | VIR_ERR_NO_XENSTORE -> "VIR_ERR_NO_XENSTORE" + | VIR_ERR_DRIVER_FULL -> "VIR_ERR_DRIVER_FULL" + | VIR_ERR_CALL_FAILED -> "VIR_ERR_CALL_FAILED" + | VIR_ERR_XML_ERROR -> "VIR_ERR_XML_ERROR" + | VIR_ERR_DOM_EXIST -> "VIR_ERR_DOM_EXIST" + | VIR_ERR_OPERATION_DENIED -> "VIR_ERR_OPERATION_DENIED" + | VIR_ERR_OPEN_FAILED -> "VIR_ERR_OPEN_FAILED" + | VIR_ERR_READ_FAILED -> "VIR_ERR_READ_FAILED" + | VIR_ERR_PARSE_FAILED -> "VIR_ERR_PARSE_FAILED" + | VIR_ERR_CONF_SYNTAX -> "VIR_ERR_CONF_SYNTAX" + | VIR_ERR_WRITE_FAILED -> "VIR_ERR_WRITE_FAILED" + | VIR_ERR_XML_DETAIL -> "VIR_ERR_XML_DETAIL" + | VIR_ERR_INVALID_NETWORK -> "VIR_ERR_INVALID_NETWORK" + | VIR_ERR_NETWORK_EXIST -> "VIR_ERR_NETWORK_EXIST" + | VIR_ERR_SYSTEM_ERROR -> "VIR_ERR_SYSTEM_ERROR" + | VIR_ERR_RPC -> "VIR_ERR_RPC" + | VIR_ERR_GNUTLS_ERROR -> "VIR_ERR_GNUTLS_ERROR" + | VIR_WAR_NO_NETWORK -> "VIR_WAR_NO_NETWORK" + | VIR_ERR_NO_DOMAIN -> "VIR_ERR_NO_DOMAIN" + | VIR_ERR_NO_NETWORK -> "VIR_ERR_NO_NETWORK" + + type level = + | VIR_ERR_NONE + | VIR_ERR_WARNING + | VIR_ERR_ERROR + + let string_of_level = function + | VIR_ERR_NONE -> "VIR_ERR_NONE" + | VIR_ERR_WARNING -> "VIR_ERR_WARNING" + | VIR_ERR_ERROR -> "VIR_ERR_ERROR" + + type domain = + | VIR_FROM_NONE + | VIR_FROM_XEN + | VIR_FROM_XEND + | VIR_FROM_XENSTORE + | VIR_FROM_SEXPR + | VIR_FROM_XML + | VIR_FROM_DOM + | VIR_FROM_RPC + | VIR_FROM_PROXY + | VIR_FROM_CONF + | VIR_FROM_QEMU + | VIR_FROM_NET + | VIR_FROM_TEST + | VIR_FROM_REMOTE + + let string_of_domain = function + | VIR_FROM_NONE -> "VIR_FROM_NONE" + | VIR_FROM_XEN -> "VIR_FROM_XEN" + | VIR_FROM_XEND -> "VIR_FROM_XEND" + | VIR_FROM_XENSTORE -> "VIR_FROM_XENSTORE" + | VIR_FROM_SEXPR -> "VIR_FROM_SEXPR" + | VIR_FROM_XML -> "VIR_FROM_XML" + | VIR_FROM_DOM -> "VIR_FROM_DOM" + | VIR_FROM_RPC -> "VIR_FROM_RPC" + | VIR_FROM_PROXY -> "VIR_FROM_PROXY" + | VIR_FROM_CONF -> "VIR_FROM_CONF" + | VIR_FROM_QEMU -> "VIR_FROM_QEMU" + | VIR_FROM_NET -> "VIR_FROM_NET" + | VIR_FROM_TEST -> "VIR_FROM_TEST" + | VIR_FROM_REMOTE -> "VIR_FROM_REMOTE" + + type t = { + code : code; + domain : domain; + message : string option; + level : level; + conn : ro Connect.t option; + dom : ro Domain.t option; + str1 : string option; + str2 : string option; + str3 : string option; + int1 : int32; + int2 : int32; + net : ro Network.t option; + } + + let to_string { code = code; domain = domain; message = message } = + let buf = Buffer.create 128 in + Buffer.add_string buf "libvirt: "; + Buffer.add_string buf (string_of_code code); + Buffer.add_string buf ": "; + Buffer.add_string buf (string_of_domain domain); + Buffer.add_string buf ": "; + (match message with Some msg -> Buffer.add_string buf msg | None -> ()); + Buffer.contents buf + + external get_last_error : unit -> t option = "ocaml_libvirt_virterror_get_last_error" + external get_last_conn_error : [>`R] Connect.t -> t option = "ocaml_libvirt_virterror_get_last_conn_error" + external reset_last_error : unit -> unit = "ocaml_libvirt_virterror_reset_last_error" + external reset_last_conn_error : [>`R] Connect.t -> unit = "ocaml_libvirt_virterror_reset_last_conn_error" + + let no_error () = + { code = VIR_ERR_OK; domain = VIR_FROM_NONE; message = None; + level = VIR_ERR_NONE; conn = None; dom = None; + str1 = None; str2 = None; str3 = None; + int1 = 0_l; int2 = 0_l; net = None } +end + +exception Virterror of Virterror.t + +(* Initialization. *) +external c_init : unit -> unit = "ocaml_libvirt_init" +let () = + Callback.register_exception + "ocaml_libvirt_virterror" (Virterror (Virterror.no_error ())); + c_init () diff --git a/libvirt/libvirt.mli b/libvirt/libvirt.mli new file mode 100644 index 0000000..66f94c7 --- /dev/null +++ b/libvirt/libvirt.mli @@ -0,0 +1,416 @@ +(** OCaml bindings for libvirt. + (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc. + http://libvirt.org/ + $Id: libvirt.mli,v 1.3 2007/08/22 10:04:07 rjones Exp $ +*) + +type uuid = string +(** This is a "raw" UUID, ie. a packed string of bytes. *) + +type xml = string +(** Type of XML (an uninterpreted string of bytes). Use PXP, expat, + xml-light, etc. if you want to do anything useful with the XML. +*) + +val get_version : ?driver:string -> unit -> int * int + (** [get_version ()] returns the library version in the first part + of the tuple, and [0] in the second part. + + [get_version ~driver ()] returns the library version in the first + part of the tuple, and the version of the driver called [driver] + in the second part. + + The version numbers are encoded as + 1,000,000 * major + 1,000 * minor + release. + *) + +val uuid_length : int + (** Length of packed UUIDs. *) + +val uuid_string_length : int + (** Length of UUID strings. *) + +(* These phantom types are used to ensure the type-safety of read-only + * versus read-write connections. For more information see: + * http://caml.inria.fr/pub/ml-archives/caml-list/2004/07/80683af867cce6bf8fff273973f70c95.en.html + *) +type rw = [`R|`W] +type ro = [`R] + +module Connect : +sig + type 'rw t + (** Connection. Read-only connections have type [ro Connect.t] and + read-write connections have type [rw Connect.t]. + *) + + type node_info = { + model : string; (** CPU model *) + memory : int64; (** memory size in kilobytes *) + cpus : int; (** number of active CPUs *) + mhz : int; (** expected CPU frequency *) + nodes : int; (** number of NUMA nodes (1 = UMA) *) + sockets : int; (** number of CPU sockets per node *) + cores : int; (** number of cores per socket *) + threads : int; (** number of threads per core *) + } + + val connect : ?name:string -> unit -> rw t + val connect_readonly : ?name:string -> unit -> ro t + (** [connect ~name ()] connects to the hypervisor with URI [name]. + + [connect ()] connects to the default hypervisor. + + [connect_readonly] is the same but connects in read-only mode. + *) + + val close : [>`R] t -> unit + (** [close conn] closes and frees the connection object in memory. + + The connection is automatically closed if it is garbage + collected. This function just forces it to be closed + and freed right away. + *) + + val get_type : [>`R] t -> string + val get_version : [>`R] t -> int + val get_hostname : [>`R] t -> string + val get_uri : [>`R] t -> string + val get_max_vcpus : [>`R] t -> ?type_:string -> unit -> int + val list_domains : [>`R] t -> int -> int array + val num_of_domains : [>`R] t -> int + val get_capabilities : [>`R] t -> string + val num_of_defined_domains : [>`R] t -> int + val list_defined_domains : [>`R] t -> int -> string array + val num_of_networks : [>`R] t -> int + val list_networks : [>`R] t -> int -> string array + val num_of_defined_networks : [>`R] t -> int + val list_defined_networks : [>`R] t -> int -> string array + + (* The name of this function is inconsistent, but the inconsistency + * is really in libvirt itself. + *) + val get_node_info : [>`R] t -> node_info + + val maxcpus_of_node_info : node_info -> int + (** Calculate the total number of CPUs supported (but not necessarily + active) in the host. + *) + + val cpumaplen : int -> int + (** Calculate the length (in bytes) required to store the complete + CPU map between a single virtual and all physical CPUs of a domain. + *) + + val use_cpu : string -> int -> unit + (** [use_cpu cpumap cpu] marks [cpu] as usable in [cpumap]. *) + val unuse_cpu : string -> int -> unit + (** [unuse_cpu cpumap cpu] marks [cpu] as not usable in [cpumap]. *) + val cpu_usable : string -> int -> int -> int -> bool + (** [cpu_usable cpumaps maplen vcpu cpu] checks returns true iff the + [cpu] is usable by [vcpu]. *) + + external const : [>`R] t -> ro t = "%identity" + (** [const conn] turns a read/write connection into a read-only + connection. Note that the opposite operation is impossible. + *) +end + (** Module dealing with connections. [Connect.t] is the + connection object. + *) + +module Domain : +sig + type 'rw t + (** Domain handle. Read-only handles have type [ro Domain.t] and + read-write handles have type [rw Domain.t]. + *) + + type state = + | InfoNoState | InfoRunning | InfoBlocked | InfoPaused + | InfoShutdown | InfoShutoff | InfoCrashed + + type info = { + state : state; (** running state *) + max_mem : int64; (** maximum memory in kilobytes *) + memory : int64; (** memory used in kilobytes *) + nr_virt_cpu : int; (** number of virtual CPUs *) + cpu_time : int64; (** CPU time used in nanoseconds *) + } + + type vcpu_state = VcpuOffline | VcpuRunning | VcpuBlocked + + type vcpu_info = { + number : int; (** virtual CPU number *) + vcpu_state : vcpu_state; (** state *) + vcpu_time : int64; (** CPU time used in nanoseconds *) + cpu : int; (** real CPU number, -1 if offline *) + } + + type sched_param = string * sched_param_value + and sched_param_value = + | SchedFieldInt32 of int32 | SchedFieldUInt32 of int32 + | SchedFieldInt64 of int64 | SchedFieldUInt64 of int64 + | SchedFieldFloat of float | SchedFieldBool of bool + + type migrate_flag = Live + + type block_stats = { + rd_req : int64; + rd_bytes : int64; + wr_req : int64; + wr_bytes : int64; + errs : int64; + } + + type interface_stats = { + rx_bytes : int64; + rx_packets : int64; + rx_errs : int64; + rx_drop : int64; + tx_bytes : int64; + tx_packets : int64; + tx_errs : int64; + tx_drop : int64; + } + + val create_linux : [>`W] Connect.t -> xml -> rw t + val lookup_by_id : 'a Connect.t -> int -> 'a t + val lookup_by_uuid : 'a Connect.t -> uuid -> 'a t + val lookup_by_uuid_string : 'a Connect.t -> string -> 'a t + val lookup_by_name : 'a Connect.t -> string -> 'a t + val destroy : [>`W] t -> unit + val free : [>`R] t -> unit + (** [free domain] frees the domain object in memory. + + The domain object is automatically freed if it is garbage + collected. This function just forces it to be freed right + away. + *) + + val suspend : [>`W] t -> unit + val resume : [>`W] t -> unit + val save : [>`W] t -> string -> unit + val restore : [>`W] Connect.t -> string -> unit + val core_dump : [>`W] t -> string -> unit + val shutdown : [>`W] t -> unit + val reboot : [>`W] t -> unit + val get_name : [>`R] t -> string + val get_uuid : [>`R] t -> uuid + val get_uuid_string : [>`R] t -> string + val get_id : [>`R] t -> int + (** [getid dom] returns the ID of the domain. + + Do not call this on a defined but not running domain. Those + domains don't have IDs, and you'll get an error here. + *) + + val get_os_type : [>`R] t -> string + val get_max_memory : [>`R] t -> int64 + val set_max_memory : [>`W] t -> int64 -> unit + val set_memory : [>`W] t -> int64 -> unit + val get_info : [>`R] t -> info + val get_xml_desc : [>`R] t -> xml + val get_scheduler_type : [>`R] t -> string * int + val get_scheduler_parameters : [>`R] t -> int -> sched_param array + val set_scheduler_parameters : [>`W] t -> sched_param array -> unit + val define_xml : [>`W] Connect.t -> xml -> rw t + val undefine : [>`W] t -> unit + val create : [>`W] t -> unit + val get_autostart : [>`R] t -> bool + val set_autostart : [>`W] t -> bool -> unit + val set_vcpus : [>`W] t -> int -> unit + val pin_vcpu : [>`W] t -> int -> string -> unit + val get_vcpus : [>`R] t -> int -> int -> int * vcpu_info array * string + val get_max_vcpus : [>`R] t -> int + val attach_device : [>`W] t -> xml -> unit + val detach_device : [>`W] t -> xml -> unit + + val migrate : [>`W] t -> [>`W] Connect.t -> migrate_flag list -> + ?dname:string -> ?uri:string -> ?bandwidth:int -> unit -> rw t + + val block_stats : [>`R] t -> string -> block_stats + val interface_stats : [>`R] t -> string -> interface_stats + + external const : [>`R] t -> ro t = "%identity" + (** [const dom] turns a read/write domain handle into a read-only + domain handle. Note that the opposite operation is impossible. + *) +end + (** Module dealing with domains. [Domain.t] is the + domain object. + *) + +module Network : +sig + type 'rw t + (** Network handle. Read-only handles have type [ro Network.t] and + read-write handles have type [rw Network.t]. + *) + + val lookup_by_name : 'a Connect.t -> string -> 'a t + val lookup_by_uuid : 'a Connect.t -> uuid -> 'a t + val lookup_by_uuid_string : 'a Connect.t -> string -> 'a t + val create_xml : [>`W] Connect.t -> xml -> rw t + val define_xml : [>`W] Connect.t -> xml -> rw t + val undefine : [>`W] t -> unit + val create : [>`W] t -> unit + val destroy : [>`W] t -> unit + val free : [>`R] t -> unit + (** [free network] frees the network object in memory. + + The network object is automatically freed if it is garbage + collected. This function just forces it to be freed right + away. + *) + + val get_name : [>`R] t -> string + val get_uuid : [>`R] t -> uuid + val get_uuid_string : [>`R] t -> string + val get_xml_desc : [>`R] t -> xml + val get_bridge_name : [>`R] t -> string + val get_autostart : [>`R] t -> bool + val set_autostart : [>`W] t -> bool -> unit + + external const : [>`R] t -> ro t = "%identity" + (** [const network] turns a read/write network handle into a read-only + network handle. Note that the opposite operation is impossible. + *) +end + (** Module dealing with networks. [Network.t] is the + network object. + *) + +module Virterror : +sig + type code = + | VIR_ERR_OK + | VIR_ERR_INTERNAL_ERROR + | VIR_ERR_NO_MEMORY + | VIR_ERR_NO_SUPPORT + | VIR_ERR_UNKNOWN_HOST + | VIR_ERR_NO_CONNECT + | VIR_ERR_INVALID_CONN + | VIR_ERR_INVALID_DOMAIN + | VIR_ERR_INVALID_ARG + | VIR_ERR_OPERATION_FAILED + | VIR_ERR_GET_FAILED + | VIR_ERR_POST_FAILED + | VIR_ERR_HTTP_ERROR + | VIR_ERR_SEXPR_SERIAL + | VIR_ERR_NO_XEN + | VIR_ERR_XEN_CALL + | VIR_ERR_OS_TYPE + | VIR_ERR_NO_KERNEL + | VIR_ERR_NO_ROOT + | VIR_ERR_NO_SOURCE + | VIR_ERR_NO_TARGET + | VIR_ERR_NO_NAME + | VIR_ERR_NO_OS + | VIR_ERR_NO_DEVICE + | VIR_ERR_NO_XENSTORE + | VIR_ERR_DRIVER_FULL + | VIR_ERR_CALL_FAILED + | VIR_ERR_XML_ERROR + | VIR_ERR_DOM_EXIST + | VIR_ERR_OPERATION_DENIED + | VIR_ERR_OPEN_FAILED + | VIR_ERR_READ_FAILED + | VIR_ERR_PARSE_FAILED + | VIR_ERR_CONF_SYNTAX + | VIR_ERR_WRITE_FAILED + | VIR_ERR_XML_DETAIL + | VIR_ERR_INVALID_NETWORK + | VIR_ERR_NETWORK_EXIST + | VIR_ERR_SYSTEM_ERROR + | VIR_ERR_RPC + | VIR_ERR_GNUTLS_ERROR + | VIR_WAR_NO_NETWORK + | VIR_ERR_NO_DOMAIN + | VIR_ERR_NO_NETWORK + (** See [] for meaning of these codes. *) + + val string_of_code : code -> string + + type level = + | VIR_ERR_NONE + | VIR_ERR_WARNING + | VIR_ERR_ERROR + (** No error, a warning or an error. *) + + val string_of_level : level -> string + + type domain = + | VIR_FROM_NONE + | VIR_FROM_XEN + | VIR_FROM_XEND + | VIR_FROM_XENSTORE + | VIR_FROM_SEXPR + | VIR_FROM_XML + | VIR_FROM_DOM + | VIR_FROM_RPC + | VIR_FROM_PROXY + | VIR_FROM_CONF + | VIR_FROM_QEMU + | VIR_FROM_NET + | VIR_FROM_TEST + | VIR_FROM_REMOTE + (** Subsystem / driver which produced the error. *) + + val string_of_domain : domain -> string + + type t = { + code : code; (** Error code. *) + domain : domain; (** Origin of the error. *) + message : string option; (** Human-readable message. *) + level : level; (** Error or warning. *) + conn : ro Connect.t option; (** Associated connection. *) + dom : ro Domain.t option; (** Associated domain. *) + str1 : string option; (** Informational string. *) + str2 : string option; (** Informational string. *) + str3 : string option; (** Informational string. *) + int1 : int32; (** Informational integer. *) + int2 : int32; (** Informational integer. *) + net : ro Network.t option; (** Associated network. *) + } + (** An error object. *) + + val to_string : t -> string + (** Turn the exception into a printable string. *) + + val get_last_error : unit -> t option + val get_last_conn_error : [>`R] Connect.t -> t option + (** Get the last error at a global or connection level. + + Normally you do not need to use these functions because + the library automatically turns errors into exceptions. + *) + + val reset_last_error : unit -> unit + val reset_last_conn_error : [>`R] Connect.t -> unit + (** Reset the error at a global or connection level. + + Normally you do not need to use these functions. + *) + + val no_error : unit -> t + (** Creates an empty error message. + + Normally you do not need to use this function. + *) +end + (** Module dealing with errors. *) + +exception Virterror of Virterror.t +(** This exception can be raised by any library function that detects + an error. To get a printable error message, call + {!Virterror.to_string} on the content of this exception. + + Note that functions may also raise + [Invalid_argument "virFoo not supported"] + (where virFoo is the libvirt function name) if a function is + not supported at either compile or runtime. This applies to + any libvirt function added after version 0.2.1. + See also [http://libvirt.org/hvsupport.html] +*) + diff --git a/libvirt/libvirt_c.c b/libvirt/libvirt_c.c new file mode 100644 index 0000000..808dd82 --- /dev/null +++ b/libvirt/libvirt_c.c @@ -0,0 +1,1953 @@ +/* OCaml bindings for libvirt. + * (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc. + * http://libvirt.org/ + * $Id: libvirt_c.c,v 1.6 2007/08/30 13:16:57 rjones Exp $ + */ + +#include "config.h" + +#include +#include +#include + +#include +#include + +#include +#include +#include +#include +#include +#include +#include +#include + +static char *Optstring_val (value strv); +typedef value (*Val_ptr_t) (void *); +static value Val_opt (void *ptr, Val_ptr_t Val_ptr); +/*static value option_default (value option, value deflt);*/ +static value _raise_virterror (virConnectPtr conn, const char *fn); +static value Val_virterror (virErrorPtr err); + +#define CHECK_ERROR(cond, conn, fn) \ + do { if (cond) _raise_virterror (conn, fn); } while (0) + +#define NOT_SUPPORTED(fn) \ + caml_invalid_argument (fn " not supported") + +/* For more about weak symbols, see: + * http://kolpackov.net/pipermail/notes/2004-March/000006.html + * We are using this to do runtime detection of library functions + * so that if we dynamically link with an older version of + * libvirt than we were compiled against, it won't fail (provided + * libvirt >= 0.2.1 - we don't support anything older). + */ +#ifdef __GNUC__ +#ifdef linux +#if (__GNUC__ == 3 && __GNUC_MINOR__ >= 3) || (__GNUC__ > 3) +#define HAVE_WEAK_SYMBOLS 1 +#endif +#endif +#endif + +#ifdef HAVE_WEAK_SYMBOLS +#define WEAK_SYMBOL_CHECK(sym) \ + do { if (!sym) NOT_SUPPORTED(#sym); } while (0) +#else +#define WEAK_SYMBOL_CHECK(sym) +#endif /* HAVE_WEAK_SYMBOLS */ + +#ifdef HAVE_WEAK_SYMBOLS +#ifdef HAVE_VIRCONNECTGETHOSTNAME +extern char *virConnectGetHostname (virConnectPtr conn) + __attribute__((weak)); +#endif +#ifdef HAVE_VIRCONNECTGETURI +extern char *virConnectGetURI (virConnectPtr conn) + __attribute__((weak)); +#endif +#ifdef HAVE_VIRDOMAINBLOCKSTATS +extern int virDomainBlockStats (virDomainPtr dom, + const char *path, + virDomainBlockStatsPtr stats, + size_t size) + __attribute__((weak)); +#endif +#ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS +extern int virDomainGetSchedulerParameters (virDomainPtr domain, + virSchedParameterPtr params, + int *nparams) + __attribute__((weak)); +#endif +#ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE +extern char *virDomainGetSchedulerType(virDomainPtr domain, + int *nparams) + __attribute__((weak)); +#endif +#ifdef HAVE_VIRDOMAININTERFACESTATS +extern int virDomainInterfaceStats (virDomainPtr dom, + const char *path, + virDomainInterfaceStatsPtr stats, + size_t size) + __attribute__((weak)); +#endif +#ifdef HAVE_VIRDOMAINMIGRATE +extern virDomainPtr virDomainMigrate (virDomainPtr domain, virConnectPtr dconn, + unsigned long flags, const char *dname, + const char *uri, unsigned long bandwidth) + __attribute__((weak)); +#endif +#ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS +extern int virDomainSetSchedulerParameters (virDomainPtr domain, + virSchedParameterPtr params, + int nparams) + __attribute__((weak)); +#endif +#endif /* HAVE_WEAK_SYMBOLS */ + +/*----------------------------------------------------------------------*/ + +CAMLprim value +ocaml_libvirt_get_version (value driverv, value unit) +{ + CAMLparam2 (driverv, unit); + CAMLlocal1 (rv); + const char *driver = Optstring_val (driverv); + unsigned long libVer, typeVer = 0, *typeVer_ptr; + int r; + + typeVer_ptr = driver ? &typeVer : NULL; + r = virGetVersion (&libVer, driver, typeVer_ptr); + CHECK_ERROR (r == -1, NULL, "virGetVersion"); + + rv = caml_alloc_tuple (2); + Store_field (rv, 0, Val_int (libVer)); + Store_field (rv, 1, Val_int (typeVer)); + CAMLreturn (rv); +} + +/*----------------------------------------------------------------------*/ + +/* Some notes about the use of custom blocks to store virConnectPtr, + * virDomainPtr and virNetworkPtr. + *------------------------------------------------------------------ + * + * Libvirt does some tricky reference counting to keep track of + * virConnectPtr's, virDomainPtr's and virNetworkPtr's. + * + * There is only one function which can return a virConnectPtr + * (virConnectOpen*) and that allocates a new one each time. + * + * virDomainPtr/virNetworkPtr's on the other hand can be returned + * repeatedly (for the same underlying domain/network), and we must + * keep track of each one and explicitly free it with virDomainFree + * or virNetworkFree. If we lose track of one then the reference + * counting in libvirt will keep it open. We therefore wrap these + * in a custom block with a finalizer function. + * + * We also have to allow the user to explicitly free them, in + * which case we set the pointer inside the custom block to NULL. + * The finalizer notices this and doesn't free the object. + * + * Domains and networks "belong to" a connection. We have to avoid + * the situation like this: + * + * let conn = Connect.open ... in + * let dom = Domain.lookup_by_id conn 0 in + * (* conn goes out of scope and is garbage collected *) + * printf "dom name = %s\n" (Domain.get_name dom) + * + * The reason is that when conn is garbage collected, virConnectClose + * is called and any subsequent operations on dom will fail (in fact + * will probably segfault). To stop this from happening, the OCaml + * wrappers store domains (and networks) as explicit (dom, conn) + * pairs. + * + * Further complication with virterror / exceptions: Virterror gives + * us virConnectPtr, virDomainPtr, virNetworkPtr pointers. If we + * follow standard practice and wrap these up in blocks with + * finalizers then we'll end up double-freeing (in particular, calling + * virConnectClose at the wrong time). So for virterror, we have + * "special" wrapper functions (Val_connect_no_finalize, etc.). + */ + +/* Unwrap a custom block. */ +#define Connect_val(rv) (*((virConnectPtr *)Data_custom_val(rv))) +#define Dom_val(rv) (*((virDomainPtr *)Data_custom_val(rv))) +#define Net_val(rv) (*((virNetworkPtr *)Data_custom_val(rv))) + +/* Wrap up a pointer to something in a custom block. */ +static value Val_connect (virConnectPtr conn); +static value Val_dom (virDomainPtr dom); +static value Val_net (virNetworkPtr net); + +/* ONLY for use by virterror wrappers. */ +static value Val_connect_no_finalize (virConnectPtr conn); +static value Val_dom_no_finalize (virDomainPtr dom); +static value Val_net_no_finalize (virNetworkPtr net); + +/* Domains and networks are stored as pairs (dom/net, conn), so have + * some convenience functions for unwrapping and wrapping them. + */ +#define Domain_val(rv) (Dom_val(Field((rv),0))) +#define Network_val(rv) (Net_val(Field((rv),0))) +#define Connect_domv(rv) (Connect_val(Field((rv),1))) +#define Connect_netv(rv) (Connect_val(Field((rv),1))) + +static value Val_domain (virDomainPtr dom, value connv); +static value Val_network (virNetworkPtr net, value connv); + +/* ONLY for use by virterror wrappers. */ +static value Val_domain_no_finalize (virDomainPtr dom, value connv); +static value Val_network_no_finalize (virNetworkPtr net, value connv); + +/*----------------------------------------------------------------------*/ + +/* Connection object. */ + +CAMLprim value +ocaml_libvirt_connect_open (value namev, value unit) +{ + CAMLparam2 (namev, unit); + CAMLlocal1 (rv); + const char *name = Optstring_val (namev); + virConnectPtr conn; + + conn = virConnectOpen (name); + CHECK_ERROR (!conn, NULL, "virConnectOpen"); + + rv = Val_connect (conn); + + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_connect_open_readonly (value namev, value unit) +{ + CAMLparam2 (namev, unit); + CAMLlocal1 (rv); + const char *name = Optstring_val (namev); + virConnectPtr conn; + + conn = virConnectOpenReadOnly (name); + CHECK_ERROR (!conn, NULL, "virConnectOpen"); + + rv = Val_connect (conn); + + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_connect_close (value connv) +{ + CAMLparam1 (connv); + virConnectPtr conn = Connect_val (connv); + int r; + + r = virConnectClose (conn); + CHECK_ERROR (r == -1, conn, "virConnectClose"); + + /* So that we don't double-free in the finalizer: */ + Connect_val (connv) = NULL; + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_connect_get_type (value connv) +{ + CAMLparam1 (connv); + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + const char *r; + + r = virConnectGetType (conn); + CHECK_ERROR (!r, conn, "virConnectGetType"); + + rv = caml_copy_string (r); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_connect_get_version (value connv) +{ + CAMLparam1 (connv); + virConnectPtr conn = Connect_val (connv); + unsigned long hvVer; + int r; + + r = virConnectGetVersion (conn, &hvVer); + CHECK_ERROR (r == -1, conn, "virConnectGetVersion"); + + CAMLreturn (Val_int (hvVer)); +} + +CAMLprim value +ocaml_libvirt_connect_get_hostname (value connv) +{ +#ifdef HAVE_VIRCONNECTGETHOSTNAME + CAMLparam1 (connv); + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *r; + + WEAK_SYMBOL_CHECK (virConnectGetHostname); + r = virConnectGetHostname (conn); + CHECK_ERROR (!r, conn, "virConnectGetHostname"); + + rv = caml_copy_string (r); + free (r); + CAMLreturn (rv); +#else + NOT_SUPPORTED ("virConnectGetHostname"); +#endif +} + +CAMLprim value +ocaml_libvirt_connect_get_uri (value connv) +{ +#ifdef HAVE_VIRCONNECTGETURI + CAMLparam1 (connv); + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *r; + + WEAK_SYMBOL_CHECK (virConnectGetURI); + r = virConnectGetURI (conn); + CHECK_ERROR (!r, conn, "virConnectGetURI"); + + rv = caml_copy_string (r); + free (r); + CAMLreturn (rv); +#else + NOT_SUPPORTED ("virConnectGetURI"); +#endif +} + +CAMLprim value +ocaml_libvirt_connect_get_max_vcpus (value connv, value typev) +{ + CAMLparam2 (connv, typev); + virConnectPtr conn = Connect_val (connv); + const char *type = Optstring_val (typev); + int r; + + r = virConnectGetMaxVcpus (conn, type); + CHECK_ERROR (r == -1, conn, "virConnectGetMaxVcpus"); + + CAMLreturn (Val_int (r)); +} + +CAMLprim value +ocaml_libvirt_connect_list_domains (value connv, value iv) +{ + CAMLparam2 (connv, iv); + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + int i = Int_val (iv); + int ids[i], r; + + r = virConnectListDomains (conn, ids, i); + CHECK_ERROR (r == -1, conn, "virConnectListDomains"); + + rv = caml_alloc (r, 0); + for (i = 0; i < r; ++i) + Store_field (rv, i, Val_int (ids[i])); + + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_connect_num_of_domains (value connv) +{ + CAMLparam1 (connv); + virConnectPtr conn = Connect_val (connv); + int r; + + r = virConnectNumOfDomains (conn); + CHECK_ERROR (r == -1, conn, "virConnectNumOfDomains"); + + CAMLreturn (Val_int (r)); +} + +CAMLprim value +ocaml_libvirt_connect_get_capabilities (value connv) +{ + CAMLparam1 (connv); + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *r; + + r = virConnectGetCapabilities (conn); + CHECK_ERROR (!r, conn, "virConnectGetCapabilities"); + + rv = caml_copy_string (r); + free (r); + + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_connect_num_of_defined_domains (value connv) +{ + CAMLparam1 (connv); + virConnectPtr conn = Connect_val (connv); + int r; + + r = virConnectNumOfDefinedDomains (conn); + CHECK_ERROR (r == -1, conn, "virConnectNumOfDefinedDomains"); + + CAMLreturn (Val_int (r)); +} + +CAMLprim value +ocaml_libvirt_connect_list_defined_domains (value connv, value iv) +{ + CAMLparam2 (connv, iv); + CAMLlocal2 (rv, strv); + virConnectPtr conn = Connect_val (connv); + int i = Int_val (iv); + char *names[i]; + int r; + + r = virConnectListDefinedDomains (conn, names, i); + CHECK_ERROR (r == -1, conn, "virConnectListDefinedDomains"); + + rv = caml_alloc (r, 0); + for (i = 0; i < r; ++i) { + strv = caml_copy_string (names[i]); + Store_field (rv, i, strv); + free (names[i]); + } + + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_connect_num_of_networks (value connv) +{ + CAMLparam1 (connv); + virConnectPtr conn = Connect_val (connv); + int r; + + r = virConnectNumOfNetworks (conn); + CHECK_ERROR (r == -1, conn, "virConnectNumOfNetworks"); + + CAMLreturn (Val_int (r)); +} + +CAMLprim value +ocaml_libvirt_connect_list_networks (value connv, value iv) +{ + CAMLparam2 (connv, iv); + CAMLlocal2 (rv, strv); + virConnectPtr conn = Connect_val (connv); + int i = Int_val (iv); + char *names[i]; + int r; + + r = virConnectListNetworks (conn, names, i); + CHECK_ERROR (r == -1, conn, "virConnectListNetworks"); + + rv = caml_alloc (r, 0); + for (i = 0; i < r; ++i) { + strv = caml_copy_string (names[i]); + Store_field (rv, i, strv); + free (names[i]); + } + + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_connect_num_of_defined_networks (value connv) +{ + CAMLparam1 (connv); + virConnectPtr conn = Connect_val (connv); + int r; + + r = virConnectNumOfDefinedNetworks (conn); + CHECK_ERROR (r == -1, conn, "virConnectNumOfDefinedNetworks"); + + CAMLreturn (Val_int (r)); +} + +CAMLprim value +ocaml_libvirt_connect_list_defined_networks (value connv, value iv) +{ + CAMLparam2 (connv, iv); + CAMLlocal2 (rv, strv); + virConnectPtr conn = Connect_val (connv); + int i = Int_val (iv); + char *names[i]; + int r; + + r = virConnectListDefinedNetworks (conn, names, i); + CHECK_ERROR (r == -1, conn, "virConnectListDefinedNetworks"); + + rv = caml_alloc (r, 0); + for (i = 0; i < r; ++i) { + strv = caml_copy_string (names[i]); + Store_field (rv, i, strv); + free (names[i]); + } + + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_connect_get_node_info (value connv) +{ + CAMLparam1 (connv); + CAMLlocal2 (rv, v); + virConnectPtr conn = Connect_val (connv); + virNodeInfo info; + int r; + + r = virNodeGetInfo (conn, &info); + CHECK_ERROR (r == -1, conn, "virNodeGetInfo"); + + rv = caml_alloc (8, 0); + v = caml_copy_string (info.model); Store_field (rv, 0, v); + v = caml_copy_int64 (info.memory); Store_field (rv, 1, v); + Store_field (rv, 2, Val_int (info.cpus)); + Store_field (rv, 3, Val_int (info.mhz)); + Store_field (rv, 4, Val_int (info.nodes)); + Store_field (rv, 5, Val_int (info.sockets)); + Store_field (rv, 6, Val_int (info.cores)); + Store_field (rv, 7, Val_int (info.threads)); + + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_domain_create_linux (value connv, value xmlv) +{ + CAMLparam2 (connv, xmlv); + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *xml = String_val (xmlv); + virDomainPtr r; + + r = virDomainCreateLinux (conn, xml, 0); + CHECK_ERROR (!r, conn, "virDomainCreateLinux"); + + rv = Val_domain (r, connv); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_domain_lookup_by_id (value connv, value iv) +{ + CAMLparam2 (connv, iv); + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + int i = Int_val (iv); + virDomainPtr r; + + r = virDomainLookupByID (conn, i); + CHECK_ERROR (!r, conn, "virDomainLookupByID"); + + rv = Val_domain (r, connv); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_domain_lookup_by_uuid (value connv, value uuidv) +{ + CAMLparam2 (connv, uuidv); + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *uuid = String_val (uuidv); + virDomainPtr r; + + r = virDomainLookupByUUID (conn, (unsigned char *) uuid); + CHECK_ERROR (!r, conn, "virDomainLookupByUUID"); + + rv = Val_domain (r, connv); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_domain_lookup_by_uuid_string (value connv, value uuidv) +{ + CAMLparam2 (connv, uuidv); + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *uuid = String_val (uuidv); + virDomainPtr r; + + r = virDomainLookupByUUIDString (conn, uuid); + CHECK_ERROR (!r, conn, "virDomainLookupByUUIDString"); + + rv = Val_domain (r, connv); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_domain_lookup_by_name (value connv, value namev) +{ + CAMLparam2 (connv, namev); + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *name = String_val (namev); + virDomainPtr r; + + r = virDomainLookupByName (conn, name); + CHECK_ERROR (!r, conn, "virDomainLookupByName"); + + rv = Val_domain (r, connv); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_domain_destroy (value domv) +{ + CAMLparam1 (domv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + int r; + + r = virDomainDestroy (dom); + CHECK_ERROR (r == -1, conn, "virDomainDestroy"); + + /* So that we don't double-free in the finalizer: */ + Domain_val (domv) = NULL; + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_free (value domv) +{ + CAMLparam1 (domv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + int r; + + r = virDomainFree (dom); + CHECK_ERROR (r == -1, conn, "virDomainFree"); + + /* So that we don't double-free in the finalizer: */ + Domain_val (domv) = NULL; + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_suspend (value domv) +{ + CAMLparam1 (domv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + int r; + + r = virDomainSuspend (dom); + CHECK_ERROR (r == -1, conn, "virDomainSuspend"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_resume (value domv) +{ + CAMLparam1 (domv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + int r; + + r = virDomainResume (dom); + CHECK_ERROR (r == -1, conn, "virDomainResume"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_save (value domv, value pathv) +{ + CAMLparam2 (domv, pathv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + char *path = String_val (pathv); + int r; + + r = virDomainSave (dom, path); + CHECK_ERROR (r == -1, conn, "virDomainSave"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_restore (value connv, value pathv) +{ + CAMLparam2 (connv, pathv); + virConnectPtr conn = Connect_val (connv); + char *path = String_val (pathv); + int r; + + r = virDomainRestore (conn, path); + CHECK_ERROR (r == -1, conn, "virDomainRestore"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_core_dump (value domv, value pathv) +{ + CAMLparam2 (domv, pathv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + char *path = String_val (pathv); + int r; + + r = virDomainCoreDump (dom, path, 0); + CHECK_ERROR (r == -1, conn, "virDomainCoreDump"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_shutdown (value domv) +{ + CAMLparam1 (domv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + int r; + + r = virDomainShutdown (dom); + CHECK_ERROR (r == -1, conn, "virDomainShutdown"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_reboot (value domv) +{ + CAMLparam1 (domv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + int r; + + r = virDomainReboot (dom, 0); + CHECK_ERROR (r == -1, conn, "virDomainReboot"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_get_name (value domv) +{ + CAMLparam1 (domv); + CAMLlocal1 (rv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + const char *r; + + r = virDomainGetName (dom); + CHECK_ERROR (!r, conn, "virDomainGetName"); + + rv = caml_copy_string (r); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_domain_get_uuid (value domv) +{ + CAMLparam1 (domv); + CAMLlocal1 (rv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + unsigned char uuid[VIR_UUID_BUFLEN]; + int r; + + r = virDomainGetUUID (dom, uuid); + CHECK_ERROR (r == -1, conn, "virDomainGetUUID"); + + rv = caml_copy_string ((char *) uuid); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_domain_get_uuid_string (value domv) +{ + CAMLparam1 (domv); + CAMLlocal1 (rv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + char uuid[VIR_UUID_STRING_BUFLEN]; + int r; + + r = virDomainGetUUIDString (dom, uuid); + CHECK_ERROR (r == -1, conn, "virDomainGetUUIDString"); + + rv = caml_copy_string (uuid); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_domain_get_id (value domv) +{ + CAMLparam1 (domv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + unsigned int r; + + r = virDomainGetID (dom); + /* There's a bug in libvirt which means that if you try to get + * the ID of a defined-but-not-running domain, it returns -1, + * and there's no way to distinguish that from an error. + */ + CHECK_ERROR (r == (unsigned int) -1, conn, "virDomainGetID"); + + CAMLreturn (Val_int ((int) r)); +} + +CAMLprim value +ocaml_libvirt_domain_get_os_type (value domv) +{ + CAMLparam1 (domv); + CAMLlocal1 (rv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + char *r; + + r = virDomainGetOSType (dom); + CHECK_ERROR (!r, conn, "virDomainGetOSType"); + + rv = caml_copy_string (r); + free (r); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_domain_get_max_memory (value domv) +{ + CAMLparam1 (domv); + CAMLlocal1 (rv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + unsigned long r; + + r = virDomainGetMaxMemory (dom); + CHECK_ERROR (r == 0 /* [sic] */, conn, "virDomainGetMaxMemory"); + + rv = caml_copy_int64 (r); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_domain_set_max_memory (value domv, value memv) +{ + CAMLparam2 (domv, memv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + unsigned long mem = Int64_val (memv); + int r; + + r = virDomainSetMaxMemory (dom, mem); + CHECK_ERROR (r == -1, conn, "virDomainSetMaxMemory"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_set_memory (value domv, value memv) +{ + CAMLparam2 (domv, memv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + unsigned long mem = Int64_val (memv); + int r; + + r = virDomainSetMemory (dom, mem); + CHECK_ERROR (r == -1, conn, "virDomainSetMemory"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_get_info (value domv) +{ + CAMLparam1 (domv); + CAMLlocal2 (rv, v); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + virDomainInfo info; + int r; + + r = virDomainGetInfo (dom, &info); + CHECK_ERROR (r == -1, conn, "virDomainGetInfo"); + + rv = caml_alloc (5, 0); + Store_field (rv, 0, Val_int (info.state)); // These flags are compatible. + v = caml_copy_int64 (info.maxMem); Store_field (rv, 1, v); + v = caml_copy_int64 (info.memory); Store_field (rv, 2, v); + Store_field (rv, 3, Val_int (info.nrVirtCpu)); + v = caml_copy_int64 (info.cpuTime); Store_field (rv, 4, v); + + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_domain_get_xml_desc (value domv) +{ + CAMLparam1 (domv); + CAMLlocal1 (rv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + char *r; + + r = virDomainGetXMLDesc (dom, 0); + CHECK_ERROR (!r, conn, "virDomainGetXMLDesc"); + + rv = caml_copy_string (r); + free (r); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_domain_get_scheduler_type (value domv) +{ +#ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE + CAMLparam1 (domv); + CAMLlocal2 (rv, strv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + char *r; + int nparams; + + WEAK_SYMBOL_CHECK (virDomainGetSchedulerType); + r = virDomainGetSchedulerType (dom, &nparams); + CHECK_ERROR (!r, conn, "virDomainGetSchedulerType"); + + rv = caml_alloc_tuple (2); + strv = caml_copy_string (r); Store_field (rv, 0, strv); + free (r); + Store_field (rv, 1, nparams); + CAMLreturn (rv); +#else + NOT_SUPPORTED ("virDomainGetSchedulerType"); +#endif +} + +CAMLprim value +ocaml_libvirt_domain_get_scheduler_parameters (value domv, value nparamsv) +{ +#ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS + CAMLparam2 (domv, nparamsv); + CAMLlocal4 (rv, v, v2, v3); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + int nparams = Int_val (nparamsv); + virSchedParameter params[nparams]; + int r, i; + + WEAK_SYMBOL_CHECK (virDomainGetSchedulerParameters); + r = virDomainGetSchedulerParameters (dom, params, &nparams); + CHECK_ERROR (r == -1, conn, "virDomainGetSchedulerParameters"); + + rv = caml_alloc (nparams, 0); + for (i = 0; i < nparams; ++i) { + v = caml_alloc_tuple (2); Store_field (rv, i, v); + v2 = caml_copy_string (params[i].field); Store_field (v, 0, v2); + switch (params[i].type) { + case VIR_DOMAIN_SCHED_FIELD_INT: + v2 = caml_alloc (1, 0); + v3 = caml_copy_int32 (params[i].value.i); Store_field (v2, 0, v3); + break; + case VIR_DOMAIN_SCHED_FIELD_UINT: + v2 = caml_alloc (1, 1); + v3 = caml_copy_int32 (params[i].value.ui); Store_field (v2, 0, v3); + break; + case VIR_DOMAIN_SCHED_FIELD_LLONG: + v2 = caml_alloc (1, 2); + v3 = caml_copy_int64 (params[i].value.l); Store_field (v2, 0, v3); + break; + case VIR_DOMAIN_SCHED_FIELD_ULLONG: + v2 = caml_alloc (1, 3); + v3 = caml_copy_int64 (params[i].value.ul); Store_field (v2, 0, v3); + break; + case VIR_DOMAIN_SCHED_FIELD_DOUBLE: + v2 = caml_alloc (1, 4); + v3 = caml_copy_double (params[i].value.d); Store_field (v2, 0, v3); + break; + case VIR_DOMAIN_SCHED_FIELD_BOOLEAN: + v2 = caml_alloc (1, 5); + Store_field (v2, 0, Val_int (params[i].value.b)); + break; + default: + caml_failwith ((char *)__FUNCTION__); + } + Store_field (v, 1, v2); + } + CAMLreturn (rv); +#else + NOT_SUPPORTED ("virDomainGetSchedulerParameters"); +#endif +} + +CAMLprim value +ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv) +{ +#ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS + CAMLparam2 (domv, paramsv); + CAMLlocal1 (v); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + int nparams = Wosize_val (paramsv); + virSchedParameter params[nparams]; + int r, i; + char *name; + + for (i = 0; i < nparams; ++i) { + v = Field (paramsv, i); /* Points to the two-element tuple. */ + name = String_val (Field (v, 0)); + strncpy (params[i].field, name, VIR_DOMAIN_SCHED_FIELD_LENGTH); + params[i].field[VIR_DOMAIN_SCHED_FIELD_LENGTH-1] = '\0'; + v = Field (v, 1); /* Points to the sched_param_value block. */ + switch (Tag_val (v)) { + case 0: + params[i].type = VIR_DOMAIN_SCHED_FIELD_INT; + params[i].value.i = Int32_val (Field (v, 0)); + break; + case 1: + params[i].type = VIR_DOMAIN_SCHED_FIELD_UINT; + params[i].value.ui = Int32_val (Field (v, 0)); + break; + case 2: + params[i].type = VIR_DOMAIN_SCHED_FIELD_LLONG; + params[i].value.l = Int64_val (Field (v, 0)); + break; + case 3: + params[i].type = VIR_DOMAIN_SCHED_FIELD_ULLONG; + params[i].value.ul = Int64_val (Field (v, 0)); + break; + case 4: + params[i].type = VIR_DOMAIN_SCHED_FIELD_DOUBLE; + params[i].value.d = Double_val (Field (v, 0)); + break; + case 5: + params[i].type = VIR_DOMAIN_SCHED_FIELD_BOOLEAN; + params[i].value.b = Int_val (Field (v, 0)); + break; + default: + caml_failwith ((char *)__FUNCTION__); + } + } + + WEAK_SYMBOL_CHECK (virDomainSetSchedulerParameters); + r = virDomainSetSchedulerParameters (dom, params, nparams); + CHECK_ERROR (r == -1, conn, "virDomainSetSchedulerParameters"); + + CAMLreturn (Val_unit); +#else + NOT_SUPPORTED ("virDomainSetSchedulerParameters"); +#endif +} + +CAMLprim value +ocaml_libvirt_domain_define_xml (value connv, value xmlv) +{ + CAMLparam2 (connv, xmlv); + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *xml = String_val (xmlv); + virDomainPtr r; + + r = virDomainDefineXML (conn, xml); + CHECK_ERROR (!r, conn, "virDomainDefineXML"); + + rv = Val_domain (r, connv); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_domain_undefine (value domv) +{ + CAMLparam1 (domv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + int r; + + r = virDomainUndefine (dom); + CHECK_ERROR (r == -1, conn, "virDomainUndefine"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_create (value domv) +{ + CAMLparam1 (domv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + int r; + + r = virDomainCreate (dom); + CHECK_ERROR (r == -1, conn, "virDomainCreate"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_get_autostart (value domv) +{ + CAMLparam1 (domv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + int r, autostart; + + r = virDomainGetAutostart (dom, &autostart); + CHECK_ERROR (r == -1, conn, "virDomainGetAutostart"); + + CAMLreturn (autostart ? Val_true : Val_false); +} + +CAMLprim value +ocaml_libvirt_domain_set_autostart (value domv, value autostartv) +{ + CAMLparam2 (domv, autostartv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + int r, autostart = autostartv == Val_true ? 1 : 0; + + r = virDomainSetAutostart (dom, autostart); + CHECK_ERROR (r == -1, conn, "virDomainSetAutostart"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_set_vcpus (value domv, value nvcpusv) +{ + CAMLparam2 (domv, nvcpusv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + int r, nvcpus = Int_val (nvcpusv); + + r = virDomainSetVcpus (dom, nvcpus); + CHECK_ERROR (r == -1, conn, "virDomainSetVcpus"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_pin_vcpu (value domv, value vcpuv, value cpumapv) +{ + CAMLparam3 (domv, vcpuv, cpumapv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + int maplen = caml_string_length (cpumapv); + unsigned char *cpumap = (unsigned char *) String_val (cpumapv); + int vcpu = Int_val (vcpuv); + int r; + + r = virDomainPinVcpu (dom, vcpu, cpumap, maplen); + CHECK_ERROR (r == -1, conn, "virDomainPinVcpu"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv) +{ + CAMLparam3 (domv, maxinfov, maplenv); + CAMLlocal5 (rv, infov, strv, v, v2); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + int maxinfo = Int_val (maxinfov); + int maplen = Int_val (maplenv); + virVcpuInfo info[maxinfo]; + unsigned char cpumaps[maxinfo * maplen]; + int r, i; + + memset (info, 0, sizeof (virVcpuInfo) * maxinfo); + memset (cpumaps, 0, maxinfo * maplen); + + r = virDomainGetVcpus (dom, info, maxinfo, cpumaps, maplen); + CHECK_ERROR (r == -1, conn, "virDomainPinVcpu"); + + /* Copy the virVcpuInfo structures. */ + infov = caml_alloc (maxinfo, 0); + for (i = 0; i < maxinfo; ++i) { + v2 = caml_alloc (4, 0); Store_field (infov, i, v2); + Store_field (v2, 0, Val_int (info[i].number)); + Store_field (v2, 1, Val_int (info[i].state)); + v = caml_copy_int64 (info[i].cpuTime); Store_field (v2, 2, v); + Store_field (v2, 3, Val_int (info[i].cpu)); + } + + /* Copy the bitmap. */ + strv = caml_alloc_string (maxinfo * maplen); + memcpy (String_val (strv), cpumaps, maxinfo * maplen); + + /* Allocate the tuple and return it. */ + rv = caml_alloc_tuple (3); + Store_field (rv, 0, Val_int (r)); /* number of CPUs. */ + Store_field (rv, 1, infov); + Store_field (rv, 2, strv); + + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_domain_get_max_vcpus (value domv) +{ + CAMLparam1 (domv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + int r; + + r = virDomainGetMaxVcpus (dom); + CHECK_ERROR (r == -1, conn, "virDomainGetMaxVcpus"); + + CAMLreturn (Val_int (r)); +} + +CAMLprim value +ocaml_libvirt_domain_attach_device (value domv, value xmlv) +{ + CAMLparam2 (domv, xmlv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + char *xml = String_val (xmlv); + int r; + + r = virDomainAttachDevice (dom, xml); + CHECK_ERROR (r == -1, conn, "virDomainAttachDevice"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_detach_device (value domv, value xmlv) +{ + CAMLparam2 (domv, xmlv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + char *xml = String_val (xmlv); + int r; + + r = virDomainDetachDevice (dom, xml); + CHECK_ERROR (r == -1, conn, "virDomainDetachDevice"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, value optdnamev, value opturiv, value optbandwidthv, value unitv) +{ +#ifdef HAVE_VIRDOMAINMIGRATE + CAMLparam5 (domv, dconnv, flagsv, optdnamev, opturiv); + CAMLxparam2 (optbandwidthv, unitv); + CAMLlocal2 (flagv, rv); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + virConnectPtr dconn = Connect_val (dconnv); + int flags = 0; + const char *dname = Optstring_val (optdnamev); + const char *uri = Optstring_val (opturiv); + unsigned long bandwidth; + virDomainPtr r; + + /* Iterate over the list of flags. */ + for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1)) + { + flagv = Field (flagsv, 0); + if (flagv == Int_val(0)) + flags |= VIR_MIGRATE_LIVE; + } + + if (optbandwidthv == Val_int (0)) /* None */ + bandwidth = 0; + else /* Some bandwidth */ + bandwidth = Int_val (Field (optbandwidthv, 0)); + + WEAK_SYMBOL_CHECK (virDomainMigrate); + r = virDomainMigrate (dom, dconn, flags, dname, uri, bandwidth); + CHECK_ERROR (!r, conn, "virDomainMigrate"); + + rv = Val_domain (r, dconnv); + + CAMLreturn (rv); + +#else /* virDomainMigrate not supported */ + NOT_SUPPORTED ("virDomainMigrate"); +#endif +} + +CAMLprim value +ocaml_libvirt_domain_migrate_bytecode (value *argv, int argn) +{ + return ocaml_libvirt_domain_migrate_native (argv[0], argv[1], argv[2], + argv[3], argv[4], argv[5], + argv[6]); +} + +CAMLprim value +ocaml_libvirt_domain_block_stats (value domv, value pathv) +{ +#if HAVE_VIRDOMAINBLOCKSTATS + CAMLparam2 (domv, pathv); + CAMLlocal2 (rv,v); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + char *path = String_val (pathv); + struct _virDomainBlockStats stats; + int r; + + WEAK_SYMBOL_CHECK (virDomainBlockStats); + r = virDomainBlockStats (dom, path, &stats, sizeof stats); + CHECK_ERROR (r == -1, conn, "virDomainBlockStats"); + + rv = caml_alloc (5, 0); + v = caml_copy_int64 (stats.rd_req); Store_field (rv, 0, v); + v = caml_copy_int64 (stats.rd_bytes); Store_field (rv, 1, v); + v = caml_copy_int64 (stats.wr_req); Store_field (rv, 2, v); + v = caml_copy_int64 (stats.wr_bytes); Store_field (rv, 3, v); + v = caml_copy_int64 (stats.errs); Store_field (rv, 4, v); + + CAMLreturn (rv); +#else + NOT_SUPPORTED ("virDomainBlockStats"); +#endif +} + +CAMLprim value +ocaml_libvirt_domain_interface_stats (value domv, value pathv) +{ +#if HAVE_VIRDOMAININTERFACESTATS + CAMLparam2 (domv, pathv); + CAMLlocal2 (rv,v); + virDomainPtr dom = Domain_val (domv); + virConnectPtr conn = Connect_domv (domv); + char *path = String_val (pathv); + struct _virDomainInterfaceStats stats; + int r; + + WEAK_SYMBOL_CHECK (virDomainInterfaceStats); + r = virDomainInterfaceStats (dom, path, &stats, sizeof stats); + CHECK_ERROR (r == -1, conn, "virDomainInterfaceStats"); + + rv = caml_alloc (8, 0); + v = caml_copy_int64 (stats.rx_bytes); Store_field (rv, 0, v); + v = caml_copy_int64 (stats.rx_packets); Store_field (rv, 1, v); + v = caml_copy_int64 (stats.rx_errs); Store_field (rv, 2, v); + v = caml_copy_int64 (stats.rx_drop); Store_field (rv, 3, v); + v = caml_copy_int64 (stats.tx_bytes); Store_field (rv, 4, v); + v = caml_copy_int64 (stats.tx_packets); Store_field (rv, 5, v); + v = caml_copy_int64 (stats.tx_errs); Store_field (rv, 6, v); + v = caml_copy_int64 (stats.tx_drop); Store_field (rv, 7, v); + + CAMLreturn (rv); +#else + NOT_SUPPORTED ("virDomainInterfaceStats"); +#endif +} + +CAMLprim value +ocaml_libvirt_network_lookup_by_name (value connv, value namev) +{ + CAMLparam2 (connv, namev); + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *name = String_val (namev); + virNetworkPtr r; + + r = virNetworkLookupByName (conn, name); + CHECK_ERROR (!r, conn, "virNetworkLookupByName"); + + rv = Val_network (r, connv); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_network_lookup_by_uuid (value connv, value uuidv) +{ + CAMLparam2 (connv, uuidv); + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *uuid = String_val (uuidv); + virNetworkPtr r; + + r = virNetworkLookupByUUID (conn, (unsigned char *) uuid); + CHECK_ERROR (!r, conn, "virNetworkLookupByUUID"); + + rv = Val_network (r, connv); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_network_lookup_by_uuid_string (value connv, value uuidv) +{ + CAMLparam2 (connv, uuidv); + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *uuid = String_val (uuidv); + virNetworkPtr r; + + r = virNetworkLookupByUUIDString (conn, uuid); + CHECK_ERROR (!r, conn, "virNetworkLookupByUUIDString"); + + rv = Val_network (r, connv); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_network_create_xml (value connv, value xmlv) +{ + CAMLparam2 (connv, xmlv); + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *xml = String_val (xmlv); + virNetworkPtr r; + + r = virNetworkCreateXML (conn, xml); + CHECK_ERROR (!r, conn, "virNetworkCreateXML"); + + rv = Val_network (r, connv); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_network_define_xml (value connv, value xmlv) +{ + CAMLparam2 (connv, xmlv); + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + char *xml = String_val (xmlv); + virNetworkPtr r; + + r = virNetworkDefineXML (conn, xml); + CHECK_ERROR (!r, conn, "virNetworkDefineXML"); + + rv = Val_network (r, connv); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_network_undefine (value netv) +{ + CAMLparam1 (netv); + virNetworkPtr net = Network_val (netv); + virConnectPtr conn = Connect_netv (netv); + int r; + + r = virNetworkUndefine (net); + CHECK_ERROR (r == -1, conn, "virNetworkUndefine"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_network_create (value netv) +{ + CAMLparam1 (netv); + virNetworkPtr net = Network_val (netv); + virConnectPtr conn = Connect_netv (netv); + int r; + + r = virNetworkCreate (net); + CHECK_ERROR (r == -1, conn, "virNetworkCreate"); + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_network_destroy (value netv) +{ + CAMLparam1 (netv); + virNetworkPtr net = Network_val (netv); + virConnectPtr conn = Connect_netv (netv); + int r; + + r = virNetworkDestroy (net); + CHECK_ERROR (r == -1, conn, "virNetworkDestroy"); + + /* So that we don't double-free in the finalizer: */ + Network_val (netv) = NULL; + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_network_free (value netv) +{ + CAMLparam1 (netv); + virNetworkPtr net = Network_val (netv); + virConnectPtr conn = Connect_netv (netv); + int r; + + r = virNetworkFree (net); + CHECK_ERROR (r == -1, conn, "virNetworkFree"); + + /* So that we don't double-free in the finalizer: */ + Network_val (netv) = NULL; + + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_network_get_name (value netv) +{ + CAMLparam1 (netv); + CAMLlocal1 (rv); + virNetworkPtr net = Network_val (netv); + virConnectPtr conn = Connect_netv (netv); + const char *r; + + r = virNetworkGetName (net); + CHECK_ERROR (!r, conn, "virNetworkGetName"); + + rv = caml_copy_string (r); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_network_get_uuid (value netv) +{ + CAMLparam1 (netv); + CAMLlocal1 (rv); + virNetworkPtr net = Network_val (netv); + virConnectPtr conn = Connect_netv (netv); + unsigned char uuid[VIR_UUID_BUFLEN]; + int r; + + r = virNetworkGetUUID (net, uuid); + CHECK_ERROR (r == -1, conn, "virNetworkGetUUID"); + + rv = caml_copy_string ((char *) uuid); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_network_get_uuid_string (value netv) +{ + CAMLparam1 (netv); + CAMLlocal1 (rv); + virNetworkPtr net = Network_val (netv); + virConnectPtr conn = Connect_netv (netv); + char uuid[VIR_UUID_STRING_BUFLEN]; + int r; + + r = virNetworkGetUUIDString (net, uuid); + CHECK_ERROR (r == -1, conn, "virNetworkGetUUIDString"); + + rv = caml_copy_string (uuid); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_network_get_xml_desc (value netv) +{ + CAMLparam1 (netv); + CAMLlocal1 (rv); + virNetworkPtr net = Network_val (netv); + virConnectPtr conn = Connect_netv (netv); + char *r; + + r = virNetworkGetXMLDesc (net, 0); + CHECK_ERROR (!r, conn, "virNetworkGetXMLDesc"); + + rv = caml_copy_string (r); + free (r); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_network_get_bridge_name (value netv) +{ + CAMLparam1 (netv); + CAMLlocal1 (rv); + virNetworkPtr net = Network_val (netv); + virConnectPtr conn = Connect_netv (netv); + char *r; + + r = virNetworkGetBridgeName (net); + CHECK_ERROR (!r, conn, "virNetworkGetBridgeName"); + + rv = caml_copy_string (r); + free (r); + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_network_get_autostart (value netv) +{ + CAMLparam1 (netv); + virNetworkPtr net = Network_val (netv); + virConnectPtr conn = Connect_netv (netv); + int r, autostart; + + r = virNetworkGetAutostart (net, &autostart); + CHECK_ERROR (r == -1, conn, "virNetworkGetAutostart"); + + CAMLreturn (autostart ? Val_true : Val_false); +} + +CAMLprim value +ocaml_libvirt_network_set_autostart (value netv, value autostartv) +{ + CAMLparam2 (netv, autostartv); + virNetworkPtr net = Network_val (netv); + virConnectPtr conn = Connect_netv (netv); + int r, autostart = autostartv == Val_true ? 1 : 0; + + r = virNetworkSetAutostart (net, autostart); + CHECK_ERROR (r == -1, conn, "virNetworkSetAutostart"); + + CAMLreturn (Val_unit); +} + +/*----------------------------------------------------------------------*/ + +CAMLprim value +ocaml_libvirt_virterror_get_last_error (value unitv) +{ + CAMLparam1 (unitv); + CAMLlocal1 (rv); + virErrorPtr err = virGetLastError (); + + rv = Val_opt (err, (Val_ptr_t) Val_virterror); + + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_virterror_get_last_conn_error (value connv) +{ + CAMLparam1 (connv); + CAMLlocal1 (rv); + virConnectPtr conn = Connect_val (connv); + + rv = Val_opt (conn, (Val_ptr_t) Val_connect); + + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_virterror_reset_last_error (value unitv) +{ + CAMLparam1 (unitv); + virResetLastError (); + CAMLreturn (Val_unit); +} + +CAMLprim value +ocaml_libvirt_virterror_reset_last_conn_error (value connv) +{ + CAMLparam1 (connv); + virConnectPtr conn = Connect_val (connv); + virConnResetLastError (conn); + CAMLreturn (Val_unit); +} + +/*----------------------------------------------------------------------*/ + +/* Initialise the library. */ +CAMLprim value +ocaml_libvirt_init (value unit) +{ + CAMLparam1 (unit); + CAMLlocal1 (rv); + int r; + + r = virInitialize (); + CHECK_ERROR (r == -1, NULL, "virInitialize"); + + CAMLreturn (Val_unit); +} + +/*----------------------------------------------------------------------*/ + +static char * +Optstring_val (value strv) +{ + if (strv == Val_int (0)) /* None */ + return NULL; + else /* Some string */ + return String_val (Field (strv, 0)); +} + +static value +Val_opt (void *ptr, Val_ptr_t Val_ptr) +{ + CAMLparam0 (); + CAMLlocal2 (optv, ptrv); + + if (ptr) { /* Some ptr */ + optv = caml_alloc (1, 0); + ptrv = Val_ptr (ptr); + Store_field (optv, 0, ptrv); + } else /* None */ + optv = Val_int (0); + + CAMLreturn (optv); +} + +#if 0 +static value +option_default (value option, value deflt) +{ + if (option == Val_int (0)) /* "None" */ + return deflt; + else /* "Some 'a" */ + return Field (option, 0); +} +#endif + +static value +_raise_virterror (virConnectPtr conn, const char *fn) +{ + CAMLparam0 (); + CAMLlocal1 (rv); + virErrorPtr errp; + struct _virError err; + + errp = conn ? virConnGetLastError (conn) : virGetLastError (); + + if (!errp) { + /* Fake a _virError structure. */ + memset (&err, 0, sizeof err); + err.code = VIR_ERR_INTERNAL_ERROR; + err.domain = VIR_FROM_NONE; + err.level = VIR_ERR_ERROR; + err.message = (char *) fn; + errp = &err; + } + + rv = Val_virterror (errp); + caml_raise_with_arg (*caml_named_value ("ocaml_libvirt_virterror"), rv); + + /*NOTREACHED*/ + CAMLreturn (Val_unit); +} + +static value +Val_virterror (virErrorPtr err) +{ + CAMLparam0 (); + CAMLlocal3 (rv, connv, optv); + + rv = caml_alloc (12, 0); + Store_field (rv, 0, Val_int (err->code)); + Store_field (rv, 1, Val_int (err->domain)); + Store_field (rv, 2, + Val_opt (err->message, (Val_ptr_t) caml_copy_string)); + Store_field (rv, 3, Val_int (err->level)); + + /* conn, dom and net fields, all optional */ + if (err->conn) { + connv = Val_connect_no_finalize (err->conn); + optv = caml_alloc (1, 0); + Store_field (optv, 0, connv); + Store_field (rv, 4, optv); /* Some conn */ + + if (err->dom) { + optv = caml_alloc (1, 0); + Store_field (optv, 0, Val_domain_no_finalize (err->dom, connv)); + Store_field (rv, 5, optv); /* Some (dom, conn) */ + } + else + Store_field (rv, 5, Val_int (0)); /* None */ + if (err->net) { + optv = caml_alloc (1, 0); + Store_field (optv, 0, Val_network_no_finalize (err->net, connv)); + Store_field (rv, 11, optv); /* Some (net, conn) */ + } else + Store_field (rv, 11, Val_int (0)); /* None */ + } else { + Store_field (rv, 4, Val_int (0)); /* None */ + Store_field (rv, 5, Val_int (0)); /* None */ + Store_field (rv, 11, Val_int (0)); /* None */ + } + + Store_field (rv, 6, + Val_opt (err->str1, (Val_ptr_t) caml_copy_string)); + Store_field (rv, 7, + Val_opt (err->str2, (Val_ptr_t) caml_copy_string)); + Store_field (rv, 8, + Val_opt (err->str3, (Val_ptr_t) caml_copy_string)); + Store_field (rv, 9, caml_copy_int32 (err->int1)); + Store_field (rv, 10, caml_copy_int32 (err->int2)); + + CAMLreturn (rv); +} + +static void conn_finalize (value); +static void dom_finalize (value); +static void net_finalize (value); + +static struct custom_operations conn_custom_operations = { + "conn_custom_operations", + conn_finalize, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default +}; + +static struct custom_operations dom_custom_operations = { + "dom_custom_operations", + dom_finalize, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default + +}; + +static struct custom_operations net_custom_operations = { + "net_custom_operations", + net_finalize, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default +}; + +static value +Val_connect (virConnectPtr conn) +{ + CAMLparam0 (); + CAMLlocal1 (rv); + rv = caml_alloc_custom (&conn_custom_operations, + sizeof (virConnectPtr), 0, 1); + Connect_val (rv) = conn; + CAMLreturn (rv); +} + +/* This wraps up the raw domain handle (Domain.dom). */ +static value +Val_dom (virDomainPtr dom) +{ + CAMLparam0 (); + CAMLlocal1 (rv); + rv = caml_alloc_custom (&dom_custom_operations, + sizeof (virDomainPtr), 0, 1); + Dom_val (rv) = dom; + CAMLreturn (rv); +} + +/* This wraps up the raw network handle (Network.net). */ +static value +Val_net (virNetworkPtr net) +{ + CAMLparam0 (); + CAMLlocal1 (rv); + rv = caml_alloc_custom (&net_custom_operations, + sizeof (virNetworkPtr), 0, 1); + Net_val (rv) = net; + CAMLreturn (rv); +} + +/* No-finalize versions of Val_connect, Val_dom, Val_net ONLY for use + * by virterror wrappers. + */ +static value +Val_connect_no_finalize (virConnectPtr conn) +{ + CAMLparam0 (); + CAMLlocal1 (rv); + rv = caml_alloc (1, Abstract_tag); + Store_field (rv, 0, (value) conn); + CAMLreturn (rv); +} + +static value +Val_dom_no_finalize (virDomainPtr dom) +{ + CAMLparam0 (); + CAMLlocal1 (rv); + rv = caml_alloc (1, Abstract_tag); + Store_field (rv, 0, (value) dom); + CAMLreturn (rv); +} + +static value +Val_net_no_finalize (virNetworkPtr net) +{ + CAMLparam0 (); + CAMLlocal1 (rv); + rv = caml_alloc (1, Abstract_tag); + Store_field (rv, 0, (value) net); + CAMLreturn (rv); +} + +/* This wraps up the (dom, conn) pair (Domain.t). */ +static value +Val_domain (virDomainPtr dom, value connv) +{ + CAMLparam1 (connv); + CAMLlocal2 (rv, v); + + rv = caml_alloc_tuple (2); + v = Val_dom (dom); + Store_field (rv, 0, v); + Store_field (rv, 1, connv); + CAMLreturn (rv); +} + +/* This wraps up the (net, conn) pair (Network.t). */ +static value +Val_network (virNetworkPtr net, value connv) +{ + CAMLparam1 (connv); + CAMLlocal2 (rv, v); + + rv = caml_alloc_tuple (2); + v = Val_net (net); + Store_field (rv, 0, v); + Store_field (rv, 1, connv); + CAMLreturn (rv); +} + +/* No-finalize versions of Val_domain, Val_network ONLY for use by + * virterror wrappers. + */ +static value +Val_domain_no_finalize (virDomainPtr dom, value connv) +{ + CAMLparam1 (connv); + CAMLlocal2 (rv, v); + + rv = caml_alloc_tuple (2); + v = Val_dom_no_finalize (dom); + Store_field (rv, 0, v); + Store_field (rv, 1, connv); + CAMLreturn (rv); +} + +static value +Val_network_no_finalize (virNetworkPtr net, value connv) +{ + CAMLparam1 (connv); + CAMLlocal2 (rv, v); + + rv = caml_alloc_tuple (2); + v = Val_net_no_finalize (net); + Store_field (rv, 0, v); + Store_field (rv, 1, connv); + CAMLreturn (rv); +} + +static void +conn_finalize (value connv) +{ + virConnectPtr conn = Connect_val (connv); + if (conn) (void) virConnectClose (conn); +} + +static void +dom_finalize (value domv) +{ + virDomainPtr dom = Dom_val (domv); + if (dom) (void) virDomainFree (dom); +} + +static void +net_finalize (value netv) +{ + virNetworkPtr net = Net_val (netv); + if (net) (void) virNetworkFree (net); +} diff --git a/libvirt/libvirt_version.ml b/libvirt/libvirt_version.ml new file mode 100644 index 0000000..329d22e --- /dev/null +++ b/libvirt/libvirt_version.ml @@ -0,0 +1,6 @@ +(* Helper module containing the version of the OCaml bindings. + * $Id: libvirt_version.ml.in,v 1.2 2007/08/21 12:33:40 rjones Exp $ + *) + +let package = "ocaml-libvirt" +let version = "0.3.2.4" diff --git a/libvirt/libvirt_version.ml.in b/libvirt/libvirt_version.ml.in new file mode 100644 index 0000000..8214980 --- /dev/null +++ b/libvirt/libvirt_version.ml.in @@ -0,0 +1,6 @@ +(* Helper module containing the version of the OCaml bindings. + * $Id: libvirt_version.ml.in,v 1.2 2007/08/21 12:33:40 rjones Exp $ + *) + +let package = "@PACKAGE_NAME@" +let version = "@PACKAGE_VERSION@" diff --git a/libvirt/libvirt_version.mli b/libvirt/libvirt_version.mli new file mode 100644 index 0000000..847089a --- /dev/null +++ b/libvirt/libvirt_version.mli @@ -0,0 +1,12 @@ +(** OCaml bindings for libvirt. + (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc. + http://libvirt.org/ + $Id: libvirt_version.mli,v 1.2 2007/08/21 14:36:15 rjones Exp $ +*) + +val package : string +val version : string +(** The name and version of the OCaml libvirt bindings. + + (To get the version of libvirt C library itself + use {!Libvirt.get_version}). *) -- cgit