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);
80 ocaml_libvirt_connect_get_version (value connv)
83 virConnectPtr conn = Connect_val (connv);
87 NONBLOCKING (r = virConnectGetVersion (conn, &hvVer));
88 CHECK_ERROR (r == -1, "virConnectGetVersion");
90 CAMLreturn (Val_int (hvVer));
94 ocaml_libvirt_connect_get_max_vcpus (value connv, value typev)
96 CAMLparam2 (connv, typev);
97 virConnectPtr conn = Connect_val (connv);
98 const char *type = Optstring_val (typev);
101 NONBLOCKING (r = virConnectGetMaxVcpus (conn, type));
102 CHECK_ERROR (r == -1, "virConnectGetMaxVcpus");
104 CAMLreturn (Val_int (r));
108 ocaml_libvirt_connect_get_node_info (value connv)
112 virConnectPtr conn = Connect_val (connv);
116 NONBLOCKING (r = virNodeGetInfo (conn, &info));
117 CHECK_ERROR (r == -1, "virNodeGetInfo");
119 rv = caml_alloc (8, 0);
120 v = caml_copy_string (info.model); Store_field (rv, 0, v);
121 v = caml_copy_int64 (info.memory); Store_field (rv, 1, v);
122 Store_field (rv, 2, Val_int (info.cpus));
123 Store_field (rv, 3, Val_int (info.mhz));
124 Store_field (rv, 4, Val_int (info.nodes));
125 Store_field (rv, 5, Val_int (info.sockets));
126 Store_field (rv, 6, Val_int (info.cores));
127 Store_field (rv, 7, Val_int (info.threads));
133 ocaml_libvirt_connect_node_get_free_memory (value connv)
137 virConnectPtr conn = Connect_val (connv);
138 unsigned long long r;
140 NONBLOCKING (r = virNodeGetFreeMemory (conn));
141 CHECK_ERROR (r == 0, "virNodeGetFreeMemory");
143 rv = caml_copy_int64 ((int64_t) r);
148 ocaml_libvirt_connect_node_get_cells_free_memory (value connv,
149 value startv, value maxv)
151 CAMLparam3 (connv, startv, maxv);
153 virConnectPtr conn = Connect_val (connv);
154 int start = Int_val (startv);
155 int max = Int_val (maxv);
157 unsigned long long freemems[max];
159 NONBLOCKING (r = virNodeGetCellsFreeMemory (conn, freemems, start, max));
160 CHECK_ERROR (r == -1, "virNodeGetCellsFreeMemory");
162 rv = caml_alloc (r, 0);
163 for (i = 0; i < r; ++i) {
164 iv = caml_copy_int64 ((int64_t) freemems[i]);
165 Store_field (rv, i, iv);
172 ocaml_libvirt_connect_set_keep_alive(value connv,
173 value intervalv, value countv)
175 CAMLparam3 (connv, intervalv, countv);
176 virConnectPtr conn = Connect_val(connv);
177 int interval = Int_val(intervalv);
178 unsigned int count = Int_val(countv);
181 NONBLOCKING(r = virConnectSetKeepAlive(conn, interval, count));
182 CHECK_ERROR (r == -1, "virConnectSetKeepAlive");
184 CAMLreturn(Val_unit);
188 ocaml_libvirt_domain_get_id (value domv)
191 virDomainPtr dom = Domain_val (domv);
194 NONBLOCKING (r = virDomainGetID (dom));
195 /* In theory this could return -1 on error, but in practice
196 * libvirt never does this unless you call it with a corrupted
197 * or NULL dom object. So ignore errors here.
200 CAMLreturn (Val_int ((int) r));
204 ocaml_libvirt_domain_get_max_memory (value domv)
208 virDomainPtr dom = Domain_val (domv);
211 NONBLOCKING (r = virDomainGetMaxMemory (dom));
212 CHECK_ERROR (r == 0 /* [sic] */, "virDomainGetMaxMemory");
214 rv = caml_copy_int64 (r);
219 ocaml_libvirt_domain_set_max_memory (value domv, value memv)
221 CAMLparam2 (domv, memv);
222 virDomainPtr dom = Domain_val (domv);
223 unsigned long mem = Int64_val (memv);
226 NONBLOCKING (r = virDomainSetMaxMemory (dom, mem));
227 CHECK_ERROR (r == -1, "virDomainSetMaxMemory");
229 CAMLreturn (Val_unit);
233 ocaml_libvirt_domain_set_memory (value domv, value memv)
235 CAMLparam2 (domv, memv);
236 virDomainPtr dom = Domain_val (domv);
237 unsigned long mem = Int64_val (memv);
240 NONBLOCKING (r = virDomainSetMemory (dom, mem));
241 CHECK_ERROR (r == -1, "virDomainSetMemory");
243 CAMLreturn (Val_unit);
247 ocaml_libvirt_domain_get_info (value domv)
251 virDomainPtr dom = Domain_val (domv);
255 NONBLOCKING (r = virDomainGetInfo (dom, &info));
256 CHECK_ERROR (r == -1, "virDomainGetInfo");
258 rv = caml_alloc (5, 0);
259 Store_field (rv, 0, Val_int (info.state)); // These flags are compatible.
260 v = caml_copy_int64 (info.maxMem); Store_field (rv, 1, v);
261 v = caml_copy_int64 (info.memory); Store_field (rv, 2, v);
262 Store_field (rv, 3, Val_int (info.nrVirtCpu));
263 v = caml_copy_int64 (info.cpuTime); Store_field (rv, 4, v);
269 ocaml_libvirt_domain_get_scheduler_type (value domv)
272 CAMLlocal2 (rv, strv);
273 virDomainPtr dom = Domain_val (domv);
277 NONBLOCKING (r = virDomainGetSchedulerType (dom, &nparams));
278 CHECK_ERROR (!r, "virDomainGetSchedulerType");
280 rv = caml_alloc_tuple (2);
281 strv = caml_copy_string (r); Store_field (rv, 0, strv);
283 Store_field (rv, 1, nparams);
288 ocaml_libvirt_domain_get_scheduler_parameters (value domv, value nparamsv)
290 CAMLparam2 (domv, nparamsv);
291 CAMLlocal4 (rv, v, v2, v3);
292 virDomainPtr dom = Domain_val (domv);
293 int nparams = Int_val (nparamsv);
294 virSchedParameter params[nparams];
297 NONBLOCKING (r = virDomainGetSchedulerParameters (dom, params, &nparams));
298 CHECK_ERROR (r == -1, "virDomainGetSchedulerParameters");
300 rv = caml_alloc (nparams, 0);
301 for (i = 0; i < nparams; ++i) {
302 v = caml_alloc_tuple (2); Store_field (rv, i, v);
303 v2 = caml_copy_string (params[i].field); Store_field (v, 0, v2);
304 switch (params[i].type) {
305 case VIR_DOMAIN_SCHED_FIELD_INT:
306 v2 = caml_alloc (1, 0);
307 v3 = caml_copy_int32 (params[i].value.i); Store_field (v2, 0, v3);
309 case VIR_DOMAIN_SCHED_FIELD_UINT:
310 v2 = caml_alloc (1, 1);
311 v3 = caml_copy_int32 (params[i].value.ui); Store_field (v2, 0, v3);
313 case VIR_DOMAIN_SCHED_FIELD_LLONG:
314 v2 = caml_alloc (1, 2);
315 v3 = caml_copy_int64 (params[i].value.l); Store_field (v2, 0, v3);
317 case VIR_DOMAIN_SCHED_FIELD_ULLONG:
318 v2 = caml_alloc (1, 3);
319 v3 = caml_copy_int64 (params[i].value.ul); Store_field (v2, 0, v3);
321 case VIR_DOMAIN_SCHED_FIELD_DOUBLE:
322 v2 = caml_alloc (1, 4);
323 v3 = caml_copy_double (params[i].value.d); Store_field (v2, 0, v3);
325 case VIR_DOMAIN_SCHED_FIELD_BOOLEAN:
326 v2 = caml_alloc (1, 5);
327 Store_field (v2, 0, Val_int (params[i].value.b));
330 caml_failwith ((char *)__FUNCTION__);
332 Store_field (v, 1, v2);
338 ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv)
340 CAMLparam2 (domv, paramsv);
342 virDomainPtr dom = Domain_val (domv);
343 int nparams = Wosize_val (paramsv);
344 virSchedParameter params[nparams];
348 for (i = 0; i < nparams; ++i) {
349 v = Field (paramsv, i); /* Points to the two-element tuple. */
350 name = String_val (Field (v, 0));
351 strncpy (params[i].field, name, VIR_DOMAIN_SCHED_FIELD_LENGTH);
352 params[i].field[VIR_DOMAIN_SCHED_FIELD_LENGTH-1] = '\0';
353 v = Field (v, 1); /* Points to the sched_param_value block. */
354 switch (Tag_val (v)) {
356 params[i].type = VIR_DOMAIN_SCHED_FIELD_INT;
357 params[i].value.i = Int32_val (Field (v, 0));
360 params[i].type = VIR_DOMAIN_SCHED_FIELD_UINT;
361 params[i].value.ui = Int32_val (Field (v, 0));
364 params[i].type = VIR_DOMAIN_SCHED_FIELD_LLONG;
365 params[i].value.l = Int64_val (Field (v, 0));
368 params[i].type = VIR_DOMAIN_SCHED_FIELD_ULLONG;
369 params[i].value.ul = Int64_val (Field (v, 0));
372 params[i].type = VIR_DOMAIN_SCHED_FIELD_DOUBLE;
373 params[i].value.d = Double_val (Field (v, 0));
376 params[i].type = VIR_DOMAIN_SCHED_FIELD_BOOLEAN;
377 params[i].value.b = Int_val (Field (v, 0));
380 caml_failwith ((char *)__FUNCTION__);
384 NONBLOCKING (r = virDomainSetSchedulerParameters (dom, params, nparams));
385 CHECK_ERROR (r == -1, "virDomainSetSchedulerParameters");
387 CAMLreturn (Val_unit);
391 ocaml_libvirt_domain_set_vcpus (value domv, value nvcpusv)
393 CAMLparam2 (domv, nvcpusv);
394 virDomainPtr dom = Domain_val (domv);
395 int r, nvcpus = Int_val (nvcpusv);
397 NONBLOCKING (r = virDomainSetVcpus (dom, nvcpus));
398 CHECK_ERROR (r == -1, "virDomainSetVcpus");
400 CAMLreturn (Val_unit);
404 ocaml_libvirt_domain_pin_vcpu (value domv, value vcpuv, value cpumapv)
406 CAMLparam3 (domv, vcpuv, cpumapv);
407 virDomainPtr dom = Domain_val (domv);
408 int maplen = caml_string_length (cpumapv);
409 unsigned char *cpumap = (unsigned char *) String_val (cpumapv);
410 int vcpu = Int_val (vcpuv);
413 NONBLOCKING (r = virDomainPinVcpu (dom, vcpu, cpumap, maplen));
414 CHECK_ERROR (r == -1, "virDomainPinVcpu");
416 CAMLreturn (Val_unit);
420 ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv)
422 CAMLparam3 (domv, maxinfov, maplenv);
423 CAMLlocal5 (rv, infov, strv, v, v2);
424 virDomainPtr dom = Domain_val (domv);
425 int maxinfo = Int_val (maxinfov);
426 int maplen = Int_val (maplenv);
427 virVcpuInfo info[maxinfo];
428 unsigned char cpumaps[maxinfo * maplen];
431 memset (info, 0, sizeof (virVcpuInfo) * maxinfo);
432 memset (cpumaps, 0, maxinfo * maplen);
434 NONBLOCKING (r = virDomainGetVcpus (dom, info, maxinfo, cpumaps, maplen));
435 CHECK_ERROR (r == -1, "virDomainPinVcpu");
437 /* Copy the virVcpuInfo structures. */
438 infov = caml_alloc (maxinfo, 0);
439 for (i = 0; i < maxinfo; ++i) {
440 v2 = caml_alloc (4, 0); Store_field (infov, i, v2);
441 Store_field (v2, 0, Val_int (info[i].number));
442 Store_field (v2, 1, Val_int (info[i].state));
443 v = caml_copy_int64 (info[i].cpuTime); Store_field (v2, 2, v);
444 Store_field (v2, 3, Val_int (info[i].cpu));
447 /* Copy the bitmap. */
448 strv = caml_alloc_string (maxinfo * maplen);
449 memcpy (String_val (strv), cpumaps, maxinfo * maplen);
451 /* Allocate the tuple and return it. */
452 rv = caml_alloc_tuple (3);
453 Store_field (rv, 0, Val_int (r)); /* number of CPUs. */
454 Store_field (rv, 1, infov);
455 Store_field (rv, 2, strv);
461 ocaml_libvirt_domain_get_cpu_stats (value domv)
464 CAMLlocal5 (cpustats, param_head, param_node, typed_param, typed_param_value);
466 virDomainPtr dom = Domain_val (domv);
467 virTypedParameterPtr params;
468 int r, cpu, ncpus, nparams, i, j, pos;
471 /* get number of pcpus */
472 NONBLOCKING (nr_pcpus = virDomainGetCPUStats(dom, NULL, 0, 0, 0, 0));
473 CHECK_ERROR (nr_pcpus < 0, "virDomainGetCPUStats");
475 /* get percpu information */
476 NONBLOCKING (nparams = virDomainGetCPUStats(dom, NULL, 0, 0, 1, 0));
477 CHECK_ERROR (nparams < 0, "virDomainGetCPUStats");
479 if ((params = malloc(sizeof(*params) * nparams * 128)) == NULL)
480 caml_failwith ("virDomainGetCPUStats: malloc");
482 cpustats = caml_alloc (nr_pcpus, 0); /* cpustats: array of params(list of typed_param) */
484 while (cpu < nr_pcpus) {
485 ncpus = nr_pcpus - cpu > 128 ? 128 : nr_pcpus - cpu;
487 NONBLOCKING (r = virDomainGetCPUStats(dom, params, nparams, cpu, ncpus, 0));
488 CHECK_ERROR (r < 0, "virDomainGetCPUStats");
490 for (i = 0; i < ncpus; i++) {
491 /* list of typed_param: single linked list of param_nodes */
492 param_head = Val_emptylist; /* param_head: the head param_node of list of typed_param */
494 if (params[i * nparams].type == 0) {
495 Store_field(cpustats, cpu + i, param_head);
499 for (j = r - 1; j >= 0; j--) {
500 pos = i * nparams + j;
501 if (params[pos].type == 0)
504 param_node = caml_alloc(2, 0); /* param_node: typed_param, next param_node */
505 Store_field(param_node, 1, param_head);
506 param_head = param_node;
508 typed_param = caml_alloc(2, 0); /* typed_param: field name(string), typed_param_value */
509 Store_field(param_node, 0, typed_param);
510 Store_field(typed_param, 0, caml_copy_string(params[pos].field));
512 /* typed_param_value: value with the corresponding type tag */
513 switch(params[pos].type) {
514 case VIR_TYPED_PARAM_INT:
515 typed_param_value = caml_alloc (1, 0);
516 v = caml_copy_int32 (params[pos].value.i);
518 case VIR_TYPED_PARAM_UINT:
519 typed_param_value = caml_alloc (1, 1);
520 v = caml_copy_int32 (params[pos].value.ui);
522 case VIR_TYPED_PARAM_LLONG:
523 typed_param_value = caml_alloc (1, 2);
524 v = caml_copy_int64 (params[pos].value.l);
526 case VIR_TYPED_PARAM_ULLONG:
527 typed_param_value = caml_alloc (1, 3);
528 v = caml_copy_int64 (params[pos].value.ul);
530 case VIR_TYPED_PARAM_DOUBLE:
531 typed_param_value = caml_alloc (1, 4);
532 v = caml_copy_double (params[pos].value.d);
534 case VIR_TYPED_PARAM_BOOLEAN:
535 typed_param_value = caml_alloc (1, 5);
536 v = Val_bool (params[pos].value.b);
538 case VIR_TYPED_PARAM_STRING:
539 typed_param_value = caml_alloc (1, 6);
540 v = caml_copy_string (params[pos].value.s);
541 free (params[pos].value.s);
544 /* XXX Memory leak on this path, if there are more
545 * VIR_TYPED_PARAM_STRING past this point in the array.
548 caml_failwith ("virDomainGetCPUStats: "
549 "unknown parameter type returned");
551 Store_field (typed_param_value, 0, v);
552 Store_field (typed_param, 1, typed_param_value);
554 Store_field (cpustats, cpu + i, param_head);
559 CAMLreturn (cpustats);
563 ocaml_libvirt_domain_get_all_domain_stats (value connv,
564 value statsv, value flagsv)
566 CAMLparam3 (connv, statsv, flagsv);
567 CAMLlocal5 (rv, dsv, tpv, v, v1);
569 virConnectPtr conn = Connect_val (connv);
570 virDomainStatsRecordPtr *rstats;
571 unsigned int stats = 0, flags = 0;
573 unsigned char uuid[VIR_UUID_BUFLEN];
575 /* Get stats and flags. */
576 for (; statsv != Val_int (0); statsv = Field (statsv, 1)) {
577 v = Field (statsv, 0);
578 if (v == Val_int (0))
579 stats |= VIR_DOMAIN_STATS_STATE;
580 else if (v == Val_int (1))
581 stats |= VIR_DOMAIN_STATS_CPU_TOTAL;
582 else if (v == Val_int (2))
583 stats |= VIR_DOMAIN_STATS_BALLOON;
584 else if (v == Val_int (3))
585 stats |= VIR_DOMAIN_STATS_VCPU;
586 else if (v == Val_int (4))
587 stats |= VIR_DOMAIN_STATS_INTERFACE;
588 else if (v == Val_int (5))
589 stats |= VIR_DOMAIN_STATS_BLOCK;
590 else if (v == Val_int (6))
591 stats |= VIR_DOMAIN_STATS_PERF;
593 for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1)) {
594 v = Field (flagsv, 0);
595 if (v == Val_int (0))
596 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_ACTIVE;
597 else if (v == Val_int (1))
598 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_INACTIVE;
599 else if (v == Val_int (2))
600 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_OTHER;
601 else if (v == Val_int (3))
602 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_PAUSED;
603 else if (v == Val_int (4))
604 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_PERSISTENT;
605 else if (v == Val_int (5))
606 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_RUNNING;
607 else if (v == Val_int (6))
608 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_SHUTOFF;
609 else if (v == Val_int (7))
610 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_TRANSIENT;
611 else if (v == Val_int (8))
612 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_BACKING;
613 else if (v == Val_int (9))
614 flags |= VIR_CONNECT_GET_ALL_DOMAINS_STATS_ENFORCE_STATS;
617 NONBLOCKING (r = virConnectGetAllDomainStats (conn, stats, &rstats, flags));
618 CHECK_ERROR (r == -1, "virConnectGetAllDomainStats");
620 rv = caml_alloc (r, 0); /* domain_stats_record array. */
621 for (i = 0; i < r; ++i) {
622 dsv = caml_alloc (2, 0); /* domain_stats_record */
624 /* Libvirt returns something superficially resembling a
625 * virDomainPtr, but it's not a real virDomainPtr object
626 * (eg. dom->id == -1, and its refcount is wrong). The only thing
627 * we can safely get from it is the UUID.
629 v = caml_alloc_string (VIR_UUID_BUFLEN);
630 virDomainGetUUID (rstats[i]->dom, uuid);
631 memcpy (String_val (v), uuid, VIR_UUID_BUFLEN);
632 Store_field (dsv, 0, v);
634 tpv = caml_alloc (rstats[i]->nparams, 0); /* typed_param array */
635 for (j = 0; j < rstats[i]->nparams; ++j) {
636 v2 = caml_alloc (2, 0); /* typed_param: field name, value */
637 Store_field (v2, 0, caml_copy_string (rstats[i]->params[j].field));
639 switch (rstats[i]->params[j].type) {
640 case VIR_TYPED_PARAM_INT:
641 v1 = caml_alloc (1, 0);
642 v = caml_copy_int32 (rstats[i]->params[j].value.i);
644 case VIR_TYPED_PARAM_UINT:
645 v1 = caml_alloc (1, 1);
646 v = caml_copy_int32 (rstats[i]->params[j].value.ui);
648 case VIR_TYPED_PARAM_LLONG:
649 v1 = caml_alloc (1, 2);
650 v = caml_copy_int64 (rstats[i]->params[j].value.l);
652 case VIR_TYPED_PARAM_ULLONG:
653 v1 = caml_alloc (1, 3);
654 v = caml_copy_int64 (rstats[i]->params[j].value.ul);
656 case VIR_TYPED_PARAM_DOUBLE:
657 v1 = caml_alloc (1, 4);
658 v = caml_copy_double (rstats[i]->params[j].value.d);
660 case VIR_TYPED_PARAM_BOOLEAN:
661 v1 = caml_alloc (1, 5);
662 v = Val_bool (rstats[i]->params[j].value.b);
664 case VIR_TYPED_PARAM_STRING:
665 v1 = caml_alloc (1, 6);
666 v = caml_copy_string (rstats[i]->params[j].value.s);
669 virDomainStatsRecordListFree (rstats);
670 caml_failwith ("virConnectGetAllDomainStats: "
671 "unknown parameter type returned");
673 Store_field (v1, 0, v);
675 Store_field (v2, 1, v1);
676 Store_field (tpv, j, v2);
679 Store_field (dsv, 1, tpv);
680 Store_field (rv, i, dsv);
683 virDomainStatsRecordListFree (rstats);
688 ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, value optdnamev, value opturiv, value optbandwidthv, value unitv)
690 CAMLparam5 (domv, dconnv, flagsv, optdnamev, opturiv);
691 CAMLxparam2 (optbandwidthv, unitv);
692 CAMLlocal2 (flagv, rv);
693 virDomainPtr dom = Domain_val (domv);
694 virConnectPtr dconn = Connect_val (dconnv);
696 const char *dname = Optstring_val (optdnamev);
697 const char *uri = Optstring_val (opturiv);
698 unsigned long bandwidth;
701 /* Iterate over the list of flags. */
702 for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
704 flagv = Field (flagsv, 0);
705 if (flagv == Val_int (0))
706 flags |= VIR_MIGRATE_LIVE;
709 if (optbandwidthv == Val_int (0)) /* None */
711 else /* Some bandwidth */
712 bandwidth = Int_val (Field (optbandwidthv, 0));
714 NONBLOCKING (r = virDomainMigrate (dom, dconn, flags, dname, uri, bandwidth));
715 CHECK_ERROR (!r, "virDomainMigrate");
717 rv = Val_domain (r, dconnv);
723 ocaml_libvirt_domain_migrate_bytecode (value *argv, int argn)
725 return ocaml_libvirt_domain_migrate_native (argv[0], argv[1], argv[2],
726 argv[3], argv[4], argv[5],
731 ocaml_libvirt_domain_block_stats (value domv, value pathv)
733 CAMLparam2 (domv, pathv);
735 virDomainPtr dom = Domain_val (domv);
736 char *path = String_val (pathv);
737 struct _virDomainBlockStats stats;
740 NONBLOCKING (r = virDomainBlockStats (dom, path, &stats, sizeof stats));
741 CHECK_ERROR (r == -1, "virDomainBlockStats");
743 rv = caml_alloc (5, 0);
744 v = caml_copy_int64 (stats.rd_req); Store_field (rv, 0, v);
745 v = caml_copy_int64 (stats.rd_bytes); Store_field (rv, 1, v);
746 v = caml_copy_int64 (stats.wr_req); Store_field (rv, 2, v);
747 v = caml_copy_int64 (stats.wr_bytes); Store_field (rv, 3, v);
748 v = caml_copy_int64 (stats.errs); Store_field (rv, 4, v);
754 ocaml_libvirt_domain_interface_stats (value domv, value pathv)
756 CAMLparam2 (domv, pathv);
758 virDomainPtr dom = Domain_val (domv);
759 char *path = String_val (pathv);
760 struct _virDomainInterfaceStats stats;
763 NONBLOCKING (r = virDomainInterfaceStats (dom, path, &stats, sizeof stats));
764 CHECK_ERROR (r == -1, "virDomainInterfaceStats");
766 rv = caml_alloc (8, 0);
767 v = caml_copy_int64 (stats.rx_bytes); Store_field (rv, 0, v);
768 v = caml_copy_int64 (stats.rx_packets); Store_field (rv, 1, v);
769 v = caml_copy_int64 (stats.rx_errs); Store_field (rv, 2, v);
770 v = caml_copy_int64 (stats.rx_drop); Store_field (rv, 3, v);
771 v = caml_copy_int64 (stats.tx_bytes); Store_field (rv, 4, v);
772 v = caml_copy_int64 (stats.tx_packets); Store_field (rv, 5, v);
773 v = caml_copy_int64 (stats.tx_errs); Store_field (rv, 6, v);
774 v = caml_copy_int64 (stats.tx_drop); Store_field (rv, 7, v);
780 ocaml_libvirt_domain_block_peek_native (value domv, value pathv, value offsetv, value sizev, value bufferv, value boffv)
782 CAMLparam5 (domv, pathv, offsetv, sizev, bufferv);
784 virDomainPtr dom = Domain_val (domv);
785 const char *path = String_val (pathv);
786 unsigned long long offset = Int64_val (offsetv);
787 size_t size = Int_val (sizev);
788 char *buffer = String_val (bufferv);
789 int boff = Int_val (boffv);
792 /* Check that the return buffer is big enough. */
793 if (caml_string_length (bufferv) < boff + size)
794 caml_failwith ("virDomainBlockPeek: return buffer too short");
796 /* NB. not NONBLOCKING because buffer might move (XXX) */
797 r = virDomainBlockPeek (dom, path, offset, size, buffer+boff, 0);
798 CHECK_ERROR (r == -1, "virDomainBlockPeek");
800 CAMLreturn (Val_unit);
804 ocaml_libvirt_domain_block_peek_bytecode (value *argv, int argn)
806 return ocaml_libvirt_domain_block_peek_native (argv[0], argv[1], argv[2],
807 argv[3], argv[4], argv[5]);
811 ocaml_libvirt_domain_memory_peek_native (value domv, value flagsv, value offsetv, value sizev, value bufferv, value boffv)
813 CAMLparam5 (domv, flagsv, offsetv, sizev, bufferv);
816 virDomainPtr dom = Domain_val (domv);
818 unsigned long long offset = Int64_val (offsetv);
819 size_t size = Int_val (sizev);
820 char *buffer = String_val (bufferv);
821 int boff = Int_val (boffv);
824 /* Check that the return buffer is big enough. */
825 if (caml_string_length (bufferv) < boff + size)
826 caml_failwith ("virDomainMemoryPeek: return buffer too short");
829 for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
831 flagv = Field (flagsv, 0);
832 if (flagv == Val_int (0))
833 flags |= VIR_MEMORY_VIRTUAL;
836 /* NB. not NONBLOCKING because buffer might move (XXX) */
837 r = virDomainMemoryPeek (dom, offset, size, buffer+boff, flags);
838 CHECK_ERROR (r == -1, "virDomainMemoryPeek");
840 CAMLreturn (Val_unit);
844 ocaml_libvirt_domain_memory_peek_bytecode (value *argv, int argn)
846 return ocaml_libvirt_domain_memory_peek_native (argv[0], argv[1], argv[2],
847 argv[3], argv[4], argv[5]);
850 /*----------------------------------------------------------------------*/
855 ocaml_libvirt_event_register_default_impl (value unitv)
859 /* arg is of type unit = void */
862 NONBLOCKING (r = virEventRegisterDefaultImpl ());
863 /* must be called before connection, therefore we can't use CHECK_ERROR */
864 if (r == -1) caml_failwith("virEventRegisterDefaultImpl");
866 CAMLreturn (Val_unit);
870 ocaml_libvirt_event_run_default_impl (value unitv)
874 /* arg is of type unit = void */
877 NONBLOCKING (r = virEventRunDefaultImpl ());
878 if (r == -1) caml_failwith("virEventRunDefaultImpl");
880 CAMLreturn (Val_unit);
883 /* We register a single C callback function for every distinct
884 callback signature. We encode the signature itself in the function
885 name and also in the name of the assocated OCaml callback
888 i_i64_s_callback(virConnectPtr conn,
894 would correspond to an OCaml callback
895 Libvirt.i_i64_s_callback :
896 int64 -> [`R] Domain.t -> int -> int64 -> string option -> unit
897 where the initial int64 is a unique ID used by the OCaml to
898 dispatch to the specific OCaml closure and stored by libvirt
899 as the "opaque" data. */
901 /* Every one of the callbacks starts with a DOMAIN_CALLBACK_BEGIN(NAME)
902 where NAME is the string name of the OCaml callback registered
904 #define DOMAIN_CALLBACK_BEGIN(NAME) \
905 value connv, domv, callback_id, result; \
906 connv = domv = callback_id = result = Val_int(0); \
907 static value *callback = NULL; \
908 caml_leave_blocking_section(); \
909 if (callback == NULL) \
910 callback = caml_named_value(NAME); \
911 if (callback == NULL) \
912 abort(); /* C code out of sync with OCaml code */ \
913 if ((virDomainRef(dom) == -1) || (virConnectRef(conn) == -1)) \
914 abort(); /* should never happen in practice? */ \
916 Begin_roots4(connv, domv, callback_id, result); \
917 connv = Val_connect(conn); \
918 domv = Val_domain(dom, connv); \
919 callback_id = caml_copy_int64(*(long *)opaque);
921 /* Every one of the callbacks ends with a CALLBACK_END */
922 #define DOMAIN_CALLBACK_END \
923 (void) caml_callback3(*callback, callback_id, domv, result); \
925 caml_enter_blocking_section();
929 i_i_callback(virConnectPtr conn,
935 DOMAIN_CALLBACK_BEGIN("Libvirt.i_i_callback")
936 result = caml_alloc_tuple(2);
937 Store_field(result, 0, Val_int(x));
938 Store_field(result, 1, Val_int(y));
943 u_callback(virConnectPtr conn,
947 DOMAIN_CALLBACK_BEGIN("Libvirt.u_callback")
948 result = Val_int(0); /* () */
953 i64_callback(virConnectPtr conn,
958 DOMAIN_CALLBACK_BEGIN("Libvirt.i64_callback")
959 result = caml_copy_int64(int64);
964 i_callback(virConnectPtr conn,
969 DOMAIN_CALLBACK_BEGIN("Libvirt.i_callback")
975 s_i_callback(virConnectPtr conn,
981 DOMAIN_CALLBACK_BEGIN("Libvirt.s_i_callback")
982 result = caml_alloc_tuple(2);
983 Store_field(result, 0,
984 Val_opt(x, (Val_ptr_t) caml_copy_string));
985 Store_field(result, 1, Val_int(y));
990 s_i_i_callback(virConnectPtr conn,
997 DOMAIN_CALLBACK_BEGIN("Libvirt.s_i_i_callback")
998 result = caml_alloc_tuple(3);
999 Store_field(result, 0,
1000 Val_opt(x, (Val_ptr_t) caml_copy_string));
1001 Store_field(result, 1, Val_int(y));
1002 Store_field(result, 2, Val_int(z));
1007 s_s_i_callback(virConnectPtr conn,
1014 DOMAIN_CALLBACK_BEGIN("Libvirt.s_s_i_callback")
1015 result = caml_alloc_tuple(3);
1016 Store_field(result, 0,
1017 Val_opt(x, (Val_ptr_t) caml_copy_string));
1018 Store_field(result, 1,
1019 Val_opt(y, (Val_ptr_t) caml_copy_string));
1020 Store_field(result, 2, Val_int(z));
1025 s_s_i_s_callback(virConnectPtr conn,
1033 DOMAIN_CALLBACK_BEGIN("Libvirt.s_s_i_s_callback")
1034 result = caml_alloc_tuple(4);
1035 Store_field(result, 0,
1036 Val_opt(x, (Val_ptr_t) caml_copy_string));
1037 Store_field(result, 1,
1038 Val_opt(y, (Val_ptr_t) caml_copy_string));
1039 Store_field(result, 2, Val_int(z));
1040 Store_field(result, 3,
1041 Val_opt(a, (Val_ptr_t) caml_copy_string));
1046 s_s_s_i_callback(virConnectPtr conn,
1054 DOMAIN_CALLBACK_BEGIN("Libvirt.s_s_s_i_callback")
1055 result = caml_alloc_tuple(4);
1056 Store_field(result, 0,
1057 Val_opt(x, (Val_ptr_t) caml_copy_string));
1058 Store_field(result, 1,
1059 Val_opt(y, (Val_ptr_t) caml_copy_string));
1060 Store_field(result, 2,
1061 Val_opt(z, (Val_ptr_t) caml_copy_string));
1062 Store_field(result, 3, Val_int(a));
1067 Val_event_graphics_address(virDomainEventGraphicsAddressPtr x)
1071 result = caml_alloc_tuple(3);
1072 Store_field(result, 0, Val_int(x->family));
1073 Store_field(result, 1,
1074 Val_opt((void *) x->node, (Val_ptr_t) caml_copy_string));
1075 Store_field(result, 2,
1076 Val_opt((void *) x->service, (Val_ptr_t) caml_copy_string));
1081 Val_event_graphics_subject_identity(virDomainEventGraphicsSubjectIdentityPtr x)
1085 result = caml_alloc_tuple(2);
1086 Store_field(result, 0,
1087 Val_opt((void *) x->type, (Val_ptr_t) caml_copy_string));
1088 Store_field(result, 1,
1089 Val_opt((void *) x->name, (Val_ptr_t) caml_copy_string));
1095 Val_event_graphics_subject(virDomainEventGraphicsSubjectPtr x)
1100 result = caml_alloc_tuple(x->nidentity);
1101 for (i = 0; i < x->nidentity; i++ )
1102 Store_field(result, i,
1103 Val_event_graphics_subject_identity(x->identities + i));
1108 i_ga_ga_s_gs_callback(virConnectPtr conn,
1111 virDomainEventGraphicsAddressPtr ga1,
1112 virDomainEventGraphicsAddressPtr ga2,
1114 virDomainEventGraphicsSubjectPtr gs1,
1117 DOMAIN_CALLBACK_BEGIN("Libvirt.i_ga_ga_s_gs_callback")
1118 result = caml_alloc_tuple(5);
1119 Store_field(result, 0, Val_int(i1));
1120 Store_field(result, 1, Val_event_graphics_address(ga1));
1121 Store_field(result, 2, Val_event_graphics_address(ga2));
1122 Store_field(result, 3,
1123 Val_opt(s1, (Val_ptr_t) caml_copy_string));
1124 Store_field(result, 4, Val_event_graphics_subject(gs1));
1129 timeout_callback(int timer, void *opaque)
1131 value callback_id, result;
1132 callback_id = result = Val_int(0);
1133 static value *callback = NULL;
1134 caml_leave_blocking_section();
1135 if (callback == NULL)
1136 callback = caml_named_value("Libvirt.timeout_callback");
1137 if (callback == NULL)
1138 abort(); /* C code out of sync with OCaml code */
1140 Begin_roots2(callback_id, result);
1141 callback_id = caml_copy_int64(*(long *)opaque);
1143 (void)caml_callback_exn(*callback, callback_id);
1145 caml_enter_blocking_section();
1149 ocaml_libvirt_event_add_timeout (value connv, value ms, value callback_id)
1151 CAMLparam3 (connv, ms, callback_id);
1153 virFreeCallback freecb = free;
1154 virEventTimeoutCallback cb = timeout_callback;
1158 /* Store the int64 callback_id as the opaque data so the OCaml
1159 callback can demultiplex to the correct OCaml handler. */
1160 if ((opaque = malloc(sizeof(long))) == NULL)
1161 caml_failwith ("virEventAddTimeout: malloc");
1162 *((long*)opaque) = Int64_val(callback_id);
1163 NONBLOCKING(r = virEventAddTimeout(Int_val(ms), cb, opaque, freecb));
1164 CHECK_ERROR(r == -1, "virEventAddTimeout");
1166 CAMLreturn(Val_int(r));
1170 ocaml_libvirt_event_remove_timeout (value connv, value timer_id)
1172 CAMLparam2 (connv, timer_id);
1175 NONBLOCKING(r = virEventRemoveTimeout(Int_val(timer_id)));
1176 CHECK_ERROR(r == -1, "virEventRemoveTimeout");
1178 CAMLreturn(Val_int(r));
1182 ocaml_libvirt_connect_domain_event_register_any(value connv, value domv, value callback, value callback_id)
1184 CAMLparam4(connv, domv, callback, callback_id);
1186 virConnectPtr conn = Connect_val (connv);
1187 virDomainPtr dom = NULL;
1188 int eventID = Tag_val(callback);
1190 virConnectDomainEventGenericCallback cb;
1192 virFreeCallback freecb = free;
1195 if (domv != Val_int(0))
1196 dom = Domain_val (Field(domv, 0));
1199 case VIR_DOMAIN_EVENT_ID_LIFECYCLE:
1200 cb = VIR_DOMAIN_EVENT_CALLBACK(i_i_callback);
1202 case VIR_DOMAIN_EVENT_ID_REBOOT:
1203 cb = VIR_DOMAIN_EVENT_CALLBACK(u_callback);
1205 case VIR_DOMAIN_EVENT_ID_RTC_CHANGE:
1206 cb = VIR_DOMAIN_EVENT_CALLBACK(i64_callback);
1208 case VIR_DOMAIN_EVENT_ID_WATCHDOG:
1209 cb = VIR_DOMAIN_EVENT_CALLBACK(i_callback);
1211 case VIR_DOMAIN_EVENT_ID_IO_ERROR:
1212 cb = VIR_DOMAIN_EVENT_CALLBACK(s_s_i_callback);
1214 case VIR_DOMAIN_EVENT_ID_GRAPHICS:
1215 cb = VIR_DOMAIN_EVENT_CALLBACK(i_ga_ga_s_gs_callback);
1217 case VIR_DOMAIN_EVENT_ID_IO_ERROR_REASON:
1218 cb = VIR_DOMAIN_EVENT_CALLBACK(s_s_i_s_callback);
1220 case VIR_DOMAIN_EVENT_ID_CONTROL_ERROR:
1221 cb = VIR_DOMAIN_EVENT_CALLBACK(u_callback);
1223 case VIR_DOMAIN_EVENT_ID_BLOCK_JOB:
1224 cb = VIR_DOMAIN_EVENT_CALLBACK(s_i_i_callback);
1226 case VIR_DOMAIN_EVENT_ID_DISK_CHANGE:
1227 cb = VIR_DOMAIN_EVENT_CALLBACK(s_s_s_i_callback);
1229 case VIR_DOMAIN_EVENT_ID_TRAY_CHANGE:
1230 cb = VIR_DOMAIN_EVENT_CALLBACK(s_i_callback);
1232 case VIR_DOMAIN_EVENT_ID_PMWAKEUP:
1233 cb = VIR_DOMAIN_EVENT_CALLBACK(i_callback);
1235 case VIR_DOMAIN_EVENT_ID_PMSUSPEND:
1236 cb = VIR_DOMAIN_EVENT_CALLBACK(i_callback);
1238 case VIR_DOMAIN_EVENT_ID_BALLOON_CHANGE:
1239 cb = VIR_DOMAIN_EVENT_CALLBACK(i64_callback);
1241 case VIR_DOMAIN_EVENT_ID_PMSUSPEND_DISK:
1242 cb = VIR_DOMAIN_EVENT_CALLBACK(i_callback);
1245 caml_failwith("vifConnectDomainEventRegisterAny: unimplemented eventID");
1248 /* Store the int64 callback_id as the opaque data so the OCaml
1249 callback can demultiplex to the correct OCaml handler. */
1250 if ((opaque = malloc(sizeof(long))) == NULL)
1251 caml_failwith ("virConnectDomainEventRegisterAny: malloc");
1252 *((long*)opaque) = Int64_val(callback_id);
1253 NONBLOCKING(r = virConnectDomainEventRegisterAny(conn, dom, eventID, cb, opaque, freecb));
1254 CHECK_ERROR(r == -1, "virConnectDomainEventRegisterAny");
1256 CAMLreturn(Val_int(r));
1260 ocaml_libvirt_storage_pool_get_info (value poolv)
1264 virStoragePoolPtr pool = Pool_val (poolv);
1265 virStoragePoolInfo info;
1268 NONBLOCKING (r = virStoragePoolGetInfo (pool, &info));
1269 CHECK_ERROR (r == -1, "virStoragePoolGetInfo");
1271 rv = caml_alloc (4, 0);
1272 Store_field (rv, 0, Val_int (info.state));
1273 v = caml_copy_int64 (info.capacity); Store_field (rv, 1, v);
1274 v = caml_copy_int64 (info.allocation); Store_field (rv, 2, v);
1275 v = caml_copy_int64 (info.available); Store_field (rv, 3, v);
1281 ocaml_libvirt_storage_vol_get_info (value volv)
1285 virStorageVolPtr vol = Volume_val (volv);
1286 virStorageVolInfo info;
1289 NONBLOCKING (r = virStorageVolGetInfo (vol, &info));
1290 CHECK_ERROR (r == -1, "virStorageVolGetInfo");
1292 rv = caml_alloc (3, 0);
1293 Store_field (rv, 0, Val_int (info.type));
1294 v = caml_copy_int64 (info.capacity); Store_field (rv, 1, v);
1295 v = caml_copy_int64 (info.allocation); Store_field (rv, 2, v);
1300 /*----------------------------------------------------------------------*/
1303 ocaml_libvirt_virterror_get_last_error (value unitv)
1307 virErrorPtr err = virGetLastError ();
1309 rv = Val_opt (err, (Val_ptr_t) Val_virterror);
1315 ocaml_libvirt_virterror_get_last_conn_error (value connv)
1319 virConnectPtr conn = Connect_val (connv);
1321 rv = Val_opt (conn, (Val_ptr_t) Val_connect);
1327 ocaml_libvirt_virterror_reset_last_error (value unitv)
1330 virResetLastError ();
1331 CAMLreturn (Val_unit);
1335 ocaml_libvirt_virterror_reset_last_conn_error (value connv)
1338 virConnectPtr conn = Connect_val (connv);
1339 virConnResetLastError (conn);
1340 CAMLreturn (Val_unit);
1343 /*----------------------------------------------------------------------*/
1346 ignore_errors (void *user_data, virErrorPtr error)
1351 /* Initialise the library. */
1353 ocaml_libvirt_init (value unit)
1357 virSetErrorFunc (NULL, ignore_errors);
1360 CAMLreturn (Val_unit);