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
26 #include <libvirt/libvirt.h>
27 #include <libvirt/virterror.h>
29 #include <caml/config.h>
30 #include <caml/alloc.h>
31 #include <caml/callback.h>
32 #include <caml/custom.h>
33 #include <caml/fail.h>
34 #include <caml/memory.h>
35 #include <caml/misc.h>
36 #include <caml/mlvalues.h>
37 #include <caml/signals.h>
39 static char *Optstring_val (value strv);
40 typedef value (*Val_ptr_t) (void *);
41 static value Val_opt (void *ptr, Val_ptr_t Val_ptr);
42 /*static value option_default (value option, value deflt);*/
43 static void _raise_virterror (virConnectPtr conn, const char *fn);
44 static void not_supported (const char *fn);
45 static value Val_virterror (virErrorPtr err);
47 /* Use this around synchronous libvirt API calls to release the OCaml
48 * lock, allowing other threads to run simultaneously. 'code' must not
49 * perform any caml_* calls, run any OCaml code, or raise any exception.
50 * http://web.archive.org/web/20030521020915/http://caml.inria.fr/archives/200106/msg00199.html
52 #define NONBLOCKING(code) \
54 caml_enter_blocking_section (); \
56 caml_leave_blocking_section (); \
59 /* Check error condition from a libvirt function, and automatically raise
60 * an exception if one is found.
62 #define CHECK_ERROR(cond, conn, fn) \
63 do { if (cond) _raise_virterror (conn, fn); } while (0)
65 /* For more about weak symbols, see:
66 * http://kolpackov.net/pipermail/notes/2004-March/000006.html
67 * We are using this to do runtime detection of library functions
68 * so that if we dynamically link with an older version of
69 * libvirt than we were compiled against, it won't fail (provided
70 * libvirt >= 0.2.1 - we don't support anything older).
74 #if (__GNUC__ == 3 && __GNUC_MINOR__ >= 3) || (__GNUC__ > 3)
75 #define HAVE_WEAK_SYMBOLS 1
80 #ifdef HAVE_WEAK_SYMBOLS
81 #define WEAK_SYMBOL_CHECK(sym) \
82 do { if (!sym) not_supported(#sym); } while (0)
84 #define WEAK_SYMBOL_CHECK(sym)
85 #endif /* HAVE_WEAK_SYMBOLS */
87 #ifdef HAVE_WEAK_SYMBOLS
88 #ifdef HAVE_VIRCONNECTGETHOSTNAME
89 extern char *virConnectGetHostname (virConnectPtr conn)
90 __attribute__((weak));
92 #ifdef HAVE_VIRCONNECTGETURI
93 extern char *virConnectGetURI (virConnectPtr conn)
94 __attribute__((weak));
96 #ifdef HAVE_VIRDOMAINBLOCKSTATS
97 extern int virDomainBlockStats (virDomainPtr dom,
99 virDomainBlockStatsPtr stats,
101 __attribute__((weak));
103 #ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS
104 extern int virDomainGetSchedulerParameters (virDomainPtr domain,
105 virSchedParameterPtr params,
107 __attribute__((weak));
109 #ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE
110 extern char *virDomainGetSchedulerType(virDomainPtr domain,
112 __attribute__((weak));
114 #ifdef HAVE_VIRDOMAININTERFACESTATS
115 extern int virDomainInterfaceStats (virDomainPtr dom,
117 virDomainInterfaceStatsPtr stats,
119 __attribute__((weak));
121 #ifdef HAVE_VIRDOMAINMIGRATE
122 extern virDomainPtr virDomainMigrate (virDomainPtr domain, virConnectPtr dconn,
123 unsigned long flags, const char *dname,
124 const char *uri, unsigned long bandwidth)
125 __attribute__((weak));
127 #ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS
128 extern int virDomainSetSchedulerParameters (virDomainPtr domain,
129 virSchedParameterPtr params,
131 __attribute__((weak));
133 #ifdef HAVE_VIRNODEGETFREEMEMORY
134 extern unsigned long long virNodeGetFreeMemory (virConnectPtr conn)
135 __attribute__((weak));
137 #ifdef HAVE_VIRNODEGETCELLSFREEMEMORY
138 extern int virNodeGetCellsFreeMemory (virConnectPtr conn,
139 unsigned long long *freeMems,
140 int startCell, int maxCells)
141 __attribute__((weak));
143 #endif /* HAVE_WEAK_SYMBOLS */
145 /*----------------------------------------------------------------------*/
148 ocaml_libvirt_get_version (value driverv, value unit)
150 CAMLparam2 (driverv, unit);
152 const char *driver = Optstring_val (driverv);
153 unsigned long libVer, typeVer = 0, *typeVer_ptr;
156 typeVer_ptr = driver ? &typeVer : NULL;
157 NONBLOCKING (r = virGetVersion (&libVer, driver, typeVer_ptr));
158 CHECK_ERROR (r == -1, NULL, "virGetVersion");
160 rv = caml_alloc_tuple (2);
161 Store_field (rv, 0, Val_int (libVer));
162 Store_field (rv, 1, Val_int (typeVer));
166 /*----------------------------------------------------------------------*/
168 /* Some notes about the use of custom blocks to store virConnectPtr,
169 * virDomainPtr and virNetworkPtr.
170 *------------------------------------------------------------------
172 * Libvirt does some tricky reference counting to keep track of
173 * virConnectPtr's, virDomainPtr's and virNetworkPtr's.
175 * There is only one function which can return a virConnectPtr
176 * (virConnectOpen*) and that allocates a new one each time.
178 * virDomainPtr/virNetworkPtr's on the other hand can be returned
179 * repeatedly (for the same underlying domain/network), and we must
180 * keep track of each one and explicitly free it with virDomainFree
181 * or virNetworkFree. If we lose track of one then the reference
182 * counting in libvirt will keep it open. We therefore wrap these
183 * in a custom block with a finalizer function.
185 * We also have to allow the user to explicitly free them, in
186 * which case we set the pointer inside the custom block to NULL.
187 * The finalizer notices this and doesn't free the object.
189 * Domains and networks "belong to" a connection. We have to avoid
190 * the situation like this:
192 * let conn = Connect.open ... in
193 * let dom = Domain.lookup_by_id conn 0 in
194 * (* conn goes out of scope and is garbage collected *)
195 * printf "dom name = %s\n" (Domain.get_name dom)
197 * The reason is that when conn is garbage collected, virConnectClose
198 * is called and any subsequent operations on dom will fail (in fact
199 * will probably segfault). To stop this from happening, the OCaml
200 * wrappers store domains (and networks) as explicit (dom, conn)
203 * Further complication with virterror / exceptions: Virterror gives
204 * us virConnectPtr, virDomainPtr, virNetworkPtr pointers. If we
205 * follow standard practice and wrap these up in blocks with
206 * finalizers then we'll end up double-freeing (in particular, calling
207 * virConnectClose at the wrong time). So for virterror, we have
208 * "special" wrapper functions (Val_connect_no_finalize, etc.).
211 /* Unwrap a custom block. */
212 #define Connect_val(rv) (*((virConnectPtr *)Data_custom_val(rv)))
213 #define Dom_val(rv) (*((virDomainPtr *)Data_custom_val(rv)))
214 #define Net_val(rv) (*((virNetworkPtr *)Data_custom_val(rv)))
216 /* Wrap up a pointer to something in a custom block. */
217 static value Val_connect (virConnectPtr conn);
218 static value Val_dom (virDomainPtr dom);
219 static value Val_net (virNetworkPtr net);
221 /* ONLY for use by virterror wrappers. */
222 static value Val_connect_no_finalize (virConnectPtr conn);
223 static value Val_dom_no_finalize (virDomainPtr dom);
224 static value Val_net_no_finalize (virNetworkPtr net);
226 /* Domains and networks are stored as pairs (dom/net, conn), so have
227 * some convenience functions for unwrapping and wrapping them.
229 #define Domain_val(rv) (Dom_val(Field((rv),0)))
230 #define Network_val(rv) (Net_val(Field((rv),0)))
231 #define Connect_domv(rv) (Connect_val(Field((rv),1)))
232 #define Connect_netv(rv) (Connect_val(Field((rv),1)))
234 static value Val_domain (virDomainPtr dom, value connv);
235 static value Val_network (virNetworkPtr net, value connv);
237 /* ONLY for use by virterror wrappers. */
238 static value Val_domain_no_finalize (virDomainPtr dom, value connv);
239 static value Val_network_no_finalize (virNetworkPtr net, value connv);
241 /*----------------------------------------------------------------------*/
243 /* Connection object. */
246 ocaml_libvirt_connect_open (value namev, value unit)
248 CAMLparam2 (namev, unit);
250 const char *name = Optstring_val (namev);
253 NONBLOCKING (conn = virConnectOpen (name));
254 CHECK_ERROR (!conn, NULL, "virConnectOpen");
256 rv = Val_connect (conn);
262 ocaml_libvirt_connect_open_readonly (value namev, value unit)
264 CAMLparam2 (namev, unit);
266 const char *name = Optstring_val (namev);
269 NONBLOCKING (conn = virConnectOpenReadOnly (name));
270 CHECK_ERROR (!conn, NULL, "virConnectOpen");
272 rv = Val_connect (conn);
278 ocaml_libvirt_connect_close (value connv)
281 virConnectPtr conn = Connect_val (connv);
284 NONBLOCKING (r = virConnectClose (conn));
285 CHECK_ERROR (r == -1, conn, "virConnectClose");
287 /* So that we don't double-free in the finalizer: */
288 Connect_val (connv) = NULL;
290 CAMLreturn (Val_unit);
294 ocaml_libvirt_connect_get_type (value connv)
298 virConnectPtr conn = Connect_val (connv);
301 NONBLOCKING (r = virConnectGetType (conn));
302 CHECK_ERROR (!r, conn, "virConnectGetType");
304 rv = caml_copy_string (r);
309 ocaml_libvirt_connect_get_version (value connv)
312 virConnectPtr conn = Connect_val (connv);
316 NONBLOCKING (r = virConnectGetVersion (conn, &hvVer));
317 CHECK_ERROR (r == -1, conn, "virConnectGetVersion");
319 CAMLreturn (Val_int (hvVer));
323 ocaml_libvirt_connect_get_hostname (value connv)
325 #ifdef HAVE_VIRCONNECTGETHOSTNAME
328 virConnectPtr conn = Connect_val (connv);
331 WEAK_SYMBOL_CHECK (virConnectGetHostname);
332 NONBLOCKING (r = virConnectGetHostname (conn));
333 CHECK_ERROR (!r, conn, "virConnectGetHostname");
335 rv = caml_copy_string (r);
339 not_supported ("virConnectGetHostname");
344 ocaml_libvirt_connect_get_uri (value connv)
346 #ifdef HAVE_VIRCONNECTGETURI
349 virConnectPtr conn = Connect_val (connv);
352 WEAK_SYMBOL_CHECK (virConnectGetURI);
353 NONBLOCKING (r = virConnectGetURI (conn));
354 CHECK_ERROR (!r, conn, "virConnectGetURI");
356 rv = caml_copy_string (r);
360 not_supported ("virConnectGetURI");
365 ocaml_libvirt_connect_get_max_vcpus (value connv, value typev)
367 CAMLparam2 (connv, typev);
368 virConnectPtr conn = Connect_val (connv);
369 const char *type = Optstring_val (typev);
372 NONBLOCKING (r = virConnectGetMaxVcpus (conn, type));
373 CHECK_ERROR (r == -1, conn, "virConnectGetMaxVcpus");
375 CAMLreturn (Val_int (r));
379 ocaml_libvirt_connect_list_domains (value connv, value iv)
381 CAMLparam2 (connv, iv);
383 virConnectPtr conn = Connect_val (connv);
384 int i = Int_val (iv);
387 NONBLOCKING (r = virConnectListDomains (conn, ids, i));
388 CHECK_ERROR (r == -1, conn, "virConnectListDomains");
390 rv = caml_alloc (r, 0);
391 for (i = 0; i < r; ++i)
392 Store_field (rv, i, Val_int (ids[i]));
398 ocaml_libvirt_connect_num_of_domains (value connv)
401 virConnectPtr conn = Connect_val (connv);
404 NONBLOCKING (r = virConnectNumOfDomains (conn));
405 CHECK_ERROR (r == -1, conn, "virConnectNumOfDomains");
407 CAMLreturn (Val_int (r));
411 ocaml_libvirt_connect_get_capabilities (value connv)
415 virConnectPtr conn = Connect_val (connv);
418 NONBLOCKING (r = virConnectGetCapabilities (conn));
419 CHECK_ERROR (!r, conn, "virConnectGetCapabilities");
421 rv = caml_copy_string (r);
428 ocaml_libvirt_connect_num_of_defined_domains (value connv)
431 virConnectPtr conn = Connect_val (connv);
434 NONBLOCKING (r = virConnectNumOfDefinedDomains (conn));
435 CHECK_ERROR (r == -1, conn, "virConnectNumOfDefinedDomains");
437 CAMLreturn (Val_int (r));
441 ocaml_libvirt_connect_list_defined_domains (value connv, value iv)
443 CAMLparam2 (connv, iv);
444 CAMLlocal2 (rv, strv);
445 virConnectPtr conn = Connect_val (connv);
446 int i = Int_val (iv);
450 NONBLOCKING (r = virConnectListDefinedDomains (conn, names, i));
451 CHECK_ERROR (r == -1, conn, "virConnectListDefinedDomains");
453 rv = caml_alloc (r, 0);
454 for (i = 0; i < r; ++i) {
455 strv = caml_copy_string (names[i]);
456 Store_field (rv, i, strv);
464 ocaml_libvirt_connect_num_of_networks (value connv)
467 virConnectPtr conn = Connect_val (connv);
470 NONBLOCKING (r = virConnectNumOfNetworks (conn));
471 CHECK_ERROR (r == -1, conn, "virConnectNumOfNetworks");
473 CAMLreturn (Val_int (r));
477 ocaml_libvirt_connect_list_networks (value connv, value iv)
479 CAMLparam2 (connv, iv);
480 CAMLlocal2 (rv, strv);
481 virConnectPtr conn = Connect_val (connv);
482 int i = Int_val (iv);
486 NONBLOCKING (r = virConnectListNetworks (conn, names, i));
487 CHECK_ERROR (r == -1, conn, "virConnectListNetworks");
489 rv = caml_alloc (r, 0);
490 for (i = 0; i < r; ++i) {
491 strv = caml_copy_string (names[i]);
492 Store_field (rv, i, strv);
500 ocaml_libvirt_connect_num_of_defined_networks (value connv)
503 virConnectPtr conn = Connect_val (connv);
506 NONBLOCKING (r = virConnectNumOfDefinedNetworks (conn));
507 CHECK_ERROR (r == -1, conn, "virConnectNumOfDefinedNetworks");
509 CAMLreturn (Val_int (r));
513 ocaml_libvirt_connect_list_defined_networks (value connv, value iv)
515 CAMLparam2 (connv, iv);
516 CAMLlocal2 (rv, strv);
517 virConnectPtr conn = Connect_val (connv);
518 int i = Int_val (iv);
522 NONBLOCKING (r = virConnectListDefinedNetworks (conn, names, i));
523 CHECK_ERROR (r == -1, conn, "virConnectListDefinedNetworks");
525 rv = caml_alloc (r, 0);
526 for (i = 0; i < r; ++i) {
527 strv = caml_copy_string (names[i]);
528 Store_field (rv, i, strv);
536 ocaml_libvirt_connect_get_node_info (value connv)
540 virConnectPtr conn = Connect_val (connv);
544 NONBLOCKING (r = virNodeGetInfo (conn, &info));
545 CHECK_ERROR (r == -1, conn, "virNodeGetInfo");
547 rv = caml_alloc (8, 0);
548 v = caml_copy_string (info.model); Store_field (rv, 0, v);
549 v = caml_copy_int64 (info.memory); Store_field (rv, 1, v);
550 Store_field (rv, 2, Val_int (info.cpus));
551 Store_field (rv, 3, Val_int (info.mhz));
552 Store_field (rv, 4, Val_int (info.nodes));
553 Store_field (rv, 5, Val_int (info.sockets));
554 Store_field (rv, 6, Val_int (info.cores));
555 Store_field (rv, 7, Val_int (info.threads));
561 ocaml_libvirt_connect_node_get_free_memory (value connv)
563 #ifdef HAVE_VIRNODEGETFREEMEMORY
566 virConnectPtr conn = Connect_val (connv);
567 unsigned long long r;
569 WEAK_SYMBOL_CHECK (virNodeGetFreeMemory);
570 NONBLOCKING (r = virNodeGetFreeMemory (conn));
571 CHECK_ERROR (r == 0, conn, "virNodeGetFreeMemory");
573 rv = caml_copy_int64 ((int64) r);
576 not_supported ("virNodeGetFreeMemory");
581 ocaml_libvirt_connect_node_get_cells_free_memory (value connv,
582 value startv, value maxv)
584 #ifdef HAVE_VIRNODEGETCELLSFREEMEMORY
585 CAMLparam3 (connv, startv, maxv);
587 virConnectPtr conn = Connect_val (connv);
588 int start = Int_val (startv);
589 int max = Int_val (maxv);
591 unsigned long long freemems[max];
593 WEAK_SYMBOL_CHECK (virNodeGetCellsFreeMemory);
594 NONBLOCKING (r = virNodeGetCellsFreeMemory (conn, freemems, start, max));
595 CHECK_ERROR (r == -1, conn, "virNodeGetCellsFreeMemory");
597 rv = caml_alloc (r, 0);
598 for (i = 0; i < r; ++i) {
599 iv = caml_copy_int64 ((int64) freemems[i]);
600 Store_field (rv, i, iv);
605 not_supported ("virNodeGetCellsFreeMemory");
610 ocaml_libvirt_domain_create_linux (value connv, value xmlv)
612 CAMLparam2 (connv, xmlv);
614 virConnectPtr conn = Connect_val (connv);
615 char *xml = String_val (xmlv);
618 NONBLOCKING (r = virDomainCreateLinux (conn, xml, 0));
619 CHECK_ERROR (!r, conn, "virDomainCreateLinux");
621 rv = Val_domain (r, connv);
626 ocaml_libvirt_domain_lookup_by_id (value connv, value iv)
628 CAMLparam2 (connv, iv);
630 virConnectPtr conn = Connect_val (connv);
631 int i = Int_val (iv);
634 NONBLOCKING (r = virDomainLookupByID (conn, i));
635 CHECK_ERROR (!r, conn, "virDomainLookupByID");
637 rv = Val_domain (r, connv);
642 ocaml_libvirt_domain_lookup_by_uuid (value connv, value uuidv)
644 CAMLparam2 (connv, uuidv);
646 virConnectPtr conn = Connect_val (connv);
647 char *uuid = String_val (uuidv);
650 NONBLOCKING (r = virDomainLookupByUUID (conn, (unsigned char *) uuid));
651 CHECK_ERROR (!r, conn, "virDomainLookupByUUID");
653 rv = Val_domain (r, connv);
658 ocaml_libvirt_domain_lookup_by_uuid_string (value connv, value uuidv)
660 CAMLparam2 (connv, uuidv);
662 virConnectPtr conn = Connect_val (connv);
663 char *uuid = String_val (uuidv);
666 NONBLOCKING (r = virDomainLookupByUUIDString (conn, uuid));
667 CHECK_ERROR (!r, conn, "virDomainLookupByUUIDString");
669 rv = Val_domain (r, connv);
674 ocaml_libvirt_domain_lookup_by_name (value connv, value namev)
676 CAMLparam2 (connv, namev);
678 virConnectPtr conn = Connect_val (connv);
679 char *name = String_val (namev);
682 NONBLOCKING (r = virDomainLookupByName (conn, name));
683 CHECK_ERROR (!r, conn, "virDomainLookupByName");
685 rv = Val_domain (r, connv);
690 ocaml_libvirt_domain_destroy (value domv)
693 virDomainPtr dom = Domain_val (domv);
694 virConnectPtr conn = Connect_domv (domv);
697 NONBLOCKING (r = virDomainDestroy (dom));
698 CHECK_ERROR (r == -1, conn, "virDomainDestroy");
700 /* So that we don't double-free in the finalizer: */
701 Domain_val (domv) = NULL;
703 CAMLreturn (Val_unit);
707 ocaml_libvirt_domain_free (value domv)
710 virDomainPtr dom = Domain_val (domv);
711 virConnectPtr conn = Connect_domv (domv);
714 NONBLOCKING (r = virDomainFree (dom));
715 CHECK_ERROR (r == -1, conn, "virDomainFree");
717 /* So that we don't double-free in the finalizer: */
718 Domain_val (domv) = NULL;
720 CAMLreturn (Val_unit);
724 ocaml_libvirt_domain_suspend (value domv)
727 virDomainPtr dom = Domain_val (domv);
728 virConnectPtr conn = Connect_domv (domv);
731 NONBLOCKING (r = virDomainSuspend (dom));
732 CHECK_ERROR (r == -1, conn, "virDomainSuspend");
734 CAMLreturn (Val_unit);
738 ocaml_libvirt_domain_resume (value domv)
741 virDomainPtr dom = Domain_val (domv);
742 virConnectPtr conn = Connect_domv (domv);
745 NONBLOCKING (r = virDomainResume (dom));
746 CHECK_ERROR (r == -1, conn, "virDomainResume");
748 CAMLreturn (Val_unit);
752 ocaml_libvirt_domain_save (value domv, value pathv)
754 CAMLparam2 (domv, pathv);
755 virDomainPtr dom = Domain_val (domv);
756 virConnectPtr conn = Connect_domv (domv);
757 char *path = String_val (pathv);
760 NONBLOCKING (r = virDomainSave (dom, path));
761 CHECK_ERROR (r == -1, conn, "virDomainSave");
763 CAMLreturn (Val_unit);
767 ocaml_libvirt_domain_restore (value connv, value pathv)
769 CAMLparam2 (connv, pathv);
770 virConnectPtr conn = Connect_val (connv);
771 char *path = String_val (pathv);
774 NONBLOCKING (r = virDomainRestore (conn, path));
775 CHECK_ERROR (r == -1, conn, "virDomainRestore");
777 CAMLreturn (Val_unit);
781 ocaml_libvirt_domain_core_dump (value domv, value pathv)
783 CAMLparam2 (domv, pathv);
784 virDomainPtr dom = Domain_val (domv);
785 virConnectPtr conn = Connect_domv (domv);
786 char *path = String_val (pathv);
789 NONBLOCKING (r = virDomainCoreDump (dom, path, 0));
790 CHECK_ERROR (r == -1, conn, "virDomainCoreDump");
792 CAMLreturn (Val_unit);
796 ocaml_libvirt_domain_shutdown (value domv)
799 virDomainPtr dom = Domain_val (domv);
800 virConnectPtr conn = Connect_domv (domv);
803 NONBLOCKING (r = virDomainShutdown (dom));
804 CHECK_ERROR (r == -1, conn, "virDomainShutdown");
806 CAMLreturn (Val_unit);
810 ocaml_libvirt_domain_reboot (value domv)
813 virDomainPtr dom = Domain_val (domv);
814 virConnectPtr conn = Connect_domv (domv);
817 NONBLOCKING (r = virDomainReboot (dom, 0));
818 CHECK_ERROR (r == -1, conn, "virDomainReboot");
820 CAMLreturn (Val_unit);
824 ocaml_libvirt_domain_get_name (value domv)
828 virDomainPtr dom = Domain_val (domv);
829 virConnectPtr conn = Connect_domv (domv);
832 NONBLOCKING (r = virDomainGetName (dom));
833 CHECK_ERROR (!r, conn, "virDomainGetName");
835 rv = caml_copy_string (r);
840 ocaml_libvirt_domain_get_uuid (value domv)
844 virDomainPtr dom = Domain_val (domv);
845 virConnectPtr conn = Connect_domv (domv);
846 unsigned char uuid[VIR_UUID_BUFLEN];
849 NONBLOCKING (r = virDomainGetUUID (dom, uuid));
850 CHECK_ERROR (r == -1, conn, "virDomainGetUUID");
852 rv = caml_copy_string ((char *) uuid);
857 ocaml_libvirt_domain_get_uuid_string (value domv)
861 virDomainPtr dom = Domain_val (domv);
862 virConnectPtr conn = Connect_domv (domv);
863 char uuid[VIR_UUID_STRING_BUFLEN];
866 NONBLOCKING (r = virDomainGetUUIDString (dom, uuid));
867 CHECK_ERROR (r == -1, conn, "virDomainGetUUIDString");
869 rv = caml_copy_string (uuid);
874 ocaml_libvirt_domain_get_id (value domv)
877 virDomainPtr dom = Domain_val (domv);
878 virConnectPtr conn = Connect_domv (domv);
881 NONBLOCKING (r = virDomainGetID (dom));
882 /* There's a bug in libvirt which means that if you try to get
883 * the ID of a defined-but-not-running domain, it returns -1,
884 * and there's no way to distinguish that from an error.
886 CHECK_ERROR (r == (unsigned int) -1, conn, "virDomainGetID");
888 CAMLreturn (Val_int ((int) r));
892 ocaml_libvirt_domain_get_os_type (value domv)
896 virDomainPtr dom = Domain_val (domv);
897 virConnectPtr conn = Connect_domv (domv);
900 NONBLOCKING (r = virDomainGetOSType (dom));
901 CHECK_ERROR (!r, conn, "virDomainGetOSType");
903 rv = caml_copy_string (r);
909 ocaml_libvirt_domain_get_max_memory (value domv)
913 virDomainPtr dom = Domain_val (domv);
914 virConnectPtr conn = Connect_domv (domv);
917 NONBLOCKING (r = virDomainGetMaxMemory (dom));
918 CHECK_ERROR (r == 0 /* [sic] */, conn, "virDomainGetMaxMemory");
920 rv = caml_copy_int64 (r);
925 ocaml_libvirt_domain_set_max_memory (value domv, value memv)
927 CAMLparam2 (domv, memv);
928 virDomainPtr dom = Domain_val (domv);
929 virConnectPtr conn = Connect_domv (domv);
930 unsigned long mem = Int64_val (memv);
933 NONBLOCKING (r = virDomainSetMaxMemory (dom, mem));
934 CHECK_ERROR (r == -1, conn, "virDomainSetMaxMemory");
936 CAMLreturn (Val_unit);
940 ocaml_libvirt_domain_set_memory (value domv, value memv)
942 CAMLparam2 (domv, memv);
943 virDomainPtr dom = Domain_val (domv);
944 virConnectPtr conn = Connect_domv (domv);
945 unsigned long mem = Int64_val (memv);
948 NONBLOCKING (r = virDomainSetMemory (dom, mem));
949 CHECK_ERROR (r == -1, conn, "virDomainSetMemory");
951 CAMLreturn (Val_unit);
955 ocaml_libvirt_domain_get_info (value domv)
959 virDomainPtr dom = Domain_val (domv);
960 virConnectPtr conn = Connect_domv (domv);
964 NONBLOCKING (r = virDomainGetInfo (dom, &info));
965 CHECK_ERROR (r == -1, conn, "virDomainGetInfo");
967 rv = caml_alloc (5, 0);
968 Store_field (rv, 0, Val_int (info.state)); // These flags are compatible.
969 v = caml_copy_int64 (info.maxMem); Store_field (rv, 1, v);
970 v = caml_copy_int64 (info.memory); Store_field (rv, 2, v);
971 Store_field (rv, 3, Val_int (info.nrVirtCpu));
972 v = caml_copy_int64 (info.cpuTime); Store_field (rv, 4, v);
978 ocaml_libvirt_domain_get_xml_desc (value domv)
982 virDomainPtr dom = Domain_val (domv);
983 virConnectPtr conn = Connect_domv (domv);
986 NONBLOCKING (r = virDomainGetXMLDesc (dom, 0));
987 CHECK_ERROR (!r, conn, "virDomainGetXMLDesc");
989 rv = caml_copy_string (r);
995 ocaml_libvirt_domain_get_scheduler_type (value domv)
997 #ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE
999 CAMLlocal2 (rv, strv);
1000 virDomainPtr dom = Domain_val (domv);
1001 virConnectPtr conn = Connect_domv (domv);
1005 WEAK_SYMBOL_CHECK (virDomainGetSchedulerType);
1006 NONBLOCKING (r = virDomainGetSchedulerType (dom, &nparams));
1007 CHECK_ERROR (!r, conn, "virDomainGetSchedulerType");
1009 rv = caml_alloc_tuple (2);
1010 strv = caml_copy_string (r); Store_field (rv, 0, strv);
1012 Store_field (rv, 1, nparams);
1015 not_supported ("virDomainGetSchedulerType");
1020 ocaml_libvirt_domain_get_scheduler_parameters (value domv, value nparamsv)
1022 #ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS
1023 CAMLparam2 (domv, nparamsv);
1024 CAMLlocal4 (rv, v, v2, v3);
1025 virDomainPtr dom = Domain_val (domv);
1026 virConnectPtr conn = Connect_domv (domv);
1027 int nparams = Int_val (nparamsv);
1028 virSchedParameter params[nparams];
1031 WEAK_SYMBOL_CHECK (virDomainGetSchedulerParameters);
1032 NONBLOCKING (r = virDomainGetSchedulerParameters (dom, params, &nparams));
1033 CHECK_ERROR (r == -1, conn, "virDomainGetSchedulerParameters");
1035 rv = caml_alloc (nparams, 0);
1036 for (i = 0; i < nparams; ++i) {
1037 v = caml_alloc_tuple (2); Store_field (rv, i, v);
1038 v2 = caml_copy_string (params[i].field); Store_field (v, 0, v2);
1039 switch (params[i].type) {
1040 case VIR_DOMAIN_SCHED_FIELD_INT:
1041 v2 = caml_alloc (1, 0);
1042 v3 = caml_copy_int32 (params[i].value.i); Store_field (v2, 0, v3);
1044 case VIR_DOMAIN_SCHED_FIELD_UINT:
1045 v2 = caml_alloc (1, 1);
1046 v3 = caml_copy_int32 (params[i].value.ui); Store_field (v2, 0, v3);
1048 case VIR_DOMAIN_SCHED_FIELD_LLONG:
1049 v2 = caml_alloc (1, 2);
1050 v3 = caml_copy_int64 (params[i].value.l); Store_field (v2, 0, v3);
1052 case VIR_DOMAIN_SCHED_FIELD_ULLONG:
1053 v2 = caml_alloc (1, 3);
1054 v3 = caml_copy_int64 (params[i].value.ul); Store_field (v2, 0, v3);
1056 case VIR_DOMAIN_SCHED_FIELD_DOUBLE:
1057 v2 = caml_alloc (1, 4);
1058 v3 = caml_copy_double (params[i].value.d); Store_field (v2, 0, v3);
1060 case VIR_DOMAIN_SCHED_FIELD_BOOLEAN:
1061 v2 = caml_alloc (1, 5);
1062 Store_field (v2, 0, Val_int (params[i].value.b));
1065 caml_failwith ((char *)__FUNCTION__);
1067 Store_field (v, 1, v2);
1071 not_supported ("virDomainGetSchedulerParameters");
1076 ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv)
1078 #ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS
1079 CAMLparam2 (domv, paramsv);
1081 virDomainPtr dom = Domain_val (domv);
1082 virConnectPtr conn = Connect_domv (domv);
1083 int nparams = Wosize_val (paramsv);
1084 virSchedParameter params[nparams];
1088 for (i = 0; i < nparams; ++i) {
1089 v = Field (paramsv, i); /* Points to the two-element tuple. */
1090 name = String_val (Field (v, 0));
1091 strncpy (params[i].field, name, VIR_DOMAIN_SCHED_FIELD_LENGTH);
1092 params[i].field[VIR_DOMAIN_SCHED_FIELD_LENGTH-1] = '\0';
1093 v = Field (v, 1); /* Points to the sched_param_value block. */
1094 switch (Tag_val (v)) {
1096 params[i].type = VIR_DOMAIN_SCHED_FIELD_INT;
1097 params[i].value.i = Int32_val (Field (v, 0));
1100 params[i].type = VIR_DOMAIN_SCHED_FIELD_UINT;
1101 params[i].value.ui = Int32_val (Field (v, 0));
1104 params[i].type = VIR_DOMAIN_SCHED_FIELD_LLONG;
1105 params[i].value.l = Int64_val (Field (v, 0));
1108 params[i].type = VIR_DOMAIN_SCHED_FIELD_ULLONG;
1109 params[i].value.ul = Int64_val (Field (v, 0));
1112 params[i].type = VIR_DOMAIN_SCHED_FIELD_DOUBLE;
1113 params[i].value.d = Double_val (Field (v, 0));
1116 params[i].type = VIR_DOMAIN_SCHED_FIELD_BOOLEAN;
1117 params[i].value.b = Int_val (Field (v, 0));
1120 caml_failwith ((char *)__FUNCTION__);
1124 WEAK_SYMBOL_CHECK (virDomainSetSchedulerParameters);
1125 NONBLOCKING (r = virDomainSetSchedulerParameters (dom, params, nparams));
1126 CHECK_ERROR (r == -1, conn, "virDomainSetSchedulerParameters");
1128 CAMLreturn (Val_unit);
1130 not_supported ("virDomainSetSchedulerParameters");
1135 ocaml_libvirt_domain_define_xml (value connv, value xmlv)
1137 CAMLparam2 (connv, xmlv);
1139 virConnectPtr conn = Connect_val (connv);
1140 char *xml = String_val (xmlv);
1143 NONBLOCKING (r = virDomainDefineXML (conn, xml));
1144 CHECK_ERROR (!r, conn, "virDomainDefineXML");
1146 rv = Val_domain (r, connv);
1151 ocaml_libvirt_domain_undefine (value domv)
1154 virDomainPtr dom = Domain_val (domv);
1155 virConnectPtr conn = Connect_domv (domv);
1158 NONBLOCKING (r = virDomainUndefine (dom));
1159 CHECK_ERROR (r == -1, conn, "virDomainUndefine");
1161 CAMLreturn (Val_unit);
1165 ocaml_libvirt_domain_create (value domv)
1168 virDomainPtr dom = Domain_val (domv);
1169 virConnectPtr conn = Connect_domv (domv);
1172 NONBLOCKING (r = virDomainCreate (dom));
1173 CHECK_ERROR (r == -1, conn, "virDomainCreate");
1175 CAMLreturn (Val_unit);
1179 ocaml_libvirt_domain_get_autostart (value domv)
1182 virDomainPtr dom = Domain_val (domv);
1183 virConnectPtr conn = Connect_domv (domv);
1186 NONBLOCKING (r = virDomainGetAutostart (dom, &autostart));
1187 CHECK_ERROR (r == -1, conn, "virDomainGetAutostart");
1189 CAMLreturn (autostart ? Val_true : Val_false);
1193 ocaml_libvirt_domain_set_autostart (value domv, value autostartv)
1195 CAMLparam2 (domv, autostartv);
1196 virDomainPtr dom = Domain_val (domv);
1197 virConnectPtr conn = Connect_domv (domv);
1198 int r, autostart = autostartv == Val_true ? 1 : 0;
1200 NONBLOCKING (r = virDomainSetAutostart (dom, autostart));
1201 CHECK_ERROR (r == -1, conn, "virDomainSetAutostart");
1203 CAMLreturn (Val_unit);
1207 ocaml_libvirt_domain_set_vcpus (value domv, value nvcpusv)
1209 CAMLparam2 (domv, nvcpusv);
1210 virDomainPtr dom = Domain_val (domv);
1211 virConnectPtr conn = Connect_domv (domv);
1212 int r, nvcpus = Int_val (nvcpusv);
1214 NONBLOCKING (r = virDomainSetVcpus (dom, nvcpus));
1215 CHECK_ERROR (r == -1, conn, "virDomainSetVcpus");
1217 CAMLreturn (Val_unit);
1221 ocaml_libvirt_domain_pin_vcpu (value domv, value vcpuv, value cpumapv)
1223 CAMLparam3 (domv, vcpuv, cpumapv);
1224 virDomainPtr dom = Domain_val (domv);
1225 virConnectPtr conn = Connect_domv (domv);
1226 int maplen = caml_string_length (cpumapv);
1227 unsigned char *cpumap = (unsigned char *) String_val (cpumapv);
1228 int vcpu = Int_val (vcpuv);
1231 NONBLOCKING (r = virDomainPinVcpu (dom, vcpu, cpumap, maplen));
1232 CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
1234 CAMLreturn (Val_unit);
1238 ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv)
1240 CAMLparam3 (domv, maxinfov, maplenv);
1241 CAMLlocal5 (rv, infov, strv, v, v2);
1242 virDomainPtr dom = Domain_val (domv);
1243 virConnectPtr conn = Connect_domv (domv);
1244 int maxinfo = Int_val (maxinfov);
1245 int maplen = Int_val (maplenv);
1246 virVcpuInfo info[maxinfo];
1247 unsigned char cpumaps[maxinfo * maplen];
1250 memset (info, 0, sizeof (virVcpuInfo) * maxinfo);
1251 memset (cpumaps, 0, maxinfo * maplen);
1253 NONBLOCKING (r = virDomainGetVcpus (dom, info, maxinfo, cpumaps, maplen));
1254 CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
1256 /* Copy the virVcpuInfo structures. */
1257 infov = caml_alloc (maxinfo, 0);
1258 for (i = 0; i < maxinfo; ++i) {
1259 v2 = caml_alloc (4, 0); Store_field (infov, i, v2);
1260 Store_field (v2, 0, Val_int (info[i].number));
1261 Store_field (v2, 1, Val_int (info[i].state));
1262 v = caml_copy_int64 (info[i].cpuTime); Store_field (v2, 2, v);
1263 Store_field (v2, 3, Val_int (info[i].cpu));
1266 /* Copy the bitmap. */
1267 strv = caml_alloc_string (maxinfo * maplen);
1268 memcpy (String_val (strv), cpumaps, maxinfo * maplen);
1270 /* Allocate the tuple and return it. */
1271 rv = caml_alloc_tuple (3);
1272 Store_field (rv, 0, Val_int (r)); /* number of CPUs. */
1273 Store_field (rv, 1, infov);
1274 Store_field (rv, 2, strv);
1280 ocaml_libvirt_domain_get_max_vcpus (value domv)
1283 virDomainPtr dom = Domain_val (domv);
1284 virConnectPtr conn = Connect_domv (domv);
1287 NONBLOCKING (r = virDomainGetMaxVcpus (dom));
1288 CHECK_ERROR (r == -1, conn, "virDomainGetMaxVcpus");
1290 CAMLreturn (Val_int (r));
1294 ocaml_libvirt_domain_attach_device (value domv, value xmlv)
1296 CAMLparam2 (domv, xmlv);
1297 virDomainPtr dom = Domain_val (domv);
1298 virConnectPtr conn = Connect_domv (domv);
1299 char *xml = String_val (xmlv);
1302 NONBLOCKING (r = virDomainAttachDevice (dom, xml));
1303 CHECK_ERROR (r == -1, conn, "virDomainAttachDevice");
1305 CAMLreturn (Val_unit);
1309 ocaml_libvirt_domain_detach_device (value domv, value xmlv)
1311 CAMLparam2 (domv, xmlv);
1312 virDomainPtr dom = Domain_val (domv);
1313 virConnectPtr conn = Connect_domv (domv);
1314 char *xml = String_val (xmlv);
1317 NONBLOCKING (r = virDomainDetachDevice (dom, xml));
1318 CHECK_ERROR (r == -1, conn, "virDomainDetachDevice");
1320 CAMLreturn (Val_unit);
1324 ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, value optdnamev, value opturiv, value optbandwidthv, value unitv)
1326 #ifdef HAVE_VIRDOMAINMIGRATE
1327 CAMLparam5 (domv, dconnv, flagsv, optdnamev, opturiv);
1328 CAMLxparam2 (optbandwidthv, unitv);
1329 CAMLlocal2 (flagv, rv);
1330 virDomainPtr dom = Domain_val (domv);
1331 virConnectPtr conn = Connect_domv (domv);
1332 virConnectPtr dconn = Connect_val (dconnv);
1334 const char *dname = Optstring_val (optdnamev);
1335 const char *uri = Optstring_val (opturiv);
1336 unsigned long bandwidth;
1339 /* Iterate over the list of flags. */
1340 for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
1342 flagv = Field (flagsv, 0);
1343 if (flagv == Int_val(0))
1344 flags |= VIR_MIGRATE_LIVE;
1347 if (optbandwidthv == Val_int (0)) /* None */
1349 else /* Some bandwidth */
1350 bandwidth = Int_val (Field (optbandwidthv, 0));
1352 WEAK_SYMBOL_CHECK (virDomainMigrate);
1353 NONBLOCKING (r = virDomainMigrate (dom, dconn, flags, dname, uri, bandwidth));
1354 CHECK_ERROR (!r, conn, "virDomainMigrate");
1356 rv = Val_domain (r, dconnv);
1360 #else /* virDomainMigrate not supported */
1361 not_supported ("virDomainMigrate");
1366 ocaml_libvirt_domain_migrate_bytecode (value *argv, int argn)
1368 return ocaml_libvirt_domain_migrate_native (argv[0], argv[1], argv[2],
1369 argv[3], argv[4], argv[5],
1374 ocaml_libvirt_domain_block_stats (value domv, value pathv)
1376 #if HAVE_VIRDOMAINBLOCKSTATS
1377 CAMLparam2 (domv, pathv);
1379 virDomainPtr dom = Domain_val (domv);
1380 virConnectPtr conn = Connect_domv (domv);
1381 char *path = String_val (pathv);
1382 struct _virDomainBlockStats stats;
1385 WEAK_SYMBOL_CHECK (virDomainBlockStats);
1386 NONBLOCKING (r = virDomainBlockStats (dom, path, &stats, sizeof stats));
1387 CHECK_ERROR (r == -1, conn, "virDomainBlockStats");
1389 rv = caml_alloc (5, 0);
1390 v = caml_copy_int64 (stats.rd_req); Store_field (rv, 0, v);
1391 v = caml_copy_int64 (stats.rd_bytes); Store_field (rv, 1, v);
1392 v = caml_copy_int64 (stats.wr_req); Store_field (rv, 2, v);
1393 v = caml_copy_int64 (stats.wr_bytes); Store_field (rv, 3, v);
1394 v = caml_copy_int64 (stats.errs); Store_field (rv, 4, v);
1398 not_supported ("virDomainBlockStats");
1403 ocaml_libvirt_domain_interface_stats (value domv, value pathv)
1405 #if HAVE_VIRDOMAININTERFACESTATS
1406 CAMLparam2 (domv, pathv);
1408 virDomainPtr dom = Domain_val (domv);
1409 virConnectPtr conn = Connect_domv (domv);
1410 char *path = String_val (pathv);
1411 struct _virDomainInterfaceStats stats;
1414 WEAK_SYMBOL_CHECK (virDomainInterfaceStats);
1415 NONBLOCKING (r = virDomainInterfaceStats (dom, path, &stats, sizeof stats));
1416 CHECK_ERROR (r == -1, conn, "virDomainInterfaceStats");
1418 rv = caml_alloc (8, 0);
1419 v = caml_copy_int64 (stats.rx_bytes); Store_field (rv, 0, v);
1420 v = caml_copy_int64 (stats.rx_packets); Store_field (rv, 1, v);
1421 v = caml_copy_int64 (stats.rx_errs); Store_field (rv, 2, v);
1422 v = caml_copy_int64 (stats.rx_drop); Store_field (rv, 3, v);
1423 v = caml_copy_int64 (stats.tx_bytes); Store_field (rv, 4, v);
1424 v = caml_copy_int64 (stats.tx_packets); Store_field (rv, 5, v);
1425 v = caml_copy_int64 (stats.tx_errs); Store_field (rv, 6, v);
1426 v = caml_copy_int64 (stats.tx_drop); Store_field (rv, 7, v);
1430 not_supported ("virDomainInterfaceStats");
1435 ocaml_libvirt_network_lookup_by_name (value connv, value namev)
1437 CAMLparam2 (connv, namev);
1439 virConnectPtr conn = Connect_val (connv);
1440 char *name = String_val (namev);
1443 NONBLOCKING (r = virNetworkLookupByName (conn, name));
1444 CHECK_ERROR (!r, conn, "virNetworkLookupByName");
1446 rv = Val_network (r, connv);
1451 ocaml_libvirt_network_lookup_by_uuid (value connv, value uuidv)
1453 CAMLparam2 (connv, uuidv);
1455 virConnectPtr conn = Connect_val (connv);
1456 char *uuid = String_val (uuidv);
1459 NONBLOCKING (r = virNetworkLookupByUUID (conn, (unsigned char *) uuid));
1460 CHECK_ERROR (!r, conn, "virNetworkLookupByUUID");
1462 rv = Val_network (r, connv);
1467 ocaml_libvirt_network_lookup_by_uuid_string (value connv, value uuidv)
1469 CAMLparam2 (connv, uuidv);
1471 virConnectPtr conn = Connect_val (connv);
1472 char *uuid = String_val (uuidv);
1475 NONBLOCKING (r = virNetworkLookupByUUIDString (conn, uuid));
1476 CHECK_ERROR (!r, conn, "virNetworkLookupByUUIDString");
1478 rv = Val_network (r, connv);
1483 ocaml_libvirt_network_create_xml (value connv, value xmlv)
1485 CAMLparam2 (connv, xmlv);
1487 virConnectPtr conn = Connect_val (connv);
1488 char *xml = String_val (xmlv);
1491 NONBLOCKING (r = virNetworkCreateXML (conn, xml));
1492 CHECK_ERROR (!r, conn, "virNetworkCreateXML");
1494 rv = Val_network (r, connv);
1499 ocaml_libvirt_network_define_xml (value connv, value xmlv)
1501 CAMLparam2 (connv, xmlv);
1503 virConnectPtr conn = Connect_val (connv);
1504 char *xml = String_val (xmlv);
1507 NONBLOCKING (r = virNetworkDefineXML (conn, xml));
1508 CHECK_ERROR (!r, conn, "virNetworkDefineXML");
1510 rv = Val_network (r, connv);
1515 ocaml_libvirt_network_undefine (value netv)
1518 virNetworkPtr net = Network_val (netv);
1519 virConnectPtr conn = Connect_netv (netv);
1522 NONBLOCKING (r = virNetworkUndefine (net));
1523 CHECK_ERROR (r == -1, conn, "virNetworkUndefine");
1525 CAMLreturn (Val_unit);
1529 ocaml_libvirt_network_create (value netv)
1532 virNetworkPtr net = Network_val (netv);
1533 virConnectPtr conn = Connect_netv (netv);
1536 NONBLOCKING (r = virNetworkCreate (net));
1537 CHECK_ERROR (r == -1, conn, "virNetworkCreate");
1539 CAMLreturn (Val_unit);
1543 ocaml_libvirt_network_destroy (value netv)
1546 virNetworkPtr net = Network_val (netv);
1547 virConnectPtr conn = Connect_netv (netv);
1550 NONBLOCKING (r = virNetworkDestroy (net));
1551 CHECK_ERROR (r == -1, conn, "virNetworkDestroy");
1553 /* So that we don't double-free in the finalizer: */
1554 Network_val (netv) = NULL;
1556 CAMLreturn (Val_unit);
1560 ocaml_libvirt_network_free (value netv)
1563 virNetworkPtr net = Network_val (netv);
1564 virConnectPtr conn = Connect_netv (netv);
1567 NONBLOCKING (r = virNetworkFree (net));
1568 CHECK_ERROR (r == -1, conn, "virNetworkFree");
1570 /* So that we don't double-free in the finalizer: */
1571 Network_val (netv) = NULL;
1573 CAMLreturn (Val_unit);
1577 ocaml_libvirt_network_get_name (value netv)
1581 virNetworkPtr net = Network_val (netv);
1582 virConnectPtr conn = Connect_netv (netv);
1585 NONBLOCKING (r = virNetworkGetName (net));
1586 CHECK_ERROR (!r, conn, "virNetworkGetName");
1588 rv = caml_copy_string (r);
1593 ocaml_libvirt_network_get_uuid (value netv)
1597 virNetworkPtr net = Network_val (netv);
1598 virConnectPtr conn = Connect_netv (netv);
1599 unsigned char uuid[VIR_UUID_BUFLEN];
1602 NONBLOCKING (r = virNetworkGetUUID (net, uuid));
1603 CHECK_ERROR (r == -1, conn, "virNetworkGetUUID");
1605 rv = caml_copy_string ((char *) uuid);
1610 ocaml_libvirt_network_get_uuid_string (value netv)
1614 virNetworkPtr net = Network_val (netv);
1615 virConnectPtr conn = Connect_netv (netv);
1616 char uuid[VIR_UUID_STRING_BUFLEN];
1619 NONBLOCKING (r = virNetworkGetUUIDString (net, uuid));
1620 CHECK_ERROR (r == -1, conn, "virNetworkGetUUIDString");
1622 rv = caml_copy_string (uuid);
1627 ocaml_libvirt_network_get_xml_desc (value netv)
1631 virNetworkPtr net = Network_val (netv);
1632 virConnectPtr conn = Connect_netv (netv);
1635 NONBLOCKING (r = virNetworkGetXMLDesc (net, 0));
1636 CHECK_ERROR (!r, conn, "virNetworkGetXMLDesc");
1638 rv = caml_copy_string (r);
1644 ocaml_libvirt_network_get_bridge_name (value netv)
1648 virNetworkPtr net = Network_val (netv);
1649 virConnectPtr conn = Connect_netv (netv);
1652 NONBLOCKING (r = virNetworkGetBridgeName (net));
1653 CHECK_ERROR (!r, conn, "virNetworkGetBridgeName");
1655 rv = caml_copy_string (r);
1661 ocaml_libvirt_network_get_autostart (value netv)
1664 virNetworkPtr net = Network_val (netv);
1665 virConnectPtr conn = Connect_netv (netv);
1668 NONBLOCKING (r = virNetworkGetAutostart (net, &autostart));
1669 CHECK_ERROR (r == -1, conn, "virNetworkGetAutostart");
1671 CAMLreturn (autostart ? Val_true : Val_false);
1675 ocaml_libvirt_network_set_autostart (value netv, value autostartv)
1677 CAMLparam2 (netv, autostartv);
1678 virNetworkPtr net = Network_val (netv);
1679 virConnectPtr conn = Connect_netv (netv);
1680 int r, autostart = autostartv == Val_true ? 1 : 0;
1682 NONBLOCKING (r = virNetworkSetAutostart (net, autostart));
1683 CHECK_ERROR (r == -1, conn, "virNetworkSetAutostart");
1685 CAMLreturn (Val_unit);
1688 /*----------------------------------------------------------------------*/
1691 ocaml_libvirt_virterror_get_last_error (value unitv)
1695 virErrorPtr err = virGetLastError ();
1697 rv = Val_opt (err, (Val_ptr_t) Val_virterror);
1703 ocaml_libvirt_virterror_get_last_conn_error (value connv)
1707 virConnectPtr conn = Connect_val (connv);
1709 rv = Val_opt (conn, (Val_ptr_t) Val_connect);
1715 ocaml_libvirt_virterror_reset_last_error (value unitv)
1718 virResetLastError ();
1719 CAMLreturn (Val_unit);
1723 ocaml_libvirt_virterror_reset_last_conn_error (value connv)
1726 virConnectPtr conn = Connect_val (connv);
1727 virConnResetLastError (conn);
1728 CAMLreturn (Val_unit);
1731 /*----------------------------------------------------------------------*/
1733 /* Initialise the library. */
1735 ocaml_libvirt_init (value unit)
1741 r = virInitialize ();
1742 CHECK_ERROR (r == -1, NULL, "virInitialize");
1744 CAMLreturn (Val_unit);
1747 /*----------------------------------------------------------------------*/
1750 Optstring_val (value strv)
1752 if (strv == Val_int (0)) /* None */
1754 else /* Some string */
1755 return String_val (Field (strv, 0));
1759 Val_opt (void *ptr, Val_ptr_t Val_ptr)
1762 CAMLlocal2 (optv, ptrv);
1764 if (ptr) { /* Some ptr */
1765 optv = caml_alloc (1, 0);
1766 ptrv = Val_ptr (ptr);
1767 Store_field (optv, 0, ptrv);
1776 option_default (value option, value deflt)
1778 if (option == Val_int (0)) /* "None" */
1780 else /* "Some 'a" */
1781 return Field (option, 0);
1786 _raise_virterror (virConnectPtr conn, const char *fn)
1791 struct _virError err;
1793 errp = conn ? virConnGetLastError (conn) : virGetLastError ();
1796 /* Fake a _virError structure. */
1797 memset (&err, 0, sizeof err);
1798 err.code = VIR_ERR_INTERNAL_ERROR;
1799 err.domain = VIR_FROM_NONE;
1800 err.level = VIR_ERR_ERROR;
1801 err.message = (char *) fn;
1805 rv = Val_virterror (errp);
1806 caml_raise_with_arg (*caml_named_value ("ocaml_libvirt_virterror"), rv);
1812 /* Raise an error if a function is not supported. */
1814 not_supported (const char *fn)
1819 fnv = caml_copy_string (fn);
1820 caml_raise_with_arg (*caml_named_value ("ocaml_libvirt_not_supported"), fnv);
1826 /* Convert the virErrorNumber, virErrorDomain and virErrorLevel enums
1827 * into values (longs because they are variants in OCaml).
1829 * The enum values are part of the libvirt ABI so they cannot change,
1830 * which means that we can convert these numbers directly into
1831 * OCaml variants (which use the same ordering) very fast.
1833 * The tricky part here is when we are linked to a newer version of
1834 * libvirt than the one we were compiled against. If the newer libvirt
1835 * generates an error code which we don't know about then we need
1836 * to convert it into VIR_*_UNKNOWN (code).
1839 #define MAX_VIR_CODE 44 /* VIR_ERR_INVALID_MAC */
1840 #define MAX_VIR_DOMAIN 16 /* VIR_FROM_STATS_LINUX */
1841 #define MAX_VIR_LEVEL VIR_ERR_ERROR
1844 Val_err_number (virErrorNumber code)
1849 if (0 <= code && code <= MAX_VIR_CODE)
1850 rv = Val_int (code);
1852 rv = caml_alloc (1, 0); /* VIR_ERR_UNKNOWN (code) */
1853 Store_field (rv, 0, Val_int (code));
1860 Val_err_domain (virErrorDomain code)
1865 if (0 <= code && code <= MAX_VIR_DOMAIN)
1866 rv = Val_int (code);
1868 rv = caml_alloc (1, 0); /* VIR_FROM_UNKNOWN (code) */
1869 Store_field (rv, 0, Val_int (code));
1876 Val_err_level (virErrorLevel code)
1881 if (0 <= code && code <= MAX_VIR_LEVEL)
1882 rv = Val_int (code);
1884 rv = caml_alloc (1, 0); /* VIR_ERR_UNKNOWN_LEVEL (code) */
1885 Store_field (rv, 0, Val_int (code));
1891 /* Convert a virterror to a value. */
1893 Val_virterror (virErrorPtr err)
1896 CAMLlocal3 (rv, connv, optv);
1898 rv = caml_alloc (12, 0);
1899 Store_field (rv, 0, Val_err_number (err->code));
1900 Store_field (rv, 1, Val_err_domain (err->domain));
1902 Val_opt (err->message, (Val_ptr_t) caml_copy_string));
1903 Store_field (rv, 3, Val_err_level (err->level));
1905 /* conn, dom and net fields, all optional */
1907 connv = Val_connect_no_finalize (err->conn);
1908 optv = caml_alloc (1, 0);
1909 Store_field (optv, 0, connv);
1910 Store_field (rv, 4, optv); /* Some conn */
1913 optv = caml_alloc (1, 0);
1914 Store_field (optv, 0, Val_domain_no_finalize (err->dom, connv));
1915 Store_field (rv, 5, optv); /* Some (dom, conn) */
1918 Store_field (rv, 5, Val_int (0)); /* None */
1920 optv = caml_alloc (1, 0);
1921 Store_field (optv, 0, Val_network_no_finalize (err->net, connv));
1922 Store_field (rv, 11, optv); /* Some (net, conn) */
1924 Store_field (rv, 11, Val_int (0)); /* None */
1926 Store_field (rv, 4, Val_int (0)); /* None */
1927 Store_field (rv, 5, Val_int (0)); /* None */
1928 Store_field (rv, 11, Val_int (0)); /* None */
1932 Val_opt (err->str1, (Val_ptr_t) caml_copy_string));
1934 Val_opt (err->str2, (Val_ptr_t) caml_copy_string));
1936 Val_opt (err->str3, (Val_ptr_t) caml_copy_string));
1937 Store_field (rv, 9, caml_copy_int32 (err->int1));
1938 Store_field (rv, 10, caml_copy_int32 (err->int2));
1943 static void conn_finalize (value);
1944 static void dom_finalize (value);
1945 static void net_finalize (value);
1947 static struct custom_operations conn_custom_operations = {
1948 "conn_custom_operations",
1950 custom_compare_default,
1951 custom_hash_default,
1952 custom_serialize_default,
1953 custom_deserialize_default
1956 static struct custom_operations dom_custom_operations = {
1957 "dom_custom_operations",
1959 custom_compare_default,
1960 custom_hash_default,
1961 custom_serialize_default,
1962 custom_deserialize_default
1966 static struct custom_operations net_custom_operations = {
1967 "net_custom_operations",
1969 custom_compare_default,
1970 custom_hash_default,
1971 custom_serialize_default,
1972 custom_deserialize_default
1976 Val_connect (virConnectPtr conn)
1980 rv = caml_alloc_custom (&conn_custom_operations,
1981 sizeof (virConnectPtr), 0, 1);
1982 Connect_val (rv) = conn;
1986 /* This wraps up the raw domain handle (Domain.dom). */
1988 Val_dom (virDomainPtr dom)
1992 rv = caml_alloc_custom (&dom_custom_operations,
1993 sizeof (virDomainPtr), 0, 1);
1998 /* This wraps up the raw network handle (Network.net). */
2000 Val_net (virNetworkPtr net)
2004 rv = caml_alloc_custom (&net_custom_operations,
2005 sizeof (virNetworkPtr), 0, 1);
2010 /* No-finalize versions of Val_connect, Val_dom, Val_net ONLY for use
2011 * by virterror wrappers.
2014 Val_connect_no_finalize (virConnectPtr conn)
2018 rv = caml_alloc (1, Abstract_tag);
2019 Store_field (rv, 0, (value) conn);
2024 Val_dom_no_finalize (virDomainPtr dom)
2028 rv = caml_alloc (1, Abstract_tag);
2029 Store_field (rv, 0, (value) dom);
2034 Val_net_no_finalize (virNetworkPtr net)
2038 rv = caml_alloc (1, Abstract_tag);
2039 Store_field (rv, 0, (value) net);
2043 /* This wraps up the (dom, conn) pair (Domain.t). */
2045 Val_domain (virDomainPtr dom, value connv)
2050 rv = caml_alloc_tuple (2);
2052 Store_field (rv, 0, v);
2053 Store_field (rv, 1, connv);
2057 /* This wraps up the (net, conn) pair (Network.t). */
2059 Val_network (virNetworkPtr net, value connv)
2064 rv = caml_alloc_tuple (2);
2066 Store_field (rv, 0, v);
2067 Store_field (rv, 1, connv);
2071 /* No-finalize versions of Val_domain, Val_network ONLY for use by
2072 * virterror wrappers.
2075 Val_domain_no_finalize (virDomainPtr dom, value connv)
2080 rv = caml_alloc_tuple (2);
2081 v = Val_dom_no_finalize (dom);
2082 Store_field (rv, 0, v);
2083 Store_field (rv, 1, connv);
2088 Val_network_no_finalize (virNetworkPtr net, value connv)
2093 rv = caml_alloc_tuple (2);
2094 v = Val_net_no_finalize (net);
2095 Store_field (rv, 0, v);
2096 Store_field (rv, 1, connv);
2101 conn_finalize (value connv)
2103 virConnectPtr conn = Connect_val (connv);
2104 if (conn) (void) virConnectClose (conn);
2108 dom_finalize (value domv)
2110 virDomainPtr dom = Dom_val (domv);
2111 if (dom) (void) virDomainFree (dom);
2115 net_finalize (value netv)
2117 virNetworkPtr net = Net_val (netv);
2118 if (net) (void) virNetworkFree (net);