X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;ds=sidebyside;f=libvirt%2Flibvirt_c_oneoffs.c;h=eb71d24734ad09595230ce549dbc3a9d8cc9f0e0;hb=e0f5ba5419dd6c8390ba979c5160a10c3644e130;hp=17412f5596fec9d2206b26aa6c59e30832f51eb6;hpb=380f1e05b244ae4750ca5101b5b5a182dcd0d1fd;p=ocaml-libvirt.git

diff --git a/libvirt/libvirt_c_oneoffs.c b/libvirt/libvirt_c_oneoffs.c
index 17412f5..eb71d24 100644
--- a/libvirt/libvirt_c_oneoffs.c
+++ b/libvirt/libvirt_c_oneoffs.c
@@ -19,6 +19,10 @@
 
 /* Please read libvirt/README file. */
 
+#ifdef __GNUC__
+#pragma GCC diagnostic ignored "-Wmissing-prototypes"
+#endif
+
 /*----------------------------------------------------------------------*/
 
 CAMLprim value
@@ -76,6 +80,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)
 {
@@ -154,16 +288,21 @@ ocaml_libvirt_connect_node_get_cells_free_memory (value connv,
   int start = Int_val (startv);
   int max = Int_val (maxv);
   int r, i;
-  unsigned long long freemems[max];
+  unsigned long long *freemems;
+
+  freemems = malloc(sizeof (*freemems) * max);
+  if (freemems == NULL)
+    caml_raise_out_of_memory ();
 
   NONBLOCKING (r = virNodeGetCellsFreeMemory (conn, freemems, start, max));
-  CHECK_ERROR (r == -1, "virNodeGetCellsFreeMemory");
+  CHECK_ERROR_CLEANUP (r == -1, free (freemems), "virNodeGetCellsFreeMemory");
 
   rv = caml_alloc (r, 0);
   for (i = 0; i < r; ++i) {
     iv = caml_copy_int64 ((int64_t) freemems[i]);
     Store_field (rv, i, iv);
   }
+  free (freemems);
 
   CAMLreturn (rv);
 }
@@ -185,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);
@@ -291,11 +526,15 @@ ocaml_libvirt_domain_get_scheduler_parameters (value domv, value nparamsv)
   CAMLlocal4 (rv, v, v2, v3);
   virDomainPtr dom = Domain_val (domv);
   int nparams = Int_val (nparamsv);
-  virSchedParameter params[nparams];
+  virSchedParameterPtr params;
   int r, i;
 
+  params = malloc (sizeof (*params) * nparams);
+  if (params == NULL)
+    caml_raise_out_of_memory ();
+
   NONBLOCKING (r = virDomainGetSchedulerParameters (dom, params, &nparams));
-  CHECK_ERROR (r == -1, "virDomainGetSchedulerParameters");
+  CHECK_ERROR_CLEANUP (r == -1, free (params), "virDomainGetSchedulerParameters");
 
   rv = caml_alloc (nparams, 0);
   for (i = 0; i < nparams; ++i) {
@@ -331,6 +570,7 @@ ocaml_libvirt_domain_get_scheduler_parameters (value domv, value nparamsv)
     }
     Store_field (v, 1, v2);
   }
+  free (params);
   CAMLreturn (rv);
 }
 
@@ -341,10 +581,14 @@ ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv)
   CAMLlocal1 (v);
   virDomainPtr dom = Domain_val (domv);
   int nparams = Wosize_val (paramsv);
-  virSchedParameter params[nparams];
+  virSchedParameterPtr params;
   int r, i;
   char *name;
 
+  params = malloc (sizeof (*params) * nparams);
+  if (params == NULL)
+    caml_raise_out_of_memory ();
+
   for (i = 0; i < nparams; ++i) {
     v = Field (paramsv, i);	/* Points to the two-element tuple. */
     name = String_val (Field (v, 0));
@@ -382,6 +626,7 @@ ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv)
   }
 
   NONBLOCKING (r = virDomainSetSchedulerParameters (dom, params, nparams));
+  free (params);
   CHECK_ERROR (r == -1, "virDomainSetSchedulerParameters");
 
   CAMLreturn (Val_unit);
@@ -424,15 +669,21 @@ ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv)
   virDomainPtr dom = Domain_val (domv);
   int maxinfo = Int_val (maxinfov);
   int maplen = Int_val (maplenv);
-  virVcpuInfo info[maxinfo];
-  unsigned char cpumaps[maxinfo * maplen];
+  virVcpuInfoPtr info;
+  unsigned char *cpumaps;
   int r, i;
 
-  memset (info, 0, sizeof (virVcpuInfo) * maxinfo);
-  memset (cpumaps, 0, maxinfo * maplen);
+  info = calloc (maxinfo, sizeof (*info));
+  if (info == NULL)
+    caml_raise_out_of_memory ();
+  cpumaps = calloc (maxinfo * maplen, sizeof (*cpumaps));
+  if (cpumaps == NULL) {
+    free (info);
+    caml_raise_out_of_memory ();
+  }
 
   NONBLOCKING (r = virDomainGetVcpus (dom, info, maxinfo, cpumaps, maplen));
-  CHECK_ERROR (r == -1, "virDomainPinVcpu");
+  CHECK_ERROR_CLEANUP (r == -1, free (info); free (cpumaps), "virDomainPinVcpu");
 
   /* Copy the virVcpuInfo structures. */
   infov = caml_alloc (maxinfo, 0);
@@ -454,6 +705,9 @@ ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv)
   Store_field (rv, 1, infov);
   Store_field (rv, 2, strv);
 
+  free (info);
+  free (cpumaps);
+
   CAMLreturn (rv);
 }
 
@@ -570,6 +824,7 @@ ocaml_libvirt_domain_get_all_domain_stats (value connv,
   virDomainStatsRecordPtr *rstats;
   unsigned int stats = 0, flags = 0;
   int i, j, r;
+  unsigned char uuid[VIR_UUID_BUFLEN];
 
   /* Get stats and flags. */
   for (; statsv != Val_int (0); statsv = Field (statsv, 1)) {
@@ -619,8 +874,16 @@ ocaml_libvirt_domain_get_all_domain_stats (value connv,
   rv = caml_alloc (r, 0);       /* domain_stats_record array. */
   for (i = 0; i < r; ++i) {
     dsv = caml_alloc (2, 0);    /* domain_stats_record */
-    virDomainRef (rstats[i]->dom);
-    Store_field (dsv, 0, Val_domain (rstats[i]->dom, connv));
+
+    /* Libvirt returns something superficially resembling a
+     * virDomainPtr, but it's not a real virDomainPtr object
+     * (eg. dom->id == -1, and its refcount is wrong).  The only thing
+     * we can safely get from it is the UUID.
+     */
+    v = caml_alloc_string (VIR_UUID_BUFLEN);
+    virDomainGetUUID (rstats[i]->dom, uuid);
+    memcpy (String_val (v), uuid, VIR_UUID_BUFLEN);
+    Store_field (dsv, 0, v);
 
     tpv = caml_alloc (rstats[i]->nparams, 0); /* typed_param array */
     for (j = 0; j < rstats[i]->nparams; ++j) {
@@ -838,6 +1101,37 @@ ocaml_libvirt_domain_memory_peek_bytecode (value *argv, int argn)
                                                   argv[3], argv[4], argv[5]);
 }
 
+CAMLprim value
+ocaml_libvirt_domain_get_xml_desc_flags (value domv, value flagsv)
+{
+  CAMLparam2 (domv, flagsv);
+  CAMLlocal2 (rv, flagv);
+  virDomainPtr dom = Domain_val (domv);
+  int flags = 0;
+  char *r;
+
+  /* Do flags. */
+  for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
+    {
+      flagv = Field (flagsv, 0);
+      if (flagv == Val_int (0))
+        flags |= VIR_DOMAIN_XML_SECURE;
+      else if (flagv == Val_int (1))
+        flags |= VIR_DOMAIN_XML_INACTIVE;
+      else if (flagv == Val_int (2))
+        flags |= VIR_DOMAIN_XML_UPDATE_CPU;
+      else if (flagv == Val_int (3))
+        flags |= VIR_DOMAIN_XML_MIGRATABLE;
+    }
+
+  NONBLOCKING (r = virDomainGetXMLDesc (dom, flags));
+  CHECK_ERROR (!r, "virDomainGetXMLDesc");
+
+  rv = caml_copy_string (r);
+  free (r);
+  CAMLreturn (rv);
+}
+
 /*----------------------------------------------------------------------*/
 
 /* Domain events */
@@ -1288,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