Switch all the links to https
[ocaml-libvirt.git] / libvirt / libvirt_c_oneoffs.c
index 69d1b40..71ca78e 100644 (file)
@@ -1,6 +1,6 @@
 /* OCaml bindings for libvirt.
  * (C) Copyright 2007-2017 Richard W.M. Jones, Red Hat Inc.
- * http://libvirt.org/
+ * https://libvirt.org/
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
 
 /* Please read libvirt/README file. */
 
+#ifdef __GNUC__
+#pragma GCC diagnostic ignored "-Wmissing-prototypes"
+#endif
+
 /*----------------------------------------------------------------------*/
 
 CAMLprim value
@@ -320,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);
@@ -1482,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