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_domain_get_id (value domv)
330 virDomainPtr dom = Domain_val (domv);
333 NONBLOCKING (r = virDomainGetID (dom));
334 /* In theory this could return -1 on error, but in practice
335 * libvirt never does this unless you call it with a corrupted
336 * or NULL dom object. So ignore errors here.
339 CAMLreturn (Val_int ((int) r));
343 ocaml_libvirt_domain_get_max_memory (value domv)
347 virDomainPtr dom = Domain_val (domv);
350 NONBLOCKING (r = virDomainGetMaxMemory (dom));
351 CHECK_ERROR (r == 0 /* [sic] */, "virDomainGetMaxMemory");
353 rv = caml_copy_int64 (r);
358 ocaml_libvirt_domain_set_max_memory (value domv, value memv)
360 CAMLparam2 (domv, memv);
361 virDomainPtr dom = Domain_val (domv);
362 unsigned long mem = Int64_val (memv);
365 NONBLOCKING (r = virDomainSetMaxMemory (dom, mem));
366 CHECK_ERROR (r == -1, "virDomainSetMaxMemory");
368 CAMLreturn (Val_unit);
372 ocaml_libvirt_domain_set_memory (value domv, value memv)
374 CAMLparam2 (domv, memv);
375 virDomainPtr dom = Domain_val (domv);
376 unsigned long mem = Int64_val (memv);
379 NONBLOCKING (r = virDomainSetMemory (dom, mem));
380 CHECK_ERROR (r == -1, "virDomainSetMemory");
382 CAMLreturn (Val_unit);
386 ocaml_libvirt_domain_get_info (value domv)
390 virDomainPtr dom = Domain_val (domv);
394 NONBLOCKING (r = virDomainGetInfo (dom, &info));
395 CHECK_ERROR (r == -1, "virDomainGetInfo");
397 rv = caml_alloc (5, 0);
398 Store_field (rv, 0, Val_int (info.state)); // These flags are compatible.
399 v = caml_copy_int64 (info.maxMem); Store_field (rv, 1, v);
400 v = caml_copy_int64 (info.memory); Store_field (rv, 2, v);
401 Store_field (rv, 3, Val_int (info.nrVirtCpu));
402 v = caml_copy_int64 (info.cpuTime); Store_field (rv, 4, v);
408 ocaml_libvirt_domain_get_scheduler_type (value domv)
411 CAMLlocal2 (rv, strv);
412 virDomainPtr dom = Domain_val (domv);
416 NONBLOCKING (r = virDomainGetSchedulerType (dom, &nparams));
417 CHECK_ERROR (!r, "virDomainGetSchedulerType");
419 rv = caml_alloc_tuple (2);
420 strv = caml_copy_string (r); Store_field (rv, 0, strv);
422 Store_field (rv, 1, nparams);
427 ocaml_libvirt_domain_get_scheduler_parameters (value domv, value nparamsv)
429 CAMLparam2 (domv, nparamsv);
430 CAMLlocal4 (rv, v, v2, v3);
431 virDomainPtr dom = Domain_val (domv);
432 int nparams = Int_val (nparamsv);
433 virSchedParameterPtr params;
436 params = malloc (sizeof (*params) * nparams);
438 caml_raise_out_of_memory ();
440 NONBLOCKING (r = virDomainGetSchedulerParameters (dom, params, &nparams));
441 CHECK_ERROR_CLEANUP (r == -1, free (params), "virDomainGetSchedulerParameters");
443 rv = caml_alloc (nparams, 0);
444 for (i = 0; i < nparams; ++i) {
445 v = caml_alloc_tuple (2); Store_field (rv, i, v);
446 v2 = caml_copy_string (params[i].field); Store_field (v, 0, v2);
447 switch (params[i].type) {
448 case VIR_DOMAIN_SCHED_FIELD_INT:
449 v2 = caml_alloc (1, 0);
450 v3 = caml_copy_int32 (params[i].value.i); Store_field (v2, 0, v3);
452 case VIR_DOMAIN_SCHED_FIELD_UINT:
453 v2 = caml_alloc (1, 1);
454 v3 = caml_copy_int32 (params[i].value.ui); Store_field (v2, 0, v3);
456 case VIR_DOMAIN_SCHED_FIELD_LLONG:
457 v2 = caml_alloc (1, 2);
458 v3 = caml_copy_int64 (params[i].value.l); Store_field (v2, 0, v3);
460 case VIR_DOMAIN_SCHED_FIELD_ULLONG:
461 v2 = caml_alloc (1, 3);
462 v3 = caml_copy_int64 (params[i].value.ul); Store_field (v2, 0, v3);
464 case VIR_DOMAIN_SCHED_FIELD_DOUBLE:
465 v2 = caml_alloc (1, 4);
466 v3 = caml_copy_double (params[i].value.d); Store_field (v2, 0, v3);
468 case VIR_DOMAIN_SCHED_FIELD_BOOLEAN:
469 v2 = caml_alloc (1, 5);
470 Store_field (v2, 0, Val_int (params[i].value.b));
473 caml_failwith ((char *)__FUNCTION__);
475 Store_field (v, 1, v2);
482 ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv)
484 CAMLparam2 (domv, paramsv);
486 virDomainPtr dom = Domain_val (domv);
487 int nparams = Wosize_val (paramsv);
488 virSchedParameterPtr params;
492 params = malloc (sizeof (*params) * nparams);
494 caml_raise_out_of_memory ();
496 for (i = 0; i < nparams; ++i) {
497 v = Field (paramsv, i); /* Points to the two-element tuple. */
498 name = String_val (Field (v, 0));
499 strncpy (params[i].field, name, VIR_DOMAIN_SCHED_FIELD_LENGTH);
500 params[i].field[VIR_DOMAIN_SCHED_FIELD_LENGTH-1] = '\0';
501 v = Field (v, 1); /* Points to the sched_param_value block. */
502 switch (Tag_val (v)) {
504 params[i].type = VIR_DOMAIN_SCHED_FIELD_INT;
505 params[i].value.i = Int32_val (Field (v, 0));
508 params[i].type = VIR_DOMAIN_SCHED_FIELD_UINT;
509 params[i].value.ui = Int32_val (Field (v, 0));
512 params[i].type = VIR_DOMAIN_SCHED_FIELD_LLONG;
513 params[i].value.l = Int64_val (Field (v, 0));
516 params[i].type = VIR_DOMAIN_SCHED_FIELD_ULLONG;
517 params[i].value.ul = Int64_val (Field (v, 0));
520 params[i].type = VIR_DOMAIN_SCHED_FIELD_DOUBLE;
521 params[i].value.d = Double_val (Field (v, 0));
524 params[i].type = VIR_DOMAIN_SCHED_FIELD_BOOLEAN;
525 params[i].value.b = Int_val (Field (v, 0));
528 caml_failwith ((char *)__FUNCTION__);
532 NONBLOCKING (r = virDomainSetSchedulerParameters (dom, params, nparams));
534 CHECK_ERROR (r == -1, "virDomainSetSchedulerParameters");
536 CAMLreturn (Val_unit);
540 ocaml_libvirt_domain_set_vcpus (value domv, value nvcpusv)
542 CAMLparam2 (domv, nvcpusv);
543 virDomainPtr dom = Domain_val (domv);
544 int r, nvcpus = Int_val (nvcpusv);
546 NONBLOCKING (r = virDomainSetVcpus (dom, nvcpus));
547 CHECK_ERROR (r == -1, "virDomainSetVcpus");
549 CAMLreturn (Val_unit);
553 ocaml_libvirt_domain_pin_vcpu (value domv, value vcpuv, value cpumapv)
555 CAMLparam3 (domv, vcpuv, cpumapv);
556 virDomainPtr dom = Domain_val (domv);
557 int maplen = caml_string_length (cpumapv);
558 unsigned char *cpumap = (unsigned char *) String_val (cpumapv);
559 int vcpu = Int_val (vcpuv);
562 NONBLOCKING (r = virDomainPinVcpu (dom, vcpu, cpumap, maplen));
563 CHECK_ERROR (r == -1, "virDomainPinVcpu");
565 CAMLreturn (Val_unit);
569 ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv)
571 CAMLparam3 (domv, maxinfov, maplenv);
572 CAMLlocal5 (rv, infov, strv, v, v2);
573 virDomainPtr dom = Domain_val (domv);
574 int maxinfo = Int_val (maxinfov);
575 int maplen = Int_val (maplenv);
577 unsigned char *cpumaps;
580 info = calloc (maxinfo, sizeof (*info));
582 caml_raise_out_of_memory ();
583 cpumaps = calloc (maxinfo * maplen, sizeof (*cpumaps));
584 if (cpumaps == NULL) {
586 caml_raise_out_of_memory ();
589 NONBLOCKING (r = virDomainGetVcpus (dom, info, maxinfo, cpumaps, maplen));
590 CHECK_ERROR_CLEANUP (r == -1, free (info); free (cpumaps), "virDomainPinVcpu");
592 /* Copy the virVcpuInfo structures. */
593 infov = caml_alloc (maxinfo, 0);
594 for (i = 0; i < maxinfo; ++i) {
595 v2 = caml_alloc (4, 0); Store_field (infov, i, v2);
596 Store_field (v2, 0, Val_int (info[i].number));
597 Store_field (v2, 1, Val_int (info[i].state));
598 v = caml_copy_int64 (info[i].cpuTime); Store_field (v2, 2, v);
599 Store_field (v2, 3, Val_int (info[i].cpu));
602 /* Copy the bitmap. */
603 strv = caml_alloc_string (maxinfo * maplen);
604 memcpy (String_val (strv), cpumaps, maxinfo * maplen);
606 /* Allocate the tuple and return it. */
607 rv = caml_alloc_tuple (3);
608 Store_field (rv, 0, Val_int (r)); /* number of CPUs. */
609 Store_field (rv, 1, infov);
610 Store_field (rv, 2, strv);
619 ocaml_libvirt_domain_get_cpu_stats (value domv)
622 CAMLlocal5 (cpustats, param_head, param_node, typed_param, typed_param_value);
624 virDomainPtr dom = Domain_val (domv);
625 virTypedParameterPtr params;
626 int r, cpu, ncpus, nparams, i, j, pos;
629 /* get number of pcpus */
630 NONBLOCKING (nr_pcpus = virDomainGetCPUStats(dom, NULL, 0, 0, 0, 0));
631 CHECK_ERROR (nr_pcpus < 0, "virDomainGetCPUStats");
633 /* get percpu information */
634 NONBLOCKING (nparams = virDomainGetCPUStats(dom, NULL, 0, 0, 1, 0));
635 CHECK_ERROR (nparams < 0, "virDomainGetCPUStats");
637 if ((params = malloc(sizeof(*params) * nparams * 128)) == NULL)
638 caml_failwith ("virDomainGetCPUStats: malloc");
640 cpustats = caml_alloc (nr_pcpus, 0); /* cpustats: array of params(list of typed_param) */
642 while (cpu < nr_pcpus) {
643 ncpus = nr_pcpus - cpu > 128 ? 128 : nr_pcpus - cpu;
645 NONBLOCKING (r = virDomainGetCPUStats(dom, params, nparams, cpu, ncpus, 0));
646 CHECK_ERROR (r < 0, "virDomainGetCPUStats");
648 for (i = 0; i < ncpus; i++) {
649 /* list of typed_param: single linked list of param_nodes */
650 param_head = Val_emptylist; /* param_head: the head param_node of list of typed_param */
652 if (params[i * nparams].type == 0) {
653 Store_field(cpustats, cpu + i, param_head);
657 for (j = r - 1; j >= 0; j--) {
658 pos = i * nparams + j;
659 if (params[pos].type == 0)
662 param_node = caml_alloc(2, 0); /* param_node: typed_param, next param_node */
663 Store_field(param_node, 1, param_head);
664 param_head = param_node;
666 typed_param = caml_alloc(2, 0); /* typed_param: field name(string), typed_param_value */
667 Store_field(param_node, 0, typed_param);
668 Store_field(typed_param, 0, caml_copy_string(params[pos].field));
670 /* typed_param_value: value with the corresponding type tag */
671 switch(params[pos].type) {
672 case VIR_TYPED_PARAM_INT:
673 typed_param_value = caml_alloc (1, 0);
674 v = caml_copy_int32 (params[pos].value.i);
676 case VIR_TYPED_PARAM_UINT:
677 typed_param_value = caml_alloc (1, 1);
678 v = caml_copy_int32 (params[pos].value.ui);
680 case VIR_TYPED_PARAM_LLONG:
681 typed_param_value = caml_alloc (1, 2);
682 v = caml_copy_int64 (params[pos].value.l);
684 case VIR_TYPED_PARAM_ULLONG:
685 typed_param_value = caml_alloc (1, 3);
686 v = caml_copy_int64 (params[pos].value.ul);
688 case VIR_TYPED_PARAM_DOUBLE:
689 typed_param_value = caml_alloc (1, 4);
690 v = caml_copy_double (params[pos].value.d);
692 case VIR_TYPED_PARAM_BOOLEAN:
693 typed_param_value = caml_alloc (1, 5);
694 v = Val_bool (params[pos].value.b);
696 case VIR_TYPED_PARAM_STRING:
697 typed_param_value = caml_alloc (1, 6);
698 v = caml_copy_string (params[pos].value.s);
699 free (params[pos].value.s);
702 /* XXX Memory leak on this path, if there are more
703 * VIR_TYPED_PARAM_STRING past this point in the array.
706 caml_failwith ("virDomainGetCPUStats: "
707 "unknown parameter type returned");
709 Store_field (typed_param_value, 0, v);
710 Store_field (typed_param, 1, typed_param_value);
712 Store_field (cpustats, cpu + i, param_head);
717 CAMLreturn (cpustats);
721 ocaml_libvirt_domain_get_all_domain_stats (value connv,
722 value statsv, value flagsv)
724 CAMLparam3 (connv, statsv, flagsv);
725 CAMLlocal5 (rv, dsv, tpv, v, v1);
727 virConnectPtr conn = Connect_val (connv);
728 virDomainStatsRecordPtr *rstats;
729 unsigned int stats = 0, flags = 0;
731 unsigned char uuid[VIR_UUID_BUFLEN];
733 /* Get stats and flags. */
734 for (; statsv != Val_int (0); statsv = Field (statsv, 1)) {
735 v = Field (statsv, 0);
736 if (v == Val_int (0))
737 stats |= VIR_DOMAIN_STATS_STATE;
738 else if (v == Val_int (1))
739 stats |= VIR_DOMAIN_STATS_CPU_TOTAL;
740 else if (v == Val_int (2))
741 stats |= VIR_DOMAIN_STATS_BALLOON;
742 else if (v == Val_int (3))
743 stats |= VIR_DOMAIN_STATS_VCPU;
744 else if (v == Val_int (4))
745 stats |= VIR_DOMAIN_STATS_INTERFACE;
746 else if (v == Val_int (5))
747 stats |= VIR_DOMAIN_STATS_BLOCK;
748 else if (v == Val_int (6))
749 stats |= VIR_DOMAIN_STATS_PERF;
751 for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1)) {
752 v = Field (flagsv, 0);
753 if (v == Val_int (0))
754 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_ACTIVE;
755 else if (v == Val_int (1))
756 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_INACTIVE;
757 else if (v == Val_int (2))
758 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_OTHER;
759 else if (v == Val_int (3))
760 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_PAUSED;
761 else if (v == Val_int (4))
762 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_PERSISTENT;
763 else if (v == Val_int (5))
764 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_RUNNING;
765 else if (v == Val_int (6))
766 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_SHUTOFF;
767 else if (v == Val_int (7))
768 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_TRANSIENT;
769 else if (v == Val_int (8))
770 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_BACKING;
771 else if (v == Val_int (9))
772 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_ENFORCE_STATS;
775 NONBLOCKING (r = virConnectGetAllDomainStats (conn, stats, &rstats, flags));
776 CHECK_ERROR (r == -1, "virConnectGetAllDomainStats");
778 rv = caml_alloc (r, 0); /* domain_stats_record array. */
779 for (i = 0; i < r; ++i) {
780 dsv = caml_alloc (2, 0); /* domain_stats_record */
782 /* Libvirt returns something superficially resembling a
783 * virDomainPtr, but it's not a real virDomainPtr object
784 * (eg. dom->id == -1, and its refcount is wrong). The only thing
785 * we can safely get from it is the UUID.
787 v = caml_alloc_string (VIR_UUID_BUFLEN);
788 virDomainGetUUID (rstats[i]->dom, uuid);
789 memcpy (String_val (v), uuid, VIR_UUID_BUFLEN);
790 Store_field (dsv, 0, v);
792 tpv = caml_alloc (rstats[i]->nparams, 0); /* typed_param array */
793 for (j = 0; j < rstats[i]->nparams; ++j) {
794 v2 = caml_alloc (2, 0); /* typed_param: field name, value */
795 Store_field (v2, 0, caml_copy_string (rstats[i]->params[j].field));
797 switch (rstats[i]->params[j].type) {
798 case VIR_TYPED_PARAM_INT:
799 v1 = caml_alloc (1, 0);
800 v = caml_copy_int32 (rstats[i]->params[j].value.i);
802 case VIR_TYPED_PARAM_UINT:
803 v1 = caml_alloc (1, 1);
804 v = caml_copy_int32 (rstats[i]->params[j].value.ui);
806 case VIR_TYPED_PARAM_LLONG:
807 v1 = caml_alloc (1, 2);
808 v = caml_copy_int64 (rstats[i]->params[j].value.l);
810 case VIR_TYPED_PARAM_ULLONG:
811 v1 = caml_alloc (1, 3);
812 v = caml_copy_int64 (rstats[i]->params[j].value.ul);
814 case VIR_TYPED_PARAM_DOUBLE:
815 v1 = caml_alloc (1, 4);
816 v = caml_copy_double (rstats[i]->params[j].value.d);
818 case VIR_TYPED_PARAM_BOOLEAN:
819 v1 = caml_alloc (1, 5);
820 v = Val_bool (rstats[i]->params[j].value.b);
822 case VIR_TYPED_PARAM_STRING:
823 v1 = caml_alloc (1, 6);
824 v = caml_copy_string (rstats[i]->params[j].value.s);
827 virDomainStatsRecordListFree (rstats);
828 caml_failwith ("virConnectGetAllDomainStats: "
829 "unknown parameter type returned");
831 Store_field (v1, 0, v);
833 Store_field (v2, 1, v1);
834 Store_field (tpv, j, v2);
837 Store_field (dsv, 1, tpv);
838 Store_field (rv, i, dsv);
841 virDomainStatsRecordListFree (rstats);
846 ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, value optdnamev, value opturiv, value optbandwidthv, value unitv)
848 CAMLparam5 (domv, dconnv, flagsv, optdnamev, opturiv);
849 CAMLxparam2 (optbandwidthv, unitv);
850 CAMLlocal2 (flagv, rv);
851 virDomainPtr dom = Domain_val (domv);
852 virConnectPtr dconn = Connect_val (dconnv);
854 const char *dname = Optstring_val (optdnamev);
855 const char *uri = Optstring_val (opturiv);
856 unsigned long bandwidth;
859 /* Iterate over the list of flags. */
860 for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
862 flagv = Field (flagsv, 0);
863 if (flagv == Val_int (0))
864 flags |= VIR_MIGRATE_LIVE;
867 if (optbandwidthv == Val_int (0)) /* None */
869 else /* Some bandwidth */
870 bandwidth = Int_val (Field (optbandwidthv, 0));
872 NONBLOCKING (r = virDomainMigrate (dom, dconn, flags, dname, uri, bandwidth));
873 CHECK_ERROR (!r, "virDomainMigrate");
875 rv = Val_domain (r, dconnv);
881 ocaml_libvirt_domain_migrate_bytecode (value *argv, int argn)
883 return ocaml_libvirt_domain_migrate_native (argv[0], argv[1], argv[2],
884 argv[3], argv[4], argv[5],
889 ocaml_libvirt_domain_block_stats (value domv, value pathv)
891 CAMLparam2 (domv, pathv);
893 virDomainPtr dom = Domain_val (domv);
894 char *path = String_val (pathv);
895 struct _virDomainBlockStats stats;
898 NONBLOCKING (r = virDomainBlockStats (dom, path, &stats, sizeof stats));
899 CHECK_ERROR (r == -1, "virDomainBlockStats");
901 rv = caml_alloc (5, 0);
902 v = caml_copy_int64 (stats.rd_req); Store_field (rv, 0, v);
903 v = caml_copy_int64 (stats.rd_bytes); Store_field (rv, 1, v);
904 v = caml_copy_int64 (stats.wr_req); Store_field (rv, 2, v);
905 v = caml_copy_int64 (stats.wr_bytes); Store_field (rv, 3, v);
906 v = caml_copy_int64 (stats.errs); Store_field (rv, 4, v);
912 ocaml_libvirt_domain_interface_stats (value domv, value pathv)
914 CAMLparam2 (domv, pathv);
916 virDomainPtr dom = Domain_val (domv);
917 char *path = String_val (pathv);
918 struct _virDomainInterfaceStats stats;
921 NONBLOCKING (r = virDomainInterfaceStats (dom, path, &stats, sizeof stats));
922 CHECK_ERROR (r == -1, "virDomainInterfaceStats");
924 rv = caml_alloc (8, 0);
925 v = caml_copy_int64 (stats.rx_bytes); Store_field (rv, 0, v);
926 v = caml_copy_int64 (stats.rx_packets); Store_field (rv, 1, v);
927 v = caml_copy_int64 (stats.rx_errs); Store_field (rv, 2, v);
928 v = caml_copy_int64 (stats.rx_drop); Store_field (rv, 3, v);
929 v = caml_copy_int64 (stats.tx_bytes); Store_field (rv, 4, v);
930 v = caml_copy_int64 (stats.tx_packets); Store_field (rv, 5, v);
931 v = caml_copy_int64 (stats.tx_errs); Store_field (rv, 6, v);
932 v = caml_copy_int64 (stats.tx_drop); Store_field (rv, 7, v);
938 ocaml_libvirt_domain_block_peek_native (value domv, value pathv, value offsetv, value sizev, value bufferv, value boffv)
940 CAMLparam5 (domv, pathv, offsetv, sizev, bufferv);
942 virDomainPtr dom = Domain_val (domv);
943 const char *path = String_val (pathv);
944 unsigned long long offset = Int64_val (offsetv);
945 size_t size = Int_val (sizev);
946 char *buffer = String_val (bufferv);
947 int boff = Int_val (boffv);
950 /* Check that the return buffer is big enough. */
951 if (caml_string_length (bufferv) < boff + size)
952 caml_failwith ("virDomainBlockPeek: return buffer too short");
954 /* NB. not NONBLOCKING because buffer might move (XXX) */
955 r = virDomainBlockPeek (dom, path, offset, size, buffer+boff, 0);
956 CHECK_ERROR (r == -1, "virDomainBlockPeek");
958 CAMLreturn (Val_unit);
962 ocaml_libvirt_domain_block_peek_bytecode (value *argv, int argn)
964 return ocaml_libvirt_domain_block_peek_native (argv[0], argv[1], argv[2],
965 argv[3], argv[4], argv[5]);
969 ocaml_libvirt_domain_memory_peek_native (value domv, value flagsv, value offsetv, value sizev, value bufferv, value boffv)
971 CAMLparam5 (domv, flagsv, offsetv, sizev, bufferv);
974 virDomainPtr dom = Domain_val (domv);
976 unsigned long long offset = Int64_val (offsetv);
977 size_t size = Int_val (sizev);
978 char *buffer = String_val (bufferv);
979 int boff = Int_val (boffv);
982 /* Check that the return buffer is big enough. */
983 if (caml_string_length (bufferv) < boff + size)
984 caml_failwith ("virDomainMemoryPeek: return buffer too short");
987 for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
989 flagv = Field (flagsv, 0);
990 if (flagv == Val_int (0))
991 flags |= VIR_MEMORY_VIRTUAL;
994 /* NB. not NONBLOCKING because buffer might move (XXX) */
995 r = virDomainMemoryPeek (dom, offset, size, buffer+boff, flags);
996 CHECK_ERROR (r == -1, "virDomainMemoryPeek");
998 CAMLreturn (Val_unit);
1002 ocaml_libvirt_domain_memory_peek_bytecode (value *argv, int argn)
1004 return ocaml_libvirt_domain_memory_peek_native (argv[0], argv[1], argv[2],
1005 argv[3], argv[4], argv[5]);
1009 ocaml_libvirt_domain_get_xml_desc_flags (value domv, value flagsv)
1011 CAMLparam2 (domv, flagsv);
1012 CAMLlocal2 (rv, flagv);
1013 virDomainPtr dom = Domain_val (domv);
1018 for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
1020 flagv = Field (flagsv, 0);
1021 if (flagv == Val_int (0))
1022 flags |= VIR_DOMAIN_XML_SECURE;
1023 else if (flagv == Val_int (1))
1024 flags |= VIR_DOMAIN_XML_INACTIVE;
1025 else if (flagv == Val_int (2))
1026 flags |= VIR_DOMAIN_XML_UPDATE_CPU;
1027 else if (flagv == Val_int (3))
1028 flags |= VIR_DOMAIN_XML_MIGRATABLE;
1031 NONBLOCKING (r = virDomainGetXMLDesc (dom, flags));
1032 CHECK_ERROR (!r, "virDomainGetXMLDesc");
1034 rv = caml_copy_string (r);
1039 /*----------------------------------------------------------------------*/
1044 ocaml_libvirt_event_register_default_impl (value unitv)
1048 /* arg is of type unit = void */
1051 NONBLOCKING (r = virEventRegisterDefaultImpl ());
1052 /* must be called before connection, therefore we can't use CHECK_ERROR */
1053 if (r == -1) caml_failwith("virEventRegisterDefaultImpl");
1055 CAMLreturn (Val_unit);
1059 ocaml_libvirt_event_run_default_impl (value unitv)
1063 /* arg is of type unit = void */
1066 NONBLOCKING (r = virEventRunDefaultImpl ());
1067 if (r == -1) caml_failwith("virEventRunDefaultImpl");
1069 CAMLreturn (Val_unit);
1072 /* We register a single C callback function for every distinct
1073 callback signature. We encode the signature itself in the function
1074 name and also in the name of the assocated OCaml callback
1077 i_i64_s_callback(virConnectPtr conn,
1083 would correspond to an OCaml callback
1084 Libvirt.i_i64_s_callback :
1085 int64 -> [`R] Domain.t -> int -> int64 -> string option -> unit
1086 where the initial int64 is a unique ID used by the OCaml to
1087 dispatch to the specific OCaml closure and stored by libvirt
1088 as the "opaque" data. */
1090 /* Every one of the callbacks starts with a DOMAIN_CALLBACK_BEGIN(NAME)
1091 where NAME is the string name of the OCaml callback registered
1093 #define DOMAIN_CALLBACK_BEGIN(NAME) \
1094 value connv, domv, callback_id, result; \
1095 connv = domv = callback_id = result = Val_int(0); \
1096 static value *callback = NULL; \
1097 caml_leave_blocking_section(); \
1098 if (callback == NULL) \
1099 callback = caml_named_value(NAME); \
1100 if (callback == NULL) \
1101 abort(); /* C code out of sync with OCaml code */ \
1102 if ((virDomainRef(dom) == -1) || (virConnectRef(conn) == -1)) \
1103 abort(); /* should never happen in practice? */ \
1105 Begin_roots4(connv, domv, callback_id, result); \
1106 connv = Val_connect(conn); \
1107 domv = Val_domain(dom, connv); \
1108 callback_id = caml_copy_int64(*(long *)opaque);
1110 /* Every one of the callbacks ends with a CALLBACK_END */
1111 #define DOMAIN_CALLBACK_END \
1112 (void) caml_callback3(*callback, callback_id, domv, result); \
1114 caml_enter_blocking_section();
1118 i_i_callback(virConnectPtr conn,
1124 DOMAIN_CALLBACK_BEGIN("Libvirt.i_i_callback")
1125 result = caml_alloc_tuple(2);
1126 Store_field(result, 0, Val_int(x));
1127 Store_field(result, 1, Val_int(y));
1132 u_callback(virConnectPtr conn,
1136 DOMAIN_CALLBACK_BEGIN("Libvirt.u_callback")
1137 result = Val_int(0); /* () */
1142 i64_callback(virConnectPtr conn,
1147 DOMAIN_CALLBACK_BEGIN("Libvirt.i64_callback")
1148 result = caml_copy_int64(int64);
1153 i_callback(virConnectPtr conn,
1158 DOMAIN_CALLBACK_BEGIN("Libvirt.i_callback")
1159 result = Val_int(x);
1164 s_i_callback(virConnectPtr conn,
1170 DOMAIN_CALLBACK_BEGIN("Libvirt.s_i_callback")
1171 result = caml_alloc_tuple(2);
1172 Store_field(result, 0,
1173 Val_opt(x, (Val_ptr_t) caml_copy_string));
1174 Store_field(result, 1, Val_int(y));
1179 s_i_i_callback(virConnectPtr conn,
1186 DOMAIN_CALLBACK_BEGIN("Libvirt.s_i_i_callback")
1187 result = caml_alloc_tuple(3);
1188 Store_field(result, 0,
1189 Val_opt(x, (Val_ptr_t) caml_copy_string));
1190 Store_field(result, 1, Val_int(y));
1191 Store_field(result, 2, Val_int(z));
1196 s_s_i_callback(virConnectPtr conn,
1203 DOMAIN_CALLBACK_BEGIN("Libvirt.s_s_i_callback")
1204 result = caml_alloc_tuple(3);
1205 Store_field(result, 0,
1206 Val_opt(x, (Val_ptr_t) caml_copy_string));
1207 Store_field(result, 1,
1208 Val_opt(y, (Val_ptr_t) caml_copy_string));
1209 Store_field(result, 2, Val_int(z));
1214 s_s_i_s_callback(virConnectPtr conn,
1222 DOMAIN_CALLBACK_BEGIN("Libvirt.s_s_i_s_callback")
1223 result = caml_alloc_tuple(4);
1224 Store_field(result, 0,
1225 Val_opt(x, (Val_ptr_t) caml_copy_string));
1226 Store_field(result, 1,
1227 Val_opt(y, (Val_ptr_t) caml_copy_string));
1228 Store_field(result, 2, Val_int(z));
1229 Store_field(result, 3,
1230 Val_opt(a, (Val_ptr_t) caml_copy_string));
1235 s_s_s_i_callback(virConnectPtr conn,
1243 DOMAIN_CALLBACK_BEGIN("Libvirt.s_s_s_i_callback")
1244 result = caml_alloc_tuple(4);
1245 Store_field(result, 0,
1246 Val_opt(x, (Val_ptr_t) caml_copy_string));
1247 Store_field(result, 1,
1248 Val_opt(y, (Val_ptr_t) caml_copy_string));
1249 Store_field(result, 2,
1250 Val_opt(z, (Val_ptr_t) caml_copy_string));
1251 Store_field(result, 3, Val_int(a));
1256 Val_event_graphics_address(virDomainEventGraphicsAddressPtr x)
1260 result = caml_alloc_tuple(3);
1261 Store_field(result, 0, Val_int(x->family));
1262 Store_field(result, 1,
1263 Val_opt((void *) x->node, (Val_ptr_t) caml_copy_string));
1264 Store_field(result, 2,
1265 Val_opt((void *) x->service, (Val_ptr_t) caml_copy_string));
1270 Val_event_graphics_subject_identity(virDomainEventGraphicsSubjectIdentityPtr x)
1274 result = caml_alloc_tuple(2);
1275 Store_field(result, 0,
1276 Val_opt((void *) x->type, (Val_ptr_t) caml_copy_string));
1277 Store_field(result, 1,
1278 Val_opt((void *) x->name, (Val_ptr_t) caml_copy_string));
1284 Val_event_graphics_subject(virDomainEventGraphicsSubjectPtr x)
1289 result = caml_alloc_tuple(x->nidentity);
1290 for (i = 0; i < x->nidentity; i++ )
1291 Store_field(result, i,
1292 Val_event_graphics_subject_identity(x->identities + i));
1297 i_ga_ga_s_gs_callback(virConnectPtr conn,
1300 virDomainEventGraphicsAddressPtr ga1,
1301 virDomainEventGraphicsAddressPtr ga2,
1303 virDomainEventGraphicsSubjectPtr gs1,
1306 DOMAIN_CALLBACK_BEGIN("Libvirt.i_ga_ga_s_gs_callback")
1307 result = caml_alloc_tuple(5);
1308 Store_field(result, 0, Val_int(i1));
1309 Store_field(result, 1, Val_event_graphics_address(ga1));
1310 Store_field(result, 2, Val_event_graphics_address(ga2));
1311 Store_field(result, 3,
1312 Val_opt(s1, (Val_ptr_t) caml_copy_string));
1313 Store_field(result, 4, Val_event_graphics_subject(gs1));
1318 timeout_callback(int timer, void *opaque)
1320 value callback_id, result;
1321 callback_id = result = Val_int(0);
1322 static value *callback = NULL;
1323 caml_leave_blocking_section();
1324 if (callback == NULL)
1325 callback = caml_named_value("Libvirt.timeout_callback");
1326 if (callback == NULL)
1327 abort(); /* C code out of sync with OCaml code */
1329 Begin_roots2(callback_id, result);
1330 callback_id = caml_copy_int64(*(long *)opaque);
1332 (void)caml_callback_exn(*callback, callback_id);
1334 caml_enter_blocking_section();
1338 ocaml_libvirt_event_add_timeout (value connv, value ms, value callback_id)
1340 CAMLparam3 (connv, ms, callback_id);
1342 virFreeCallback freecb = free;
1343 virEventTimeoutCallback cb = timeout_callback;
1347 /* Store the int64 callback_id as the opaque data so the OCaml
1348 callback can demultiplex to the correct OCaml handler. */
1349 if ((opaque = malloc(sizeof(long))) == NULL)
1350 caml_failwith ("virEventAddTimeout: malloc");
1351 *((long*)opaque) = Int64_val(callback_id);
1352 NONBLOCKING(r = virEventAddTimeout(Int_val(ms), cb, opaque, freecb));
1353 CHECK_ERROR(r == -1, "virEventAddTimeout");
1355 CAMLreturn(Val_int(r));
1359 ocaml_libvirt_event_remove_timeout (value connv, value timer_id)
1361 CAMLparam2 (connv, timer_id);
1364 NONBLOCKING(r = virEventRemoveTimeout(Int_val(timer_id)));
1365 CHECK_ERROR(r == -1, "virEventRemoveTimeout");
1367 CAMLreturn(Val_int(r));
1371 ocaml_libvirt_connect_domain_event_register_any(value connv, value domv, value callback, value callback_id)
1373 CAMLparam4(connv, domv, callback, callback_id);
1375 virConnectPtr conn = Connect_val (connv);
1376 virDomainPtr dom = NULL;
1377 int eventID = Tag_val(callback);
1379 virConnectDomainEventGenericCallback cb;
1381 virFreeCallback freecb = free;
1384 if (domv != Val_int(0))
1385 dom = Domain_val (Field(domv, 0));
1388 case VIR_DOMAIN_EVENT_ID_LIFECYCLE:
1389 cb = VIR_DOMAIN_EVENT_CALLBACK(i_i_callback);
1391 case VIR_DOMAIN_EVENT_ID_REBOOT:
1392 cb = VIR_DOMAIN_EVENT_CALLBACK(u_callback);
1394 case VIR_DOMAIN_EVENT_ID_RTC_CHANGE:
1395 cb = VIR_DOMAIN_EVENT_CALLBACK(i64_callback);
1397 case VIR_DOMAIN_EVENT_ID_WATCHDOG:
1398 cb = VIR_DOMAIN_EVENT_CALLBACK(i_callback);
1400 case VIR_DOMAIN_EVENT_ID_IO_ERROR:
1401 cb = VIR_DOMAIN_EVENT_CALLBACK(s_s_i_callback);
1403 case VIR_DOMAIN_EVENT_ID_GRAPHICS:
1404 cb = VIR_DOMAIN_EVENT_CALLBACK(i_ga_ga_s_gs_callback);
1406 case VIR_DOMAIN_EVENT_ID_IO_ERROR_REASON:
1407 cb = VIR_DOMAIN_EVENT_CALLBACK(s_s_i_s_callback);
1409 case VIR_DOMAIN_EVENT_ID_CONTROL_ERROR:
1410 cb = VIR_DOMAIN_EVENT_CALLBACK(u_callback);
1412 case VIR_DOMAIN_EVENT_ID_BLOCK_JOB:
1413 cb = VIR_DOMAIN_EVENT_CALLBACK(s_i_i_callback);
1415 case VIR_DOMAIN_EVENT_ID_DISK_CHANGE:
1416 cb = VIR_DOMAIN_EVENT_CALLBACK(s_s_s_i_callback);
1418 case VIR_DOMAIN_EVENT_ID_TRAY_CHANGE:
1419 cb = VIR_DOMAIN_EVENT_CALLBACK(s_i_callback);
1421 case VIR_DOMAIN_EVENT_ID_PMWAKEUP:
1422 cb = VIR_DOMAIN_EVENT_CALLBACK(i_callback);
1424 case VIR_DOMAIN_EVENT_ID_PMSUSPEND:
1425 cb = VIR_DOMAIN_EVENT_CALLBACK(i_callback);
1427 case VIR_DOMAIN_EVENT_ID_BALLOON_CHANGE:
1428 cb = VIR_DOMAIN_EVENT_CALLBACK(i64_callback);
1430 case VIR_DOMAIN_EVENT_ID_PMSUSPEND_DISK:
1431 cb = VIR_DOMAIN_EVENT_CALLBACK(i_callback);
1434 caml_failwith("vifConnectDomainEventRegisterAny: unimplemented eventID");
1437 /* Store the int64 callback_id as the opaque data so the OCaml
1438 callback can demultiplex to the correct OCaml handler. */
1439 if ((opaque = malloc(sizeof(long))) == NULL)
1440 caml_failwith ("virConnectDomainEventRegisterAny: malloc");
1441 *((long*)opaque) = Int64_val(callback_id);
1442 NONBLOCKING(r = virConnectDomainEventRegisterAny(conn, dom, eventID, cb, opaque, freecb));
1443 CHECK_ERROR(r == -1, "virConnectDomainEventRegisterAny");
1445 CAMLreturn(Val_int(r));
1449 ocaml_libvirt_storage_pool_get_info (value poolv)
1453 virStoragePoolPtr pool = Pool_val (poolv);
1454 virStoragePoolInfo info;
1457 NONBLOCKING (r = virStoragePoolGetInfo (pool, &info));
1458 CHECK_ERROR (r == -1, "virStoragePoolGetInfo");
1460 rv = caml_alloc (4, 0);
1461 Store_field (rv, 0, Val_int (info.state));
1462 v = caml_copy_int64 (info.capacity); Store_field (rv, 1, v);
1463 v = caml_copy_int64 (info.allocation); Store_field (rv, 2, v);
1464 v = caml_copy_int64 (info.available); Store_field (rv, 3, v);
1470 ocaml_libvirt_storage_vol_get_info (value volv)
1474 virStorageVolPtr vol = Volume_val (volv);
1475 virStorageVolInfo info;
1478 NONBLOCKING (r = virStorageVolGetInfo (vol, &info));
1479 CHECK_ERROR (r == -1, "virStorageVolGetInfo");
1481 rv = caml_alloc (3, 0);
1482 Store_field (rv, 0, Val_int (info.type));
1483 v = caml_copy_int64 (info.capacity); Store_field (rv, 1, v);
1484 v = caml_copy_int64 (info.allocation); Store_field (rv, 2, v);
1489 /*----------------------------------------------------------------------*/
1492 ocaml_libvirt_virterror_get_last_error (value unitv)
1496 virErrorPtr err = virGetLastError ();
1498 rv = Val_opt (err, (Val_ptr_t) Val_virterror);
1504 ocaml_libvirt_virterror_get_last_conn_error (value connv)
1508 virConnectPtr conn = Connect_val (connv);
1510 rv = Val_opt (conn, (Val_ptr_t) Val_connect);
1516 ocaml_libvirt_virterror_reset_last_error (value unitv)
1519 virResetLastError ();
1520 CAMLreturn (Val_unit);
1524 ocaml_libvirt_virterror_reset_last_conn_error (value connv)
1527 virConnectPtr conn = Connect_val (connv);
1528 virConnResetLastError (conn);
1529 CAMLreturn (Val_unit);
1532 /*----------------------------------------------------------------------*/
1535 ignore_errors (void *user_data, virErrorPtr error)
1540 /* Initialise the library. */
1542 ocaml_libvirt_init (value unit)
1546 virSetErrorFunc (NULL, ignore_errors);
1549 CAMLreturn (Val_unit);