Commit be5973f6 authored by Pino Toscano's avatar Pino Toscano Committed by Richard W.M. Jones

Expose Secret API

Add a new Secret submodule to expose most of the virSecret* APIs, so it
is possible to interact with libvirt secrets.

Add the needed glue in the generator, in the helper macros/functions,
and in the Libvirt module itself.

Include a simple example, list_secrets.ml.
parent 86a58a32
......@@ -13,6 +13,7 @@ examples/domain_events.ml
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
......
......@@ -6,5 +6,7 @@ get_cpu_stats.cmo : ../libvirt/libvirt.cmi
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
......@@ -27,7 +27,7 @@ OCAMLOPTLIBS := $(OCAMLCLIBS)
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)
......@@ -45,6 +45,16 @@ list_domains.opt: list_domains.cmx
$(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) \
......
(* 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 ()
......@@ -58,6 +58,8 @@ my @functions = (
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" },
......@@ -169,6 +171,17 @@ my @functions = (
{ 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
......@@ -266,6 +279,7 @@ sub short_name_to_c_type
elsif ($_ eq "net") { "virNetworkPtr" }
elsif ($_ eq "pool") { "virStoragePoolPtr" }
elsif ($_ eq "vol") { "virStorageVolPtr" }
elsif ($_ eq "sec") { "virSecretPtr" }
else {
die "unknown short name $_"
}
......@@ -350,6 +364,8 @@ sub gen_unpack_args
"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 $_"
}
......@@ -365,6 +381,7 @@ sub gen_pack_result
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 $_"
}
......@@ -379,6 +396,7 @@ sub gen_free_arg
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 $_"
}
......
......@@ -101,6 +101,8 @@ struct
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"
......@@ -1618,6 +1620,32 @@ struct
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 () =
......
......@@ -382,6 +382,10 @@ sig
(* 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. *)
......@@ -1271,6 +1275,65 @@ sig
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 :
......
......@@ -226,6 +226,7 @@ static void dom_finalize (value);
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",
......@@ -273,6 +274,15 @@ static struct custom_operations vol_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)
{
......@@ -328,6 +338,17 @@ Val_vol (virStorageVolPtr vol)
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)
......@@ -384,6 +405,20 @@ Val_volume (virStorageVolPtr vol, 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)
{
......@@ -418,3 +453,10 @@ vol_finalize (value volv)
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);
}
......@@ -1582,6 +1582,58 @@ ocaml_libvirt_storage_vol_get_info (value volv)
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
......
......@@ -103,6 +103,7 @@ static value Val_virconnectcredential (const virConnectCredentialPtr cred);
#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);
......@@ -110,6 +111,7 @@ static value Val_dom (virDomainPtr dom);
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.
......@@ -118,12 +120,15 @@ static value Val_vol (virStorageVolPtr vol);
#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);
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment