examples/get_all_domain_stats.ml
examples/get_cpu_stats.ml
examples/list_domains.ml
+examples/list_secrets.ml
examples/node_info.ml
examples/Makefile.in
install-sh
get_cpu_stats.cmx : ../libvirt/libvirt.cmx
list_domains.cmo : ../libvirt/libvirt.cmi
list_domains.cmx : ../libvirt/libvirt.cmx
+list_secrets.cmo : ../libvirt/libvirt.cmi
+list_secrets.cmx : ../libvirt/libvirt.cmx
node_info.cmo : ../libvirt/libvirt.cmi
node_info.cmx : ../libvirt/libvirt.cmx
export LIBRARY_PATH=../libvirt
export LD_LIBRARY_PATH=../libvirt
-BYTE_TARGETS := list_domains node_info get_cpu_stats \
+BYTE_TARGETS := list_domains list_secrets node_info get_cpu_stats \
get_all_domain_stats domain_events
OPT_TARGETS := $(BYTE_TARGETS:%=%.opt)
$(OCAMLOPTPACKAGES) $(OCAMLOPTFLAGS) $(OCAMLOPTLIBS) \
../libvirt/mllibvirt.cmxa -o $@ $<
+list_secrets: list_secrets
+ $(OCAMLFIND) ocamlc \
+ $(OCAMLCPACKAGES) $(OCAMLCFLAGS) $(OCAMLCLIBS) \
+ ../libvirt/mllibvirt.cma -o $@ $<
+
+list_secrets.opt: list_secrets.cmx
+ $(OCAMLFIND) ocamlopt \
+ $(OCAMLOPTPACKAGES) $(OCAMLOPTFLAGS) $(OCAMLOPTLIBS) \
+ ../libvirt/mllibvirt.cmxa -o $@ $<
+
node_info: node_info.cmo
$(OCAMLFIND) ocamlc \
$(OCAMLCPACKAGES) $(OCAMLCFLAGS) $(OCAMLCLIBS) \
--- /dev/null
+(* Simple demo program showing how to list out secrets.
+ Usage: list_secrets [URI]
+ (C) Copyright 2018 Pino Toscano, Red Hat Inc.
+ http://libvirt.org/
+ *)
+
+open Printf
+
+module C = Libvirt.Connect
+module S = Libvirt.Secret
+
+let string_of_secret_usage_type = function
+ | S.NoType -> "none"
+ | S.Volume -> "volume"
+ | S.Ceph -> "ceph"
+ | S.ISCSI -> "iscsi"
+ | S.TLS -> "tls"
+
+let () =
+ try
+ let name =
+ if Array.length Sys.argv >= 2 then
+ Some (Sys.argv.(1))
+ else
+ None in
+ let conn = C.connect_auth_readonly ?name (C.get_auth_default ()) in
+
+ (* List all the secrets. *)
+ let secrets = C.list_secrets conn (C.num_of_secrets conn) in
+ let secrets = Array.to_list secrets in
+ let secrets = List.map (S.lookup_by_uuid_string conn) secrets in
+ List.iter (
+ fun secret ->
+ let uuid = S.get_uuid_string secret in
+ let usageType = string_of_secret_usage_type (S.get_usage_type secret) in
+ let usageId = S.get_usage_id secret in
+ printf "%*s %-7s %s\n%!"
+ (Libvirt.uuid_string_length) uuid usageType usageId
+ ) secrets
+ with
+ Libvirt.Virterror err ->
+ eprintf "error: %s\n" (Libvirt.Virterror.to_string err)
+
+let () =
+ (* Run the garbage collector which is a good way to check for
+ * memory corruption errors and reference counting issues in libvirt.
+ *)
+ Gc.compact ()
sig => "conn : int" },
{ name => "virConnectListDefinedStoragePools",
sig => "conn, int : string array" },
+ { name => "virConnectNumOfSecrets", sig => "conn : int" },
+ { name => "virConnectListSecrets", sig => "conn, int : string array" },
{ name => "virConnectGetCapabilities", sig => "conn : string" },
{ name => "virConnectDomainEventDeregisterAny",
sig => "conn, int : unit" },
{ name => "virStoragePoolLookupByVolume",
sig => "vol : pool from vol" },
+ { name => "virSecretFree", sig => "sec : free" },
+ { name => "virSecretUndefine", sig => "sec : unit" },
+ { name => "virSecretLookupByUUID", sig => "conn, uuid : sec" },
+ { name => "virSecretLookupByUUIDString", sig => "conn, string : sec" },
+ { name => "virSecretDefineXML", sig => "conn, string, 0 : sec" },
+ { name => "virSecretGetUUID", sig => "sec : uuid" },
+ { name => "virSecretGetUUIDString", sig => "sec : uuid string" },
+ { name => "virSecretGetUsageType", sig => "sec : int" },
+ { name => "virSecretGetUsageID", sig => "sec : static string" },
+ { name => "virSecretGetXMLDesc", sig => "sec, 0 : string" },
+
);
# Functions we haven't implemented anywhere yet but which are mentioned
elsif ($_ eq "net") { "virNetworkPtr" }
elsif ($_ eq "pool") { "virStoragePoolPtr" }
elsif ($_ eq "vol") { "virStorageVolPtr" }
+ elsif ($_ eq "sec") { "virSecretPtr" }
else {
die "unknown short name $_"
}
"virStoragePoolPtr pool = Pool_val (poolv);"
} elsif ($_ eq "vol") {
"virStorageVolPtr vol = Volume_val (volv);"
+ } elsif ($_ eq "sec") {
+ "virSecretPtr sec = Secret_val (secv);"
} else {
die "unknown short name $_"
}
elsif ($_ eq "net") { "rv = Val_network (r, connv);" }
elsif ($_ eq "pool") { "rv = Val_pool (r, connv);" }
elsif ($_ eq "vol") { "rv = Val_volume (r, connv);" }
+ elsif ($_ eq "sec") { "rv = Val_secret (r, connv);" }
else {
die "unknown short name $_"
}
elsif ($_ eq "net") { "Network_val (netv) = NULL;" }
elsif ($_ eq "pool") { "Pool_val (poolv) = NULL;" }
elsif ($_ eq "vol") { "Volume_val (volv) = NULL;" }
+ elsif ($_ eq "sec") { "Secret_val (secv) = NULL;" }
else {
die "unknown short name $_"
}
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 num_of_secrets : [>`R] t -> int = "ocaml_libvirt_connect_num_of_secrets"
+ external list_secrets : [>`R] t -> int -> string array = "ocaml_libvirt_connect_list_secrets"
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 const : [>`R] t -> ro t = "%identity"
end
+module Secret =
+struct
+ type 'rw t
+ type secret_usage_type =
+ | NoType
+ | Volume
+ | Ceph
+ | ISCSI
+ | TLS
+
+ external lookup_by_uuid : 'a Connect.t -> uuid -> 'a t = "ocaml_libvirt_secret_lookup_by_uuid"
+ external lookup_by_uuid_string : 'a Connect.t -> string -> 'a t = "ocaml_libvirt_secret_lookup_by_uuid_string"
+ external lookup_by_usage : 'a Connect.t -> secret_usage_type -> string -> 'a t = "ocaml_libvirt_secret_lookup_by_usage"
+ external define_xml : [>`W] Connect.t -> xml -> rw t = "ocaml_libvirt_secret_define_xml"
+ external get_uuid : [>`R] t -> uuid = "ocaml_libvirt_secret_get_uuid"
+ external get_uuid_string : [>`R] t -> string = "ocaml_libvirt_secret_get_uuid_string"
+ external get_usage_type : [>`R] t -> secret_usage_type = "ocaml_libvirt_secret_get_usage_type"
+ external get_usage_id : [>`R] t -> string = "ocaml_libvirt_secret_get_usage_id"
+ external get_xml_desc : [>`R] t -> xml = "ocaml_libvirt_secret_get_xml_desc"
+ external set_value : [>`W] t -> bytes -> unit = "ocaml_libvirt_secret_set_value"
+ external get_value : [>`R] t -> bytes = "ocaml_libvirt_secret_get_value"
+ external undefine : [>`W] t -> unit = "ocaml_libvirt_secret_undefine"
+ external free : [>`R] t -> unit = "ocaml_libvirt_secret_free"
+ external const : [>`R] t -> ro t = "%identity"
+end
+
(* Initialization. *)
external c_init : unit -> unit = "ocaml_libvirt_init"
let () =
(* The name of this function is inconsistent, but the inconsistency
* is really in libvirt itself.
*)
+ val num_of_secrets : [>`R] t -> int
+ (** Returns the number of secrets. *)
+ val list_secrets : [>`R] t -> int -> string array
+ (** Returns the list of secrets. *)
val get_node_info : [>`R] t -> node_info
(** Return information about the physical server. *)
end
(** Module dealing with storage volumes. *)
+(** {3 Secrets} *)
+
+module Secret :
+sig
+ type 'rw t
+ (** Secret handle. *)
+
+ type secret_usage_type =
+ | NoType
+ | Volume
+ | Ceph
+ | ISCSI
+ | TLS
+ (** Usage type of a secret. *)
+
+ val lookup_by_uuid : 'a Connect.t -> uuid -> 'a t
+ (** Lookup a secret by UUID. This uses the packed byte array UUID. *)
+ val lookup_by_uuid_string : 'a Connect.t -> string -> 'a t
+ (** Lookup a secret by (string) UUID. *)
+ val lookup_by_usage : 'a Connect.t -> secret_usage_type -> string -> 'a t
+ (** Lookup a secret by usage type, and usage ID. *)
+
+ val define_xml : [>`W] Connect.t -> xml -> rw t
+ (** Define a secret. *)
+
+ val get_uuid : [>`R] t -> uuid
+ (** Get the UUID (as a packed byte array) of the secret. *)
+ val get_uuid_string : [>`R] t -> string
+ (** Get the UUID (as a printable string) of the secret. *)
+ val get_usage_type : [>`R] t -> secret_usage_type
+ (** Get the usage type of the secret. *)
+ val get_usage_id : [>`R] t -> string
+ (** Get the usage ID of the secret. *)
+ val get_xml_desc : [>`R] t -> xml
+ (** Get the XML description. *)
+
+ val set_value : [>`W] t -> bytes -> unit
+ (** Set a new value for the secret. *)
+ val get_value : [>`R] t -> bytes
+ (** Get the value of the secret. *)
+
+ val undefine : [>`W] t -> unit
+ (** Undefine a secret. *)
+
+ val free : [>`R] t -> unit
+ (** Free a secret object in memory.
+
+ The secret object is automatically freed if it is garbage
+ collected. This function just forces it to be freed right
+ away.
+ *)
+
+ external const : [>`R] t -> ro t = "%identity"
+ (** [const conn] turns a read/write secret into a read-only
+ secret. Note that the opposite operation is impossible.
+ *)
+end
+ (** Module dealing with secrets. *)
+
(** {3 Error handling and exceptions} *)
module Virterror :
static void net_finalize (value);
static void pol_finalize (value);
static void vol_finalize (value);
+static void sec_finalize (value);
static struct custom_operations conn_custom_operations = {
(char *) "conn_custom_operations",
custom_deserialize_default
};
+static struct custom_operations sec_custom_operations = {
+ (char *) "sec_custom_operations",
+ sec_finalize,
+ custom_compare_default,
+ custom_hash_default,
+ custom_serialize_default,
+ custom_deserialize_default
+};
+
static value
Val_connect (virConnectPtr conn)
{
CAMLreturn (rv);
}
+static value
+Val_sec (virSecretPtr sec)
+{
+ CAMLparam0 ();
+ CAMLlocal1 (rv);
+ rv = caml_alloc_custom (&sec_custom_operations,
+ sizeof (virSecretPtr), 0, 1);
+ Sec_val (rv) = sec;
+ CAMLreturn (rv);
+}
+
/* This wraps up the (dom, conn) pair (Domain.t). */
static value
Val_domain (virDomainPtr dom, value connv)
CAMLreturn (rv);
}
+/* This wraps up the (sec, conn) pair (Secret.t). */
+static value
+Val_secret (virSecretPtr sec, value connv)
+{
+ CAMLparam1 (connv);
+ CAMLlocal2 (rv, v);
+
+ rv = caml_alloc_tuple (2);
+ v = Val_sec (sec);
+ Store_field (rv, 0, v);
+ Store_field (rv, 1, connv);
+ CAMLreturn (rv);
+}
+
static void
conn_finalize (value connv)
{
virStorageVolPtr vol = Vol_val (volv);
if (vol) (void) virStorageVolFree (vol);
}
+
+static void
+sec_finalize (value secv)
+{
+ virSecretPtr sec = Sec_val (secv);
+ if (sec) (void) virSecretFree (sec);
+}
CAMLreturn (rv);
}
+CAMLprim value
+ocaml_libvirt_secret_lookup_by_usage (value connv, value usagetypev, value usageidv)
+{
+ CAMLparam3 (connv, usagetypev, usageidv);
+ CAMLlocal1 (rv);
+ virConnectPtr conn = Connect_val (connv);
+ int usageType = Int_val (usagetypev);
+ const char *usageID = String_val (usageidv);
+ virSecretPtr r;
+
+ NONBLOCKING (r = virSecretLookupByUsage (conn, usageType, usageID));
+ CHECK_ERROR (!r, "virSecretLookupByUsage");
+
+ rv = Val_secret (r, connv);
+
+ CAMLreturn (rv);
+}
+
+CAMLprim value
+ocaml_libvirt_secret_set_value (value secv, value vv)
+{
+ CAMLparam2 (secv, vv);
+ virSecretPtr sec = Secret_val (secv);
+ const unsigned char *secval = (unsigned char *) String_val (vv);
+ const size_t size = caml_string_length (vv);
+ int r;
+
+ NONBLOCKING (r = virSecretSetValue (sec, secval, size, 0));
+ CHECK_ERROR (r == -1, "virSecretSetValue");
+
+ CAMLreturn (Val_unit);
+}
+
+CAMLprim value
+ocaml_libvirt_secret_get_value (value secv)
+{
+ CAMLparam1 (secv);
+ CAMLlocal1 (rv);
+ virSecretPtr sec = Secret_val (secv);
+ unsigned char *secval;
+ size_t size = 0;
+
+ NONBLOCKING (secval = virSecretGetValue (sec, &size, 0));
+ CHECK_ERROR (secval == NULL, "virSecretGetValue");
+
+ rv = caml_alloc_string (size);
+ memcpy (String_val (rv), secval, size);
+ free (secval);
+
+ CAMLreturn (rv);
+}
+
/*----------------------------------------------------------------------*/
CAMLprim value
#define Net_val(rv) (*((virNetworkPtr *)Data_custom_val(rv)))
#define Pol_val(rv) (*((virStoragePoolPtr *)Data_custom_val(rv)))
#define Vol_val(rv) (*((virStorageVolPtr *)Data_custom_val(rv)))
+#define Sec_val(rv) (*((virSecretPtr *)Data_custom_val(rv)))
/* Wrap up a pointer to something in a custom block. */
static value Val_connect (virConnectPtr conn);
static value Val_net (virNetworkPtr net);
static value Val_pol (virStoragePoolPtr pool);
static value Val_vol (virStorageVolPtr vol);
+static value Val_sec (virSecretPtr sec);
/* Domains and networks are stored as pairs (dom/net, conn), so have
* some convenience functions for unwrapping and wrapping them.
#define Network_val(rv) (Net_val(Field((rv),0)))
#define Pool_val(rv) (Pol_val(Field((rv),0)))
#define Volume_val(rv) (Vol_val(Field((rv),0)))
+#define Secret_val(rv) (Sec_val(Field((rv),0)))
#define Connect_domv(rv) (Connect_val(Field((rv),1)))
#define Connect_netv(rv) (Connect_val(Field((rv),1)))
#define Connect_polv(rv) (Connect_val(Field((rv),1)))
#define Connect_volv(rv) (Connect_val(Field((rv),1)))
+#define Connect_secv(rv) (Connect_val(Field((rv),1)))
static value Val_domain (virDomainPtr dom, value connv);
static value Val_network (virNetworkPtr net, value connv);
static value Val_pool (virStoragePoolPtr pol, value connv);
static value Val_volume (virStorageVolPtr vol, value connv);
+static value Val_secret (virSecretPtr sec, value connv);
git.annexia.org / ocaml-libvirt.git / commitdiff