From: Pino Toscano Date: Thu, 30 Aug 2018 10:13:36 +0000 (+0200) Subject: Connect: add auth/credential handling for connect X-Git-Url: http://git.annexia.org/?p=ocaml-libvirt.git;a=commitdiff_plain;h=1ea690b8c809f3b13cb6400721cf28e65b13ca39 Connect: add auth/credential handling for connect Add OCaml versions of virConnectCredential & virConnectAuth structs, using them to implement proper connect_auth & connect_auth_readonly. This makes it possible to properly supply credentials when opening a connection. --- diff --git a/libvirt/libvirt.ml b/libvirt/libvirt.ml index 7e1e470..eb9f6e4 100644 --- a/libvirt/libvirt.ml +++ b/libvirt/libvirt.ml @@ -48,6 +48,29 @@ struct threads : int; } + type credential_type = + | CredentialUsername + | CredentialAuthname + | CredentialLanguage + | CredentialCnonce + | CredentialPassphrase + | CredentialEchoprompt + | CredentialNoechoprompt + | CredentialRealm + | CredentialExternal + + type credential = { + typ : credential_type; + prompt : string; + challenge : string option; + defresult : string option; + } + + type auth = { + credtype : credential_type list; + cb : (credential list -> string option list); + } + type list_flag = | ListNoState | ListRunning | ListBlocked | ListPaused | ListShutdown | ListShutoff | ListCrashed @@ -57,6 +80,8 @@ struct 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 connect_auth : ?name:string -> auth -> rw t = "ocaml_libvirt_connect_open_auth" + external connect_auth_readonly : ?name:string -> auth -> ro t = "ocaml_libvirt_connect_open_auth_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" diff --git a/libvirt/libvirt.mli b/libvirt/libvirt.mli index 87f50f5..e3920d5 100644 --- a/libvirt/libvirt.mli +++ b/libvirt/libvirt.mli @@ -260,6 +260,38 @@ sig threads : int; (** number of threads per core *) } + type credential_type = + | CredentialUsername (** Identity to act as *) + | CredentialAuthname (** Identify to authorize as *) + | CredentialLanguage (** RFC 1766 languages, comma separated *) + | CredentialCnonce (** client supplies a nonce *) + | CredentialPassphrase (** Passphrase secret *) + | CredentialEchoprompt (** Challenge response *) + | CredentialNoechoprompt (** Challenge response *) + | CredentialRealm (** Authentication realm *) + | CredentialExternal (** Externally managed credential *) + + type credential = { + typ : credential_type; (** The type of credential *) + prompt : string; (** Prompt to show to user *) + challenge : string option; (** Additional challenge to show *) + defresult : string option; (** Optional default result *) + } + + type auth = { + credtype : credential_type list; (** List of supported credential_type values *) + cb : (credential list -> string option list); + (** Callback used to collect credentials. + + The input is a list of all the requested credentials. + + The function returns a list of all the results from the + requested credentials, so the number of results {e must} match + the number of input credentials. Each result is optional, + and in case it is [None] it means there was no result. + *) + } + val connect : ?name:string -> unit -> rw t val connect_readonly : ?name:string -> unit -> ro t (** [connect ~name ()] connects to the hypervisor with URI [name]. @@ -269,6 +301,9 @@ sig [connect_readonly] is the same but connects in read-only mode. *) + val connect_auth : ?name:string -> auth -> rw t + val connect_auth_readonly : ?name:string -> auth -> ro t + val close : [>`R] t -> unit (** [close conn] closes and frees the connection object in memory. diff --git a/libvirt/libvirt_c_epilogue.c b/libvirt/libvirt_c_epilogue.c index c7284b1..f5f0591 100644 --- a/libvirt/libvirt_c_epilogue.c +++ b/libvirt/libvirt_c_epilogue.c @@ -100,6 +100,36 @@ _raise_virterror (const char *fn) (void) caml__frame; } +static int +_list_length (value listv) +{ + CAMLparam1 (listv); + int len = 0; + + for (; listv != Val_emptylist; listv = Field (listv, 1), ++len) {} + + CAMLreturnT (int, len); +} + +static value +Val_virconnectcredential (const virConnectCredentialPtr cred) +{ + CAMLparam0 (); + CAMLlocal1 (rv); + + rv = caml_alloc (4, 0); + Store_field (rv, 0, Val_int (cred->type - 1)); + Store_field (rv, 1, caml_copy_string (cred->prompt)); + Store_field (rv, 2, + Val_opt_const (cred->challenge, + (Val_const_ptr_t) caml_copy_string)); + Store_field (rv, 3, + Val_opt_const (cred->defresult, + (Val_const_ptr_t) caml_copy_string)); + + CAMLreturn (rv); +} + /* Convert the virErrorNumber, virErrorDomain and virErrorLevel enums * into values (longs because they are variants in OCaml). * diff --git a/libvirt/libvirt_c_oneoffs.c b/libvirt/libvirt_c_oneoffs.c index 958ba69..11612f6 100644 --- a/libvirt/libvirt_c_oneoffs.c +++ b/libvirt/libvirt_c_oneoffs.c @@ -76,6 +76,136 @@ ocaml_libvirt_connect_open_readonly (value namev, value unit) CAMLreturn (rv); } +/* Helper struct holding data needed for the helper C authentication + * callback (which will call the actual OCaml callback). + */ +struct ocaml_auth_callback_data { + value *fvp; /* The OCaml auth callback. */ +}; + +static int +_ocaml_auth_callback (virConnectCredentialPtr cred, unsigned int ncred, void *cbdata) +{ + CAMLparam0 (); + CAMLlocal4 (listv, elemv, rv, v); + struct ocaml_auth_callback_data *s = cbdata; + int i, len; + + listv = Val_emptylist; + for (i = ncred - 1; i >= 0; --i) { + elemv = caml_alloc (2, 0); + Store_field (elemv, 0, Val_virconnectcredential (&cred[i])); + Store_field (elemv, 1, listv); + listv = elemv; + } + + /* Call the auth callback. */ + rv = caml_callback_exn (*s->fvp, listv); + if (Is_exception_result (rv)) { + /* The callback raised an exception, so return an error. */ + CAMLreturnT (int, -1); + } + + len = _list_length (rv); + if (len != (int) ncred) { + /* The callback did not return the same number of results as the + * credentials. + */ + CAMLreturnT (int, -1); + } + + for (i = 0; rv != Val_emptylist; rv = Field (rv, 1), ++i) { + virConnectCredentialPtr c = &cred[i]; + elemv = Field (rv, 0); + if (elemv == Val_int (0)) { + c->result = NULL; + c->resultlen = 0; + } else { + v = Field (elemv, 0); + len = caml_string_length (v); + c->result = malloc (len + 1); + if (c->result == NULL) + CAMLreturnT (int, -1); + memcpy (c->result, String_val (v), len); + c->result[len] = '\0'; + c->resultlen = len; + } + } + + CAMLreturnT (int, 0); +} + +static virConnectPtr +_ocaml_libvirt_connect_open_auth_common (value namev, value authv, int flags) +{ + CAMLparam2 (namev, authv); + CAMLlocal2 (listv, fv); + virConnectPtr conn; + virConnectAuth auth; + struct ocaml_auth_callback_data data; + int i; + char *name = NULL; + + /* Keep a copy of the 'namev' string, as its value could move around + * when calling other OCaml code that allocates memory. + */ + if (namev != Val_int (0)) { /* Some string */ + name = strdup (String_val (Field (namev, 0))); + if (name == NULL) + caml_raise_out_of_memory (); + } + + fv = Field (authv, 1); + data.fvp = &fv; + + listv = Field (authv, 0); + auth.ncredtype = _list_length (listv); + auth.credtype = malloc (sizeof (int) * auth.ncredtype); + if (auth.credtype == NULL) + caml_raise_out_of_memory (); + for (i = 0; listv != Val_emptylist; listv = Field (listv, 1), ++i) { + auth.credtype[i] = Int_val (Field (listv, 0)) + 1; + } + auth.cb = &_ocaml_auth_callback; + auth.cbdata = &data; + + /* Call virConnectOpenAuth directly, without using the NONBLOCKING + * macro, as this will indeed call ocaml_* APIs, and run OCaml code. + */ + conn = virConnectOpenAuth (name, &auth, flags); + free (auth.credtype); + free (name); + CHECK_ERROR (!conn, "virConnectOpenAuth"); + + CAMLreturnT (virConnectPtr, conn); +} + +CAMLprim value +ocaml_libvirt_connect_open_auth (value namev, value authv) +{ + CAMLparam2 (namev, authv); + CAMLlocal1 (rv); + virConnectPtr conn; + + conn = _ocaml_libvirt_connect_open_auth_common (namev, authv, 0); + rv = Val_connect (conn); + + CAMLreturn (rv); +} + +CAMLprim value +ocaml_libvirt_connect_open_auth_readonly (value namev, value authv) +{ + CAMLparam2 (namev, authv); + CAMLlocal1 (rv); + virConnectPtr conn; + + conn = _ocaml_libvirt_connect_open_auth_common (namev, authv, VIR_CONNECT_RO); + rv = Val_connect (conn); + + CAMLreturn (rv); +} + CAMLprim value ocaml_libvirt_connect_get_version (value connv) { diff --git a/libvirt/libvirt_c_prologue.c b/libvirt/libvirt_c_prologue.c index c82bd5f..af4a4e9 100644 --- a/libvirt/libvirt_c_prologue.c +++ b/libvirt/libvirt_c_prologue.c @@ -28,6 +28,8 @@ static value Val_opt_const (const void *ptr, Val_const_ptr_t Val_ptr); /*static value option_default (value option, value deflt);*/ static void _raise_virterror (const char *fn) Noreturn; static value Val_virterror (virErrorPtr err); +static int _list_length (value listv); +static value Val_virconnectcredential (const virConnectCredentialPtr cred); /* Use this around synchronous libvirt API calls to release the OCaml * lock, allowing other threads to run simultaneously. 'code' must not