X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;ds=sidebyside;f=libvirt%2Flibvirt_c_oneoffs.c;h=70cf96f337d6b502b01565084b1e0021b8478d3c;hb=c6c9c3fff5993056e0af7219f4fe67ab8db3cdf2;hp=5df783e0d076cdaf631bec540c54e23394d88c3b;hpb=9b1c8e53eaa6fb79ee801e3014793618b977857d;p=ocaml-libvirt.git

diff --git a/libvirt/libvirt_c_oneoffs.c b/libvirt/libvirt_c_oneoffs.c
index 5df783e..70cf96f 100644
--- a/libvirt/libvirt_c_oneoffs.c
+++ b/libvirt/libvirt_c_oneoffs.c
@@ -199,15 +199,14 @@ ocaml_libvirt_domain_get_id (value domv)
 {
   CAMLparam1 (domv);
   virDomainPtr dom = Domain_val (domv);
-  virConnectPtr conn = Connect_domv (domv);
+  /*virConnectPtr conn = Connect_domv (domv);*/
   unsigned int r;
 
   NONBLOCKING (r = virDomainGetID (dom));
-  /* There's a bug in libvirt which means that if you try to get
-   * the ID of a defined-but-not-running domain, it returns -1,
-   * and there's no way to distinguish that from an error.
+  /* In theory this could return -1 on error, but in practice
+   * libvirt never does this unless you call it with a corrupted
+   * or NULL dom object.  So ignore errors here.
    */
-  CHECK_ERROR (r == (unsigned int) -1, conn, "virDomainGetID");
 
   CAMLreturn (Val_int ((int) r));
 }
@@ -521,6 +520,125 @@ ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv)
 }
 
 #ifdef HAVE_WEAK_SYMBOLS
+#ifdef HAVE_VIRDOMAINGETCPUSTATS
+extern int virDomainGetCPUStats (virDomainPtr domain,
+                         virTypedParameterPtr params,
+                         unsigned int nparams,
+                         int start_cpu,
+                         unsigned int ncpus,
+                         unsigned int flags)
+  __attribute__((weak));
+#endif
+#endif
+
+CAMLprim value
+ocaml_libvirt_domain_get_cpu_stats (value domv)
+{
+#ifdef HAVE_VIRDOMAINGETCPUSTATS
+  CAMLparam1 (domv);
+  CAMLlocal5 (cpustats, param_head, param_node, typed_param, typed_param_value);
+  CAMLlocal1 (v);
+  virDomainPtr dom = Domain_val (domv);
+  virConnectPtr conn = Connect_domv (domv);
+  virTypedParameterPtr params;
+  int r, cpu, ncpus, nparams, i, j, pos;
+  int nr_pcpus;
+
+  /* get number of pcpus */
+  NONBLOCKING (nr_pcpus = virDomainGetCPUStats(dom, NULL, 0, 0, 0, 0));
+  CHECK_ERROR (nr_pcpus < 0, conn, "virDomainGetCPUStats");
+
+  /* get percpu information */
+  NONBLOCKING (nparams = virDomainGetCPUStats(dom, NULL, 0, 0, 1, 0));
+  CHECK_ERROR (nparams < 0, conn, "virDomainGetCPUStats");
+
+  if ((params = malloc(sizeof(*params) * nparams * 128)) == NULL)
+    caml_failwith ("virDomainGetCPUStats: malloc");
+
+  cpustats = caml_alloc (nr_pcpus, 0); /* cpustats: array of params(list of typed_param) */
+  cpu = 0;
+  while (cpu < nr_pcpus) {
+    ncpus = nr_pcpus - cpu > 128 ? 128 : nr_pcpus - cpu;
+
+    NONBLOCKING (r = virDomainGetCPUStats(dom, params, nparams, cpu, ncpus, 0));
+    CHECK_ERROR (r < 0, conn, "virDomainGetCPUStats");
+
+    for (i = 0; i < ncpus; i++) {
+      /* list of typed_param: single linked list of param_nodes */
+      param_head = Val_emptylist; /* param_head: the head param_node of list of typed_param */
+
+      if (params[i * nparams].type == 0) {
+        Store_field(cpustats, cpu + i, param_head);
+        continue;
+      }
+
+      for (j = r - 1; j >= 0; j--) {
+        pos = i * nparams + j;
+          if (params[pos].type == 0)
+            continue;
+
+        param_node = caml_alloc(2, 0); /* param_node: typed_param, next param_node */
+        Store_field(param_node, 1, param_head);
+        param_head = param_node;
+
+        typed_param = caml_alloc(2, 0); /* typed_param: field name(string), typed_param_value */
+        Store_field(param_node, 0, typed_param);
+        Store_field(typed_param, 0, caml_copy_string(params[pos].field));
+
+        /* typed_param_value: value with the corresponding type tag */
+        switch(params[pos].type) {
+        case VIR_TYPED_PARAM_INT:
+          typed_param_value = caml_alloc (1, 0);
+          v = caml_copy_int32 (params[pos].value.i);
+          break;
+        case VIR_TYPED_PARAM_UINT:
+          typed_param_value = caml_alloc (1, 1);
+          v = caml_copy_int32 (params[pos].value.ui);
+          break;
+        case VIR_TYPED_PARAM_LLONG:
+          typed_param_value = caml_alloc (1, 2);
+          v = caml_copy_int64 (params[pos].value.l);
+          break;
+        case VIR_TYPED_PARAM_ULLONG:
+          typed_param_value = caml_alloc (1, 3);
+          v = caml_copy_int64 (params[pos].value.ul);
+          break;
+        case VIR_TYPED_PARAM_DOUBLE:
+          typed_param_value = caml_alloc (1, 4);
+          v = caml_copy_double (params[pos].value.d);
+          break;
+        case VIR_TYPED_PARAM_BOOLEAN:
+          typed_param_value = caml_alloc (1, 5);
+          v = Val_bool (params[pos].value.b);
+          break;
+        case VIR_TYPED_PARAM_STRING:
+          typed_param_value = caml_alloc (1, 6);
+          v = caml_copy_string (params[pos].value.s);
+          free (params[pos].value.s);
+          break;
+        default:
+            /* XXX Memory leak on this path, if there are more
+             * VIR_TYPED_PARAM_STRING past this point in the array.
+             */
+          free (params);
+          caml_failwith ("virDomainGetCPUStats: "
+                         "unknown parameter type returned");
+        }
+        Store_field (typed_param_value, 0, v);
+        Store_field (typed_param, 1, typed_param_value);
+      }
+      Store_field (cpustats, cpu + i, param_head);
+    }
+    cpu += ncpus;
+  }
+  free(params);
+  CAMLreturn (cpustats);
+#else
+  not_supported ("virDomainGetCPUStats");
+#endif
+}
+
+#ifdef HAVE_WEAK_SYMBOLS
 #ifdef HAVE_VIRDOMAINMIGRATE
 extern virDomainPtr virDomainMigrate (virDomainPtr domain, virConnectPtr dconn,
 				      unsigned long flags, const char *dname,
@@ -549,7 +667,7 @@ ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, val
   for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
     {
       flagv = Field (flagsv, 0);
-      if (flagv == Int_val(0))
+      if (flagv == Val_int (0))
 	flags |= VIR_MIGRATE_LIVE;
     }
 
@@ -661,6 +779,114 @@ ocaml_libvirt_domain_interface_stats (value domv, value pathv)
 }
 
 #ifdef HAVE_WEAK_SYMBOLS
+#ifdef HAVE_VIRDOMAINBLOCKPEEK
+extern int virDomainBlockPeek (virDomainPtr domain,
+                               const char *path,
+                               unsigned long long offset,
+                               size_t size,
+                               void *buffer,
+                               unsigned int flags)
+  __attribute__((weak));
+#endif
+#endif
+
+CAMLprim value
+ocaml_libvirt_domain_block_peek_native (value domv, value pathv, value offsetv, value sizev, value bufferv, value boffv)
+{
+#ifdef HAVE_VIRDOMAINBLOCKPEEK
+  CAMLparam5 (domv, pathv, offsetv, sizev, bufferv);
+  CAMLxparam1 (boffv);
+  virDomainPtr dom = Domain_val (domv);
+  virConnectPtr conn = Connect_domv (domv);
+  const char *path = String_val (pathv);
+  unsigned long long offset = Int64_val (offsetv);
+  size_t size = Int_val (sizev);
+  char *buffer = String_val (bufferv);
+  int boff = Int_val (boffv);
+  int r;
+
+  /* Check that the return buffer is big enough. */
+  if (caml_string_length (bufferv) < boff + size)
+    caml_failwith ("virDomainBlockPeek: return buffer too short");
+
+  WEAK_SYMBOL_CHECK (virDomainBlockPeek);
+  /* NB. not NONBLOCKING because buffer might move (XXX) */
+  r = virDomainBlockPeek (dom, path, offset, size, buffer+boff, 0);
+  CHECK_ERROR (r == -1, conn, "virDomainBlockPeek");
+
+  CAMLreturn (Val_unit);
+
+#else /* virDomainBlockPeek not supported */
+  not_supported ("virDomainBlockPeek");
+#endif
+}
+
+CAMLprim value
+ocaml_libvirt_domain_block_peek_bytecode (value *argv, int argn)
+{
+  return ocaml_libvirt_domain_block_peek_native (argv[0], argv[1], argv[2],
+                                                 argv[3], argv[4], argv[5]);
+}
+
+#ifdef HAVE_WEAK_SYMBOLS
+#ifdef HAVE_VIRDOMAINMEMORYPEEK
+extern int virDomainMemoryPeek (virDomainPtr domain,
+                                unsigned long long start,
+                                size_t size,
+                                void *buffer,
+                                unsigned int flags)
+  __attribute__((weak));
+#endif
+#endif
+
+CAMLprim value
+ocaml_libvirt_domain_memory_peek_native (value domv, value flagsv, value offsetv, value sizev, value bufferv, value boffv)
+{
+#ifdef HAVE_VIRDOMAINMEMORYPEEK
+  CAMLparam5 (domv, flagsv, offsetv, sizev, bufferv);
+  CAMLxparam1 (boffv);
+  CAMLlocal1 (flagv);
+  virDomainPtr dom = Domain_val (domv);
+  virConnectPtr conn = Connect_domv (domv);
+  int flags = 0;
+  unsigned long long offset = Int64_val (offsetv);
+  size_t size = Int_val (sizev);
+  char *buffer = String_val (bufferv);
+  int boff = Int_val (boffv);
+  int r;
+
+  /* Check that the return buffer is big enough. */
+  if (caml_string_length (bufferv) < boff + size)
+    caml_failwith ("virDomainMemoryPeek: return buffer too short");
+
+  /* Do flags. */
+  for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
+    {
+      flagv = Field (flagsv, 0);
+      if (flagv == Val_int (0))
+        flags |= VIR_MEMORY_VIRTUAL;
+    }
+
+  WEAK_SYMBOL_CHECK (virDomainMemoryPeek);
+  /* NB. not NONBLOCKING because buffer might move (XXX) */
+  r = virDomainMemoryPeek (dom, offset, size, buffer+boff, flags);
+  CHECK_ERROR (r == -1, conn, "virDomainMemoryPeek");
+
+  CAMLreturn (Val_unit);
+
+#else /* virDomainMemoryPeek not supported */
+  not_supported ("virDomainMemoryPeek");
+#endif
+}
+
+CAMLprim value
+ocaml_libvirt_domain_memory_peek_bytecode (value *argv, int argn)
+{
+  return ocaml_libvirt_domain_memory_peek_native (argv[0], argv[1], argv[2],
+                                                  argv[3], argv[4], argv[5]);
+}
+
+#ifdef HAVE_WEAK_SYMBOLS
 #ifdef HAVE_VIRSTORAGEPOOLGETINFO
 extern int virStoragePoolGetInfo(virStoragePoolPtr pool, virStoragePoolInfoPtr info)
   __attribute__((weak));
@@ -727,41 +953,6 @@ ocaml_libvirt_storage_vol_get_info (value volv)
 #endif
 }
 
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRJOBGETINFO
-extern int virJobGetInfo(virJobPtr job, virJobInfoPtr info)
-  __attribute__((weak));
-#endif
-#endif
-
-CAMLprim value
-ocaml_libvirt_job_get_info (value jobv)
-{
-#if HAVE_VIRJOBGETINFO
-  CAMLparam1 (jobv);
-  CAMLlocal1 (rv);
-  virJobPtr job = Job_val (jobv);
-  virConnectPtr conn = Connect_jobv (jobv);
-  virJobInfo info;
-  int r;
-
-  WEAK_SYMBOL_CHECK (virJobGetInfo);
-  NONBLOCKING (r = virJobGetInfo (job, &info));
-  CHECK_ERROR (r == -1, conn, "virJobGetInfo");
-
-  rv = caml_alloc (5, 0);
-  Store_field (rv, 0, Val_int (info.type));
-  Store_field (rv, 1, Val_int (info.state));
-  Store_field (rv, 2, Val_int (info.runningTime));
-  Store_field (rv, 3, Val_int (info.remainingTime));
-  Store_field (rv, 4, Val_int (info.percentComplete));
-
-  CAMLreturn (rv);
-#else
-  not_supported ("virJobGetInfo");
-#endif
-}
-
 /*----------------------------------------------------------------------*/
 
 CAMLprim value