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. */
22 /*----------------------------------------------------------------------*/
25 ocaml_libvirt_get_version (value driverv, value unit)
27 CAMLparam2 (driverv, unit);
29 const char *driver = Optstring_val (driverv);
30 unsigned long libVer, typeVer = 0, *typeVer_ptr;
33 typeVer_ptr = driver ? &typeVer : NULL;
34 NONBLOCKING (r = virGetVersion (&libVer, driver, typeVer_ptr));
35 CHECK_ERROR (r == -1, "virGetVersion");
37 rv = caml_alloc_tuple (2);
38 Store_field (rv, 0, Val_int (libVer));
39 Store_field (rv, 1, Val_int (typeVer));
43 /*----------------------------------------------------------------------*/
45 /* Connection object. */
48 ocaml_libvirt_connect_open (value namev, value unit)
50 CAMLparam2 (namev, unit);
52 const char *name = Optstring_val (namev);
55 NONBLOCKING (conn = virConnectOpen (name));
56 CHECK_ERROR (!conn, "virConnectOpen");
58 rv = Val_connect (conn);
64 ocaml_libvirt_connect_open_readonly (value namev, value unit)
66 CAMLparam2 (namev, unit);
68 const char *name = Optstring_val (namev);
71 NONBLOCKING (conn = virConnectOpenReadOnly (name));
72 CHECK_ERROR (!conn, "virConnectOpen");
74 rv = Val_connect (conn);
79 /* Helper struct holding data needed for the helper C authentication
80 * callback (which will call the actual OCaml callback).
82 struct ocaml_auth_callback_data {
83 value *fvp; /* The OCaml auth callback. */
87 _ocaml_auth_callback (virConnectCredentialPtr cred, unsigned int ncred, void *cbdata)
90 CAMLlocal4 (listv, elemv, rv, v);
91 struct ocaml_auth_callback_data *s = cbdata;
94 listv = Val_emptylist;
95 for (i = ncred - 1; i >= 0; --i) {
96 elemv = caml_alloc (2, 0);
97 Store_field (elemv, 0, Val_virconnectcredential (&cred[i]));
98 Store_field (elemv, 1, listv);
102 /* Call the auth callback. */
103 rv = caml_callback_exn (*s->fvp, listv);
104 if (Is_exception_result (rv)) {
105 /* The callback raised an exception, so return an error. */
106 CAMLreturnT (int, -1);
109 len = _list_length (rv);
110 if (len != (int) ncred) {
111 /* The callback did not return the same number of results as the
114 CAMLreturnT (int, -1);
117 for (i = 0; rv != Val_emptylist; rv = Field (rv, 1), ++i) {
118 virConnectCredentialPtr c = &cred[i];
119 elemv = Field (rv, 0);
120 if (elemv == Val_int (0)) {
124 v = Field (elemv, 0);
125 len = caml_string_length (v);
126 c->result = malloc (len + 1);
127 if (c->result == NULL)
128 CAMLreturnT (int, -1);
129 memcpy (c->result, String_val (v), len);
130 c->result[len] = '\0';
135 CAMLreturnT (int, 0);
139 _ocaml_libvirt_connect_open_auth_common (value namev, value authv, int flags)
141 CAMLparam2 (namev, authv);
142 CAMLlocal2 (listv, fv);
145 struct ocaml_auth_callback_data data;
149 /* Keep a copy of the 'namev' string, as its value could move around
150 * when calling other OCaml code that allocates memory.
152 if (namev != Val_int (0)) { /* Some string */
153 name = strdup (String_val (Field (namev, 0)));
155 caml_raise_out_of_memory ();
158 fv = Field (authv, 1);
161 listv = Field (authv, 0);
162 auth.ncredtype = _list_length (listv);
163 auth.credtype = malloc (sizeof (int) * auth.ncredtype);
164 if (auth.credtype == NULL)
165 caml_raise_out_of_memory ();
166 for (i = 0; listv != Val_emptylist; listv = Field (listv, 1), ++i) {
167 auth.credtype[i] = Int_val (Field (listv, 0)) + 1;
169 auth.cb = &_ocaml_auth_callback;
172 /* Call virConnectOpenAuth directly, without using the NONBLOCKING
173 * macro, as this will indeed call ocaml_* APIs, and run OCaml code.
175 conn = virConnectOpenAuth (name, &auth, flags);
176 free (auth.credtype);
178 CHECK_ERROR (!conn, "virConnectOpenAuth");
180 CAMLreturnT (virConnectPtr, conn);
184 ocaml_libvirt_connect_open_auth (value namev, value authv)
186 CAMLparam2 (namev, authv);
190 conn = _ocaml_libvirt_connect_open_auth_common (namev, authv, 0);
191 rv = Val_connect (conn);
197 ocaml_libvirt_connect_open_auth_readonly (value namev, value authv)
199 CAMLparam2 (namev, authv);
203 conn = _ocaml_libvirt_connect_open_auth_common (namev, authv, VIR_CONNECT_RO);
204 rv = Val_connect (conn);
210 ocaml_libvirt_connect_get_version (value connv)
213 virConnectPtr conn = Connect_val (connv);
217 NONBLOCKING (r = virConnectGetVersion (conn, &hvVer));
218 CHECK_ERROR (r == -1, "virConnectGetVersion");
220 CAMLreturn (Val_int (hvVer));
224 ocaml_libvirt_connect_get_max_vcpus (value connv, value typev)
226 CAMLparam2 (connv, typev);
227 virConnectPtr conn = Connect_val (connv);
228 const char *type = Optstring_val (typev);
231 NONBLOCKING (r = virConnectGetMaxVcpus (conn, type));
232 CHECK_ERROR (r == -1, "virConnectGetMaxVcpus");
234 CAMLreturn (Val_int (r));
238 ocaml_libvirt_connect_get_node_info (value connv)
242 virConnectPtr conn = Connect_val (connv);
246 NONBLOCKING (r = virNodeGetInfo (conn, &info));
247 CHECK_ERROR (r == -1, "virNodeGetInfo");
249 rv = caml_alloc (8, 0);
250 v = caml_copy_string (info.model); Store_field (rv, 0, v);
251 v = caml_copy_int64 (info.memory); Store_field (rv, 1, v);
252 Store_field (rv, 2, Val_int (info.cpus));
253 Store_field (rv, 3, Val_int (info.mhz));
254 Store_field (rv, 4, Val_int (info.nodes));
255 Store_field (rv, 5, Val_int (info.sockets));
256 Store_field (rv, 6, Val_int (info.cores));
257 Store_field (rv, 7, Val_int (info.threads));
263 ocaml_libvirt_connect_node_get_free_memory (value connv)
267 virConnectPtr conn = Connect_val (connv);
268 unsigned long long r;
270 NONBLOCKING (r = virNodeGetFreeMemory (conn));
271 CHECK_ERROR (r == 0, "virNodeGetFreeMemory");
273 rv = caml_copy_int64 ((int64_t) r);
278 ocaml_libvirt_connect_node_get_cells_free_memory (value connv,
279 value startv, value maxv)
281 CAMLparam3 (connv, startv, maxv);
283 virConnectPtr conn = Connect_val (connv);
284 int start = Int_val (startv);
285 int max = Int_val (maxv);
287 unsigned long long freemems[max];
289 NONBLOCKING (r = virNodeGetCellsFreeMemory (conn, freemems, start, max));
290 CHECK_ERROR (r == -1, "virNodeGetCellsFreeMemory");
292 rv = caml_alloc (r, 0);
293 for (i = 0; i < r; ++i) {
294 iv = caml_copy_int64 ((int64_t) freemems[i]);
295 Store_field (rv, i, iv);
302 ocaml_libvirt_connect_set_keep_alive(value connv,
303 value intervalv, value countv)
305 CAMLparam3 (connv, intervalv, countv);
306 virConnectPtr conn = Connect_val(connv);
307 int interval = Int_val(intervalv);
308 unsigned int count = Int_val(countv);
311 NONBLOCKING(r = virConnectSetKeepAlive(conn, interval, count));
312 CHECK_ERROR (r == -1, "virConnectSetKeepAlive");
314 CAMLreturn(Val_unit);
318 ocaml_libvirt_domain_get_id (value domv)
321 virDomainPtr dom = Domain_val (domv);
324 NONBLOCKING (r = virDomainGetID (dom));
325 /* In theory this could return -1 on error, but in practice
326 * libvirt never does this unless you call it with a corrupted
327 * or NULL dom object. So ignore errors here.
330 CAMLreturn (Val_int ((int) r));
334 ocaml_libvirt_domain_get_max_memory (value domv)
338 virDomainPtr dom = Domain_val (domv);
341 NONBLOCKING (r = virDomainGetMaxMemory (dom));
342 CHECK_ERROR (r == 0 /* [sic] */, "virDomainGetMaxMemory");
344 rv = caml_copy_int64 (r);
349 ocaml_libvirt_domain_set_max_memory (value domv, value memv)
351 CAMLparam2 (domv, memv);
352 virDomainPtr dom = Domain_val (domv);
353 unsigned long mem = Int64_val (memv);
356 NONBLOCKING (r = virDomainSetMaxMemory (dom, mem));
357 CHECK_ERROR (r == -1, "virDomainSetMaxMemory");
359 CAMLreturn (Val_unit);
363 ocaml_libvirt_domain_set_memory (value domv, value memv)
365 CAMLparam2 (domv, memv);
366 virDomainPtr dom = Domain_val (domv);
367 unsigned long mem = Int64_val (memv);
370 NONBLOCKING (r = virDomainSetMemory (dom, mem));
371 CHECK_ERROR (r == -1, "virDomainSetMemory");
373 CAMLreturn (Val_unit);
377 ocaml_libvirt_domain_get_info (value domv)
381 virDomainPtr dom = Domain_val (domv);
385 NONBLOCKING (r = virDomainGetInfo (dom, &info));
386 CHECK_ERROR (r == -1, "virDomainGetInfo");
388 rv = caml_alloc (5, 0);
389 Store_field (rv, 0, Val_int (info.state)); // These flags are compatible.
390 v = caml_copy_int64 (info.maxMem); Store_field (rv, 1, v);
391 v = caml_copy_int64 (info.memory); Store_field (rv, 2, v);
392 Store_field (rv, 3, Val_int (info.nrVirtCpu));
393 v = caml_copy_int64 (info.cpuTime); Store_field (rv, 4, v);
399 ocaml_libvirt_domain_get_scheduler_type (value domv)
402 CAMLlocal2 (rv, strv);
403 virDomainPtr dom = Domain_val (domv);
407 NONBLOCKING (r = virDomainGetSchedulerType (dom, &nparams));
408 CHECK_ERROR (!r, "virDomainGetSchedulerType");
410 rv = caml_alloc_tuple (2);
411 strv = caml_copy_string (r); Store_field (rv, 0, strv);
413 Store_field (rv, 1, nparams);
418 ocaml_libvirt_domain_get_scheduler_parameters (value domv, value nparamsv)
420 CAMLparam2 (domv, nparamsv);
421 CAMLlocal4 (rv, v, v2, v3);
422 virDomainPtr dom = Domain_val (domv);
423 int nparams = Int_val (nparamsv);
424 virSchedParameter params[nparams];
427 NONBLOCKING (r = virDomainGetSchedulerParameters (dom, params, &nparams));
428 CHECK_ERROR (r == -1, "virDomainGetSchedulerParameters");
430 rv = caml_alloc (nparams, 0);
431 for (i = 0; i < nparams; ++i) {
432 v = caml_alloc_tuple (2); Store_field (rv, i, v);
433 v2 = caml_copy_string (params[i].field); Store_field (v, 0, v2);
434 switch (params[i].type) {
435 case VIR_DOMAIN_SCHED_FIELD_INT:
436 v2 = caml_alloc (1, 0);
437 v3 = caml_copy_int32 (params[i].value.i); Store_field (v2, 0, v3);
439 case VIR_DOMAIN_SCHED_FIELD_UINT:
440 v2 = caml_alloc (1, 1);
441 v3 = caml_copy_int32 (params[i].value.ui); Store_field (v2, 0, v3);
443 case VIR_DOMAIN_SCHED_FIELD_LLONG:
444 v2 = caml_alloc (1, 2);
445 v3 = caml_copy_int64 (params[i].value.l); Store_field (v2, 0, v3);
447 case VIR_DOMAIN_SCHED_FIELD_ULLONG:
448 v2 = caml_alloc (1, 3);
449 v3 = caml_copy_int64 (params[i].value.ul); Store_field (v2, 0, v3);
451 case VIR_DOMAIN_SCHED_FIELD_DOUBLE:
452 v2 = caml_alloc (1, 4);
453 v3 = caml_copy_double (params[i].value.d); Store_field (v2, 0, v3);
455 case VIR_DOMAIN_SCHED_FIELD_BOOLEAN:
456 v2 = caml_alloc (1, 5);
457 Store_field (v2, 0, Val_int (params[i].value.b));
460 caml_failwith ((char *)__FUNCTION__);
462 Store_field (v, 1, v2);
468 ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv)
470 CAMLparam2 (domv, paramsv);
472 virDomainPtr dom = Domain_val (domv);
473 int nparams = Wosize_val (paramsv);
474 virSchedParameter params[nparams];
478 for (i = 0; i < nparams; ++i) {
479 v = Field (paramsv, i); /* Points to the two-element tuple. */
480 name = String_val (Field (v, 0));
481 strncpy (params[i].field, name, VIR_DOMAIN_SCHED_FIELD_LENGTH);
482 params[i].field[VIR_DOMAIN_SCHED_FIELD_LENGTH-1] = '\0';
483 v = Field (v, 1); /* Points to the sched_param_value block. */
484 switch (Tag_val (v)) {
486 params[i].type = VIR_DOMAIN_SCHED_FIELD_INT;
487 params[i].value.i = Int32_val (Field (v, 0));
490 params[i].type = VIR_DOMAIN_SCHED_FIELD_UINT;
491 params[i].value.ui = Int32_val (Field (v, 0));
494 params[i].type = VIR_DOMAIN_SCHED_FIELD_LLONG;
495 params[i].value.l = Int64_val (Field (v, 0));
498 params[i].type = VIR_DOMAIN_SCHED_FIELD_ULLONG;
499 params[i].value.ul = Int64_val (Field (v, 0));
502 params[i].type = VIR_DOMAIN_SCHED_FIELD_DOUBLE;
503 params[i].value.d = Double_val (Field (v, 0));
506 params[i].type = VIR_DOMAIN_SCHED_FIELD_BOOLEAN;
507 params[i].value.b = Int_val (Field (v, 0));
510 caml_failwith ((char *)__FUNCTION__);
514 NONBLOCKING (r = virDomainSetSchedulerParameters (dom, params, nparams));
515 CHECK_ERROR (r == -1, "virDomainSetSchedulerParameters");
517 CAMLreturn (Val_unit);
521 ocaml_libvirt_domain_set_vcpus (value domv, value nvcpusv)
523 CAMLparam2 (domv, nvcpusv);
524 virDomainPtr dom = Domain_val (domv);
525 int r, nvcpus = Int_val (nvcpusv);
527 NONBLOCKING (r = virDomainSetVcpus (dom, nvcpus));
528 CHECK_ERROR (r == -1, "virDomainSetVcpus");
530 CAMLreturn (Val_unit);
534 ocaml_libvirt_domain_pin_vcpu (value domv, value vcpuv, value cpumapv)
536 CAMLparam3 (domv, vcpuv, cpumapv);
537 virDomainPtr dom = Domain_val (domv);
538 int maplen = caml_string_length (cpumapv);
539 unsigned char *cpumap = (unsigned char *) String_val (cpumapv);
540 int vcpu = Int_val (vcpuv);
543 NONBLOCKING (r = virDomainPinVcpu (dom, vcpu, cpumap, maplen));
544 CHECK_ERROR (r == -1, "virDomainPinVcpu");
546 CAMLreturn (Val_unit);
550 ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv)
552 CAMLparam3 (domv, maxinfov, maplenv);
553 CAMLlocal5 (rv, infov, strv, v, v2);
554 virDomainPtr dom = Domain_val (domv);
555 int maxinfo = Int_val (maxinfov);
556 int maplen = Int_val (maplenv);
557 virVcpuInfo info[maxinfo];
558 unsigned char cpumaps[maxinfo * maplen];
561 memset (info, 0, sizeof (virVcpuInfo) * maxinfo);
562 memset (cpumaps, 0, maxinfo * maplen);
564 NONBLOCKING (r = virDomainGetVcpus (dom, info, maxinfo, cpumaps, maplen));
565 CHECK_ERROR (r == -1, "virDomainPinVcpu");
567 /* Copy the virVcpuInfo structures. */
568 infov = caml_alloc (maxinfo, 0);
569 for (i = 0; i < maxinfo; ++i) {
570 v2 = caml_alloc (4, 0); Store_field (infov, i, v2);
571 Store_field (v2, 0, Val_int (info[i].number));
572 Store_field (v2, 1, Val_int (info[i].state));
573 v = caml_copy_int64 (info[i].cpuTime); Store_field (v2, 2, v);
574 Store_field (v2, 3, Val_int (info[i].cpu));
577 /* Copy the bitmap. */
578 strv = caml_alloc_string (maxinfo * maplen);
579 memcpy (String_val (strv), cpumaps, maxinfo * maplen);
581 /* Allocate the tuple and return it. */
582 rv = caml_alloc_tuple (3);
583 Store_field (rv, 0, Val_int (r)); /* number of CPUs. */
584 Store_field (rv, 1, infov);
585 Store_field (rv, 2, strv);
591 ocaml_libvirt_domain_get_cpu_stats (value domv)
594 CAMLlocal5 (cpustats, param_head, param_node, typed_param, typed_param_value);
596 virDomainPtr dom = Domain_val (domv);
597 virTypedParameterPtr params;
598 int r, cpu, ncpus, nparams, i, j, pos;
601 /* get number of pcpus */
602 NONBLOCKING (nr_pcpus = virDomainGetCPUStats(dom, NULL, 0, 0, 0, 0));
603 CHECK_ERROR (nr_pcpus < 0, "virDomainGetCPUStats");
605 /* get percpu information */
606 NONBLOCKING (nparams = virDomainGetCPUStats(dom, NULL, 0, 0, 1, 0));
607 CHECK_ERROR (nparams < 0, "virDomainGetCPUStats");
609 if ((params = malloc(sizeof(*params) * nparams * 128)) == NULL)
610 caml_failwith ("virDomainGetCPUStats: malloc");
612 cpustats = caml_alloc (nr_pcpus, 0); /* cpustats: array of params(list of typed_param) */
614 while (cpu < nr_pcpus) {
615 ncpus = nr_pcpus - cpu > 128 ? 128 : nr_pcpus - cpu;
617 NONBLOCKING (r = virDomainGetCPUStats(dom, params, nparams, cpu, ncpus, 0));
618 CHECK_ERROR (r < 0, "virDomainGetCPUStats");
620 for (i = 0; i < ncpus; i++) {
621 /* list of typed_param: single linked list of param_nodes */
622 param_head = Val_emptylist; /* param_head: the head param_node of list of typed_param */
624 if (params[i * nparams].type == 0) {
625 Store_field(cpustats, cpu + i, param_head);
629 for (j = r - 1; j >= 0; j--) {
630 pos = i * nparams + j;
631 if (params[pos].type == 0)
634 param_node = caml_alloc(2, 0); /* param_node: typed_param, next param_node */
635 Store_field(param_node, 1, param_head);
636 param_head = param_node;
638 typed_param = caml_alloc(2, 0); /* typed_param: field name(string), typed_param_value */
639 Store_field(param_node, 0, typed_param);
640 Store_field(typed_param, 0, caml_copy_string(params[pos].field));
642 /* typed_param_value: value with the corresponding type tag */
643 switch(params[pos].type) {
644 case VIR_TYPED_PARAM_INT:
645 typed_param_value = caml_alloc (1, 0);
646 v = caml_copy_int32 (params[pos].value.i);
648 case VIR_TYPED_PARAM_UINT:
649 typed_param_value = caml_alloc (1, 1);
650 v = caml_copy_int32 (params[pos].value.ui);
652 case VIR_TYPED_PARAM_LLONG:
653 typed_param_value = caml_alloc (1, 2);
654 v = caml_copy_int64 (params[pos].value.l);
656 case VIR_TYPED_PARAM_ULLONG:
657 typed_param_value = caml_alloc (1, 3);
658 v = caml_copy_int64 (params[pos].value.ul);
660 case VIR_TYPED_PARAM_DOUBLE:
661 typed_param_value = caml_alloc (1, 4);
662 v = caml_copy_double (params[pos].value.d);
664 case VIR_TYPED_PARAM_BOOLEAN:
665 typed_param_value = caml_alloc (1, 5);
666 v = Val_bool (params[pos].value.b);
668 case VIR_TYPED_PARAM_STRING:
669 typed_param_value = caml_alloc (1, 6);
670 v = caml_copy_string (params[pos].value.s);
671 free (params[pos].value.s);
674 /* XXX Memory leak on this path, if there are more
675 * VIR_TYPED_PARAM_STRING past this point in the array.
678 caml_failwith ("virDomainGetCPUStats: "
679 "unknown parameter type returned");
681 Store_field (typed_param_value, 0, v);
682 Store_field (typed_param, 1, typed_param_value);
684 Store_field (cpustats, cpu + i, param_head);
689 CAMLreturn (cpustats);
693 ocaml_libvirt_domain_get_all_domain_stats (value connv,
694 value statsv, value flagsv)
696 CAMLparam3 (connv, statsv, flagsv);
697 CAMLlocal5 (rv, dsv, tpv, v, v1);
699 virConnectPtr conn = Connect_val (connv);
700 virDomainStatsRecordPtr *rstats;
701 unsigned int stats = 0, flags = 0;
703 unsigned char uuid[VIR_UUID_BUFLEN];
705 /* Get stats and flags. */
706 for (; statsv != Val_int (0); statsv = Field (statsv, 1)) {
707 v = Field (statsv, 0);
708 if (v == Val_int (0))
709 stats |= VIR_DOMAIN_STATS_STATE;
710 else if (v == Val_int (1))
711 stats |= VIR_DOMAIN_STATS_CPU_TOTAL;
712 else if (v == Val_int (2))
713 stats |= VIR_DOMAIN_STATS_BALLOON;
714 else if (v == Val_int (3))
715 stats |= VIR_DOMAIN_STATS_VCPU;
716 else if (v == Val_int (4))
717 stats |= VIR_DOMAIN_STATS_INTERFACE;
718 else if (v == Val_int (5))
719 stats |= VIR_DOMAIN_STATS_BLOCK;
720 else if (v == Val_int (6))
721 stats |= VIR_DOMAIN_STATS_PERF;
723 for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1)) {
724 v = Field (flagsv, 0);
725 if (v == Val_int (0))
726 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_ACTIVE;
727 else if (v == Val_int (1))
728 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_INACTIVE;
729 else if (v == Val_int (2))
730 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_OTHER;
731 else if (v == Val_int (3))
732 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_PAUSED;
733 else if (v == Val_int (4))
734 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_PERSISTENT;
735 else if (v == Val_int (5))
736 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_RUNNING;
737 else if (v == Val_int (6))
738 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_SHUTOFF;
739 else if (v == Val_int (7))
740 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_TRANSIENT;
741 else if (v == Val_int (8))
742 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_BACKING;
743 else if (v == Val_int (9))
744 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_ENFORCE_STATS;
747 NONBLOCKING (r = virConnectGetAllDomainStats (conn, stats, &rstats, flags));
748 CHECK_ERROR (r == -1, "virConnectGetAllDomainStats");
750 rv = caml_alloc (r, 0); /* domain_stats_record array. */
751 for (i = 0; i < r; ++i) {
752 dsv = caml_alloc (2, 0); /* domain_stats_record */
754 /* Libvirt returns something superficially resembling a
755 * virDomainPtr, but it's not a real virDomainPtr object
756 * (eg. dom->id == -1, and its refcount is wrong). The only thing
757 * we can safely get from it is the UUID.
759 v = caml_alloc_string (VIR_UUID_BUFLEN);
760 virDomainGetUUID (rstats[i]->dom, uuid);
761 memcpy (String_val (v), uuid, VIR_UUID_BUFLEN);
762 Store_field (dsv, 0, v);
764 tpv = caml_alloc (rstats[i]->nparams, 0); /* typed_param array */
765 for (j = 0; j < rstats[i]->nparams; ++j) {
766 v2 = caml_alloc (2, 0); /* typed_param: field name, value */
767 Store_field (v2, 0, caml_copy_string (rstats[i]->params[j].field));
769 switch (rstats[i]->params[j].type) {
770 case VIR_TYPED_PARAM_INT:
771 v1 = caml_alloc (1, 0);
772 v = caml_copy_int32 (rstats[i]->params[j].value.i);
774 case VIR_TYPED_PARAM_UINT:
775 v1 = caml_alloc (1, 1);
776 v = caml_copy_int32 (rstats[i]->params[j].value.ui);
778 case VIR_TYPED_PARAM_LLONG:
779 v1 = caml_alloc (1, 2);
780 v = caml_copy_int64 (rstats[i]->params[j].value.l);
782 case VIR_TYPED_PARAM_ULLONG:
783 v1 = caml_alloc (1, 3);
784 v = caml_copy_int64 (rstats[i]->params[j].value.ul);
786 case VIR_TYPED_PARAM_DOUBLE:
787 v1 = caml_alloc (1, 4);
788 v = caml_copy_double (rstats[i]->params[j].value.d);
790 case VIR_TYPED_PARAM_BOOLEAN:
791 v1 = caml_alloc (1, 5);
792 v = Val_bool (rstats[i]->params[j].value.b);
794 case VIR_TYPED_PARAM_STRING:
795 v1 = caml_alloc (1, 6);
796 v = caml_copy_string (rstats[i]->params[j].value.s);
799 virDomainStatsRecordListFree (rstats);
800 caml_failwith ("virConnectGetAllDomainStats: "
801 "unknown parameter type returned");
803 Store_field (v1, 0, v);
805 Store_field (v2, 1, v1);
806 Store_field (tpv, j, v2);
809 Store_field (dsv, 1, tpv);
810 Store_field (rv, i, dsv);
813 virDomainStatsRecordListFree (rstats);
818 ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, value optdnamev, value opturiv, value optbandwidthv, value unitv)
820 CAMLparam5 (domv, dconnv, flagsv, optdnamev, opturiv);
821 CAMLxparam2 (optbandwidthv, unitv);
822 CAMLlocal2 (flagv, rv);
823 virDomainPtr dom = Domain_val (domv);
824 virConnectPtr dconn = Connect_val (dconnv);
826 const char *dname = Optstring_val (optdnamev);
827 const char *uri = Optstring_val (opturiv);
828 unsigned long bandwidth;
831 /* Iterate over the list of flags. */
832 for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
834 flagv = Field (flagsv, 0);
835 if (flagv == Val_int (0))
836 flags |= VIR_MIGRATE_LIVE;
839 if (optbandwidthv == Val_int (0)) /* None */
841 else /* Some bandwidth */
842 bandwidth = Int_val (Field (optbandwidthv, 0));
844 NONBLOCKING (r = virDomainMigrate (dom, dconn, flags, dname, uri, bandwidth));
845 CHECK_ERROR (!r, "virDomainMigrate");
847 rv = Val_domain (r, dconnv);
853 ocaml_libvirt_domain_migrate_bytecode (value *argv, int argn)
855 return ocaml_libvirt_domain_migrate_native (argv[0], argv[1], argv[2],
856 argv[3], argv[4], argv[5],
861 ocaml_libvirt_domain_block_stats (value domv, value pathv)
863 CAMLparam2 (domv, pathv);
865 virDomainPtr dom = Domain_val (domv);
866 char *path = String_val (pathv);
867 struct _virDomainBlockStats stats;
870 NONBLOCKING (r = virDomainBlockStats (dom, path, &stats, sizeof stats));
871 CHECK_ERROR (r == -1, "virDomainBlockStats");
873 rv = caml_alloc (5, 0);
874 v = caml_copy_int64 (stats.rd_req); Store_field (rv, 0, v);
875 v = caml_copy_int64 (stats.rd_bytes); Store_field (rv, 1, v);
876 v = caml_copy_int64 (stats.wr_req); Store_field (rv, 2, v);
877 v = caml_copy_int64 (stats.wr_bytes); Store_field (rv, 3, v);
878 v = caml_copy_int64 (stats.errs); Store_field (rv, 4, v);
884 ocaml_libvirt_domain_interface_stats (value domv, value pathv)
886 CAMLparam2 (domv, pathv);
888 virDomainPtr dom = Domain_val (domv);
889 char *path = String_val (pathv);
890 struct _virDomainInterfaceStats stats;
893 NONBLOCKING (r = virDomainInterfaceStats (dom, path, &stats, sizeof stats));
894 CHECK_ERROR (r == -1, "virDomainInterfaceStats");
896 rv = caml_alloc (8, 0);
897 v = caml_copy_int64 (stats.rx_bytes); Store_field (rv, 0, v);
898 v = caml_copy_int64 (stats.rx_packets); Store_field (rv, 1, v);
899 v = caml_copy_int64 (stats.rx_errs); Store_field (rv, 2, v);
900 v = caml_copy_int64 (stats.rx_drop); Store_field (rv, 3, v);
901 v = caml_copy_int64 (stats.tx_bytes); Store_field (rv, 4, v);
902 v = caml_copy_int64 (stats.tx_packets); Store_field (rv, 5, v);
903 v = caml_copy_int64 (stats.tx_errs); Store_field (rv, 6, v);
904 v = caml_copy_int64 (stats.tx_drop); Store_field (rv, 7, v);
910 ocaml_libvirt_domain_block_peek_native (value domv, value pathv, value offsetv, value sizev, value bufferv, value boffv)
912 CAMLparam5 (domv, pathv, offsetv, sizev, bufferv);
914 virDomainPtr dom = Domain_val (domv);
915 const char *path = String_val (pathv);
916 unsigned long long offset = Int64_val (offsetv);
917 size_t size = Int_val (sizev);
918 char *buffer = String_val (bufferv);
919 int boff = Int_val (boffv);
922 /* Check that the return buffer is big enough. */
923 if (caml_string_length (bufferv) < boff + size)
924 caml_failwith ("virDomainBlockPeek: return buffer too short");
926 /* NB. not NONBLOCKING because buffer might move (XXX) */
927 r = virDomainBlockPeek (dom, path, offset, size, buffer+boff, 0);
928 CHECK_ERROR (r == -1, "virDomainBlockPeek");
930 CAMLreturn (Val_unit);
934 ocaml_libvirt_domain_block_peek_bytecode (value *argv, int argn)
936 return ocaml_libvirt_domain_block_peek_native (argv[0], argv[1], argv[2],
937 argv[3], argv[4], argv[5]);
941 ocaml_libvirt_domain_memory_peek_native (value domv, value flagsv, value offsetv, value sizev, value bufferv, value boffv)
943 CAMLparam5 (domv, flagsv, offsetv, sizev, bufferv);
946 virDomainPtr dom = Domain_val (domv);
948 unsigned long long offset = Int64_val (offsetv);
949 size_t size = Int_val (sizev);
950 char *buffer = String_val (bufferv);
951 int boff = Int_val (boffv);
954 /* Check that the return buffer is big enough. */
955 if (caml_string_length (bufferv) < boff + size)
956 caml_failwith ("virDomainMemoryPeek: return buffer too short");
959 for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
961 flagv = Field (flagsv, 0);
962 if (flagv == Val_int (0))
963 flags |= VIR_MEMORY_VIRTUAL;
966 /* NB. not NONBLOCKING because buffer might move (XXX) */
967 r = virDomainMemoryPeek (dom, offset, size, buffer+boff, flags);
968 CHECK_ERROR (r == -1, "virDomainMemoryPeek");
970 CAMLreturn (Val_unit);
974 ocaml_libvirt_domain_memory_peek_bytecode (value *argv, int argn)
976 return ocaml_libvirt_domain_memory_peek_native (argv[0], argv[1], argv[2],
977 argv[3], argv[4], argv[5]);
980 /*----------------------------------------------------------------------*/
985 ocaml_libvirt_event_register_default_impl (value unitv)
989 /* arg is of type unit = void */
992 NONBLOCKING (r = virEventRegisterDefaultImpl ());
993 /* must be called before connection, therefore we can't use CHECK_ERROR */
994 if (r == -1) caml_failwith("virEventRegisterDefaultImpl");
996 CAMLreturn (Val_unit);
1000 ocaml_libvirt_event_run_default_impl (value unitv)
1004 /* arg is of type unit = void */
1007 NONBLOCKING (r = virEventRunDefaultImpl ());
1008 if (r == -1) caml_failwith("virEventRunDefaultImpl");
1010 CAMLreturn (Val_unit);
1013 /* We register a single C callback function for every distinct
1014 callback signature. We encode the signature itself in the function
1015 name and also in the name of the assocated OCaml callback
1018 i_i64_s_callback(virConnectPtr conn,
1024 would correspond to an OCaml callback
1025 Libvirt.i_i64_s_callback :
1026 int64 -> [`R] Domain.t -> int -> int64 -> string option -> unit
1027 where the initial int64 is a unique ID used by the OCaml to
1028 dispatch to the specific OCaml closure and stored by libvirt
1029 as the "opaque" data. */
1031 /* Every one of the callbacks starts with a DOMAIN_CALLBACK_BEGIN(NAME)
1032 where NAME is the string name of the OCaml callback registered
1034 #define DOMAIN_CALLBACK_BEGIN(NAME) \
1035 value connv, domv, callback_id, result; \
1036 connv = domv = callback_id = result = Val_int(0); \
1037 static value *callback = NULL; \
1038 caml_leave_blocking_section(); \
1039 if (callback == NULL) \
1040 callback = caml_named_value(NAME); \
1041 if (callback == NULL) \
1042 abort(); /* C code out of sync with OCaml code */ \
1043 if ((virDomainRef(dom) == -1) || (virConnectRef(conn) == -1)) \
1044 abort(); /* should never happen in practice? */ \
1046 Begin_roots4(connv, domv, callback_id, result); \
1047 connv = Val_connect(conn); \
1048 domv = Val_domain(dom, connv); \
1049 callback_id = caml_copy_int64(*(long *)opaque);
1051 /* Every one of the callbacks ends with a CALLBACK_END */
1052 #define DOMAIN_CALLBACK_END \
1053 (void) caml_callback3(*callback, callback_id, domv, result); \
1055 caml_enter_blocking_section();
1059 i_i_callback(virConnectPtr conn,
1065 DOMAIN_CALLBACK_BEGIN("Libvirt.i_i_callback")
1066 result = caml_alloc_tuple(2);
1067 Store_field(result, 0, Val_int(x));
1068 Store_field(result, 1, Val_int(y));
1073 u_callback(virConnectPtr conn,
1077 DOMAIN_CALLBACK_BEGIN("Libvirt.u_callback")
1078 result = Val_int(0); /* () */
1083 i64_callback(virConnectPtr conn,
1088 DOMAIN_CALLBACK_BEGIN("Libvirt.i64_callback")
1089 result = caml_copy_int64(int64);
1094 i_callback(virConnectPtr conn,
1099 DOMAIN_CALLBACK_BEGIN("Libvirt.i_callback")
1100 result = Val_int(x);
1105 s_i_callback(virConnectPtr conn,
1111 DOMAIN_CALLBACK_BEGIN("Libvirt.s_i_callback")
1112 result = caml_alloc_tuple(2);
1113 Store_field(result, 0,
1114 Val_opt(x, (Val_ptr_t) caml_copy_string));
1115 Store_field(result, 1, Val_int(y));
1120 s_i_i_callback(virConnectPtr conn,
1127 DOMAIN_CALLBACK_BEGIN("Libvirt.s_i_i_callback")
1128 result = caml_alloc_tuple(3);
1129 Store_field(result, 0,
1130 Val_opt(x, (Val_ptr_t) caml_copy_string));
1131 Store_field(result, 1, Val_int(y));
1132 Store_field(result, 2, Val_int(z));
1137 s_s_i_callback(virConnectPtr conn,
1144 DOMAIN_CALLBACK_BEGIN("Libvirt.s_s_i_callback")
1145 result = caml_alloc_tuple(3);
1146 Store_field(result, 0,
1147 Val_opt(x, (Val_ptr_t) caml_copy_string));
1148 Store_field(result, 1,
1149 Val_opt(y, (Val_ptr_t) caml_copy_string));
1150 Store_field(result, 2, Val_int(z));
1155 s_s_i_s_callback(virConnectPtr conn,
1163 DOMAIN_CALLBACK_BEGIN("Libvirt.s_s_i_s_callback")
1164 result = caml_alloc_tuple(4);
1165 Store_field(result, 0,
1166 Val_opt(x, (Val_ptr_t) caml_copy_string));
1167 Store_field(result, 1,
1168 Val_opt(y, (Val_ptr_t) caml_copy_string));
1169 Store_field(result, 2, Val_int(z));
1170 Store_field(result, 3,
1171 Val_opt(a, (Val_ptr_t) caml_copy_string));
1176 s_s_s_i_callback(virConnectPtr conn,
1184 DOMAIN_CALLBACK_BEGIN("Libvirt.s_s_s_i_callback")
1185 result = caml_alloc_tuple(4);
1186 Store_field(result, 0,
1187 Val_opt(x, (Val_ptr_t) caml_copy_string));
1188 Store_field(result, 1,
1189 Val_opt(y, (Val_ptr_t) caml_copy_string));
1190 Store_field(result, 2,
1191 Val_opt(z, (Val_ptr_t) caml_copy_string));
1192 Store_field(result, 3, Val_int(a));
1197 Val_event_graphics_address(virDomainEventGraphicsAddressPtr x)
1201 result = caml_alloc_tuple(3);
1202 Store_field(result, 0, Val_int(x->family));
1203 Store_field(result, 1,
1204 Val_opt((void *) x->node, (Val_ptr_t) caml_copy_string));
1205 Store_field(result, 2,
1206 Val_opt((void *) x->service, (Val_ptr_t) caml_copy_string));
1211 Val_event_graphics_subject_identity(virDomainEventGraphicsSubjectIdentityPtr x)
1215 result = caml_alloc_tuple(2);
1216 Store_field(result, 0,
1217 Val_opt((void *) x->type, (Val_ptr_t) caml_copy_string));
1218 Store_field(result, 1,
1219 Val_opt((void *) x->name, (Val_ptr_t) caml_copy_string));
1225 Val_event_graphics_subject(virDomainEventGraphicsSubjectPtr x)
1230 result = caml_alloc_tuple(x->nidentity);
1231 for (i = 0; i < x->nidentity; i++ )
1232 Store_field(result, i,
1233 Val_event_graphics_subject_identity(x->identities + i));
1238 i_ga_ga_s_gs_callback(virConnectPtr conn,
1241 virDomainEventGraphicsAddressPtr ga1,
1242 virDomainEventGraphicsAddressPtr ga2,
1244 virDomainEventGraphicsSubjectPtr gs1,
1247 DOMAIN_CALLBACK_BEGIN("Libvirt.i_ga_ga_s_gs_callback")
1248 result = caml_alloc_tuple(5);
1249 Store_field(result, 0, Val_int(i1));
1250 Store_field(result, 1, Val_event_graphics_address(ga1));
1251 Store_field(result, 2, Val_event_graphics_address(ga2));
1252 Store_field(result, 3,
1253 Val_opt(s1, (Val_ptr_t) caml_copy_string));
1254 Store_field(result, 4, Val_event_graphics_subject(gs1));
1259 timeout_callback(int timer, void *opaque)
1261 value callback_id, result;
1262 callback_id = result = Val_int(0);
1263 static value *callback = NULL;
1264 caml_leave_blocking_section();
1265 if (callback == NULL)
1266 callback = caml_named_value("Libvirt.timeout_callback");
1267 if (callback == NULL)
1268 abort(); /* C code out of sync with OCaml code */
1270 Begin_roots2(callback_id, result);
1271 callback_id = caml_copy_int64(*(long *)opaque);
1273 (void)caml_callback_exn(*callback, callback_id);
1275 caml_enter_blocking_section();
1279 ocaml_libvirt_event_add_timeout (value connv, value ms, value callback_id)
1281 CAMLparam3 (connv, ms, callback_id);
1283 virFreeCallback freecb = free;
1284 virEventTimeoutCallback cb = timeout_callback;
1288 /* Store the int64 callback_id as the opaque data so the OCaml
1289 callback can demultiplex to the correct OCaml handler. */
1290 if ((opaque = malloc(sizeof(long))) == NULL)
1291 caml_failwith ("virEventAddTimeout: malloc");
1292 *((long*)opaque) = Int64_val(callback_id);
1293 NONBLOCKING(r = virEventAddTimeout(Int_val(ms), cb, opaque, freecb));
1294 CHECK_ERROR(r == -1, "virEventAddTimeout");
1296 CAMLreturn(Val_int(r));
1300 ocaml_libvirt_event_remove_timeout (value connv, value timer_id)
1302 CAMLparam2 (connv, timer_id);
1305 NONBLOCKING(r = virEventRemoveTimeout(Int_val(timer_id)));
1306 CHECK_ERROR(r == -1, "virEventRemoveTimeout");
1308 CAMLreturn(Val_int(r));
1312 ocaml_libvirt_connect_domain_event_register_any(value connv, value domv, value callback, value callback_id)
1314 CAMLparam4(connv, domv, callback, callback_id);
1316 virConnectPtr conn = Connect_val (connv);
1317 virDomainPtr dom = NULL;
1318 int eventID = Tag_val(callback);
1320 virConnectDomainEventGenericCallback cb;
1322 virFreeCallback freecb = free;
1325 if (domv != Val_int(0))
1326 dom = Domain_val (Field(domv, 0));
1329 case VIR_DOMAIN_EVENT_ID_LIFECYCLE:
1330 cb = VIR_DOMAIN_EVENT_CALLBACK(i_i_callback);
1332 case VIR_DOMAIN_EVENT_ID_REBOOT:
1333 cb = VIR_DOMAIN_EVENT_CALLBACK(u_callback);
1335 case VIR_DOMAIN_EVENT_ID_RTC_CHANGE:
1336 cb = VIR_DOMAIN_EVENT_CALLBACK(i64_callback);
1338 case VIR_DOMAIN_EVENT_ID_WATCHDOG:
1339 cb = VIR_DOMAIN_EVENT_CALLBACK(i_callback);
1341 case VIR_DOMAIN_EVENT_ID_IO_ERROR:
1342 cb = VIR_DOMAIN_EVENT_CALLBACK(s_s_i_callback);
1344 case VIR_DOMAIN_EVENT_ID_GRAPHICS:
1345 cb = VIR_DOMAIN_EVENT_CALLBACK(i_ga_ga_s_gs_callback);
1347 case VIR_DOMAIN_EVENT_ID_IO_ERROR_REASON:
1348 cb = VIR_DOMAIN_EVENT_CALLBACK(s_s_i_s_callback);
1350 case VIR_DOMAIN_EVENT_ID_CONTROL_ERROR:
1351 cb = VIR_DOMAIN_EVENT_CALLBACK(u_callback);
1353 case VIR_DOMAIN_EVENT_ID_BLOCK_JOB:
1354 cb = VIR_DOMAIN_EVENT_CALLBACK(s_i_i_callback);
1356 case VIR_DOMAIN_EVENT_ID_DISK_CHANGE:
1357 cb = VIR_DOMAIN_EVENT_CALLBACK(s_s_s_i_callback);
1359 case VIR_DOMAIN_EVENT_ID_TRAY_CHANGE:
1360 cb = VIR_DOMAIN_EVENT_CALLBACK(s_i_callback);
1362 case VIR_DOMAIN_EVENT_ID_PMWAKEUP:
1363 cb = VIR_DOMAIN_EVENT_CALLBACK(i_callback);
1365 case VIR_DOMAIN_EVENT_ID_PMSUSPEND:
1366 cb = VIR_DOMAIN_EVENT_CALLBACK(i_callback);
1368 case VIR_DOMAIN_EVENT_ID_BALLOON_CHANGE:
1369 cb = VIR_DOMAIN_EVENT_CALLBACK(i64_callback);
1371 case VIR_DOMAIN_EVENT_ID_PMSUSPEND_DISK:
1372 cb = VIR_DOMAIN_EVENT_CALLBACK(i_callback);
1375 caml_failwith("vifConnectDomainEventRegisterAny: unimplemented eventID");
1378 /* Store the int64 callback_id as the opaque data so the OCaml
1379 callback can demultiplex to the correct OCaml handler. */
1380 if ((opaque = malloc(sizeof(long))) == NULL)
1381 caml_failwith ("virConnectDomainEventRegisterAny: malloc");
1382 *((long*)opaque) = Int64_val(callback_id);
1383 NONBLOCKING(r = virConnectDomainEventRegisterAny(conn, dom, eventID, cb, opaque, freecb));
1384 CHECK_ERROR(r == -1, "virConnectDomainEventRegisterAny");
1386 CAMLreturn(Val_int(r));
1390 ocaml_libvirt_storage_pool_get_info (value poolv)
1394 virStoragePoolPtr pool = Pool_val (poolv);
1395 virStoragePoolInfo info;
1398 NONBLOCKING (r = virStoragePoolGetInfo (pool, &info));
1399 CHECK_ERROR (r == -1, "virStoragePoolGetInfo");
1401 rv = caml_alloc (4, 0);
1402 Store_field (rv, 0, Val_int (info.state));
1403 v = caml_copy_int64 (info.capacity); Store_field (rv, 1, v);
1404 v = caml_copy_int64 (info.allocation); Store_field (rv, 2, v);
1405 v = caml_copy_int64 (info.available); Store_field (rv, 3, v);
1411 ocaml_libvirt_storage_vol_get_info (value volv)
1415 virStorageVolPtr vol = Volume_val (volv);
1416 virStorageVolInfo info;
1419 NONBLOCKING (r = virStorageVolGetInfo (vol, &info));
1420 CHECK_ERROR (r == -1, "virStorageVolGetInfo");
1422 rv = caml_alloc (3, 0);
1423 Store_field (rv, 0, Val_int (info.type));
1424 v = caml_copy_int64 (info.capacity); Store_field (rv, 1, v);
1425 v = caml_copy_int64 (info.allocation); Store_field (rv, 2, v);
1430 /*----------------------------------------------------------------------*/
1433 ocaml_libvirt_virterror_get_last_error (value unitv)
1437 virErrorPtr err = virGetLastError ();
1439 rv = Val_opt (err, (Val_ptr_t) Val_virterror);
1445 ocaml_libvirt_virterror_get_last_conn_error (value connv)
1449 virConnectPtr conn = Connect_val (connv);
1451 rv = Val_opt (conn, (Val_ptr_t) Val_connect);
1457 ocaml_libvirt_virterror_reset_last_error (value unitv)
1460 virResetLastError ();
1461 CAMLreturn (Val_unit);
1465 ocaml_libvirt_virterror_reset_last_conn_error (value connv)
1468 virConnectPtr conn = Connect_val (connv);
1469 virConnResetLastError (conn);
1470 CAMLreturn (Val_unit);
1473 /*----------------------------------------------------------------------*/
1476 ignore_errors (void *user_data, virErrorPtr error)
1481 /* Initialise the library. */
1483 ocaml_libvirt_init (value unit)
1487 virSetErrorFunc (NULL, ignore_errors);
1490 CAMLreturn (Val_unit);