X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=libvirt%2Flibvirt.ml;h=784a2b5a8b9f0fc666393709d7c774f880bfc528;hb=0ec198e7784de1a49672183c961a2498b6c85b90;hp=044d4a200a8a8c2a352d7e89968d945604878e9a;hpb=3b39f65412f3583fb4a3c7c833da09e7c22a64a9;p=ocaml-libvirt.git diff --git a/libvirt/libvirt.ml b/libvirt/libvirt.ml index 044d4a2..784a2b5 100644 --- a/libvirt/libvirt.ml +++ b/libvirt/libvirt.ml @@ -5,7 +5,8 @@ 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. + version 2 of the License, or (at your option) any later version, + with the OCaml linking exception described in ../COPYING.LIB. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -32,8 +33,6 @@ let uuid_string_length = 36 type rw = [`R|`W] type ro = [`R] -type ('a, 'b) job_t - module Connect = struct type 'rw t @@ -49,6 +48,13 @@ struct threads : int; } + type list_flag = + | ListNoState | ListRunning | ListBlocked + | ListPaused | ListShutdown | ListShutoff | ListCrashed + | ListActive + | ListInactive + | ListAll + 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" @@ -94,224 +100,11 @@ struct 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 memory_flag = Virtual - - 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 block_peek : [>`R] t -> string -> int64 -> int -> string -> int -> unit = "ocaml_libvirt_domain_block_peek_bytecode" "ocaml_libvirt_domain_block_peek_native" - external memory_peek : [>`R] t -> memory_flag -> int64 -> int -> string -> int -> unit = "ocaml_libvirt_domain_memory_peek_bytecode" "ocaml_libvirt_domain_memory_peek_native" - - 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 + external set_keep_alive : [>`R] t -> int -> int -> unit = "ocaml_libvirt_connect_set_keep_alive" -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 = @@ -513,6 +306,270 @@ end exception Virterror of Virterror.t exception Not_supported of string +let rec map_ignore_errors f = function + | [] -> [] + | x :: xs -> + try f x :: map_ignore_errors f xs + with Virterror _ -> map_ignore_errors f xs + +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 typed_param = string * typed_param_value + and typed_param_value = + | TypedFieldInt32 of int32 | TypedFieldUInt32 of int32 + | TypedFieldInt64 of int64 | TypedFieldUInt64 of int64 + | TypedFieldFloat of float | TypedFieldBool of bool + | TypedFieldString of string + + type migrate_flag = Live + + type memory_flag = Virtual + + type list_flag = + | ListActive + | ListInactive + | ListAll + + 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; + } + + (* The maximum size for Domain.memory_peek and Domain.block_peek + * supported by libvirt. This may change with different versions + * of libvirt in the future, hence it's a function. + *) + let max_peek _ = 65536 + + 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 -> filename -> unit = "ocaml_libvirt_domain_save" + external restore : [>`W] Connect.t -> filename -> unit = "ocaml_libvirt_domain_restore" + external core_dump : [>`W] t -> filename -> 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_cpu_stats : [>`R] t -> typed_param list array = "ocaml_libvirt_domain_get_cpu_stats" + 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 block_peek : [>`W] t -> string -> int64 -> int -> string -> int -> unit = "ocaml_libvirt_domain_block_peek_bytecode" "ocaml_libvirt_domain_block_peek_native" + external memory_peek : [>`W] t -> memory_flag list -> int64 -> int -> string -> int -> unit = "ocaml_libvirt_domain_memory_peek_bytecode" "ocaml_libvirt_domain_memory_peek_native" + + external const : [>`R] t -> ro t = "%identity" + + let get_domains conn flags = + (* Old/slow/inefficient method. *) + let get_active, get_inactive = + if List.mem ListAll flags then + (true, true) + else + (List.mem ListActive flags, List.mem ListInactive flags) in + let active_doms = + if get_active then ( + let n = Connect.num_of_domains conn in + let ids = Connect.list_domains conn n in + let ids = Array.to_list ids in + map_ignore_errors (lookup_by_id conn) ids + ) else [] in + + let inactive_doms = + if get_inactive then ( + let n = Connect.num_of_defined_domains conn in + let names = Connect.list_defined_domains conn n in + let names = Array.to_list names in + map_ignore_errors (lookup_by_name conn) names + ) else [] in + + active_doms @ inactive_doms + + let get_domains_and_infos conn flags = + (* Old/slow/inefficient method. *) + let get_active, get_inactive = + if List.mem ListAll flags then + (true, true) + else (List.mem ListActive flags, List.mem ListInactive flags) in + let active_doms = + if get_active then ( + let n = Connect.num_of_domains conn in + let ids = Connect.list_domains conn n in + let ids = Array.to_list ids in + map_ignore_errors (lookup_by_id conn) ids + ) else [] in + + let inactive_doms = + if get_inactive then ( + let n = Connect.num_of_defined_domains conn in + let names = Connect.list_defined_domains conn n in + let names = Array.to_list names in + map_ignore_errors (lookup_by_name conn) names + ) else [] in + + let doms = active_doms @ inactive_doms in + + map_ignore_errors (fun dom -> (dom, get_info dom)) doms +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 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 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 -> vol_delete_flags -> unit = "ocaml_libvirt_storage_vol_delete" + external free : [>`R] t -> unit = "ocaml_libvirt_storage_vol_free" + external const : [>`R] t -> ro t = "%identity" +end + (* Initialization. *) external c_init : unit -> unit = "ocaml_libvirt_init" let () =