1 /* OCaml bindings for libvirt.
2 * (C) Copyright 2007-2017 Richard W.M. Jones, Red Hat Inc.
5 * This library is free software; you can redistribute it and/or
6 * modify it under the terms of the GNU Lesser General Public
7 * License as published by the Free Software Foundation; either
8 * version 2 of the License, or (at your option) any later version.
10 * This library is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 * Lesser General Public License for more details.
15 * You should have received a copy of the GNU Lesser General Public
16 * License along with this library; if not, write to the Free Software
17 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
20 /* Please read libvirt/README file. */
23 #pragma GCC diagnostic ignored "-Wmissing-prototypes"
26 /*----------------------------------------------------------------------*/
29 ocaml_libvirt_get_version (value driverv, value unit)
31 CAMLparam2 (driverv, unit);
33 const char *driver = Optstring_val (driverv);
34 unsigned long libVer, typeVer = 0, *typeVer_ptr;
37 typeVer_ptr = driver ? &typeVer : NULL;
38 NONBLOCKING (r = virGetVersion (&libVer, driver, typeVer_ptr));
39 CHECK_ERROR (r == -1, "virGetVersion");
41 rv = caml_alloc_tuple (2);
42 Store_field (rv, 0, Val_int (libVer));
43 Store_field (rv, 1, Val_int (typeVer));
47 /*----------------------------------------------------------------------*/
49 /* Connection object. */
52 ocaml_libvirt_connect_open (value namev, value unit)
54 CAMLparam2 (namev, unit);
56 const char *name = Optstring_val (namev);
59 NONBLOCKING (conn = virConnectOpen (name));
60 CHECK_ERROR (!conn, "virConnectOpen");
62 rv = Val_connect (conn);
68 ocaml_libvirt_connect_open_readonly (value namev, value unit)
70 CAMLparam2 (namev, unit);
72 const char *name = Optstring_val (namev);
75 NONBLOCKING (conn = virConnectOpenReadOnly (name));
76 CHECK_ERROR (!conn, "virConnectOpen");
78 rv = Val_connect (conn);
83 /* Helper struct holding data needed for the helper C authentication
84 * callback (which will call the actual OCaml callback).
86 struct ocaml_auth_callback_data {
87 value *fvp; /* The OCaml auth callback. */
91 _ocaml_auth_callback (virConnectCredentialPtr cred, unsigned int ncred, void *cbdata)
94 CAMLlocal4 (listv, elemv, rv, v);
95 struct ocaml_auth_callback_data *s = cbdata;
98 listv = Val_emptylist;
99 for (i = ncred - 1; i >= 0; --i) {
100 elemv = caml_alloc (2, 0);
101 Store_field (elemv, 0, Val_virconnectcredential (&cred[i]));
102 Store_field (elemv, 1, listv);
106 /* Call the auth callback. */
107 rv = caml_callback_exn (*s->fvp, listv);
108 if (Is_exception_result (rv)) {
109 /* The callback raised an exception, so return an error. */
110 CAMLreturnT (int, -1);
113 len = _list_length (rv);
114 if (len != (int) ncred) {
115 /* The callback did not return the same number of results as the
118 CAMLreturnT (int, -1);
121 for (i = 0; rv != Val_emptylist; rv = Field (rv, 1), ++i) {
122 virConnectCredentialPtr c = &cred[i];
123 elemv = Field (rv, 0);
124 if (elemv == Val_int (0)) {
128 v = Field (elemv, 0);
129 len = caml_string_length (v);
130 c->result = malloc (len + 1);
131 if (c->result == NULL)
132 CAMLreturnT (int, -1);
133 memcpy (c->result, String_val (v), len);
134 c->result[len] = '\0';
139 CAMLreturnT (int, 0);
143 _ocaml_libvirt_connect_open_auth_common (value namev, value authv, int flags)
145 CAMLparam2 (namev, authv);
146 CAMLlocal2 (listv, fv);
149 struct ocaml_auth_callback_data data;
153 /* Keep a copy of the 'namev' string, as its value could move around
154 * when calling other OCaml code that allocates memory.
156 if (namev != Val_int (0)) { /* Some string */
157 name = strdup (String_val (Field (namev, 0)));
159 caml_raise_out_of_memory ();
162 fv = Field (authv, 1);
165 listv = Field (authv, 0);
166 auth.ncredtype = _list_length (listv);
167 auth.credtype = malloc (sizeof (int) * auth.ncredtype);
168 if (auth.credtype == NULL)
169 caml_raise_out_of_memory ();
170 for (i = 0; listv != Val_emptylist; listv = Field (listv, 1), ++i) {
171 auth.credtype[i] = Int_val (Field (listv, 0)) + 1;
173 auth.cb = &_ocaml_auth_callback;
176 /* Call virConnectOpenAuth directly, without using the NONBLOCKING
177 * macro, as this will indeed call ocaml_* APIs, and run OCaml code.
179 conn = virConnectOpenAuth (name, &auth, flags);
180 free (auth.credtype);
182 CHECK_ERROR (!conn, "virConnectOpenAuth");
184 CAMLreturnT (virConnectPtr, conn);
188 ocaml_libvirt_connect_open_auth (value namev, value authv)
190 CAMLparam2 (namev, authv);
194 conn = _ocaml_libvirt_connect_open_auth_common (namev, authv, 0);
195 rv = Val_connect (conn);
201 ocaml_libvirt_connect_open_auth_readonly (value namev, value authv)
203 CAMLparam2 (namev, authv);
207 conn = _ocaml_libvirt_connect_open_auth_common (namev, authv, VIR_CONNECT_RO);
208 rv = Val_connect (conn);
214 ocaml_libvirt_connect_get_version (value connv)
217 virConnectPtr conn = Connect_val (connv);
221 NONBLOCKING (r = virConnectGetVersion (conn, &hvVer));
222 CHECK_ERROR (r == -1, "virConnectGetVersion");
224 CAMLreturn (Val_int (hvVer));
228 ocaml_libvirt_connect_get_max_vcpus (value connv, value typev)
230 CAMLparam2 (connv, typev);
231 virConnectPtr conn = Connect_val (connv);
232 const char *type = Optstring_val (typev);
235 NONBLOCKING (r = virConnectGetMaxVcpus (conn, type));
236 CHECK_ERROR (r == -1, "virConnectGetMaxVcpus");
238 CAMLreturn (Val_int (r));
242 ocaml_libvirt_connect_get_node_info (value connv)
246 virConnectPtr conn = Connect_val (connv);
250 NONBLOCKING (r = virNodeGetInfo (conn, &info));
251 CHECK_ERROR (r == -1, "virNodeGetInfo");
253 rv = caml_alloc (8, 0);
254 v = caml_copy_string (info.model); Store_field (rv, 0, v);
255 v = caml_copy_int64 (info.memory); Store_field (rv, 1, v);
256 Store_field (rv, 2, Val_int (info.cpus));
257 Store_field (rv, 3, Val_int (info.mhz));
258 Store_field (rv, 4, Val_int (info.nodes));
259 Store_field (rv, 5, Val_int (info.sockets));
260 Store_field (rv, 6, Val_int (info.cores));
261 Store_field (rv, 7, Val_int (info.threads));
267 ocaml_libvirt_connect_node_get_free_memory (value connv)
271 virConnectPtr conn = Connect_val (connv);
272 unsigned long long r;
274 NONBLOCKING (r = virNodeGetFreeMemory (conn));
275 CHECK_ERROR (r == 0, "virNodeGetFreeMemory");
277 rv = caml_copy_int64 ((int64_t) r);
282 ocaml_libvirt_connect_node_get_cells_free_memory (value connv,
283 value startv, value maxv)
285 CAMLparam3 (connv, startv, maxv);
287 virConnectPtr conn = Connect_val (connv);
288 int start = Int_val (startv);
289 int max = Int_val (maxv);
291 unsigned long long *freemems;
293 freemems = malloc(sizeof (*freemems) * max);
294 if (freemems == NULL)
295 caml_raise_out_of_memory ();
297 NONBLOCKING (r = virNodeGetCellsFreeMemory (conn, freemems, start, max));
298 CHECK_ERROR_CLEANUP (r == -1, free (freemems), "virNodeGetCellsFreeMemory");
300 rv = caml_alloc (r, 0);
301 for (i = 0; i < r; ++i) {
302 iv = caml_copy_int64 ((int64_t) freemems[i]);
303 Store_field (rv, i, iv);
311 ocaml_libvirt_connect_set_keep_alive(value connv,
312 value intervalv, value countv)
314 CAMLparam3 (connv, intervalv, countv);
315 virConnectPtr conn = Connect_val(connv);
316 int interval = Int_val(intervalv);
317 unsigned int count = Int_val(countv);
320 NONBLOCKING(r = virConnectSetKeepAlive(conn, interval, count));
321 CHECK_ERROR (r == -1, "virConnectSetKeepAlive");
323 CAMLreturn(Val_unit);
327 ocaml_libvirt_connect_credtypes_from_auth_default (value unitv)
330 CAMLlocal2 (listv, itemv);
333 listv = Val_emptylist;
335 if (virConnectAuthPtrDefault) {
336 for (i = virConnectAuthPtrDefault->ncredtype; i >= 0; --i) {
337 const int type = virConnectAuthPtrDefault->credtype[i];
338 itemv = caml_alloc (2, 0);
339 Store_field (itemv, 0, Val_int (type - 1));
340 Store_field (itemv, 1, listv);
349 ocaml_libvirt_connect_call_auth_default_callback (value listv)
352 CAMLlocal5 (credv, retv, elemv, optv, v);
355 virConnectCredentialPtr creds;
357 if (virConnectAuthPtrDefault == NULL
358 || virConnectAuthPtrDefault->cb == NULL)
359 CAMLreturn (Val_unit);
361 len = _list_length (listv);
362 creds = calloc (len, sizeof (*creds));
364 caml_raise_out_of_memory ();
365 for (i = 0; listv != Val_emptylist; listv = Field (listv, 1), ++i) {
366 virConnectCredentialPtr cred = &creds[i];
367 credv = Field (listv, 0);
368 cred->type = Int_val (Field (credv, 0)) + 1;
369 cred->prompt = strdup (String_val (Field (credv, 1)));
370 if (cred->prompt == NULL)
371 caml_raise_out_of_memory ();
372 str = Optstring_val (Field (credv, 2));
374 cred->challenge = strdup (str);
375 if (cred->challenge == NULL)
376 caml_raise_out_of_memory ();
378 str = Optstring_val (Field (credv, 3));
380 cred->defresult = strdup (str);
381 if (cred->defresult == NULL)
382 caml_raise_out_of_memory ();
386 ret = virConnectAuthPtrDefault->cb (creds, len,
387 virConnectAuthPtrDefault->cbdata);
389 retv = Val_emptylist;
390 for (i = len - 1; i >= 0; --i) {
391 virConnectCredentialPtr cred = &creds[i];
392 elemv = caml_alloc (2, 0);
393 if (cred->result != NULL && cred->resultlen > 0) {
394 v = caml_alloc_string (cred->resultlen);
395 memcpy (String_val (v), cred->result, cred->resultlen);
396 optv = caml_alloc (1, 0);
397 Store_field (optv, 0, v);
400 Store_field (elemv, 0, optv);
401 Store_field (elemv, 1, retv);
405 for (i = 0; i < len; ++i) {
406 virConnectCredentialPtr cred = &creds[i];
407 /* Cast to char *, as the virConnectCredential structs we fill have
408 * const char * qualifiers.
410 free ((char *) cred->prompt);
411 free ((char *) cred->challenge);
412 free ((char *) cred->defresult);
417 caml_failwith ("virConnectAuthPtrDefault callback failed");
423 ocaml_libvirt_domain_get_id (value domv)
426 virDomainPtr dom = Domain_val (domv);
429 NONBLOCKING (r = virDomainGetID (dom));
430 /* In theory this could return -1 on error, but in practice
431 * libvirt never does this unless you call it with a corrupted
432 * or NULL dom object. So ignore errors here.
435 CAMLreturn (Val_int ((int) r));
439 ocaml_libvirt_domain_get_max_memory (value domv)
443 virDomainPtr dom = Domain_val (domv);
446 NONBLOCKING (r = virDomainGetMaxMemory (dom));
447 CHECK_ERROR (r == 0 /* [sic] */, "virDomainGetMaxMemory");
449 rv = caml_copy_int64 (r);
454 ocaml_libvirt_domain_set_max_memory (value domv, value memv)
456 CAMLparam2 (domv, memv);
457 virDomainPtr dom = Domain_val (domv);
458 unsigned long mem = Int64_val (memv);
461 NONBLOCKING (r = virDomainSetMaxMemory (dom, mem));
462 CHECK_ERROR (r == -1, "virDomainSetMaxMemory");
464 CAMLreturn (Val_unit);
468 ocaml_libvirt_domain_set_memory (value domv, value memv)
470 CAMLparam2 (domv, memv);
471 virDomainPtr dom = Domain_val (domv);
472 unsigned long mem = Int64_val (memv);
475 NONBLOCKING (r = virDomainSetMemory (dom, mem));
476 CHECK_ERROR (r == -1, "virDomainSetMemory");
478 CAMLreturn (Val_unit);
482 ocaml_libvirt_domain_get_info (value domv)
486 virDomainPtr dom = Domain_val (domv);
490 NONBLOCKING (r = virDomainGetInfo (dom, &info));
491 CHECK_ERROR (r == -1, "virDomainGetInfo");
493 rv = caml_alloc (5, 0);
494 Store_field (rv, 0, Val_int (info.state)); // These flags are compatible.
495 v = caml_copy_int64 (info.maxMem); Store_field (rv, 1, v);
496 v = caml_copy_int64 (info.memory); Store_field (rv, 2, v);
497 Store_field (rv, 3, Val_int (info.nrVirtCpu));
498 v = caml_copy_int64 (info.cpuTime); Store_field (rv, 4, v);
504 ocaml_libvirt_domain_get_scheduler_type (value domv)
507 CAMLlocal2 (rv, strv);
508 virDomainPtr dom = Domain_val (domv);
512 NONBLOCKING (r = virDomainGetSchedulerType (dom, &nparams));
513 CHECK_ERROR (!r, "virDomainGetSchedulerType");
515 rv = caml_alloc_tuple (2);
516 strv = caml_copy_string (r); Store_field (rv, 0, strv);
518 Store_field (rv, 1, nparams);
523 ocaml_libvirt_domain_get_scheduler_parameters (value domv, value nparamsv)
525 CAMLparam2 (domv, nparamsv);
526 CAMLlocal4 (rv, v, v2, v3);
527 virDomainPtr dom = Domain_val (domv);
528 int nparams = Int_val (nparamsv);
529 virSchedParameterPtr params;
532 params = malloc (sizeof (*params) * nparams);
534 caml_raise_out_of_memory ();
536 NONBLOCKING (r = virDomainGetSchedulerParameters (dom, params, &nparams));
537 CHECK_ERROR_CLEANUP (r == -1, free (params), "virDomainGetSchedulerParameters");
539 rv = caml_alloc (nparams, 0);
540 for (i = 0; i < nparams; ++i) {
541 v = caml_alloc_tuple (2); Store_field (rv, i, v);
542 v2 = caml_copy_string (params[i].field); Store_field (v, 0, v2);
543 switch (params[i].type) {
544 case VIR_DOMAIN_SCHED_FIELD_INT:
545 v2 = caml_alloc (1, 0);
546 v3 = caml_copy_int32 (params[i].value.i); Store_field (v2, 0, v3);
548 case VIR_DOMAIN_SCHED_FIELD_UINT:
549 v2 = caml_alloc (1, 1);
550 v3 = caml_copy_int32 (params[i].value.ui); Store_field (v2, 0, v3);
552 case VIR_DOMAIN_SCHED_FIELD_LLONG:
553 v2 = caml_alloc (1, 2);
554 v3 = caml_copy_int64 (params[i].value.l); Store_field (v2, 0, v3);
556 case VIR_DOMAIN_SCHED_FIELD_ULLONG:
557 v2 = caml_alloc (1, 3);
558 v3 = caml_copy_int64 (params[i].value.ul); Store_field (v2, 0, v3);
560 case VIR_DOMAIN_SCHED_FIELD_DOUBLE:
561 v2 = caml_alloc (1, 4);
562 v3 = caml_copy_double (params[i].value.d); Store_field (v2, 0, v3);
564 case VIR_DOMAIN_SCHED_FIELD_BOOLEAN:
565 v2 = caml_alloc (1, 5);
566 Store_field (v2, 0, Val_int (params[i].value.b));
569 caml_failwith ((char *)__FUNCTION__);
571 Store_field (v, 1, v2);
578 ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv)
580 CAMLparam2 (domv, paramsv);
582 virDomainPtr dom = Domain_val (domv);
583 int nparams = Wosize_val (paramsv);
584 virSchedParameterPtr params;
588 params = malloc (sizeof (*params) * nparams);
590 caml_raise_out_of_memory ();
592 for (i = 0; i < nparams; ++i) {
593 v = Field (paramsv, i); /* Points to the two-element tuple. */
594 name = String_val (Field (v, 0));
595 strncpy (params[i].field, name, VIR_DOMAIN_SCHED_FIELD_LENGTH);
596 params[i].field[VIR_DOMAIN_SCHED_FIELD_LENGTH-1] = '\0';
597 v = Field (v, 1); /* Points to the sched_param_value block. */
598 switch (Tag_val (v)) {
600 params[i].type = VIR_DOMAIN_SCHED_FIELD_INT;
601 params[i].value.i = Int32_val (Field (v, 0));
604 params[i].type = VIR_DOMAIN_SCHED_FIELD_UINT;
605 params[i].value.ui = Int32_val (Field (v, 0));
608 params[i].type = VIR_DOMAIN_SCHED_FIELD_LLONG;
609 params[i].value.l = Int64_val (Field (v, 0));
612 params[i].type = VIR_DOMAIN_SCHED_FIELD_ULLONG;
613 params[i].value.ul = Int64_val (Field (v, 0));
616 params[i].type = VIR_DOMAIN_SCHED_FIELD_DOUBLE;
617 params[i].value.d = Double_val (Field (v, 0));
620 params[i].type = VIR_DOMAIN_SCHED_FIELD_BOOLEAN;
621 params[i].value.b = Int_val (Field (v, 0));
624 caml_failwith ((char *)__FUNCTION__);
628 NONBLOCKING (r = virDomainSetSchedulerParameters (dom, params, nparams));
630 CHECK_ERROR (r == -1, "virDomainSetSchedulerParameters");
632 CAMLreturn (Val_unit);
636 ocaml_libvirt_domain_set_vcpus (value domv, value nvcpusv)
638 CAMLparam2 (domv, nvcpusv);
639 virDomainPtr dom = Domain_val (domv);
640 int r, nvcpus = Int_val (nvcpusv);
642 NONBLOCKING (r = virDomainSetVcpus (dom, nvcpus));
643 CHECK_ERROR (r == -1, "virDomainSetVcpus");
645 CAMLreturn (Val_unit);
649 ocaml_libvirt_domain_pin_vcpu (value domv, value vcpuv, value cpumapv)
651 CAMLparam3 (domv, vcpuv, cpumapv);
652 virDomainPtr dom = Domain_val (domv);
653 int maplen = caml_string_length (cpumapv);
654 unsigned char *cpumap = (unsigned char *) String_val (cpumapv);
655 int vcpu = Int_val (vcpuv);
658 NONBLOCKING (r = virDomainPinVcpu (dom, vcpu, cpumap, maplen));
659 CHECK_ERROR (r == -1, "virDomainPinVcpu");
661 CAMLreturn (Val_unit);
665 ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv)
667 CAMLparam3 (domv, maxinfov, maplenv);
668 CAMLlocal5 (rv, infov, strv, v, v2);
669 virDomainPtr dom = Domain_val (domv);
670 int maxinfo = Int_val (maxinfov);
671 int maplen = Int_val (maplenv);
673 unsigned char *cpumaps;
676 info = calloc (maxinfo, sizeof (*info));
678 caml_raise_out_of_memory ();
679 cpumaps = calloc (maxinfo * maplen, sizeof (*cpumaps));
680 if (cpumaps == NULL) {
682 caml_raise_out_of_memory ();
685 NONBLOCKING (r = virDomainGetVcpus (dom, info, maxinfo, cpumaps, maplen));
686 CHECK_ERROR_CLEANUP (r == -1, free (info); free (cpumaps), "virDomainPinVcpu");
688 /* Copy the virVcpuInfo structures. */
689 infov = caml_alloc (maxinfo, 0);
690 for (i = 0; i < maxinfo; ++i) {
691 v2 = caml_alloc (4, 0); Store_field (infov, i, v2);
692 Store_field (v2, 0, Val_int (info[i].number));
693 Store_field (v2, 1, Val_int (info[i].state));
694 v = caml_copy_int64 (info[i].cpuTime); Store_field (v2, 2, v);
695 Store_field (v2, 3, Val_int (info[i].cpu));
698 /* Copy the bitmap. */
699 strv = caml_alloc_string (maxinfo * maplen);
700 memcpy (String_val (strv), cpumaps, maxinfo * maplen);
702 /* Allocate the tuple and return it. */
703 rv = caml_alloc_tuple (3);
704 Store_field (rv, 0, Val_int (r)); /* number of CPUs. */
705 Store_field (rv, 1, infov);
706 Store_field (rv, 2, strv);
715 ocaml_libvirt_domain_get_cpu_stats (value domv)
718 CAMLlocal5 (cpustats, param_head, param_node, typed_param, typed_param_value);
720 virDomainPtr dom = Domain_val (domv);
721 virTypedParameterPtr params;
722 int r, cpu, ncpus, nparams, i, j, pos;
725 /* get number of pcpus */
726 NONBLOCKING (nr_pcpus = virDomainGetCPUStats(dom, NULL, 0, 0, 0, 0));
727 CHECK_ERROR (nr_pcpus < 0, "virDomainGetCPUStats");
729 /* get percpu information */
730 NONBLOCKING (nparams = virDomainGetCPUStats(dom, NULL, 0, 0, 1, 0));
731 CHECK_ERROR (nparams < 0, "virDomainGetCPUStats");
733 if ((params = malloc(sizeof(*params) * nparams * 128)) == NULL)
734 caml_failwith ("virDomainGetCPUStats: malloc");
736 cpustats = caml_alloc (nr_pcpus, 0); /* cpustats: array of params(list of typed_param) */
738 while (cpu < nr_pcpus) {
739 ncpus = nr_pcpus - cpu > 128 ? 128 : nr_pcpus - cpu;
741 NONBLOCKING (r = virDomainGetCPUStats(dom, params, nparams, cpu, ncpus, 0));
742 CHECK_ERROR (r < 0, "virDomainGetCPUStats");
744 for (i = 0; i < ncpus; i++) {
745 /* list of typed_param: single linked list of param_nodes */
746 param_head = Val_emptylist; /* param_head: the head param_node of list of typed_param */
748 if (params[i * nparams].type == 0) {
749 Store_field(cpustats, cpu + i, param_head);
753 for (j = r - 1; j >= 0; j--) {
754 pos = i * nparams + j;
755 if (params[pos].type == 0)
758 param_node = caml_alloc(2, 0); /* param_node: typed_param, next param_node */
759 Store_field(param_node, 1, param_head);
760 param_head = param_node;
762 typed_param = caml_alloc(2, 0); /* typed_param: field name(string), typed_param_value */
763 Store_field(param_node, 0, typed_param);
764 Store_field(typed_param, 0, caml_copy_string(params[pos].field));
766 /* typed_param_value: value with the corresponding type tag */
767 switch(params[pos].type) {
768 case VIR_TYPED_PARAM_INT:
769 typed_param_value = caml_alloc (1, 0);
770 v = caml_copy_int32 (params[pos].value.i);
772 case VIR_TYPED_PARAM_UINT:
773 typed_param_value = caml_alloc (1, 1);
774 v = caml_copy_int32 (params[pos].value.ui);
776 case VIR_TYPED_PARAM_LLONG:
777 typed_param_value = caml_alloc (1, 2);
778 v = caml_copy_int64 (params[pos].value.l);
780 case VIR_TYPED_PARAM_ULLONG:
781 typed_param_value = caml_alloc (1, 3);
782 v = caml_copy_int64 (params[pos].value.ul);
784 case VIR_TYPED_PARAM_DOUBLE:
785 typed_param_value = caml_alloc (1, 4);
786 v = caml_copy_double (params[pos].value.d);
788 case VIR_TYPED_PARAM_BOOLEAN:
789 typed_param_value = caml_alloc (1, 5);
790 v = Val_bool (params[pos].value.b);
792 case VIR_TYPED_PARAM_STRING:
793 typed_param_value = caml_alloc (1, 6);
794 v = caml_copy_string (params[pos].value.s);
795 free (params[pos].value.s);
798 /* XXX Memory leak on this path, if there are more
799 * VIR_TYPED_PARAM_STRING past this point in the array.
802 caml_failwith ("virDomainGetCPUStats: "
803 "unknown parameter type returned");
805 Store_field (typed_param_value, 0, v);
806 Store_field (typed_param, 1, typed_param_value);
808 Store_field (cpustats, cpu + i, param_head);
813 CAMLreturn (cpustats);
817 ocaml_libvirt_domain_get_all_domain_stats (value connv,
818 value statsv, value flagsv)
820 CAMLparam3 (connv, statsv, flagsv);
821 CAMLlocal5 (rv, dsv, tpv, v, v1);
823 virConnectPtr conn = Connect_val (connv);
824 virDomainStatsRecordPtr *rstats;
825 unsigned int stats = 0, flags = 0;
827 unsigned char uuid[VIR_UUID_BUFLEN];
829 /* Get stats and flags. */
830 for (; statsv != Val_int (0); statsv = Field (statsv, 1)) {
831 v = Field (statsv, 0);
832 if (v == Val_int (0))
833 stats |= VIR_DOMAIN_STATS_STATE;
834 else if (v == Val_int (1))
835 stats |= VIR_DOMAIN_STATS_CPU_TOTAL;
836 else if (v == Val_int (2))
837 stats |= VIR_DOMAIN_STATS_BALLOON;
838 else if (v == Val_int (3))
839 stats |= VIR_DOMAIN_STATS_VCPU;
840 else if (v == Val_int (4))
841 stats |= VIR_DOMAIN_STATS_INTERFACE;
842 else if (v == Val_int (5))
843 stats |= VIR_DOMAIN_STATS_BLOCK;
844 else if (v == Val_int (6))
845 stats |= VIR_DOMAIN_STATS_PERF;
847 for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1)) {
848 v = Field (flagsv, 0);
849 if (v == Val_int (0))
850 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_ACTIVE;
851 else if (v == Val_int (1))
852 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_INACTIVE;
853 else if (v == Val_int (2))
854 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_OTHER;
855 else if (v == Val_int (3))
856 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_PAUSED;
857 else if (v == Val_int (4))
858 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_PERSISTENT;
859 else if (v == Val_int (5))
860 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_RUNNING;
861 else if (v == Val_int (6))
862 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_SHUTOFF;
863 else if (v == Val_int (7))
864 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_TRANSIENT;
865 else if (v == Val_int (8))
866 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_BACKING;
867 else if (v == Val_int (9))
868 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_ENFORCE_STATS;
871 NONBLOCKING (r = virConnectGetAllDomainStats (conn, stats, &rstats, flags));
872 CHECK_ERROR (r == -1, "virConnectGetAllDomainStats");
874 rv = caml_alloc (r, 0); /* domain_stats_record array. */
875 for (i = 0; i < r; ++i) {
876 dsv = caml_alloc (2, 0); /* domain_stats_record */
878 /* Libvirt returns something superficially resembling a
879 * virDomainPtr, but it's not a real virDomainPtr object
880 * (eg. dom->id == -1, and its refcount is wrong). The only thing
881 * we can safely get from it is the UUID.
883 v = caml_alloc_string (VIR_UUID_BUFLEN);
884 virDomainGetUUID (rstats[i]->dom, uuid);
885 memcpy (String_val (v), uuid, VIR_UUID_BUFLEN);
886 Store_field (dsv, 0, v);
888 tpv = caml_alloc (rstats[i]->nparams, 0); /* typed_param array */
889 for (j = 0; j < rstats[i]->nparams; ++j) {
890 v2 = caml_alloc (2, 0); /* typed_param: field name, value */
891 Store_field (v2, 0, caml_copy_string (rstats[i]->params[j].field));
893 switch (rstats[i]->params[j].type) {
894 case VIR_TYPED_PARAM_INT:
895 v1 = caml_alloc (1, 0);
896 v = caml_copy_int32 (rstats[i]->params[j].value.i);
898 case VIR_TYPED_PARAM_UINT:
899 v1 = caml_alloc (1, 1);
900 v = caml_copy_int32 (rstats[i]->params[j].value.ui);
902 case VIR_TYPED_PARAM_LLONG:
903 v1 = caml_alloc (1, 2);
904 v = caml_copy_int64 (rstats[i]->params[j].value.l);
906 case VIR_TYPED_PARAM_ULLONG:
907 v1 = caml_alloc (1, 3);
908 v = caml_copy_int64 (rstats[i]->params[j].value.ul);
910 case VIR_TYPED_PARAM_DOUBLE:
911 v1 = caml_alloc (1, 4);
912 v = caml_copy_double (rstats[i]->params[j].value.d);
914 case VIR_TYPED_PARAM_BOOLEAN:
915 v1 = caml_alloc (1, 5);
916 v = Val_bool (rstats[i]->params[j].value.b);
918 case VIR_TYPED_PARAM_STRING:
919 v1 = caml_alloc (1, 6);
920 v = caml_copy_string (rstats[i]->params[j].value.s);
923 virDomainStatsRecordListFree (rstats);
924 caml_failwith ("virConnectGetAllDomainStats: "
925 "unknown parameter type returned");
927 Store_field (v1, 0, v);
929 Store_field (v2, 1, v1);
930 Store_field (tpv, j, v2);
933 Store_field (dsv, 1, tpv);
934 Store_field (rv, i, dsv);
937 virDomainStatsRecordListFree (rstats);
942 ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, value optdnamev, value opturiv, value optbandwidthv, value unitv)
944 CAMLparam5 (domv, dconnv, flagsv, optdnamev, opturiv);
945 CAMLxparam2 (optbandwidthv, unitv);
946 CAMLlocal2 (flagv, rv);
947 virDomainPtr dom = Domain_val (domv);
948 virConnectPtr dconn = Connect_val (dconnv);
950 const char *dname = Optstring_val (optdnamev);
951 const char *uri = Optstring_val (opturiv);
952 unsigned long bandwidth;
955 /* Iterate over the list of flags. */
956 for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
958 flagv = Field (flagsv, 0);
959 if (flagv == Val_int (0))
960 flags |= VIR_MIGRATE_LIVE;
963 if (optbandwidthv == Val_int (0)) /* None */
965 else /* Some bandwidth */
966 bandwidth = Int_val (Field (optbandwidthv, 0));
968 NONBLOCKING (r = virDomainMigrate (dom, dconn, flags, dname, uri, bandwidth));
969 CHECK_ERROR (!r, "virDomainMigrate");
971 rv = Val_domain (r, dconnv);
977 ocaml_libvirt_domain_migrate_bytecode (value *argv, int argn)
979 return ocaml_libvirt_domain_migrate_native (argv[0], argv[1], argv[2],
980 argv[3], argv[4], argv[5],
985 ocaml_libvirt_domain_block_stats (value domv, value pathv)
987 CAMLparam2 (domv, pathv);
989 virDomainPtr dom = Domain_val (domv);
990 char *path = String_val (pathv);
991 struct _virDomainBlockStats stats;
994 NONBLOCKING (r = virDomainBlockStats (dom, path, &stats, sizeof stats));
995 CHECK_ERROR (r == -1, "virDomainBlockStats");
997 rv = caml_alloc (5, 0);
998 v = caml_copy_int64 (stats.rd_req); Store_field (rv, 0, v);
999 v = caml_copy_int64 (stats.rd_bytes); Store_field (rv, 1, v);
1000 v = caml_copy_int64 (stats.wr_req); Store_field (rv, 2, v);
1001 v = caml_copy_int64 (stats.wr_bytes); Store_field (rv, 3, v);
1002 v = caml_copy_int64 (stats.errs); Store_field (rv, 4, v);
1008 ocaml_libvirt_domain_interface_stats (value domv, value pathv)
1010 CAMLparam2 (domv, pathv);
1012 virDomainPtr dom = Domain_val (domv);
1013 char *path = String_val (pathv);
1014 struct _virDomainInterfaceStats stats;
1017 NONBLOCKING (r = virDomainInterfaceStats (dom, path, &stats, sizeof stats));
1018 CHECK_ERROR (r == -1, "virDomainInterfaceStats");
1020 rv = caml_alloc (8, 0);
1021 v = caml_copy_int64 (stats.rx_bytes); Store_field (rv, 0, v);
1022 v = caml_copy_int64 (stats.rx_packets); Store_field (rv, 1, v);
1023 v = caml_copy_int64 (stats.rx_errs); Store_field (rv, 2, v);
1024 v = caml_copy_int64 (stats.rx_drop); Store_field (rv, 3, v);
1025 v = caml_copy_int64 (stats.tx_bytes); Store_field (rv, 4, v);
1026 v = caml_copy_int64 (stats.tx_packets); Store_field (rv, 5, v);
1027 v = caml_copy_int64 (stats.tx_errs); Store_field (rv, 6, v);
1028 v = caml_copy_int64 (stats.tx_drop); Store_field (rv, 7, v);
1034 ocaml_libvirt_domain_block_peek_native (value domv, value pathv, value offsetv, value sizev, value bufferv, value boffv)
1036 CAMLparam5 (domv, pathv, offsetv, sizev, bufferv);
1037 CAMLxparam1 (boffv);
1038 virDomainPtr dom = Domain_val (domv);
1039 const char *path = String_val (pathv);
1040 unsigned long long offset = Int64_val (offsetv);
1041 size_t size = Int_val (sizev);
1042 char *buffer = String_val (bufferv);
1043 int boff = Int_val (boffv);
1046 /* Check that the return buffer is big enough. */
1047 if (caml_string_length (bufferv) < boff + size)
1048 caml_failwith ("virDomainBlockPeek: return buffer too short");
1050 /* NB. not NONBLOCKING because buffer might move (XXX) */
1051 r = virDomainBlockPeek (dom, path, offset, size, buffer+boff, 0);
1052 CHECK_ERROR (r == -1, "virDomainBlockPeek");
1054 CAMLreturn (Val_unit);
1058 ocaml_libvirt_domain_block_peek_bytecode (value *argv, int argn)
1060 return ocaml_libvirt_domain_block_peek_native (argv[0], argv[1], argv[2],
1061 argv[3], argv[4], argv[5]);
1065 ocaml_libvirt_domain_memory_peek_native (value domv, value flagsv, value offsetv, value sizev, value bufferv, value boffv)
1067 CAMLparam5 (domv, flagsv, offsetv, sizev, bufferv);
1068 CAMLxparam1 (boffv);
1070 virDomainPtr dom = Domain_val (domv);
1072 unsigned long long offset = Int64_val (offsetv);
1073 size_t size = Int_val (sizev);
1074 char *buffer = String_val (bufferv);
1075 int boff = Int_val (boffv);
1078 /* Check that the return buffer is big enough. */
1079 if (caml_string_length (bufferv) < boff + size)
1080 caml_failwith ("virDomainMemoryPeek: return buffer too short");
1083 for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
1085 flagv = Field (flagsv, 0);
1086 if (flagv == Val_int (0))
1087 flags |= VIR_MEMORY_VIRTUAL;
1090 /* NB. not NONBLOCKING because buffer might move (XXX) */
1091 r = virDomainMemoryPeek (dom, offset, size, buffer+boff, flags);
1092 CHECK_ERROR (r == -1, "virDomainMemoryPeek");
1094 CAMLreturn (Val_unit);
1098 ocaml_libvirt_domain_memory_peek_bytecode (value *argv, int argn)
1100 return ocaml_libvirt_domain_memory_peek_native (argv[0], argv[1], argv[2],
1101 argv[3], argv[4], argv[5]);
1105 ocaml_libvirt_domain_get_xml_desc_flags (value domv, value flagsv)
1107 CAMLparam2 (domv, flagsv);
1108 CAMLlocal2 (rv, flagv);
1109 virDomainPtr dom = Domain_val (domv);
1114 for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
1116 flagv = Field (flagsv, 0);
1117 if (flagv == Val_int (0))
1118 flags |= VIR_DOMAIN_XML_SECURE;
1119 else if (flagv == Val_int (1))
1120 flags |= VIR_DOMAIN_XML_INACTIVE;
1121 else if (flagv == Val_int (2))
1122 flags |= VIR_DOMAIN_XML_UPDATE_CPU;
1123 else if (flagv == Val_int (3))
1124 flags |= VIR_DOMAIN_XML_MIGRATABLE;
1127 NONBLOCKING (r = virDomainGetXMLDesc (dom, flags));
1128 CHECK_ERROR (!r, "virDomainGetXMLDesc");
1130 rv = caml_copy_string (r);
1135 /*----------------------------------------------------------------------*/
1140 ocaml_libvirt_event_register_default_impl (value unitv)
1144 /* arg is of type unit = void */
1147 NONBLOCKING (r = virEventRegisterDefaultImpl ());
1148 /* must be called before connection, therefore we can't use CHECK_ERROR */
1149 if (r == -1) caml_failwith("virEventRegisterDefaultImpl");
1151 CAMLreturn (Val_unit);
1155 ocaml_libvirt_event_run_default_impl (value unitv)
1159 /* arg is of type unit = void */
1162 NONBLOCKING (r = virEventRunDefaultImpl ());
1163 if (r == -1) caml_failwith("virEventRunDefaultImpl");
1165 CAMLreturn (Val_unit);
1168 /* We register a single C callback function for every distinct
1169 callback signature. We encode the signature itself in the function
1170 name and also in the name of the assocated OCaml callback
1173 i_i64_s_callback(virConnectPtr conn,
1179 would correspond to an OCaml callback
1180 Libvirt.i_i64_s_callback :
1181 int64 -> [`R] Domain.t -> int -> int64 -> string option -> unit
1182 where the initial int64 is a unique ID used by the OCaml to
1183 dispatch to the specific OCaml closure and stored by libvirt
1184 as the "opaque" data. */
1186 /* Every one of the callbacks starts with a DOMAIN_CALLBACK_BEGIN(NAME)
1187 where NAME is the string name of the OCaml callback registered
1189 #define DOMAIN_CALLBACK_BEGIN(NAME) \
1190 value connv, domv, callback_id, result; \
1191 connv = domv = callback_id = result = Val_int(0); \
1192 static value *callback = NULL; \
1193 caml_leave_blocking_section(); \
1194 if (callback == NULL) \
1195 callback = caml_named_value(NAME); \
1196 if (callback == NULL) \
1197 abort(); /* C code out of sync with OCaml code */ \
1198 if ((virDomainRef(dom) == -1) || (virConnectRef(conn) == -1)) \
1199 abort(); /* should never happen in practice? */ \
1201 Begin_roots4(connv, domv, callback_id, result); \
1202 connv = Val_connect(conn); \
1203 domv = Val_domain(dom, connv); \
1204 callback_id = caml_copy_int64(*(long *)opaque);
1206 /* Every one of the callbacks ends with a CALLBACK_END */
1207 #define DOMAIN_CALLBACK_END \
1208 (void) caml_callback3(*callback, callback_id, domv, result); \
1210 caml_enter_blocking_section();
1214 i_i_callback(virConnectPtr conn,
1220 DOMAIN_CALLBACK_BEGIN("Libvirt.i_i_callback")
1221 result = caml_alloc_tuple(2);
1222 Store_field(result, 0, Val_int(x));
1223 Store_field(result, 1, Val_int(y));
1228 u_callback(virConnectPtr conn,
1232 DOMAIN_CALLBACK_BEGIN("Libvirt.u_callback")
1233 result = Val_int(0); /* () */
1238 i64_callback(virConnectPtr conn,
1243 DOMAIN_CALLBACK_BEGIN("Libvirt.i64_callback")
1244 result = caml_copy_int64(int64);
1249 i_callback(virConnectPtr conn,
1254 DOMAIN_CALLBACK_BEGIN("Libvirt.i_callback")
1255 result = Val_int(x);
1260 s_i_callback(virConnectPtr conn,
1266 DOMAIN_CALLBACK_BEGIN("Libvirt.s_i_callback")
1267 result = caml_alloc_tuple(2);
1268 Store_field(result, 0,
1269 Val_opt(x, (Val_ptr_t) caml_copy_string));
1270 Store_field(result, 1, Val_int(y));
1275 s_i_i_callback(virConnectPtr conn,
1282 DOMAIN_CALLBACK_BEGIN("Libvirt.s_i_i_callback")
1283 result = caml_alloc_tuple(3);
1284 Store_field(result, 0,
1285 Val_opt(x, (Val_ptr_t) caml_copy_string));
1286 Store_field(result, 1, Val_int(y));
1287 Store_field(result, 2, Val_int(z));
1292 s_s_i_callback(virConnectPtr conn,
1299 DOMAIN_CALLBACK_BEGIN("Libvirt.s_s_i_callback")
1300 result = caml_alloc_tuple(3);
1301 Store_field(result, 0,
1302 Val_opt(x, (Val_ptr_t) caml_copy_string));
1303 Store_field(result, 1,
1304 Val_opt(y, (Val_ptr_t) caml_copy_string));
1305 Store_field(result, 2, Val_int(z));
1310 s_s_i_s_callback(virConnectPtr conn,
1318 DOMAIN_CALLBACK_BEGIN("Libvirt.s_s_i_s_callback")
1319 result = caml_alloc_tuple(4);
1320 Store_field(result, 0,
1321 Val_opt(x, (Val_ptr_t) caml_copy_string));
1322 Store_field(result, 1,
1323 Val_opt(y, (Val_ptr_t) caml_copy_string));
1324 Store_field(result, 2, Val_int(z));
1325 Store_field(result, 3,
1326 Val_opt(a, (Val_ptr_t) caml_copy_string));
1331 s_s_s_i_callback(virConnectPtr conn,
1339 DOMAIN_CALLBACK_BEGIN("Libvirt.s_s_s_i_callback")
1340 result = caml_alloc_tuple(4);
1341 Store_field(result, 0,
1342 Val_opt(x, (Val_ptr_t) caml_copy_string));
1343 Store_field(result, 1,
1344 Val_opt(y, (Val_ptr_t) caml_copy_string));
1345 Store_field(result, 2,
1346 Val_opt(z, (Val_ptr_t) caml_copy_string));
1347 Store_field(result, 3, Val_int(a));
1352 Val_event_graphics_address(virDomainEventGraphicsAddressPtr x)
1356 result = caml_alloc_tuple(3);
1357 Store_field(result, 0, Val_int(x->family));
1358 Store_field(result, 1,
1359 Val_opt((void *) x->node, (Val_ptr_t) caml_copy_string));
1360 Store_field(result, 2,
1361 Val_opt((void *) x->service, (Val_ptr_t) caml_copy_string));
1366 Val_event_graphics_subject_identity(virDomainEventGraphicsSubjectIdentityPtr x)
1370 result = caml_alloc_tuple(2);
1371 Store_field(result, 0,
1372 Val_opt((void *) x->type, (Val_ptr_t) caml_copy_string));
1373 Store_field(result, 1,
1374 Val_opt((void *) x->name, (Val_ptr_t) caml_copy_string));
1380 Val_event_graphics_subject(virDomainEventGraphicsSubjectPtr x)
1385 result = caml_alloc_tuple(x->nidentity);
1386 for (i = 0; i < x->nidentity; i++ )
1387 Store_field(result, i,
1388 Val_event_graphics_subject_identity(x->identities + i));
1393 i_ga_ga_s_gs_callback(virConnectPtr conn,
1396 virDomainEventGraphicsAddressPtr ga1,
1397 virDomainEventGraphicsAddressPtr ga2,
1399 virDomainEventGraphicsSubjectPtr gs1,
1402 DOMAIN_CALLBACK_BEGIN("Libvirt.i_ga_ga_s_gs_callback")
1403 result = caml_alloc_tuple(5);
1404 Store_field(result, 0, Val_int(i1));
1405 Store_field(result, 1, Val_event_graphics_address(ga1));
1406 Store_field(result, 2, Val_event_graphics_address(ga2));
1407 Store_field(result, 3,
1408 Val_opt(s1, (Val_ptr_t) caml_copy_string));
1409 Store_field(result, 4, Val_event_graphics_subject(gs1));
1414 timeout_callback(int timer, void *opaque)
1416 value callback_id, result;
1417 callback_id = result = Val_int(0);
1418 static value *callback = NULL;
1419 caml_leave_blocking_section();
1420 if (callback == NULL)
1421 callback = caml_named_value("Libvirt.timeout_callback");
1422 if (callback == NULL)
1423 abort(); /* C code out of sync with OCaml code */
1425 Begin_roots2(callback_id, result);
1426 callback_id = caml_copy_int64(*(long *)opaque);
1428 (void)caml_callback_exn(*callback, callback_id);
1430 caml_enter_blocking_section();
1434 ocaml_libvirt_event_add_timeout (value connv, value ms, value callback_id)
1436 CAMLparam3 (connv, ms, callback_id);
1438 virFreeCallback freecb = free;
1439 virEventTimeoutCallback cb = timeout_callback;
1443 /* Store the int64 callback_id as the opaque data so the OCaml
1444 callback can demultiplex to the correct OCaml handler. */
1445 if ((opaque = malloc(sizeof(long))) == NULL)
1446 caml_failwith ("virEventAddTimeout: malloc");
1447 *((long*)opaque) = Int64_val(callback_id);
1448 NONBLOCKING(r = virEventAddTimeout(Int_val(ms), cb, opaque, freecb));
1449 CHECK_ERROR(r == -1, "virEventAddTimeout");
1451 CAMLreturn(Val_int(r));
1455 ocaml_libvirt_event_remove_timeout (value connv, value timer_id)
1457 CAMLparam2 (connv, timer_id);
1460 NONBLOCKING(r = virEventRemoveTimeout(Int_val(timer_id)));
1461 CHECK_ERROR(r == -1, "virEventRemoveTimeout");
1463 CAMLreturn(Val_int(r));
1467 ocaml_libvirt_connect_domain_event_register_any(value connv, value domv, value callback, value callback_id)
1469 CAMLparam4(connv, domv, callback, callback_id);
1471 virConnectPtr conn = Connect_val (connv);
1472 virDomainPtr dom = NULL;
1473 int eventID = Tag_val(callback);
1475 virConnectDomainEventGenericCallback cb;
1477 virFreeCallback freecb = free;
1480 if (domv != Val_int(0))
1481 dom = Domain_val (Field(domv, 0));
1484 case VIR_DOMAIN_EVENT_ID_LIFECYCLE:
1485 cb = VIR_DOMAIN_EVENT_CALLBACK(i_i_callback);
1487 case VIR_DOMAIN_EVENT_ID_REBOOT:
1488 cb = VIR_DOMAIN_EVENT_CALLBACK(u_callback);
1490 case VIR_DOMAIN_EVENT_ID_RTC_CHANGE:
1491 cb = VIR_DOMAIN_EVENT_CALLBACK(i64_callback);
1493 case VIR_DOMAIN_EVENT_ID_WATCHDOG:
1494 cb = VIR_DOMAIN_EVENT_CALLBACK(i_callback);
1496 case VIR_DOMAIN_EVENT_ID_IO_ERROR:
1497 cb = VIR_DOMAIN_EVENT_CALLBACK(s_s_i_callback);
1499 case VIR_DOMAIN_EVENT_ID_GRAPHICS:
1500 cb = VIR_DOMAIN_EVENT_CALLBACK(i_ga_ga_s_gs_callback);
1502 case VIR_DOMAIN_EVENT_ID_IO_ERROR_REASON:
1503 cb = VIR_DOMAIN_EVENT_CALLBACK(s_s_i_s_callback);
1505 case VIR_DOMAIN_EVENT_ID_CONTROL_ERROR:
1506 cb = VIR_DOMAIN_EVENT_CALLBACK(u_callback);
1508 case VIR_DOMAIN_EVENT_ID_BLOCK_JOB:
1509 cb = VIR_DOMAIN_EVENT_CALLBACK(s_i_i_callback);
1511 case VIR_DOMAIN_EVENT_ID_DISK_CHANGE:
1512 cb = VIR_DOMAIN_EVENT_CALLBACK(s_s_s_i_callback);
1514 case VIR_DOMAIN_EVENT_ID_TRAY_CHANGE:
1515 cb = VIR_DOMAIN_EVENT_CALLBACK(s_i_callback);
1517 case VIR_DOMAIN_EVENT_ID_PMWAKEUP:
1518 cb = VIR_DOMAIN_EVENT_CALLBACK(i_callback);
1520 case VIR_DOMAIN_EVENT_ID_PMSUSPEND:
1521 cb = VIR_DOMAIN_EVENT_CALLBACK(i_callback);
1523 case VIR_DOMAIN_EVENT_ID_BALLOON_CHANGE:
1524 cb = VIR_DOMAIN_EVENT_CALLBACK(i64_callback);
1526 case VIR_DOMAIN_EVENT_ID_PMSUSPEND_DISK:
1527 cb = VIR_DOMAIN_EVENT_CALLBACK(i_callback);
1530 caml_failwith("vifConnectDomainEventRegisterAny: unimplemented eventID");
1533 /* Store the int64 callback_id as the opaque data so the OCaml
1534 callback can demultiplex to the correct OCaml handler. */
1535 if ((opaque = malloc(sizeof(long))) == NULL)
1536 caml_failwith ("virConnectDomainEventRegisterAny: malloc");
1537 *((long*)opaque) = Int64_val(callback_id);
1538 NONBLOCKING(r = virConnectDomainEventRegisterAny(conn, dom, eventID, cb, opaque, freecb));
1539 CHECK_ERROR(r == -1, "virConnectDomainEventRegisterAny");
1541 CAMLreturn(Val_int(r));
1545 ocaml_libvirt_storage_pool_get_info (value poolv)
1549 virStoragePoolPtr pool = Pool_val (poolv);
1550 virStoragePoolInfo info;
1553 NONBLOCKING (r = virStoragePoolGetInfo (pool, &info));
1554 CHECK_ERROR (r == -1, "virStoragePoolGetInfo");
1556 rv = caml_alloc (4, 0);
1557 Store_field (rv, 0, Val_int (info.state));
1558 v = caml_copy_int64 (info.capacity); Store_field (rv, 1, v);
1559 v = caml_copy_int64 (info.allocation); Store_field (rv, 2, v);
1560 v = caml_copy_int64 (info.available); Store_field (rv, 3, v);
1566 ocaml_libvirt_storage_vol_get_info (value volv)
1570 virStorageVolPtr vol = Volume_val (volv);
1571 virStorageVolInfo info;
1574 NONBLOCKING (r = virStorageVolGetInfo (vol, &info));
1575 CHECK_ERROR (r == -1, "virStorageVolGetInfo");
1577 rv = caml_alloc (3, 0);
1578 Store_field (rv, 0, Val_int (info.type));
1579 v = caml_copy_int64 (info.capacity); Store_field (rv, 1, v);
1580 v = caml_copy_int64 (info.allocation); Store_field (rv, 2, v);
1585 /*----------------------------------------------------------------------*/
1588 ocaml_libvirt_virterror_get_last_error (value unitv)
1592 virErrorPtr err = virGetLastError ();
1594 rv = Val_opt (err, (Val_ptr_t) Val_virterror);
1600 ocaml_libvirt_virterror_get_last_conn_error (value connv)
1604 virConnectPtr conn = Connect_val (connv);
1606 rv = Val_opt (conn, (Val_ptr_t) Val_connect);
1612 ocaml_libvirt_virterror_reset_last_error (value unitv)
1615 virResetLastError ();
1616 CAMLreturn (Val_unit);
1620 ocaml_libvirt_virterror_reset_last_conn_error (value connv)
1623 virConnectPtr conn = Connect_val (connv);
1624 virConnResetLastError (conn);
1625 CAMLreturn (Val_unit);
1628 /*----------------------------------------------------------------------*/
1631 ignore_errors (void *user_data, virErrorPtr error)
1636 /* Initialise the library. */
1638 ocaml_libvirt_init (value unit)
1642 virSetErrorFunc (NULL, ignore_errors);
1645 CAMLreturn (Val_unit);