1 /* OCaml bindings for libvirt.
2 * (C) Copyright 2007 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 #ifdef HAVE_WEAK_SYMBOLS
23 #ifdef HAVE_VIRDOMAINBLOCKSTATS
24 extern int virDomainBlockStats (virDomainPtr dom,
26 virDomainBlockStatsPtr stats,
28 __attribute__((weak));
30 #ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS
31 extern int virDomainGetSchedulerParameters (virDomainPtr domain,
32 virSchedParameterPtr params,
34 __attribute__((weak));
36 #ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE
37 extern char *virDomainGetSchedulerType(virDomainPtr domain,
39 __attribute__((weak));
41 #ifdef HAVE_VIRDOMAININTERFACESTATS
42 extern int virDomainInterfaceStats (virDomainPtr dom,
44 virDomainInterfaceStatsPtr stats,
46 __attribute__((weak));
48 #ifdef HAVE_VIRDOMAINMIGRATE
49 extern virDomainPtr virDomainMigrate (virDomainPtr domain, virConnectPtr dconn,
50 unsigned long flags, const char *dname,
51 const char *uri, unsigned long bandwidth)
52 __attribute__((weak));
54 #ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS
55 extern int virDomainSetSchedulerParameters (virDomainPtr domain,
56 virSchedParameterPtr params,
58 __attribute__((weak));
60 #ifdef HAVE_VIRNODEGETFREEMEMORY
61 extern unsigned long long virNodeGetFreeMemory (virConnectPtr conn)
62 __attribute__((weak));
64 #ifdef HAVE_VIRNODEGETCELLSFREEMEMORY
65 extern int virNodeGetCellsFreeMemory (virConnectPtr conn,
66 unsigned long long *freeMems,
67 int startCell, int maxCells)
68 __attribute__((weak));
70 #endif /* HAVE_WEAK_SYMBOLS */
72 /*----------------------------------------------------------------------*/
75 ocaml_libvirt_get_version (value driverv, value unit)
77 CAMLparam2 (driverv, unit);
79 const char *driver = Optstring_val (driverv);
80 unsigned long libVer, typeVer = 0, *typeVer_ptr;
83 typeVer_ptr = driver ? &typeVer : NULL;
84 NONBLOCKING (r = virGetVersion (&libVer, driver, typeVer_ptr));
85 CHECK_ERROR (r == -1, NULL, "virGetVersion");
87 rv = caml_alloc_tuple (2);
88 Store_field (rv, 0, Val_int (libVer));
89 Store_field (rv, 1, Val_int (typeVer));
93 /*----------------------------------------------------------------------*/
95 /* Connection object. */
98 ocaml_libvirt_connect_open (value namev, value unit)
100 CAMLparam2 (namev, unit);
102 const char *name = Optstring_val (namev);
105 NONBLOCKING (conn = virConnectOpen (name));
106 CHECK_ERROR (!conn, NULL, "virConnectOpen");
108 rv = Val_connect (conn);
114 ocaml_libvirt_connect_open_readonly (value namev, value unit)
116 CAMLparam2 (namev, unit);
118 const char *name = Optstring_val (namev);
121 NONBLOCKING (conn = virConnectOpenReadOnly (name));
122 CHECK_ERROR (!conn, NULL, "virConnectOpen");
124 rv = Val_connect (conn);
130 ocaml_libvirt_connect_close (value connv)
133 virConnectPtr conn = Connect_val (connv);
136 NONBLOCKING (r = virConnectClose (conn));
137 CHECK_ERROR (r == -1, conn, "virConnectClose");
139 /* So that we don't double-free in the finalizer: */
140 Connect_val (connv) = NULL;
142 CAMLreturn (Val_unit);
146 ocaml_libvirt_connect_get_version (value connv)
149 virConnectPtr conn = Connect_val (connv);
153 NONBLOCKING (r = virConnectGetVersion (conn, &hvVer));
154 CHECK_ERROR (r == -1, conn, "virConnectGetVersion");
156 CAMLreturn (Val_int (hvVer));
160 ocaml_libvirt_connect_get_max_vcpus (value connv, value typev)
162 CAMLparam2 (connv, typev);
163 virConnectPtr conn = Connect_val (connv);
164 const char *type = Optstring_val (typev);
167 NONBLOCKING (r = virConnectGetMaxVcpus (conn, type));
168 CHECK_ERROR (r == -1, conn, "virConnectGetMaxVcpus");
170 CAMLreturn (Val_int (r));
174 ocaml_libvirt_connect_get_node_info (value connv)
178 virConnectPtr conn = Connect_val (connv);
182 NONBLOCKING (r = virNodeGetInfo (conn, &info));
183 CHECK_ERROR (r == -1, conn, "virNodeGetInfo");
185 rv = caml_alloc (8, 0);
186 v = caml_copy_string (info.model); Store_field (rv, 0, v);
187 v = caml_copy_int64 (info.memory); Store_field (rv, 1, v);
188 Store_field (rv, 2, Val_int (info.cpus));
189 Store_field (rv, 3, Val_int (info.mhz));
190 Store_field (rv, 4, Val_int (info.nodes));
191 Store_field (rv, 5, Val_int (info.sockets));
192 Store_field (rv, 6, Val_int (info.cores));
193 Store_field (rv, 7, Val_int (info.threads));
199 ocaml_libvirt_connect_node_get_free_memory (value connv)
201 #ifdef HAVE_VIRNODEGETFREEMEMORY
204 virConnectPtr conn = Connect_val (connv);
205 unsigned long long r;
207 WEAK_SYMBOL_CHECK (virNodeGetFreeMemory);
208 NONBLOCKING (r = virNodeGetFreeMemory (conn));
209 CHECK_ERROR (r == 0, conn, "virNodeGetFreeMemory");
211 rv = caml_copy_int64 ((int64) r);
214 not_supported ("virNodeGetFreeMemory");
219 ocaml_libvirt_connect_node_get_cells_free_memory (value connv,
220 value startv, value maxv)
222 #ifdef HAVE_VIRNODEGETCELLSFREEMEMORY
223 CAMLparam3 (connv, startv, maxv);
225 virConnectPtr conn = Connect_val (connv);
226 int start = Int_val (startv);
227 int max = Int_val (maxv);
229 unsigned long long freemems[max];
231 WEAK_SYMBOL_CHECK (virNodeGetCellsFreeMemory);
232 NONBLOCKING (r = virNodeGetCellsFreeMemory (conn, freemems, start, max));
233 CHECK_ERROR (r == -1, conn, "virNodeGetCellsFreeMemory");
235 rv = caml_alloc (r, 0);
236 for (i = 0; i < r; ++i) {
237 iv = caml_copy_int64 ((int64) freemems[i]);
238 Store_field (rv, i, iv);
243 not_supported ("virNodeGetCellsFreeMemory");
248 ocaml_libvirt_domain_create_linux (value connv, value xmlv)
250 CAMLparam2 (connv, xmlv);
252 virConnectPtr conn = Connect_val (connv);
253 char *xml = String_val (xmlv);
256 NONBLOCKING (r = virDomainCreateLinux (conn, xml, 0));
257 CHECK_ERROR (!r, conn, "virDomainCreateLinux");
259 rv = Val_domain (r, connv);
264 ocaml_libvirt_domain_lookup_by_id (value connv, value iv)
266 CAMLparam2 (connv, iv);
268 virConnectPtr conn = Connect_val (connv);
269 int i = Int_val (iv);
272 NONBLOCKING (r = virDomainLookupByID (conn, i));
273 CHECK_ERROR (!r, conn, "virDomainLookupByID");
275 rv = Val_domain (r, connv);
280 ocaml_libvirt_domain_lookup_by_uuid (value connv, value uuidv)
282 CAMLparam2 (connv, uuidv);
284 virConnectPtr conn = Connect_val (connv);
285 char *uuid = String_val (uuidv);
288 NONBLOCKING (r = virDomainLookupByUUID (conn, (unsigned char *) uuid));
289 CHECK_ERROR (!r, conn, "virDomainLookupByUUID");
291 rv = Val_domain (r, connv);
296 ocaml_libvirt_domain_lookup_by_uuid_string (value connv, value uuidv)
298 CAMLparam2 (connv, uuidv);
300 virConnectPtr conn = Connect_val (connv);
301 char *uuid = String_val (uuidv);
304 NONBLOCKING (r = virDomainLookupByUUIDString (conn, uuid));
305 CHECK_ERROR (!r, conn, "virDomainLookupByUUIDString");
307 rv = Val_domain (r, connv);
312 ocaml_libvirt_domain_lookup_by_name (value connv, value namev)
314 CAMLparam2 (connv, namev);
316 virConnectPtr conn = Connect_val (connv);
317 char *name = String_val (namev);
320 NONBLOCKING (r = virDomainLookupByName (conn, name));
321 CHECK_ERROR (!r, conn, "virDomainLookupByName");
323 rv = Val_domain (r, connv);
328 ocaml_libvirt_domain_destroy (value domv)
331 virDomainPtr dom = Domain_val (domv);
332 virConnectPtr conn = Connect_domv (domv);
335 NONBLOCKING (r = virDomainDestroy (dom));
336 CHECK_ERROR (r == -1, conn, "virDomainDestroy");
338 /* So that we don't double-free in the finalizer: */
339 Domain_val (domv) = NULL;
341 CAMLreturn (Val_unit);
345 ocaml_libvirt_domain_free (value domv)
348 virDomainPtr dom = Domain_val (domv);
349 virConnectPtr conn = Connect_domv (domv);
352 NONBLOCKING (r = virDomainFree (dom));
353 CHECK_ERROR (r == -1, conn, "virDomainFree");
355 /* So that we don't double-free in the finalizer: */
356 Domain_val (domv) = NULL;
358 CAMLreturn (Val_unit);
362 ocaml_libvirt_domain_save (value domv, value pathv)
364 CAMLparam2 (domv, pathv);
365 virDomainPtr dom = Domain_val (domv);
366 virConnectPtr conn = Connect_domv (domv);
367 char *path = String_val (pathv);
370 NONBLOCKING (r = virDomainSave (dom, path));
371 CHECK_ERROR (r == -1, conn, "virDomainSave");
373 CAMLreturn (Val_unit);
377 ocaml_libvirt_domain_restore (value connv, value pathv)
379 CAMLparam2 (connv, pathv);
380 virConnectPtr conn = Connect_val (connv);
381 char *path = String_val (pathv);
384 NONBLOCKING (r = virDomainRestore (conn, path));
385 CHECK_ERROR (r == -1, conn, "virDomainRestore");
387 CAMLreturn (Val_unit);
391 ocaml_libvirt_domain_core_dump (value domv, value pathv)
393 CAMLparam2 (domv, pathv);
394 virDomainPtr dom = Domain_val (domv);
395 virConnectPtr conn = Connect_domv (domv);
396 char *path = String_val (pathv);
399 NONBLOCKING (r = virDomainCoreDump (dom, path, 0));
400 CHECK_ERROR (r == -1, conn, "virDomainCoreDump");
402 CAMLreturn (Val_unit);
406 ocaml_libvirt_domain_get_uuid (value domv)
410 virDomainPtr dom = Domain_val (domv);
411 virConnectPtr conn = Connect_domv (domv);
412 unsigned char uuid[VIR_UUID_BUFLEN];
415 NONBLOCKING (r = virDomainGetUUID (dom, uuid));
416 CHECK_ERROR (r == -1, conn, "virDomainGetUUID");
418 rv = caml_copy_string ((char *) uuid);
423 ocaml_libvirt_domain_get_uuid_string (value domv)
427 virDomainPtr dom = Domain_val (domv);
428 virConnectPtr conn = Connect_domv (domv);
429 char uuid[VIR_UUID_STRING_BUFLEN];
432 NONBLOCKING (r = virDomainGetUUIDString (dom, uuid));
433 CHECK_ERROR (r == -1, conn, "virDomainGetUUIDString");
435 rv = caml_copy_string (uuid);
440 ocaml_libvirt_domain_get_id (value domv)
443 virDomainPtr dom = Domain_val (domv);
444 virConnectPtr conn = Connect_domv (domv);
447 NONBLOCKING (r = virDomainGetID (dom));
448 /* There's a bug in libvirt which means that if you try to get
449 * the ID of a defined-but-not-running domain, it returns -1,
450 * and there's no way to distinguish that from an error.
452 CHECK_ERROR (r == (unsigned int) -1, conn, "virDomainGetID");
454 CAMLreturn (Val_int ((int) r));
458 ocaml_libvirt_domain_get_max_memory (value domv)
462 virDomainPtr dom = Domain_val (domv);
463 virConnectPtr conn = Connect_domv (domv);
466 NONBLOCKING (r = virDomainGetMaxMemory (dom));
467 CHECK_ERROR (r == 0 /* [sic] */, conn, "virDomainGetMaxMemory");
469 rv = caml_copy_int64 (r);
474 ocaml_libvirt_domain_set_max_memory (value domv, value memv)
476 CAMLparam2 (domv, memv);
477 virDomainPtr dom = Domain_val (domv);
478 virConnectPtr conn = Connect_domv (domv);
479 unsigned long mem = Int64_val (memv);
482 NONBLOCKING (r = virDomainSetMaxMemory (dom, mem));
483 CHECK_ERROR (r == -1, conn, "virDomainSetMaxMemory");
485 CAMLreturn (Val_unit);
489 ocaml_libvirt_domain_set_memory (value domv, value memv)
491 CAMLparam2 (domv, memv);
492 virDomainPtr dom = Domain_val (domv);
493 virConnectPtr conn = Connect_domv (domv);
494 unsigned long mem = Int64_val (memv);
497 NONBLOCKING (r = virDomainSetMemory (dom, mem));
498 CHECK_ERROR (r == -1, conn, "virDomainSetMemory");
500 CAMLreturn (Val_unit);
504 ocaml_libvirt_domain_get_info (value domv)
508 virDomainPtr dom = Domain_val (domv);
509 virConnectPtr conn = Connect_domv (domv);
513 NONBLOCKING (r = virDomainGetInfo (dom, &info));
514 CHECK_ERROR (r == -1, conn, "virDomainGetInfo");
516 rv = caml_alloc (5, 0);
517 Store_field (rv, 0, Val_int (info.state)); // These flags are compatible.
518 v = caml_copy_int64 (info.maxMem); Store_field (rv, 1, v);
519 v = caml_copy_int64 (info.memory); Store_field (rv, 2, v);
520 Store_field (rv, 3, Val_int (info.nrVirtCpu));
521 v = caml_copy_int64 (info.cpuTime); Store_field (rv, 4, v);
527 ocaml_libvirt_domain_get_scheduler_type (value domv)
529 #ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE
531 CAMLlocal2 (rv, strv);
532 virDomainPtr dom = Domain_val (domv);
533 virConnectPtr conn = Connect_domv (domv);
537 WEAK_SYMBOL_CHECK (virDomainGetSchedulerType);
538 NONBLOCKING (r = virDomainGetSchedulerType (dom, &nparams));
539 CHECK_ERROR (!r, conn, "virDomainGetSchedulerType");
541 rv = caml_alloc_tuple (2);
542 strv = caml_copy_string (r); Store_field (rv, 0, strv);
544 Store_field (rv, 1, nparams);
547 not_supported ("virDomainGetSchedulerType");
552 ocaml_libvirt_domain_get_scheduler_parameters (value domv, value nparamsv)
554 #ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS
555 CAMLparam2 (domv, nparamsv);
556 CAMLlocal4 (rv, v, v2, v3);
557 virDomainPtr dom = Domain_val (domv);
558 virConnectPtr conn = Connect_domv (domv);
559 int nparams = Int_val (nparamsv);
560 virSchedParameter params[nparams];
563 WEAK_SYMBOL_CHECK (virDomainGetSchedulerParameters);
564 NONBLOCKING (r = virDomainGetSchedulerParameters (dom, params, &nparams));
565 CHECK_ERROR (r == -1, conn, "virDomainGetSchedulerParameters");
567 rv = caml_alloc (nparams, 0);
568 for (i = 0; i < nparams; ++i) {
569 v = caml_alloc_tuple (2); Store_field (rv, i, v);
570 v2 = caml_copy_string (params[i].field); Store_field (v, 0, v2);
571 switch (params[i].type) {
572 case VIR_DOMAIN_SCHED_FIELD_INT:
573 v2 = caml_alloc (1, 0);
574 v3 = caml_copy_int32 (params[i].value.i); Store_field (v2, 0, v3);
576 case VIR_DOMAIN_SCHED_FIELD_UINT:
577 v2 = caml_alloc (1, 1);
578 v3 = caml_copy_int32 (params[i].value.ui); Store_field (v2, 0, v3);
580 case VIR_DOMAIN_SCHED_FIELD_LLONG:
581 v2 = caml_alloc (1, 2);
582 v3 = caml_copy_int64 (params[i].value.l); Store_field (v2, 0, v3);
584 case VIR_DOMAIN_SCHED_FIELD_ULLONG:
585 v2 = caml_alloc (1, 3);
586 v3 = caml_copy_int64 (params[i].value.ul); Store_field (v2, 0, v3);
588 case VIR_DOMAIN_SCHED_FIELD_DOUBLE:
589 v2 = caml_alloc (1, 4);
590 v3 = caml_copy_double (params[i].value.d); Store_field (v2, 0, v3);
592 case VIR_DOMAIN_SCHED_FIELD_BOOLEAN:
593 v2 = caml_alloc (1, 5);
594 Store_field (v2, 0, Val_int (params[i].value.b));
597 caml_failwith ((char *)__FUNCTION__);
599 Store_field (v, 1, v2);
603 not_supported ("virDomainGetSchedulerParameters");
608 ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv)
610 #ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS
611 CAMLparam2 (domv, paramsv);
613 virDomainPtr dom = Domain_val (domv);
614 virConnectPtr conn = Connect_domv (domv);
615 int nparams = Wosize_val (paramsv);
616 virSchedParameter params[nparams];
620 for (i = 0; i < nparams; ++i) {
621 v = Field (paramsv, i); /* Points to the two-element tuple. */
622 name = String_val (Field (v, 0));
623 strncpy (params[i].field, name, VIR_DOMAIN_SCHED_FIELD_LENGTH);
624 params[i].field[VIR_DOMAIN_SCHED_FIELD_LENGTH-1] = '\0';
625 v = Field (v, 1); /* Points to the sched_param_value block. */
626 switch (Tag_val (v)) {
628 params[i].type = VIR_DOMAIN_SCHED_FIELD_INT;
629 params[i].value.i = Int32_val (Field (v, 0));
632 params[i].type = VIR_DOMAIN_SCHED_FIELD_UINT;
633 params[i].value.ui = Int32_val (Field (v, 0));
636 params[i].type = VIR_DOMAIN_SCHED_FIELD_LLONG;
637 params[i].value.l = Int64_val (Field (v, 0));
640 params[i].type = VIR_DOMAIN_SCHED_FIELD_ULLONG;
641 params[i].value.ul = Int64_val (Field (v, 0));
644 params[i].type = VIR_DOMAIN_SCHED_FIELD_DOUBLE;
645 params[i].value.d = Double_val (Field (v, 0));
648 params[i].type = VIR_DOMAIN_SCHED_FIELD_BOOLEAN;
649 params[i].value.b = Int_val (Field (v, 0));
652 caml_failwith ((char *)__FUNCTION__);
656 WEAK_SYMBOL_CHECK (virDomainSetSchedulerParameters);
657 NONBLOCKING (r = virDomainSetSchedulerParameters (dom, params, nparams));
658 CHECK_ERROR (r == -1, conn, "virDomainSetSchedulerParameters");
660 CAMLreturn (Val_unit);
662 not_supported ("virDomainSetSchedulerParameters");
667 ocaml_libvirt_domain_define_xml (value connv, value xmlv)
669 CAMLparam2 (connv, xmlv);
671 virConnectPtr conn = Connect_val (connv);
672 char *xml = String_val (xmlv);
675 NONBLOCKING (r = virDomainDefineXML (conn, xml));
676 CHECK_ERROR (!r, conn, "virDomainDefineXML");
678 rv = Val_domain (r, connv);
683 ocaml_libvirt_domain_get_autostart (value domv)
686 virDomainPtr dom = Domain_val (domv);
687 virConnectPtr conn = Connect_domv (domv);
690 NONBLOCKING (r = virDomainGetAutostart (dom, &autostart));
691 CHECK_ERROR (r == -1, conn, "virDomainGetAutostart");
693 CAMLreturn (autostart ? Val_true : Val_false);
697 ocaml_libvirt_domain_set_autostart (value domv, value autostartv)
699 CAMLparam2 (domv, autostartv);
700 virDomainPtr dom = Domain_val (domv);
701 virConnectPtr conn = Connect_domv (domv);
702 int r, autostart = autostartv == Val_true ? 1 : 0;
704 NONBLOCKING (r = virDomainSetAutostart (dom, autostart));
705 CHECK_ERROR (r == -1, conn, "virDomainSetAutostart");
707 CAMLreturn (Val_unit);
711 ocaml_libvirt_domain_set_vcpus (value domv, value nvcpusv)
713 CAMLparam2 (domv, nvcpusv);
714 virDomainPtr dom = Domain_val (domv);
715 virConnectPtr conn = Connect_domv (domv);
716 int r, nvcpus = Int_val (nvcpusv);
718 NONBLOCKING (r = virDomainSetVcpus (dom, nvcpus));
719 CHECK_ERROR (r == -1, conn, "virDomainSetVcpus");
721 CAMLreturn (Val_unit);
725 ocaml_libvirt_domain_pin_vcpu (value domv, value vcpuv, value cpumapv)
727 CAMLparam3 (domv, vcpuv, cpumapv);
728 virDomainPtr dom = Domain_val (domv);
729 virConnectPtr conn = Connect_domv (domv);
730 int maplen = caml_string_length (cpumapv);
731 unsigned char *cpumap = (unsigned char *) String_val (cpumapv);
732 int vcpu = Int_val (vcpuv);
735 NONBLOCKING (r = virDomainPinVcpu (dom, vcpu, cpumap, maplen));
736 CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
738 CAMLreturn (Val_unit);
742 ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv)
744 CAMLparam3 (domv, maxinfov, maplenv);
745 CAMLlocal5 (rv, infov, strv, v, v2);
746 virDomainPtr dom = Domain_val (domv);
747 virConnectPtr conn = Connect_domv (domv);
748 int maxinfo = Int_val (maxinfov);
749 int maplen = Int_val (maplenv);
750 virVcpuInfo info[maxinfo];
751 unsigned char cpumaps[maxinfo * maplen];
754 memset (info, 0, sizeof (virVcpuInfo) * maxinfo);
755 memset (cpumaps, 0, maxinfo * maplen);
757 NONBLOCKING (r = virDomainGetVcpus (dom, info, maxinfo, cpumaps, maplen));
758 CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
760 /* Copy the virVcpuInfo structures. */
761 infov = caml_alloc (maxinfo, 0);
762 for (i = 0; i < maxinfo; ++i) {
763 v2 = caml_alloc (4, 0); Store_field (infov, i, v2);
764 Store_field (v2, 0, Val_int (info[i].number));
765 Store_field (v2, 1, Val_int (info[i].state));
766 v = caml_copy_int64 (info[i].cpuTime); Store_field (v2, 2, v);
767 Store_field (v2, 3, Val_int (info[i].cpu));
770 /* Copy the bitmap. */
771 strv = caml_alloc_string (maxinfo * maplen);
772 memcpy (String_val (strv), cpumaps, maxinfo * maplen);
774 /* Allocate the tuple and return it. */
775 rv = caml_alloc_tuple (3);
776 Store_field (rv, 0, Val_int (r)); /* number of CPUs. */
777 Store_field (rv, 1, infov);
778 Store_field (rv, 2, strv);
784 ocaml_libvirt_domain_get_max_vcpus (value domv)
787 virDomainPtr dom = Domain_val (domv);
788 virConnectPtr conn = Connect_domv (domv);
791 NONBLOCKING (r = virDomainGetMaxVcpus (dom));
792 CHECK_ERROR (r == -1, conn, "virDomainGetMaxVcpus");
794 CAMLreturn (Val_int (r));
798 ocaml_libvirt_domain_attach_device (value domv, value xmlv)
800 CAMLparam2 (domv, xmlv);
801 virDomainPtr dom = Domain_val (domv);
802 virConnectPtr conn = Connect_domv (domv);
803 char *xml = String_val (xmlv);
806 NONBLOCKING (r = virDomainAttachDevice (dom, xml));
807 CHECK_ERROR (r == -1, conn, "virDomainAttachDevice");
809 CAMLreturn (Val_unit);
813 ocaml_libvirt_domain_detach_device (value domv, value xmlv)
815 CAMLparam2 (domv, xmlv);
816 virDomainPtr dom = Domain_val (domv);
817 virConnectPtr conn = Connect_domv (domv);
818 char *xml = String_val (xmlv);
821 NONBLOCKING (r = virDomainDetachDevice (dom, xml));
822 CHECK_ERROR (r == -1, conn, "virDomainDetachDevice");
824 CAMLreturn (Val_unit);
828 ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, value optdnamev, value opturiv, value optbandwidthv, value unitv)
830 #ifdef HAVE_VIRDOMAINMIGRATE
831 CAMLparam5 (domv, dconnv, flagsv, optdnamev, opturiv);
832 CAMLxparam2 (optbandwidthv, unitv);
833 CAMLlocal2 (flagv, rv);
834 virDomainPtr dom = Domain_val (domv);
835 virConnectPtr conn = Connect_domv (domv);
836 virConnectPtr dconn = Connect_val (dconnv);
838 const char *dname = Optstring_val (optdnamev);
839 const char *uri = Optstring_val (opturiv);
840 unsigned long bandwidth;
843 /* Iterate over the list of flags. */
844 for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
846 flagv = Field (flagsv, 0);
847 if (flagv == Int_val(0))
848 flags |= VIR_MIGRATE_LIVE;
851 if (optbandwidthv == Val_int (0)) /* None */
853 else /* Some bandwidth */
854 bandwidth = Int_val (Field (optbandwidthv, 0));
856 WEAK_SYMBOL_CHECK (virDomainMigrate);
857 NONBLOCKING (r = virDomainMigrate (dom, dconn, flags, dname, uri, bandwidth));
858 CHECK_ERROR (!r, conn, "virDomainMigrate");
860 rv = Val_domain (r, dconnv);
864 #else /* virDomainMigrate not supported */
865 not_supported ("virDomainMigrate");
870 ocaml_libvirt_domain_migrate_bytecode (value *argv, int argn)
872 return ocaml_libvirt_domain_migrate_native (argv[0], argv[1], argv[2],
873 argv[3], argv[4], argv[5],
878 ocaml_libvirt_domain_block_stats (value domv, value pathv)
880 #if HAVE_VIRDOMAINBLOCKSTATS
881 CAMLparam2 (domv, pathv);
883 virDomainPtr dom = Domain_val (domv);
884 virConnectPtr conn = Connect_domv (domv);
885 char *path = String_val (pathv);
886 struct _virDomainBlockStats stats;
889 WEAK_SYMBOL_CHECK (virDomainBlockStats);
890 NONBLOCKING (r = virDomainBlockStats (dom, path, &stats, sizeof stats));
891 CHECK_ERROR (r == -1, conn, "virDomainBlockStats");
893 rv = caml_alloc (5, 0);
894 v = caml_copy_int64 (stats.rd_req); Store_field (rv, 0, v);
895 v = caml_copy_int64 (stats.rd_bytes); Store_field (rv, 1, v);
896 v = caml_copy_int64 (stats.wr_req); Store_field (rv, 2, v);
897 v = caml_copy_int64 (stats.wr_bytes); Store_field (rv, 3, v);
898 v = caml_copy_int64 (stats.errs); Store_field (rv, 4, v);
902 not_supported ("virDomainBlockStats");
907 ocaml_libvirt_domain_interface_stats (value domv, value pathv)
909 #if HAVE_VIRDOMAININTERFACESTATS
910 CAMLparam2 (domv, pathv);
912 virDomainPtr dom = Domain_val (domv);
913 virConnectPtr conn = Connect_domv (domv);
914 char *path = String_val (pathv);
915 struct _virDomainInterfaceStats stats;
918 WEAK_SYMBOL_CHECK (virDomainInterfaceStats);
919 NONBLOCKING (r = virDomainInterfaceStats (dom, path, &stats, sizeof stats));
920 CHECK_ERROR (r == -1, conn, "virDomainInterfaceStats");
922 rv = caml_alloc (8, 0);
923 v = caml_copy_int64 (stats.rx_bytes); Store_field (rv, 0, v);
924 v = caml_copy_int64 (stats.rx_packets); Store_field (rv, 1, v);
925 v = caml_copy_int64 (stats.rx_errs); Store_field (rv, 2, v);
926 v = caml_copy_int64 (stats.rx_drop); Store_field (rv, 3, v);
927 v = caml_copy_int64 (stats.tx_bytes); Store_field (rv, 4, v);
928 v = caml_copy_int64 (stats.tx_packets); Store_field (rv, 5, v);
929 v = caml_copy_int64 (stats.tx_errs); Store_field (rv, 6, v);
930 v = caml_copy_int64 (stats.tx_drop); Store_field (rv, 7, v);
934 not_supported ("virDomainInterfaceStats");
939 ocaml_libvirt_network_lookup_by_name (value connv, value namev)
941 CAMLparam2 (connv, namev);
943 virConnectPtr conn = Connect_val (connv);
944 char *name = String_val (namev);
947 NONBLOCKING (r = virNetworkLookupByName (conn, name));
948 CHECK_ERROR (!r, conn, "virNetworkLookupByName");
950 rv = Val_network (r, connv);
955 ocaml_libvirt_network_lookup_by_uuid (value connv, value uuidv)
957 CAMLparam2 (connv, uuidv);
959 virConnectPtr conn = Connect_val (connv);
960 char *uuid = String_val (uuidv);
963 NONBLOCKING (r = virNetworkLookupByUUID (conn, (unsigned char *) uuid));
964 CHECK_ERROR (!r, conn, "virNetworkLookupByUUID");
966 rv = Val_network (r, connv);
971 ocaml_libvirt_network_lookup_by_uuid_string (value connv, value uuidv)
973 CAMLparam2 (connv, uuidv);
975 virConnectPtr conn = Connect_val (connv);
976 char *uuid = String_val (uuidv);
979 NONBLOCKING (r = virNetworkLookupByUUIDString (conn, uuid));
980 CHECK_ERROR (!r, conn, "virNetworkLookupByUUIDString");
982 rv = Val_network (r, connv);
987 ocaml_libvirt_network_create_xml (value connv, value xmlv)
989 CAMLparam2 (connv, xmlv);
991 virConnectPtr conn = Connect_val (connv);
992 char *xml = String_val (xmlv);
995 NONBLOCKING (r = virNetworkCreateXML (conn, xml));
996 CHECK_ERROR (!r, conn, "virNetworkCreateXML");
998 rv = Val_network (r, connv);
1003 ocaml_libvirt_network_define_xml (value connv, value xmlv)
1005 CAMLparam2 (connv, xmlv);
1007 virConnectPtr conn = Connect_val (connv);
1008 char *xml = String_val (xmlv);
1011 NONBLOCKING (r = virNetworkDefineXML (conn, xml));
1012 CHECK_ERROR (!r, conn, "virNetworkDefineXML");
1014 rv = Val_network (r, connv);
1019 ocaml_libvirt_network_destroy (value netv)
1022 virNetworkPtr net = Network_val (netv);
1023 virConnectPtr conn = Connect_netv (netv);
1026 NONBLOCKING (r = virNetworkDestroy (net));
1027 CHECK_ERROR (r == -1, conn, "virNetworkDestroy");
1029 /* So that we don't double-free in the finalizer: */
1030 Network_val (netv) = NULL;
1032 CAMLreturn (Val_unit);
1036 ocaml_libvirt_network_free (value netv)
1039 virNetworkPtr net = Network_val (netv);
1040 virConnectPtr conn = Connect_netv (netv);
1043 NONBLOCKING (r = virNetworkFree (net));
1044 CHECK_ERROR (r == -1, conn, "virNetworkFree");
1046 /* So that we don't double-free in the finalizer: */
1047 Network_val (netv) = NULL;
1049 CAMLreturn (Val_unit);
1053 ocaml_libvirt_network_get_uuid (value netv)
1057 virNetworkPtr net = Network_val (netv);
1058 virConnectPtr conn = Connect_netv (netv);
1059 unsigned char uuid[VIR_UUID_BUFLEN];
1062 NONBLOCKING (r = virNetworkGetUUID (net, uuid));
1063 CHECK_ERROR (r == -1, conn, "virNetworkGetUUID");
1065 rv = caml_copy_string ((char *) uuid);
1070 ocaml_libvirt_network_get_uuid_string (value netv)
1074 virNetworkPtr net = Network_val (netv);
1075 virConnectPtr conn = Connect_netv (netv);
1076 char uuid[VIR_UUID_STRING_BUFLEN];
1079 NONBLOCKING (r = virNetworkGetUUIDString (net, uuid));
1080 CHECK_ERROR (r == -1, conn, "virNetworkGetUUIDString");
1082 rv = caml_copy_string (uuid);
1087 ocaml_libvirt_network_get_autostart (value netv)
1090 virNetworkPtr net = Network_val (netv);
1091 virConnectPtr conn = Connect_netv (netv);
1094 NONBLOCKING (r = virNetworkGetAutostart (net, &autostart));
1095 CHECK_ERROR (r == -1, conn, "virNetworkGetAutostart");
1097 CAMLreturn (autostart ? Val_true : Val_false);
1101 ocaml_libvirt_network_set_autostart (value netv, value autostartv)
1103 CAMLparam2 (netv, autostartv);
1104 virNetworkPtr net = Network_val (netv);
1105 virConnectPtr conn = Connect_netv (netv);
1106 int r, autostart = autostartv == Val_true ? 1 : 0;
1108 NONBLOCKING (r = virNetworkSetAutostart (net, autostart));
1109 CHECK_ERROR (r == -1, conn, "virNetworkSetAutostart");
1111 CAMLreturn (Val_unit);
1114 /*----------------------------------------------------------------------*/
1117 ocaml_libvirt_virterror_get_last_error (value unitv)
1121 virErrorPtr err = virGetLastError ();
1123 rv = Val_opt (err, (Val_ptr_t) Val_virterror);
1129 ocaml_libvirt_virterror_get_last_conn_error (value connv)
1133 virConnectPtr conn = Connect_val (connv);
1135 rv = Val_opt (conn, (Val_ptr_t) Val_connect);
1141 ocaml_libvirt_virterror_reset_last_error (value unitv)
1144 virResetLastError ();
1145 CAMLreturn (Val_unit);
1149 ocaml_libvirt_virterror_reset_last_conn_error (value connv)
1152 virConnectPtr conn = Connect_val (connv);
1153 virConnResetLastError (conn);
1154 CAMLreturn (Val_unit);
1157 /*----------------------------------------------------------------------*/
1159 /* Initialise the library. */
1161 ocaml_libvirt_init (value unit)
1167 r = virInitialize ();
1168 CHECK_ERROR (r == -1, NULL, "virInitialize");
1170 CAMLreturn (Val_unit);