diff options
Diffstat (limited to 'libvirt/libvirt.ml')
| -rw-r--r-- | libvirt/libvirt.ml | 522 |
1 files changed, 0 insertions, 522 deletions
diff --git a/libvirt/libvirt.ml b/libvirt/libvirt.ml deleted file mode 100644 index aefc6c4..0000000 --- a/libvirt/libvirt.ml +++ /dev/null @@ -1,522 +0,0 @@ -(* OCaml bindings for libvirt. - (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc. - http://libvirt.org/ - - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2 of the License, or (at your option) any later version. - - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -*) - -type uuid = string - -type xml = string - -type filename = 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] - -type ('a, 'b) job_t - -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 -> xml = "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 num_of_pools : [>`R] t -> int = "ocaml_libvirt_connect_num_of_storage_pools" - external list_pools : [>`R] t -> int -> string array = "ocaml_libvirt_connect_list_storage_pools" - external num_of_defined_pools : [>`R] t -> int = "ocaml_libvirt_connect_num_of_defined_storage_pools" - external list_defined_pools : [>`R] t -> int -> string array = "ocaml_libvirt_connect_list_defined_storage_pools" - - external get_node_info : [>`R] t -> node_info = "ocaml_libvirt_connect_get_node_info" - external node_get_free_memory : [> `R] t -> int64 = "ocaml_libvirt_connect_node_get_free_memory" - external node_get_cells_free_memory : [> `R] t -> int -> int -> int64 array = "ocaml_libvirt_connect_node_get_cells_free_memory" - - (* See VIR_NODEINFO_MAXCPUS macro defined in <libvirt.h>. *) - let maxcpus_of_node_info { nodes = nodes; sockets = sockets; - cores = cores; threads = threads } = - nodes * sockets * cores * threads - - (* See VIR_CPU_MAPLEN macro defined in <libvirt.h>. *) - let cpumaplen nr_cpus = - (nr_cpus + 7) / 8 - - (* See VIR_USE_CPU, VIR_UNUSE_CPU, VIR_CPU_USABLE macros defined in <libvirt.h>. *) - 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 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 create_linux_job : [>`W] Connect.t -> xml -> ([`Domain], rw) job_t = "ocaml_libvirt_domain_create_linux_job" - 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 -> filename -> unit = "ocaml_libvirt_domain_save" - external save_job : [>`W] t -> filename -> ([`Domain_nocreate], rw) job_t = "ocaml_libvirt_domain_save_job" - external restore : [>`W] Connect.t -> filename -> unit = "ocaml_libvirt_domain_restore" - external restore_job : [>`W] Connect.t -> filename -> ([`Domain_nocreate], rw) job_t = "ocaml_libvirt_domain_restore_job" - external core_dump : [>`W] t -> filename -> unit = "ocaml_libvirt_domain_core_dump" - external core_dump_job : [>`W] t -> filename -> ([`Domain_nocreate], rw) job_t = "ocaml_libvirt_domain_core_dump_job" - 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 create_job : [>`W] t -> ([`Domain_nocreate], rw) job_t = "ocaml_libvirt_domain_create_job" - 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 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 create_xml_job : [>`W] Connect.t -> xml -> ([`Network], rw) job_t = "ocaml_libvirt_network_create_xml_job" - 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 create_job : [>`W] t -> ([`Network_nocreate], rw) job_t = "ocaml_libvirt_network_create_job" - 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 Pool = -struct - type 'rw t - type pool_state = Inactive | Building | Running | Degraded - type pool_build_flags = New | Repair | Resize - type pool_delete_flags = Normal | Zeroed - type pool_info = { - state : pool_state; - capacity : int64; - allocation : int64; - available : int64; - } - - external lookup_by_name : 'a Connect.t -> string -> 'a t = "ocaml_libvirt_storage_pool_lookup_by_name" - external lookup_by_uuid : 'a Connect.t -> uuid -> 'a t = "ocaml_libvirt_storage_pool_lookup_by_uuid" - external lookup_by_uuid_string : 'a Connect.t -> string -> 'a t = "ocaml_libvirt_storage_pool_lookup_by_uuid_string" - external create_xml : [>`W] Connect.t -> xml -> rw t = "ocaml_libvirt_storage_pool_create_xml" - external define_xml : [>`W] Connect.t -> xml -> rw t = "ocaml_libvirt_storage_pool_define_xml" - external build : [>`W] t -> pool_build_flags -> unit = "ocaml_libvirt_storage_pool_build" - external undefine : [>`W] t -> unit = "ocaml_libvirt_storage_pool_undefine" - external create : [>`W] t -> unit = "ocaml_libvirt_storage_pool_create" - external destroy : [>`W] t -> unit = "ocaml_libvirt_storage_pool_destroy" - external delete : [>`W] t -> unit = "ocaml_libvirt_storage_pool_delete" - external free : [>`R] t -> unit = "ocaml_libvirt_storage_pool_free" - external refresh : [`R] t -> unit = "ocaml_libvirt_storage_pool_refresh" - external get_name : [`R] t -> string = "ocaml_libvirt_storage_pool_get_name" - external get_uuid : [`R] t -> uuid = "ocaml_libvirt_storage_pool_get_uuid" - external get_uuid_string : [`R] t -> string = "ocaml_libvirt_storage_pool_get_uuid_string" - external get_info : [`R] t -> pool_info = "ocaml_libvirt_storage_pool_get_info" - external get_xml_desc : [`R] t -> xml = "ocaml_libvirt_storage_pool_get_xml_desc" - external get_autostart : [`R] t -> bool = "ocaml_libvirt_storage_pool_get_autostart" - external set_autostart : [`W] t -> bool -> unit = "ocaml_libvirt_storage_pool_set_autostart" - external num_of_volumes : [`R] t -> int = "ocaml_libvirt_storage_pool_num_of_volumes" - external list_volumes : [`R] t -> int -> string array = "ocaml_libvirt_storage_pool_list_volumes" - external const : [>`R] t -> ro t = "%identity" -end - -module Volume = -struct - type 'rw t - type vol_type = File | Block - type vol_delete_flags = Normal | Zeroed - type vol_info = { - typ : vol_type; - capacity : int64; - allocation : int64; - } - - external lookup_by_name : 'a Pool.t -> string -> 'a t = "ocaml_libvirt_storage_vol_lookup_by_name" - external lookup_by_key : 'a Connect.t -> string -> 'a t = "ocaml_libvirt_storage_vol_lookup_by_key" - external lookup_by_path : 'a Connect.t -> string -> 'a t = "ocaml_libvirt_storage_vol_lookup_by_path" - external pool_of_volume : 'a t -> 'a Pool.t = "ocaml_libvirt_storage_pool_lookup_by_volume" - external get_name : [`R] t -> string = "ocaml_libvirt_storage_vol_get_name" - external get_key : [`R] t -> string = "ocaml_libvirt_storage_vol_get_key" - external get_path : [`R] t -> string = "ocaml_libvirt_storage_vol_get_path" - external get_info : [`R] t -> vol_info = "ocaml_libvirt_storage_vol_get_info" - external get_xml_desc : [`R] t -> xml = "ocaml_libvirt_storage_vol_get_xml_desc" - external create_xml : [`W] Pool.t -> xml -> unit = "ocaml_libvirt_storage_vol_create_xml" - external delete : [`W] t -> unit = "ocaml_libvirt_storage_vol_delete" - external free : [>`R] t -> unit = "ocaml_libvirt_storage_vol_free" - external const : [>`R] t -> ro t = "%identity" -end - -module Job = -struct - type ('jobclass, 'rw) t = ('jobclass, 'rw) job_t - type job_type = Bounded | Unbounded - type job_state = Running | Complete | Failed | Cancelled - type job_info = { - typ : job_type; - state : job_state; - running_time : int; - remaining_time : int; - percent_complete : int - } - external get_info : ('a,'b) t -> job_info = "ocaml_libvirt_job_get_info" - external get_domain : ([`Domain], 'a) t -> 'a Domain.t = "ocaml_libvirt_job_get_domain" - external get_network : ([`Network], 'a) t -> 'a Network.t = "ocaml_libvirt_job_get_network" - external cancel : ('a,'b) t -> unit = "ocaml_libvirt_job_cancel" - external free : ('a, [>`R]) t -> unit = "ocaml_libvirt_job_free" - external const : ('a, [>`R]) t -> ('a, 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 - | VIR_ERR_INVALID_MAC - | VIR_ERR_AUTH_FAILED - | VIR_ERR_INVALID_STORAGE_POOL - | VIR_ERR_INVALID_STORAGE_VOL - | VIR_WAR_NO_STORAGE - | VIR_ERR_NO_STORAGE_POOL - | VIR_ERR_NO_STORAGE_VOL - | VIR_ERR_UNKNOWN of int - - 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" - | VIR_ERR_INVALID_MAC -> "VIR_ERR_INVALID_MAC" - | VIR_ERR_AUTH_FAILED -> "VIR_ERR_AUTH_FAILED" - | VIR_ERR_INVALID_STORAGE_POOL -> "VIR_ERR_INVALID_STORAGE_POOL" - | VIR_ERR_INVALID_STORAGE_VOL -> "VIR_ERR_INVALID_STORAGE_VOL" - | VIR_WAR_NO_STORAGE -> "VIR_WAR_NO_STORAGE" - | VIR_ERR_NO_STORAGE_POOL -> "VIR_ERR_NO_STORAGE_POOL" - | VIR_ERR_NO_STORAGE_VOL -> "VIR_ERR_NO_STORAGE_VOL" - | VIR_ERR_UNKNOWN i -> "VIR_ERR_" ^ string_of_int i - - 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 - | VIR_FROM_OPENVZ - | VIR_FROM_XENXM - | VIR_FROM_STATS_LINUX - | VIR_FROM_STORAGE - | VIR_FROM_UNKNOWN of int - - 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" - | VIR_FROM_OPENVZ -> "VIR_FROM_OPENVZ" - | VIR_FROM_XENXM -> "VIR_FROM_XENXM" - | VIR_FROM_STATS_LINUX -> "VIR_FROM_STATS_LINUX" - | VIR_FROM_STORAGE -> "VIR_FROM_STORAGE" - | VIR_FROM_UNKNOWN i -> "VIR_FROM_" ^ string_of_int i - - type level = - | VIR_ERR_NONE - | VIR_ERR_WARNING - | VIR_ERR_ERROR - | VIR_ERR_UNKNOWN_LEVEL of int - - let string_of_level = function - | VIR_ERR_NONE -> "VIR_ERR_NONE" - | VIR_ERR_WARNING -> "VIR_ERR_WARNING" - | VIR_ERR_ERROR -> "VIR_ERR_ERROR" - | VIR_ERR_UNKNOWN_LEVEL i -> "VIR_ERR_LEVEL_" ^ string_of_int i - - 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 -exception Not_supported of string - -(* Initialization. *) -external c_init : unit -> unit = "ocaml_libvirt_init" -let () = - Callback.register_exception - "ocaml_libvirt_virterror" (Virterror (Virterror.no_error ())); - Callback.register_exception - "ocaml_libvirt_not_supported" (Not_supported ""); - c_init () |