#include <caml/memory.h>
#include <caml/misc.h>
#include <caml/mlvalues.h>
+#include <caml/signals.h>
static char *Optstring_val (value strv);
typedef value (*Val_ptr_t) (void *);
static value _raise_virterror (virConnectPtr conn, const char *fn);
static value Val_virterror (virErrorPtr err);
+/* Use this around synchronous libvirt API calls to release the OCaml
+ * lock, allowing other threads to run simultaneously. 'code' must not
+ * perform any caml_* calls, run any OCaml code, or raise any exception.
+ * http://web.archive.org/web/20030521020915/http://caml.inria.fr/archives/200106/msg00199.html
+ */
+#define NONBLOCKING(code) \
+ do { \
+ caml_enter_blocking_section (); \
+ code; \
+ caml_leave_blocking_section (); \
+ } while (0)
+
+/* Check error condition from a libvirt function, and automatically raise
+ * an exception if one is found.
+ */
#define CHECK_ERROR(cond, conn, fn) \
do { if (cond) _raise_virterror (conn, fn); } while (0)
int r;
typeVer_ptr = driver ? &typeVer : NULL;
- r = virGetVersion (&libVer, driver, typeVer_ptr);
+ NONBLOCKING (r = virGetVersion (&libVer, driver, typeVer_ptr));
CHECK_ERROR (r == -1, NULL, "virGetVersion");
rv = caml_alloc_tuple (2);
const char *name = Optstring_val (namev);
virConnectPtr conn;
- conn = virConnectOpen (name);
+ NONBLOCKING (conn = virConnectOpen (name));
CHECK_ERROR (!conn, NULL, "virConnectOpen");
rv = Val_connect (conn);
const char *name = Optstring_val (namev);
virConnectPtr conn;
- conn = virConnectOpenReadOnly (name);
+ NONBLOCKING (conn = virConnectOpenReadOnly (name));
CHECK_ERROR (!conn, NULL, "virConnectOpen");
rv = Val_connect (conn);
virConnectPtr conn = Connect_val (connv);
int r;
- r = virConnectClose (conn);
+ NONBLOCKING (r = virConnectClose (conn));
CHECK_ERROR (r == -1, conn, "virConnectClose");
/* So that we don't double-free in the finalizer: */
virConnectPtr conn = Connect_val (connv);
const char *r;
- r = virConnectGetType (conn);
+ NONBLOCKING (r = virConnectGetType (conn));
CHECK_ERROR (!r, conn, "virConnectGetType");
rv = caml_copy_string (r);
unsigned long hvVer;
int r;
- r = virConnectGetVersion (conn, &hvVer);
+ NONBLOCKING (r = virConnectGetVersion (conn, &hvVer));
CHECK_ERROR (r == -1, conn, "virConnectGetVersion");
CAMLreturn (Val_int (hvVer));
char *r;
WEAK_SYMBOL_CHECK (virConnectGetHostname);
- r = virConnectGetHostname (conn);
+ NONBLOCKING (r = virConnectGetHostname (conn));
CHECK_ERROR (!r, conn, "virConnectGetHostname");
rv = caml_copy_string (r);
char *r;
WEAK_SYMBOL_CHECK (virConnectGetURI);
- r = virConnectGetURI (conn);
+ NONBLOCKING (r = virConnectGetURI (conn));
CHECK_ERROR (!r, conn, "virConnectGetURI");
rv = caml_copy_string (r);
const char *type = Optstring_val (typev);
int r;
- r = virConnectGetMaxVcpus (conn, type);
+ NONBLOCKING (r = virConnectGetMaxVcpus (conn, type));
CHECK_ERROR (r == -1, conn, "virConnectGetMaxVcpus");
CAMLreturn (Val_int (r));
int i = Int_val (iv);
int ids[i], r;
- r = virConnectListDomains (conn, ids, i);
+ NONBLOCKING (r = virConnectListDomains (conn, ids, i));
CHECK_ERROR (r == -1, conn, "virConnectListDomains");
rv = caml_alloc (r, 0);
virConnectPtr conn = Connect_val (connv);
int r;
- r = virConnectNumOfDomains (conn);
+ NONBLOCKING (r = virConnectNumOfDomains (conn));
CHECK_ERROR (r == -1, conn, "virConnectNumOfDomains");
CAMLreturn (Val_int (r));
virConnectPtr conn = Connect_val (connv);
char *r;
- r = virConnectGetCapabilities (conn);
+ NONBLOCKING (r = virConnectGetCapabilities (conn));
CHECK_ERROR (!r, conn, "virConnectGetCapabilities");
rv = caml_copy_string (r);
virConnectPtr conn = Connect_val (connv);
int r;
- r = virConnectNumOfDefinedDomains (conn);
+ NONBLOCKING (r = virConnectNumOfDefinedDomains (conn));
CHECK_ERROR (r == -1, conn, "virConnectNumOfDefinedDomains");
CAMLreturn (Val_int (r));
char *names[i];
int r;
- r = virConnectListDefinedDomains (conn, names, i);
+ NONBLOCKING (r = virConnectListDefinedDomains (conn, names, i));
CHECK_ERROR (r == -1, conn, "virConnectListDefinedDomains");
rv = caml_alloc (r, 0);
virConnectPtr conn = Connect_val (connv);
int r;
- r = virConnectNumOfNetworks (conn);
+ NONBLOCKING (r = virConnectNumOfNetworks (conn));
CHECK_ERROR (r == -1, conn, "virConnectNumOfNetworks");
CAMLreturn (Val_int (r));
char *names[i];
int r;
- r = virConnectListNetworks (conn, names, i);
+ NONBLOCKING (r = virConnectListNetworks (conn, names, i));
CHECK_ERROR (r == -1, conn, "virConnectListNetworks");
rv = caml_alloc (r, 0);
virConnectPtr conn = Connect_val (connv);
int r;
- r = virConnectNumOfDefinedNetworks (conn);
+ NONBLOCKING (r = virConnectNumOfDefinedNetworks (conn));
CHECK_ERROR (r == -1, conn, "virConnectNumOfDefinedNetworks");
CAMLreturn (Val_int (r));
char *names[i];
int r;
- r = virConnectListDefinedNetworks (conn, names, i);
+ NONBLOCKING (r = virConnectListDefinedNetworks (conn, names, i));
CHECK_ERROR (r == -1, conn, "virConnectListDefinedNetworks");
rv = caml_alloc (r, 0);
virNodeInfo info;
int r;
- r = virNodeGetInfo (conn, &info);
+ NONBLOCKING (r = virNodeGetInfo (conn, &info));
CHECK_ERROR (r == -1, conn, "virNodeGetInfo");
rv = caml_alloc (8, 0);
unsigned long long r;
WEAK_SYMBOL_CHECK (virNodeGetFreeMemory);
- r = virNodeGetFreeMemory (conn);
+ NONBLOCKING (r = virNodeGetFreeMemory (conn));
CHECK_ERROR (r == 0, conn, "virNodeGetFreeMemory");
rv = caml_copy_int64 ((int64) r);
unsigned long long freemems[max];
WEAK_SYMBOL_CHECK (virNodeGetCellsFreeMemory);
- r = virNodeGetCellsFreeMemory (conn, freemems, start, max);
+ NONBLOCKING (r = virNodeGetCellsFreeMemory (conn, freemems, start, max));
CHECK_ERROR (r == -1, conn, "virNodeGetCellsFreeMemory");
rv = caml_alloc (r, 0);
char *xml = String_val (xmlv);
virDomainPtr r;
- r = virDomainCreateLinux (conn, xml, 0);
+ NONBLOCKING (r = virDomainCreateLinux (conn, xml, 0));
CHECK_ERROR (!r, conn, "virDomainCreateLinux");
rv = Val_domain (r, connv);
int i = Int_val (iv);
virDomainPtr r;
- r = virDomainLookupByID (conn, i);
+ NONBLOCKING (r = virDomainLookupByID (conn, i));
CHECK_ERROR (!r, conn, "virDomainLookupByID");
rv = Val_domain (r, connv);
char *uuid = String_val (uuidv);
virDomainPtr r;
- r = virDomainLookupByUUID (conn, (unsigned char *) uuid);
+ NONBLOCKING (r = virDomainLookupByUUID (conn, (unsigned char *) uuid));
CHECK_ERROR (!r, conn, "virDomainLookupByUUID");
rv = Val_domain (r, connv);
char *uuid = String_val (uuidv);
virDomainPtr r;
- r = virDomainLookupByUUIDString (conn, uuid);
+ NONBLOCKING (r = virDomainLookupByUUIDString (conn, uuid));
CHECK_ERROR (!r, conn, "virDomainLookupByUUIDString");
rv = Val_domain (r, connv);
char *name = String_val (namev);
virDomainPtr r;
- r = virDomainLookupByName (conn, name);
+ NONBLOCKING (r = virDomainLookupByName (conn, name));
CHECK_ERROR (!r, conn, "virDomainLookupByName");
rv = Val_domain (r, connv);
virConnectPtr conn = Connect_domv (domv);
int r;
- r = virDomainDestroy (dom);
+ NONBLOCKING (r = virDomainDestroy (dom));
CHECK_ERROR (r == -1, conn, "virDomainDestroy");
/* So that we don't double-free in the finalizer: */
virConnectPtr conn = Connect_domv (domv);
int r;
- r = virDomainFree (dom);
+ NONBLOCKING (r = virDomainFree (dom));
CHECK_ERROR (r == -1, conn, "virDomainFree");
/* So that we don't double-free in the finalizer: */
virConnectPtr conn = Connect_domv (domv);
int r;
- r = virDomainSuspend (dom);
+ NONBLOCKING (r = virDomainSuspend (dom));
CHECK_ERROR (r == -1, conn, "virDomainSuspend");
CAMLreturn (Val_unit);
virConnectPtr conn = Connect_domv (domv);
int r;
- r = virDomainResume (dom);
+ NONBLOCKING (r = virDomainResume (dom));
CHECK_ERROR (r == -1, conn, "virDomainResume");
CAMLreturn (Val_unit);
char *path = String_val (pathv);
int r;
- r = virDomainSave (dom, path);
+ NONBLOCKING (r = virDomainSave (dom, path));
CHECK_ERROR (r == -1, conn, "virDomainSave");
CAMLreturn (Val_unit);
char *path = String_val (pathv);
int r;
- r = virDomainRestore (conn, path);
+ NONBLOCKING (r = virDomainRestore (conn, path));
CHECK_ERROR (r == -1, conn, "virDomainRestore");
CAMLreturn (Val_unit);
char *path = String_val (pathv);
int r;
- r = virDomainCoreDump (dom, path, 0);
+ NONBLOCKING (r = virDomainCoreDump (dom, path, 0));
CHECK_ERROR (r == -1, conn, "virDomainCoreDump");
CAMLreturn (Val_unit);
virConnectPtr conn = Connect_domv (domv);
int r;
- r = virDomainShutdown (dom);
+ NONBLOCKING (r = virDomainShutdown (dom));
CHECK_ERROR (r == -1, conn, "virDomainShutdown");
CAMLreturn (Val_unit);
virConnectPtr conn = Connect_domv (domv);
int r;
- r = virDomainReboot (dom, 0);
+ NONBLOCKING (r = virDomainReboot (dom, 0));
CHECK_ERROR (r == -1, conn, "virDomainReboot");
CAMLreturn (Val_unit);
virConnectPtr conn = Connect_domv (domv);
const char *r;
- r = virDomainGetName (dom);
+ NONBLOCKING (r = virDomainGetName (dom));
CHECK_ERROR (!r, conn, "virDomainGetName");
rv = caml_copy_string (r);
unsigned char uuid[VIR_UUID_BUFLEN];
int r;
- r = virDomainGetUUID (dom, uuid);
+ NONBLOCKING (r = virDomainGetUUID (dom, uuid));
CHECK_ERROR (r == -1, conn, "virDomainGetUUID");
rv = caml_copy_string ((char *) uuid);
char uuid[VIR_UUID_STRING_BUFLEN];
int r;
- r = virDomainGetUUIDString (dom, uuid);
+ NONBLOCKING (r = virDomainGetUUIDString (dom, uuid));
CHECK_ERROR (r == -1, conn, "virDomainGetUUIDString");
rv = caml_copy_string (uuid);
virConnectPtr conn = Connect_domv (domv);
unsigned int r;
- r = virDomainGetID (dom);
+ 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.
virConnectPtr conn = Connect_domv (domv);
char *r;
- r = virDomainGetOSType (dom);
+ NONBLOCKING (r = virDomainGetOSType (dom));
CHECK_ERROR (!r, conn, "virDomainGetOSType");
rv = caml_copy_string (r);
virConnectPtr conn = Connect_domv (domv);
unsigned long r;
- r = virDomainGetMaxMemory (dom);
+ NONBLOCKING (r = virDomainGetMaxMemory (dom));
CHECK_ERROR (r == 0 /* [sic] */, conn, "virDomainGetMaxMemory");
rv = caml_copy_int64 (r);
unsigned long mem = Int64_val (memv);
int r;
- r = virDomainSetMaxMemory (dom, mem);
+ NONBLOCKING (r = virDomainSetMaxMemory (dom, mem));
CHECK_ERROR (r == -1, conn, "virDomainSetMaxMemory");
CAMLreturn (Val_unit);
unsigned long mem = Int64_val (memv);
int r;
- r = virDomainSetMemory (dom, mem);
+ NONBLOCKING (r = virDomainSetMemory (dom, mem));
CHECK_ERROR (r == -1, conn, "virDomainSetMemory");
CAMLreturn (Val_unit);
virDomainInfo info;
int r;
- r = virDomainGetInfo (dom, &info);
+ NONBLOCKING (r = virDomainGetInfo (dom, &info));
CHECK_ERROR (r == -1, conn, "virDomainGetInfo");
rv = caml_alloc (5, 0);
virConnectPtr conn = Connect_domv (domv);
char *r;
- r = virDomainGetXMLDesc (dom, 0);
+ NONBLOCKING (r = virDomainGetXMLDesc (dom, 0));
CHECK_ERROR (!r, conn, "virDomainGetXMLDesc");
rv = caml_copy_string (r);
int nparams;
WEAK_SYMBOL_CHECK (virDomainGetSchedulerType);
- r = virDomainGetSchedulerType (dom, &nparams);
+ NONBLOCKING (r = virDomainGetSchedulerType (dom, &nparams));
CHECK_ERROR (!r, conn, "virDomainGetSchedulerType");
rv = caml_alloc_tuple (2);
int r, i;
WEAK_SYMBOL_CHECK (virDomainGetSchedulerParameters);
- r = virDomainGetSchedulerParameters (dom, params, &nparams);
+ NONBLOCKING (r = virDomainGetSchedulerParameters (dom, params, &nparams));
CHECK_ERROR (r == -1, conn, "virDomainGetSchedulerParameters");
rv = caml_alloc (nparams, 0);
}
WEAK_SYMBOL_CHECK (virDomainSetSchedulerParameters);
- r = virDomainSetSchedulerParameters (dom, params, nparams);
+ NONBLOCKING (r = virDomainSetSchedulerParameters (dom, params, nparams));
CHECK_ERROR (r == -1, conn, "virDomainSetSchedulerParameters");
CAMLreturn (Val_unit);
char *xml = String_val (xmlv);
virDomainPtr r;
- r = virDomainDefineXML (conn, xml);
+ NONBLOCKING (r = virDomainDefineXML (conn, xml));
CHECK_ERROR (!r, conn, "virDomainDefineXML");
rv = Val_domain (r, connv);
virConnectPtr conn = Connect_domv (domv);
int r;
- r = virDomainUndefine (dom);
+ NONBLOCKING (r = virDomainUndefine (dom));
CHECK_ERROR (r == -1, conn, "virDomainUndefine");
CAMLreturn (Val_unit);
virConnectPtr conn = Connect_domv (domv);
int r;
- r = virDomainCreate (dom);
+ NONBLOCKING (r = virDomainCreate (dom));
CHECK_ERROR (r == -1, conn, "virDomainCreate");
CAMLreturn (Val_unit);
virConnectPtr conn = Connect_domv (domv);
int r, autostart;
- r = virDomainGetAutostart (dom, &autostart);
+ NONBLOCKING (r = virDomainGetAutostart (dom, &autostart));
CHECK_ERROR (r == -1, conn, "virDomainGetAutostart");
CAMLreturn (autostart ? Val_true : Val_false);
virConnectPtr conn = Connect_domv (domv);
int r, autostart = autostartv == Val_true ? 1 : 0;
- r = virDomainSetAutostart (dom, autostart);
+ NONBLOCKING (r = virDomainSetAutostart (dom, autostart));
CHECK_ERROR (r == -1, conn, "virDomainSetAutostart");
CAMLreturn (Val_unit);
virConnectPtr conn = Connect_domv (domv);
int r, nvcpus = Int_val (nvcpusv);
- r = virDomainSetVcpus (dom, nvcpus);
+ NONBLOCKING (r = virDomainSetVcpus (dom, nvcpus));
CHECK_ERROR (r == -1, conn, "virDomainSetVcpus");
CAMLreturn (Val_unit);
int vcpu = Int_val (vcpuv);
int r;
- r = virDomainPinVcpu (dom, vcpu, cpumap, maplen);
+ NONBLOCKING (r = virDomainPinVcpu (dom, vcpu, cpumap, maplen));
CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
CAMLreturn (Val_unit);
memset (info, 0, sizeof (virVcpuInfo) * maxinfo);
memset (cpumaps, 0, maxinfo * maplen);
- r = virDomainGetVcpus (dom, info, maxinfo, cpumaps, maplen);
+ NONBLOCKING (r = virDomainGetVcpus (dom, info, maxinfo, cpumaps, maplen));
CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
/* Copy the virVcpuInfo structures. */
virConnectPtr conn = Connect_domv (domv);
int r;
- r = virDomainGetMaxVcpus (dom);
+ NONBLOCKING (r = virDomainGetMaxVcpus (dom));
CHECK_ERROR (r == -1, conn, "virDomainGetMaxVcpus");
CAMLreturn (Val_int (r));
char *xml = String_val (xmlv);
int r;
- r = virDomainAttachDevice (dom, xml);
+ NONBLOCKING (r = virDomainAttachDevice (dom, xml));
CHECK_ERROR (r == -1, conn, "virDomainAttachDevice");
CAMLreturn (Val_unit);
char *xml = String_val (xmlv);
int r;
- r = virDomainDetachDevice (dom, xml);
+ NONBLOCKING (r = virDomainDetachDevice (dom, xml));
CHECK_ERROR (r == -1, conn, "virDomainDetachDevice");
CAMLreturn (Val_unit);
bandwidth = Int_val (Field (optbandwidthv, 0));
WEAK_SYMBOL_CHECK (virDomainMigrate);
- r = virDomainMigrate (dom, dconn, flags, dname, uri, bandwidth);
+ NONBLOCKING (r = virDomainMigrate (dom, dconn, flags, dname, uri, bandwidth));
CHECK_ERROR (!r, conn, "virDomainMigrate");
rv = Val_domain (r, dconnv);
int r;
WEAK_SYMBOL_CHECK (virDomainBlockStats);
- r = virDomainBlockStats (dom, path, &stats, sizeof stats);
+ NONBLOCKING (r = virDomainBlockStats (dom, path, &stats, sizeof stats));
CHECK_ERROR (r == -1, conn, "virDomainBlockStats");
rv = caml_alloc (5, 0);
int r;
WEAK_SYMBOL_CHECK (virDomainInterfaceStats);
- r = virDomainInterfaceStats (dom, path, &stats, sizeof stats);
+ NONBLOCKING (r = virDomainInterfaceStats (dom, path, &stats, sizeof stats));
CHECK_ERROR (r == -1, conn, "virDomainInterfaceStats");
rv = caml_alloc (8, 0);
char *name = String_val (namev);
virNetworkPtr r;
- r = virNetworkLookupByName (conn, name);
+ NONBLOCKING (r = virNetworkLookupByName (conn, name));
CHECK_ERROR (!r, conn, "virNetworkLookupByName");
rv = Val_network (r, connv);
char *uuid = String_val (uuidv);
virNetworkPtr r;
- r = virNetworkLookupByUUID (conn, (unsigned char *) uuid);
+ NONBLOCKING (r = virNetworkLookupByUUID (conn, (unsigned char *) uuid));
CHECK_ERROR (!r, conn, "virNetworkLookupByUUID");
rv = Val_network (r, connv);
char *uuid = String_val (uuidv);
virNetworkPtr r;
- r = virNetworkLookupByUUIDString (conn, uuid);
+ NONBLOCKING (r = virNetworkLookupByUUIDString (conn, uuid));
CHECK_ERROR (!r, conn, "virNetworkLookupByUUIDString");
rv = Val_network (r, connv);
char *xml = String_val (xmlv);
virNetworkPtr r;
- r = virNetworkCreateXML (conn, xml);
+ NONBLOCKING (r = virNetworkCreateXML (conn, xml));
CHECK_ERROR (!r, conn, "virNetworkCreateXML");
rv = Val_network (r, connv);
char *xml = String_val (xmlv);
virNetworkPtr r;
- r = virNetworkDefineXML (conn, xml);
+ NONBLOCKING (r = virNetworkDefineXML (conn, xml));
CHECK_ERROR (!r, conn, "virNetworkDefineXML");
rv = Val_network (r, connv);
virConnectPtr conn = Connect_netv (netv);
int r;
- r = virNetworkUndefine (net);
+ NONBLOCKING (r = virNetworkUndefine (net));
CHECK_ERROR (r == -1, conn, "virNetworkUndefine");
CAMLreturn (Val_unit);
virConnectPtr conn = Connect_netv (netv);
int r;
- r = virNetworkCreate (net);
+ NONBLOCKING (r = virNetworkCreate (net));
CHECK_ERROR (r == -1, conn, "virNetworkCreate");
CAMLreturn (Val_unit);
virConnectPtr conn = Connect_netv (netv);
int r;
- r = virNetworkDestroy (net);
+ NONBLOCKING (r = virNetworkDestroy (net));
CHECK_ERROR (r == -1, conn, "virNetworkDestroy");
/* So that we don't double-free in the finalizer: */
virConnectPtr conn = Connect_netv (netv);
int r;
- r = virNetworkFree (net);
+ NONBLOCKING (r = virNetworkFree (net));
CHECK_ERROR (r == -1, conn, "virNetworkFree");
/* So that we don't double-free in the finalizer: */
virConnectPtr conn = Connect_netv (netv);
const char *r;
- r = virNetworkGetName (net);
+ NONBLOCKING (r = virNetworkGetName (net));
CHECK_ERROR (!r, conn, "virNetworkGetName");
rv = caml_copy_string (r);
unsigned char uuid[VIR_UUID_BUFLEN];
int r;
- r = virNetworkGetUUID (net, uuid);
+ NONBLOCKING (r = virNetworkGetUUID (net, uuid));
CHECK_ERROR (r == -1, conn, "virNetworkGetUUID");
rv = caml_copy_string ((char *) uuid);
char uuid[VIR_UUID_STRING_BUFLEN];
int r;
- r = virNetworkGetUUIDString (net, uuid);
+ NONBLOCKING (r = virNetworkGetUUIDString (net, uuid));
CHECK_ERROR (r == -1, conn, "virNetworkGetUUIDString");
rv = caml_copy_string (uuid);
virConnectPtr conn = Connect_netv (netv);
char *r;
- r = virNetworkGetXMLDesc (net, 0);
+ NONBLOCKING (r = virNetworkGetXMLDesc (net, 0));
CHECK_ERROR (!r, conn, "virNetworkGetXMLDesc");
rv = caml_copy_string (r);
virConnectPtr conn = Connect_netv (netv);
char *r;
- r = virNetworkGetBridgeName (net);
+ NONBLOCKING (r = virNetworkGetBridgeName (net));
CHECK_ERROR (!r, conn, "virNetworkGetBridgeName");
rv = caml_copy_string (r);
virConnectPtr conn = Connect_netv (netv);
int r, autostart;
- r = virNetworkGetAutostart (net, &autostart);
+ NONBLOCKING (r = virNetworkGetAutostart (net, &autostart));
CHECK_ERROR (r == -1, conn, "virNetworkGetAutostart");
CAMLreturn (autostart ? Val_true : Val_false);
virConnectPtr conn = Connect_netv (netv);
int r, autostart = autostartv == Val_true ? 1 : 0;
- r = virNetworkSetAutostart (net, autostart);
+ NONBLOCKING (r = virNetworkSetAutostart (net, autostart));
CHECK_ERROR (r == -1, conn, "virNetworkSetAutostart");
CAMLreturn (Val_unit);