#endif
}
+#ifdef HAVE_WEAK_SYMBOLS
+#ifdef HAVE_VIRCONNECTLISTALLDOMAINS
+extern int virConnectListAllDomains (virConnectPtr conn,
+ virDomainPtr **domains,
+ virDomainInfo **infos,
+ unsigned long stateflags,
+ unsigned long flags)
+ __attribute__((weak));
+#endif
+#endif
+
+CAMLprim value
+ocaml_libvirt_connect_list_all_domains (value connv,
+ value wantinfov,
+ value flagsv)
+{
+#ifdef HAVE_VIRCONNECTLISTALLDOMAINS
+ CAMLparam3 (connv, wantinfov, flagsv);
+ CAMLlocal4 (flagv, rv, rv1, rv2);
+ CAMLlocal2 (v1, v2);
+ virConnectPtr conn = Connect_val (connv);
+ virDomainPtr *domains;
+ virDomainInfo *infos;
+ int want_info, i, r, flag;
+ unsigned long flags = 0;
+
+ /* ?want_info */
+ if (wantinfov == Val_int (0)) /* None == true */
+ want_info = 1;
+ else
+ want_info = Bool_val (Field (wantinfov, 0));
+
+ /* Iterate over the list of flags. */
+ for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1)) {
+ flagv = Field (flagsv, 0);
+ flag = Int_val (flagv);
+ switch (flag) {
+ case 0: flags |= VIR_DOMAIN_LIST_ACTIVE; break;
+ case 1: flags |= VIR_DOMAIN_LIST_INACTIVE; break;
+ case 2: flags |= VIR_DOMAIN_LIST_ALL; break;
+ }
+ }
+
+ WEAK_SYMBOL_CHECK (virConnectListAllDomains);
+ NONBLOCKING (r = virConnectListAllDomains (conn, &domains,
+ want_info ? &infos : NULL,
+ flags, 0));
+ CHECK_ERROR (r == -1, conn, "virConnectListAllDomains");
+
+ /* Convert the result into a pair of arrays. */
+ rv1 = caml_alloc (r, 0);
+ for (i = 0; i < r; ++i) {
+ v1 = Val_domain (domains[i], connv);
+ Store_field (rv1, i, v1);
+ }
+ free (domains);
+
+ if (want_info) {
+ rv2 = caml_alloc (r, 0);
+
+ for (i = 0; i < r; ++i) {
+ v1 = caml_alloc (5, 0);
+ Store_field (v1, 0, Val_int (infos[i].state));
+ v2 = caml_copy_int64 (infos[i].maxMem); Store_field (v1, 1, v2);
+ v2 = caml_copy_int64 (infos[i].memory); Store_field (v1, 2, v2);
+ Store_field (v1, 3, Val_int (infos[i].nrVirtCpu));
+ v2 = caml_copy_int64 (infos[i].cpuTime); Store_field (v1, 4, v2);
+
+ Store_field (rv2, i, v1);
+ }
+
+ free (infos);
+ }
+ else
+ rv2 = caml_alloc (0, 0); /* zero-length array */
+
+ rv = caml_alloc_tuple (2);
+ Store_field (rv, 0, rv1);
+ Store_field (rv, 1, rv2);
+ CAMLreturn (rv);
+#else
+ not_supported ("virConnectListAllDomains");
+#endif
+}
+
CAMLprim value
ocaml_libvirt_domain_get_id (value domv)
{
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;
}
}
#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));
git.annexia.org / ocaml-libvirt.git / blobdiff