From c5cd2cc96ff724ba21fa3eb7b876febf811ce784 Mon Sep 17 00:00:00 2001
From: Pino Toscano <ptoscano@redhat.com>
Date: Wed, 5 Sep 2018 18:03:14 +0200
Subject: [PATCH] Implement Connect.get_auth_default ()

Add a function to return the default libvirt authentication handler,
in case it is needed.

Followup of commit 1ea690b8c809f3b13cb6400721cf28e65b13ca39.
---
 libvirt/libvirt.ml          |  9 +++++
 libvirt/libvirt.mli         |  5 +++
 libvirt/libvirt_c_oneoffs.c | 96 +++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 110 insertions(+)

diff --git a/libvirt/libvirt.ml b/libvirt/libvirt.ml
index c03032f..c432fdf 100644
--- a/libvirt/libvirt.ml
+++ b/libvirt/libvirt.ml
@@ -127,6 +127,15 @@ struct
 
   external set_keep_alive : [>`R] t -> int -> int -> unit = "ocaml_libvirt_connect_set_keep_alive"
 
+  (* Internal API needed for get_auth_default. *)
+  external _credtypes_from_auth_default : unit -> credential_type list = "ocaml_libvirt_connect_credtypes_from_auth_default"
+  external _call_auth_default_callback : credential list -> string option list = "ocaml_libvirt_connect_call_auth_default_callback"
+  let get_auth_default () =
+    {
+      credtype = _credtypes_from_auth_default ();
+      cb = _call_auth_default_callback;
+    }
+
   external const : [>`R] t -> ro t = "%identity"
 end
 
diff --git a/libvirt/libvirt.mli b/libvirt/libvirt.mli
index ff8d4ca..c05ed7e 100644
--- a/libvirt/libvirt.mli
+++ b/libvirt/libvirt.mli
@@ -427,6 +427,11 @@ sig
         Note: the client has to implement and run an event loop to
         be able to use keep-alive messages. *)
 
+  val get_auth_default : unit -> auth
+    (** [get_auth_default ()] returns the default authentication handler
+	of libvirt.
+      *)
+
   external const : [>`R] t -> ro t = "%identity"
     (** [const conn] turns a read/write connection into a read-only
 	connection.  Note that the opposite operation is impossible.
diff --git a/libvirt/libvirt_c_oneoffs.c b/libvirt/libvirt_c_oneoffs.c
index e4fd444..7263d69 100644
--- a/libvirt/libvirt_c_oneoffs.c
+++ b/libvirt/libvirt_c_oneoffs.c
@@ -324,6 +324,102 @@ ocaml_libvirt_connect_set_keep_alive(value connv,
 }
 
 CAMLprim value
+ocaml_libvirt_connect_credtypes_from_auth_default (value unitv)
+{
+  CAMLparam1 (unitv);
+  CAMLlocal2 (listv, itemv);
+  int i;
+
+  listv = Val_emptylist;
+
+  if (virConnectAuthPtrDefault) {
+    for (i = virConnectAuthPtrDefault->ncredtype; i >= 0; --i) {
+      const int type = virConnectAuthPtrDefault->credtype[i];
+      itemv = caml_alloc (2, 0);
+      Store_field (itemv, 0, Val_int (type - 1));
+      Store_field (itemv, 1, listv);
+      listv = itemv;
+    }
+  }
+
+  CAMLreturn (listv);
+}
+
+CAMLprim value
+ocaml_libvirt_connect_call_auth_default_callback (value listv)
+{
+  CAMLparam1 (listv);
+  CAMLlocal5 (credv, retv, elemv, optv, v);
+  int i, len, ret;
+  const char *str;
+  virConnectCredentialPtr creds;
+
+  if (virConnectAuthPtrDefault == NULL
+      || virConnectAuthPtrDefault->cb == NULL)
+    CAMLreturn (Val_unit);
+
+  len = _list_length (listv);
+  creds = calloc (len, sizeof (*creds));
+  if (creds == NULL)
+    caml_raise_out_of_memory ();
+  for (i = 0; listv != Val_emptylist; listv = Field (listv, 1), ++i) {
+    virConnectCredentialPtr cred = &creds[i];
+    credv = Field (listv, 0);
+    cred->type = Int_val (Field (credv, 0)) + 1;
+    cred->prompt = strdup (String_val (Field (credv, 1)));
+    if (cred->prompt == NULL)
+      caml_raise_out_of_memory ();
+    str = Optstring_val (Field (credv, 2));
+    if (str) {
+      cred->challenge = strdup (str);
+      if (cred->challenge == NULL)
+        caml_raise_out_of_memory ();
+    }
+    str = Optstring_val (Field (credv, 3));
+    if (str) {
+      cred->defresult = strdup (str);
+      if (cred->defresult == NULL)
+        caml_raise_out_of_memory ();
+    }
+  }
+
+  ret = virConnectAuthPtrDefault->cb (creds, len,
+                                      virConnectAuthPtrDefault->cbdata);
+  if (ret >= 0) {
+    retv = Val_emptylist;
+    for (i = len - 1; i >= 0; --i) {
+      virConnectCredentialPtr cred = &creds[i];
+      elemv = caml_alloc (2, 0);
+      if (cred->result != NULL && cred->resultlen > 0) {
+        v = caml_alloc_string (cred->resultlen);
+        memcpy (String_val (v), cred->result, cred->resultlen);
+        optv = caml_alloc (1, 0);
+        Store_field (optv, 0, v);
+      } else
+        optv = Val_int (0);
+      Store_field (elemv, 0, optv);
+      Store_field (elemv, 1, retv);
+      retv = elemv;
+    }
+  }
+  for (i = 0; i < len; ++i) {
+    virConnectCredentialPtr cred = &creds[i];
+    /* Cast to char *, as the virConnectCredential structs we fill have
+     * const char * qualifiers.
+     */
+    free ((char *) cred->prompt);
+    free ((char *) cred->challenge);
+    free ((char *) cred->defresult);
+  }
+  free (creds);
+
+  if (ret < 0)
+    caml_failwith ("virConnectAuthPtrDefault callback failed");
+
+  CAMLreturn (retv);
+}
+
+CAMLprim value
 ocaml_libvirt_domain_get_id (value domv)
 {
   CAMLparam1 (domv);
-- 
1.8.3.1