1 /* OCaml bindings for libvirt.
2 * (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc.
12 #include <libvirt/libvirt.h>
13 #include <libvirt/virterror.h>
15 #include <caml/config.h>
16 #include <caml/alloc.h>
17 #include <caml/callback.h>
18 #include <caml/custom.h>
19 #include <caml/fail.h>
20 #include <caml/memory.h>
21 #include <caml/misc.h>
22 #include <caml/mlvalues.h>
24 static char *Optstring_val (value strv);
25 typedef value (*Val_ptr_t) (void *);
26 static value Val_opt (void *ptr, Val_ptr_t Val_ptr);
27 /*static value option_default (value option, value deflt);*/
28 static value _raise_virterror (virConnectPtr conn, const char *fn);
29 static value Val_virterror (virErrorPtr err);
31 #define CHECK_ERROR(cond, conn, fn) \
32 do { if (cond) _raise_virterror (conn, fn); } while (0)
34 #define NOT_SUPPORTED(fn) \
35 caml_invalid_argument (fn " not supported")
37 /* For more about weak symbols, see:
38 * http://kolpackov.net/pipermail/notes/2004-March/000006.html
39 * We are using this to do runtime detection of library functions
40 * so that if we dynamically link with an older version of
41 * libvirt than we were compiled against, it won't fail (provided
42 * libvirt >= 0.2.1 - we don't support anything older).
46 #if (__GNUC__ == 3 && __GNUC_MINOR__ >= 3) || (__GNUC__ > 3)
47 #define HAVE_WEAK_SYMBOLS 1
52 #ifdef HAVE_WEAK_SYMBOLS
53 #define WEAK_SYMBOL_CHECK(sym) \
54 do { if (!sym) NOT_SUPPORTED(#sym); } while (0)
56 #define WEAK_SYMBOL_CHECK(sym)
57 #endif /* HAVE_WEAK_SYMBOLS */
59 #ifdef HAVE_WEAK_SYMBOLS
60 #ifdef HAVE_VIRCONNECTGETHOSTNAME
61 extern char *virConnectGetHostname (virConnectPtr conn)
62 __attribute__((weak));
64 #ifdef HAVE_VIRCONNECTGETURI
65 extern char *virConnectGetURI (virConnectPtr conn)
66 __attribute__((weak));
68 #ifdef HAVE_VIRDOMAINBLOCKSTATS
69 extern int virDomainBlockStats (virDomainPtr dom,
71 virDomainBlockStatsPtr stats,
73 __attribute__((weak));
75 #ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS
76 extern int virDomainGetSchedulerParameters (virDomainPtr domain,
77 virSchedParameterPtr params,
79 __attribute__((weak));
81 #ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE
82 extern char *virDomainGetSchedulerType(virDomainPtr domain,
84 __attribute__((weak));
86 #ifdef HAVE_VIRDOMAININTERFACESTATS
87 extern int virDomainInterfaceStats (virDomainPtr dom,
89 virDomainInterfaceStatsPtr stats,
91 __attribute__((weak));
93 #ifdef HAVE_VIRDOMAINMIGRATE
94 extern virDomainPtr virDomainMigrate (virDomainPtr domain, virConnectPtr dconn,
95 unsigned long flags, const char *dname,
96 const char *uri, unsigned long bandwidth)
97 __attribute__((weak));
99 #ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS
100 extern int virDomainSetSchedulerParameters (virDomainPtr domain,
101 virSchedParameterPtr params,
103 __attribute__((weak));
105 #endif /* HAVE_WEAK_SYMBOLS */
107 /*----------------------------------------------------------------------*/
110 ocaml_libvirt_get_version (value driverv, value unit)
112 CAMLparam2 (driverv, unit);
114 const char *driver = Optstring_val (driverv);
115 unsigned long libVer, typeVer = 0, *typeVer_ptr;
118 typeVer_ptr = driver ? &typeVer : NULL;
119 r = virGetVersion (&libVer, driver, typeVer_ptr);
120 CHECK_ERROR (r == -1, NULL, "virGetVersion");
122 rv = caml_alloc_tuple (2);
123 Store_field (rv, 0, Val_int (libVer));
124 Store_field (rv, 1, Val_int (typeVer));
128 /*----------------------------------------------------------------------*/
130 /* Some notes about the use of custom blocks to store virConnectPtr,
131 * virDomainPtr and virNetworkPtr.
132 *------------------------------------------------------------------
134 * Libvirt does some tricky reference counting to keep track of
135 * virConnectPtr's, virDomainPtr's and virNetworkPtr's.
137 * There is only one function which can return a virConnectPtr
138 * (virConnectOpen*) and that allocates a new one each time.
140 * virDomainPtr/virNetworkPtr's on the other hand can be returned
141 * repeatedly (for the same underlying domain/network), and we must
142 * keep track of each one and explicitly free it with virDomainFree
143 * or virNetworkFree. If we lose track of one then the reference
144 * counting in libvirt will keep it open. We therefore wrap these
145 * in a custom block with a finalizer function.
147 * We also have to allow the user to explicitly free them, in
148 * which case we set the pointer inside the custom block to NULL.
149 * The finalizer notices this and doesn't free the object.
151 * Domains and networks "belong to" a connection. We have to avoid
152 * the situation like this:
154 * let conn = Connect.open ... in
155 * let dom = Domain.lookup_by_id conn 0 in
156 * (* conn goes out of scope and is garbage collected *)
157 * printf "dom name = %s\n" (Domain.get_name dom)
159 * The reason is that when conn is garbage collected, virConnectClose
160 * is called and any subsequent operations on dom will fail (in fact
161 * will probably segfault). To stop this from happening, the OCaml
162 * wrappers store domains (and networks) as explicit (dom, conn)
165 * Further complication with virterror / exceptions: Virterror gives
166 * us virConnectPtr, virDomainPtr, virNetworkPtr pointers. If we
167 * follow standard practice and wrap these up in blocks with
168 * finalizers then we'll end up double-freeing (in particular, calling
169 * virConnectClose at the wrong time). So for virterror, we have
170 * "special" wrapper functions (Val_connect_no_finalize, etc.).
173 /* Unwrap a custom block. */
174 #define Connect_val(rv) (*((virConnectPtr *)Data_custom_val(rv)))
175 #define Dom_val(rv) (*((virDomainPtr *)Data_custom_val(rv)))
176 #define Net_val(rv) (*((virNetworkPtr *)Data_custom_val(rv)))
178 /* Wrap up a pointer to something in a custom block. */
179 static value Val_connect (virConnectPtr conn);
180 static value Val_dom (virDomainPtr dom);
181 static value Val_net (virNetworkPtr net);
183 /* ONLY for use by virterror wrappers. */
184 static value Val_connect_no_finalize (virConnectPtr conn);
185 static value Val_dom_no_finalize (virDomainPtr dom);
186 static value Val_net_no_finalize (virNetworkPtr net);
188 /* Domains and networks are stored as pairs (dom/net, conn), so have
189 * some convenience functions for unwrapping and wrapping them.
191 #define Domain_val(rv) (Dom_val(Field((rv),0)))
192 #define Network_val(rv) (Net_val(Field((rv),0)))
193 #define Connect_domv(rv) (Connect_val(Field((rv),1)))
194 #define Connect_netv(rv) (Connect_val(Field((rv),1)))
196 static value Val_domain (virDomainPtr dom, value connv);
197 static value Val_network (virNetworkPtr net, value connv);
199 /* ONLY for use by virterror wrappers. */
200 static value Val_domain_no_finalize (virDomainPtr dom, value connv);
201 static value Val_network_no_finalize (virNetworkPtr net, value connv);
203 /*----------------------------------------------------------------------*/
205 /* Connection object. */
208 ocaml_libvirt_connect_open (value namev, value unit)
210 CAMLparam2 (namev, unit);
212 const char *name = Optstring_val (namev);
215 conn = virConnectOpen (name);
216 CHECK_ERROR (!conn, NULL, "virConnectOpen");
218 rv = Val_connect (conn);
224 ocaml_libvirt_connect_open_readonly (value namev, value unit)
226 CAMLparam2 (namev, unit);
228 const char *name = Optstring_val (namev);
231 conn = virConnectOpenReadOnly (name);
232 CHECK_ERROR (!conn, NULL, "virConnectOpen");
234 rv = Val_connect (conn);
240 ocaml_libvirt_connect_close (value connv)
243 virConnectPtr conn = Connect_val (connv);
246 r = virConnectClose (conn);
247 CHECK_ERROR (r == -1, conn, "virConnectClose");
249 /* So that we don't double-free in the finalizer: */
250 Connect_val (connv) = NULL;
252 CAMLreturn (Val_unit);
256 ocaml_libvirt_connect_get_type (value connv)
260 virConnectPtr conn = Connect_val (connv);
263 r = virConnectGetType (conn);
264 CHECK_ERROR (!r, conn, "virConnectGetType");
266 rv = caml_copy_string (r);
271 ocaml_libvirt_connect_get_version (value connv)
274 virConnectPtr conn = Connect_val (connv);
278 r = virConnectGetVersion (conn, &hvVer);
279 CHECK_ERROR (r == -1, conn, "virConnectGetVersion");
281 CAMLreturn (Val_int (hvVer));
285 ocaml_libvirt_connect_get_hostname (value connv)
287 #ifdef HAVE_VIRCONNECTGETHOSTNAME
290 virConnectPtr conn = Connect_val (connv);
293 WEAK_SYMBOL_CHECK (virConnectGetHostname);
294 r = virConnectGetHostname (conn);
295 CHECK_ERROR (!r, conn, "virConnectGetHostname");
297 rv = caml_copy_string (r);
301 NOT_SUPPORTED ("virConnectGetHostname");
306 ocaml_libvirt_connect_get_uri (value connv)
308 #ifdef HAVE_VIRCONNECTGETURI
311 virConnectPtr conn = Connect_val (connv);
314 WEAK_SYMBOL_CHECK (virConnectGetURI);
315 r = virConnectGetURI (conn);
316 CHECK_ERROR (!r, conn, "virConnectGetURI");
318 rv = caml_copy_string (r);
322 NOT_SUPPORTED ("virConnectGetURI");
327 ocaml_libvirt_connect_get_max_vcpus (value connv, value typev)
329 CAMLparam2 (connv, typev);
330 virConnectPtr conn = Connect_val (connv);
331 const char *type = Optstring_val (typev);
334 r = virConnectGetMaxVcpus (conn, type);
335 CHECK_ERROR (r == -1, conn, "virConnectGetMaxVcpus");
337 CAMLreturn (Val_int (r));
341 ocaml_libvirt_connect_list_domains (value connv, value iv)
343 CAMLparam2 (connv, iv);
345 virConnectPtr conn = Connect_val (connv);
346 int i = Int_val (iv);
349 r = virConnectListDomains (conn, ids, i);
350 CHECK_ERROR (r == -1, conn, "virConnectListDomains");
352 rv = caml_alloc (r, 0);
353 for (i = 0; i < r; ++i)
354 Store_field (rv, i, Val_int (ids[i]));
360 ocaml_libvirt_connect_num_of_domains (value connv)
363 virConnectPtr conn = Connect_val (connv);
366 r = virConnectNumOfDomains (conn);
367 CHECK_ERROR (r == -1, conn, "virConnectNumOfDomains");
369 CAMLreturn (Val_int (r));
373 ocaml_libvirt_connect_get_capabilities (value connv)
377 virConnectPtr conn = Connect_val (connv);
380 r = virConnectGetCapabilities (conn);
381 CHECK_ERROR (!r, conn, "virConnectGetCapabilities");
383 rv = caml_copy_string (r);
390 ocaml_libvirt_connect_num_of_defined_domains (value connv)
393 virConnectPtr conn = Connect_val (connv);
396 r = virConnectNumOfDefinedDomains (conn);
397 CHECK_ERROR (r == -1, conn, "virConnectNumOfDefinedDomains");
399 CAMLreturn (Val_int (r));
403 ocaml_libvirt_connect_list_defined_domains (value connv, value iv)
405 CAMLparam2 (connv, iv);
406 CAMLlocal2 (rv, strv);
407 virConnectPtr conn = Connect_val (connv);
408 int i = Int_val (iv);
412 r = virConnectListDefinedDomains (conn, names, i);
413 CHECK_ERROR (r == -1, conn, "virConnectListDefinedDomains");
415 rv = caml_alloc (r, 0);
416 for (i = 0; i < r; ++i) {
417 strv = caml_copy_string (names[i]);
418 Store_field (rv, i, strv);
426 ocaml_libvirt_connect_num_of_networks (value connv)
429 virConnectPtr conn = Connect_val (connv);
432 r = virConnectNumOfNetworks (conn);
433 CHECK_ERROR (r == -1, conn, "virConnectNumOfNetworks");
435 CAMLreturn (Val_int (r));
439 ocaml_libvirt_connect_list_networks (value connv, value iv)
441 CAMLparam2 (connv, iv);
442 CAMLlocal2 (rv, strv);
443 virConnectPtr conn = Connect_val (connv);
444 int i = Int_val (iv);
448 r = virConnectListNetworks (conn, names, i);
449 CHECK_ERROR (r == -1, conn, "virConnectListNetworks");
451 rv = caml_alloc (r, 0);
452 for (i = 0; i < r; ++i) {
453 strv = caml_copy_string (names[i]);
454 Store_field (rv, i, strv);
462 ocaml_libvirt_connect_num_of_defined_networks (value connv)
465 virConnectPtr conn = Connect_val (connv);
468 r = virConnectNumOfDefinedNetworks (conn);
469 CHECK_ERROR (r == -1, conn, "virConnectNumOfDefinedNetworks");
471 CAMLreturn (Val_int (r));
475 ocaml_libvirt_connect_list_defined_networks (value connv, value iv)
477 CAMLparam2 (connv, iv);
478 CAMLlocal2 (rv, strv);
479 virConnectPtr conn = Connect_val (connv);
480 int i = Int_val (iv);
484 r = virConnectListDefinedNetworks (conn, names, i);
485 CHECK_ERROR (r == -1, conn, "virConnectListDefinedNetworks");
487 rv = caml_alloc (r, 0);
488 for (i = 0; i < r; ++i) {
489 strv = caml_copy_string (names[i]);
490 Store_field (rv, i, strv);
498 ocaml_libvirt_connect_get_node_info (value connv)
502 virConnectPtr conn = Connect_val (connv);
506 r = virNodeGetInfo (conn, &info);
507 CHECK_ERROR (r == -1, conn, "virNodeGetInfo");
509 rv = caml_alloc (8, 0);
510 v = caml_copy_string (info.model); Store_field (rv, 0, v);
511 v = caml_copy_int64 (info.memory); Store_field (rv, 1, v);
512 Store_field (rv, 2, Val_int (info.cpus));
513 Store_field (rv, 3, Val_int (info.mhz));
514 Store_field (rv, 4, Val_int (info.nodes));
515 Store_field (rv, 5, Val_int (info.sockets));
516 Store_field (rv, 6, Val_int (info.cores));
517 Store_field (rv, 7, Val_int (info.threads));
523 ocaml_libvirt_domain_create_linux (value connv, value xmlv)
525 CAMLparam2 (connv, xmlv);
527 virConnectPtr conn = Connect_val (connv);
528 char *xml = String_val (xmlv);
531 r = virDomainCreateLinux (conn, xml, 0);
532 CHECK_ERROR (!r, conn, "virDomainCreateLinux");
534 rv = Val_domain (r, connv);
539 ocaml_libvirt_domain_lookup_by_id (value connv, value iv)
541 CAMLparam2 (connv, iv);
543 virConnectPtr conn = Connect_val (connv);
544 int i = Int_val (iv);
547 r = virDomainLookupByID (conn, i);
548 CHECK_ERROR (!r, conn, "virDomainLookupByID");
550 rv = Val_domain (r, connv);
555 ocaml_libvirt_domain_lookup_by_uuid (value connv, value uuidv)
557 CAMLparam2 (connv, uuidv);
559 virConnectPtr conn = Connect_val (connv);
560 char *uuid = String_val (uuidv);
563 r = virDomainLookupByUUID (conn, (unsigned char *) uuid);
564 CHECK_ERROR (!r, conn, "virDomainLookupByUUID");
566 rv = Val_domain (r, connv);
571 ocaml_libvirt_domain_lookup_by_uuid_string (value connv, value uuidv)
573 CAMLparam2 (connv, uuidv);
575 virConnectPtr conn = Connect_val (connv);
576 char *uuid = String_val (uuidv);
579 r = virDomainLookupByUUIDString (conn, uuid);
580 CHECK_ERROR (!r, conn, "virDomainLookupByUUIDString");
582 rv = Val_domain (r, connv);
587 ocaml_libvirt_domain_lookup_by_name (value connv, value namev)
589 CAMLparam2 (connv, namev);
591 virConnectPtr conn = Connect_val (connv);
592 char *name = String_val (namev);
595 r = virDomainLookupByName (conn, name);
596 CHECK_ERROR (!r, conn, "virDomainLookupByName");
598 rv = Val_domain (r, connv);
603 ocaml_libvirt_domain_destroy (value domv)
606 virDomainPtr dom = Domain_val (domv);
607 virConnectPtr conn = Connect_domv (domv);
610 r = virDomainDestroy (dom);
611 CHECK_ERROR (r == -1, conn, "virDomainDestroy");
613 /* So that we don't double-free in the finalizer: */
614 Domain_val (domv) = NULL;
616 CAMLreturn (Val_unit);
620 ocaml_libvirt_domain_free (value domv)
623 virDomainPtr dom = Domain_val (domv);
624 virConnectPtr conn = Connect_domv (domv);
627 r = virDomainFree (dom);
628 CHECK_ERROR (r == -1, conn, "virDomainFree");
630 /* So that we don't double-free in the finalizer: */
631 Domain_val (domv) = NULL;
633 CAMLreturn (Val_unit);
637 ocaml_libvirt_domain_suspend (value domv)
640 virDomainPtr dom = Domain_val (domv);
641 virConnectPtr conn = Connect_domv (domv);
644 r = virDomainSuspend (dom);
645 CHECK_ERROR (r == -1, conn, "virDomainSuspend");
647 CAMLreturn (Val_unit);
651 ocaml_libvirt_domain_resume (value domv)
654 virDomainPtr dom = Domain_val (domv);
655 virConnectPtr conn = Connect_domv (domv);
658 r = virDomainResume (dom);
659 CHECK_ERROR (r == -1, conn, "virDomainResume");
661 CAMLreturn (Val_unit);
665 ocaml_libvirt_domain_save (value domv, value pathv)
667 CAMLparam2 (domv, pathv);
668 virDomainPtr dom = Domain_val (domv);
669 virConnectPtr conn = Connect_domv (domv);
670 char *path = String_val (pathv);
673 r = virDomainSave (dom, path);
674 CHECK_ERROR (r == -1, conn, "virDomainSave");
676 CAMLreturn (Val_unit);
680 ocaml_libvirt_domain_restore (value connv, value pathv)
682 CAMLparam2 (connv, pathv);
683 virConnectPtr conn = Connect_val (connv);
684 char *path = String_val (pathv);
687 r = virDomainRestore (conn, path);
688 CHECK_ERROR (r == -1, conn, "virDomainRestore");
690 CAMLreturn (Val_unit);
694 ocaml_libvirt_domain_core_dump (value domv, value pathv)
696 CAMLparam2 (domv, pathv);
697 virDomainPtr dom = Domain_val (domv);
698 virConnectPtr conn = Connect_domv (domv);
699 char *path = String_val (pathv);
702 r = virDomainCoreDump (dom, path, 0);
703 CHECK_ERROR (r == -1, conn, "virDomainCoreDump");
705 CAMLreturn (Val_unit);
709 ocaml_libvirt_domain_shutdown (value domv)
712 virDomainPtr dom = Domain_val (domv);
713 virConnectPtr conn = Connect_domv (domv);
716 r = virDomainShutdown (dom);
717 CHECK_ERROR (r == -1, conn, "virDomainShutdown");
719 CAMLreturn (Val_unit);
723 ocaml_libvirt_domain_reboot (value domv)
726 virDomainPtr dom = Domain_val (domv);
727 virConnectPtr conn = Connect_domv (domv);
730 r = virDomainReboot (dom, 0);
731 CHECK_ERROR (r == -1, conn, "virDomainReboot");
733 CAMLreturn (Val_unit);
737 ocaml_libvirt_domain_get_name (value domv)
741 virDomainPtr dom = Domain_val (domv);
742 virConnectPtr conn = Connect_domv (domv);
745 r = virDomainGetName (dom);
746 CHECK_ERROR (!r, conn, "virDomainGetName");
748 rv = caml_copy_string (r);
753 ocaml_libvirt_domain_get_uuid (value domv)
757 virDomainPtr dom = Domain_val (domv);
758 virConnectPtr conn = Connect_domv (domv);
759 unsigned char uuid[VIR_UUID_BUFLEN];
762 r = virDomainGetUUID (dom, uuid);
763 CHECK_ERROR (r == -1, conn, "virDomainGetUUID");
765 rv = caml_copy_string ((char *) uuid);
770 ocaml_libvirt_domain_get_uuid_string (value domv)
774 virDomainPtr dom = Domain_val (domv);
775 virConnectPtr conn = Connect_domv (domv);
776 char uuid[VIR_UUID_STRING_BUFLEN];
779 r = virDomainGetUUIDString (dom, uuid);
780 CHECK_ERROR (r == -1, conn, "virDomainGetUUIDString");
782 rv = caml_copy_string (uuid);
787 ocaml_libvirt_domain_get_id (value domv)
790 virDomainPtr dom = Domain_val (domv);
791 virConnectPtr conn = Connect_domv (domv);
794 r = virDomainGetID (dom);
795 /* There's a bug in libvirt which means that if you try to get
796 * the ID of a defined-but-not-running domain, it returns -1,
797 * and there's no way to distinguish that from an error.
799 CHECK_ERROR (r == (unsigned int) -1, conn, "virDomainGetID");
801 CAMLreturn (Val_int ((int) r));
805 ocaml_libvirt_domain_get_os_type (value domv)
809 virDomainPtr dom = Domain_val (domv);
810 virConnectPtr conn = Connect_domv (domv);
813 r = virDomainGetOSType (dom);
814 CHECK_ERROR (!r, conn, "virDomainGetOSType");
816 rv = caml_copy_string (r);
822 ocaml_libvirt_domain_get_max_memory (value domv)
826 virDomainPtr dom = Domain_val (domv);
827 virConnectPtr conn = Connect_domv (domv);
830 r = virDomainGetMaxMemory (dom);
831 CHECK_ERROR (r == 0 /* [sic] */, conn, "virDomainGetMaxMemory");
833 rv = caml_copy_int64 (r);
838 ocaml_libvirt_domain_set_max_memory (value domv, value memv)
840 CAMLparam2 (domv, memv);
841 virDomainPtr dom = Domain_val (domv);
842 virConnectPtr conn = Connect_domv (domv);
843 unsigned long mem = Int64_val (memv);
846 r = virDomainSetMaxMemory (dom, mem);
847 CHECK_ERROR (r == -1, conn, "virDomainSetMaxMemory");
849 CAMLreturn (Val_unit);
853 ocaml_libvirt_domain_set_memory (value domv, value memv)
855 CAMLparam2 (domv, memv);
856 virDomainPtr dom = Domain_val (domv);
857 virConnectPtr conn = Connect_domv (domv);
858 unsigned long mem = Int64_val (memv);
861 r = virDomainSetMemory (dom, mem);
862 CHECK_ERROR (r == -1, conn, "virDomainSetMemory");
864 CAMLreturn (Val_unit);
868 ocaml_libvirt_domain_get_info (value domv)
872 virDomainPtr dom = Domain_val (domv);
873 virConnectPtr conn = Connect_domv (domv);
877 r = virDomainGetInfo (dom, &info);
878 CHECK_ERROR (r == -1, conn, "virDomainGetInfo");
880 rv = caml_alloc (5, 0);
881 Store_field (rv, 0, Val_int (info.state)); // These flags are compatible.
882 v = caml_copy_int64 (info.maxMem); Store_field (rv, 1, v);
883 v = caml_copy_int64 (info.memory); Store_field (rv, 2, v);
884 Store_field (rv, 3, Val_int (info.nrVirtCpu));
885 v = caml_copy_int64 (info.cpuTime); Store_field (rv, 4, v);
891 ocaml_libvirt_domain_get_xml_desc (value domv)
895 virDomainPtr dom = Domain_val (domv);
896 virConnectPtr conn = Connect_domv (domv);
899 r = virDomainGetXMLDesc (dom, 0);
900 CHECK_ERROR (!r, conn, "virDomainGetXMLDesc");
902 rv = caml_copy_string (r);
908 ocaml_libvirt_domain_get_scheduler_type (value domv)
910 #ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE
912 CAMLlocal2 (rv, strv);
913 virDomainPtr dom = Domain_val (domv);
914 virConnectPtr conn = Connect_domv (domv);
918 WEAK_SYMBOL_CHECK (virDomainGetSchedulerType);
919 r = virDomainGetSchedulerType (dom, &nparams);
920 CHECK_ERROR (!r, conn, "virDomainGetSchedulerType");
922 rv = caml_alloc_tuple (2);
923 strv = caml_copy_string (r); Store_field (rv, 0, strv);
925 Store_field (rv, 1, nparams);
928 NOT_SUPPORTED ("virDomainGetSchedulerType");
933 ocaml_libvirt_domain_get_scheduler_parameters (value domv, value nparamsv)
935 #ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS
936 CAMLparam2 (domv, nparamsv);
937 CAMLlocal4 (rv, v, v2, v3);
938 virDomainPtr dom = Domain_val (domv);
939 virConnectPtr conn = Connect_domv (domv);
940 int nparams = Int_val (nparamsv);
941 virSchedParameter params[nparams];
944 WEAK_SYMBOL_CHECK (virDomainGetSchedulerParameters);
945 r = virDomainGetSchedulerParameters (dom, params, &nparams);
946 CHECK_ERROR (r == -1, conn, "virDomainGetSchedulerParameters");
948 rv = caml_alloc (nparams, 0);
949 for (i = 0; i < nparams; ++i) {
950 v = caml_alloc_tuple (2); Store_field (rv, i, v);
951 v2 = caml_copy_string (params[i].field); Store_field (v, 0, v2);
952 switch (params[i].type) {
953 case VIR_DOMAIN_SCHED_FIELD_INT:
954 v2 = caml_alloc (1, 0);
955 v3 = caml_copy_int32 (params[i].value.i); Store_field (v2, 0, v3);
957 case VIR_DOMAIN_SCHED_FIELD_UINT:
958 v2 = caml_alloc (1, 1);
959 v3 = caml_copy_int32 (params[i].value.ui); Store_field (v2, 0, v3);
961 case VIR_DOMAIN_SCHED_FIELD_LLONG:
962 v2 = caml_alloc (1, 2);
963 v3 = caml_copy_int64 (params[i].value.l); Store_field (v2, 0, v3);
965 case VIR_DOMAIN_SCHED_FIELD_ULLONG:
966 v2 = caml_alloc (1, 3);
967 v3 = caml_copy_int64 (params[i].value.ul); Store_field (v2, 0, v3);
969 case VIR_DOMAIN_SCHED_FIELD_DOUBLE:
970 v2 = caml_alloc (1, 4);
971 v3 = caml_copy_double (params[i].value.d); Store_field (v2, 0, v3);
973 case VIR_DOMAIN_SCHED_FIELD_BOOLEAN:
974 v2 = caml_alloc (1, 5);
975 Store_field (v2, 0, Val_int (params[i].value.b));
978 caml_failwith ((char *)__FUNCTION__);
980 Store_field (v, 1, v2);
984 NOT_SUPPORTED ("virDomainGetSchedulerParameters");
989 ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv)
991 #ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS
992 CAMLparam2 (domv, paramsv);
994 virDomainPtr dom = Domain_val (domv);
995 virConnectPtr conn = Connect_domv (domv);
996 int nparams = Wosize_val (paramsv);
997 virSchedParameter params[nparams];
1001 for (i = 0; i < nparams; ++i) {
1002 v = Field (paramsv, i); /* Points to the two-element tuple. */
1003 name = String_val (Field (v, 0));
1004 strncpy (params[i].field, name, VIR_DOMAIN_SCHED_FIELD_LENGTH);
1005 params[i].field[VIR_DOMAIN_SCHED_FIELD_LENGTH-1] = '\0';
1006 v = Field (v, 1); /* Points to the sched_param_value block. */
1007 switch (Tag_val (v)) {
1009 params[i].type = VIR_DOMAIN_SCHED_FIELD_INT;
1010 params[i].value.i = Int32_val (Field (v, 0));
1013 params[i].type = VIR_DOMAIN_SCHED_FIELD_UINT;
1014 params[i].value.ui = Int32_val (Field (v, 0));
1017 params[i].type = VIR_DOMAIN_SCHED_FIELD_LLONG;
1018 params[i].value.l = Int64_val (Field (v, 0));
1021 params[i].type = VIR_DOMAIN_SCHED_FIELD_ULLONG;
1022 params[i].value.ul = Int64_val (Field (v, 0));
1025 params[i].type = VIR_DOMAIN_SCHED_FIELD_DOUBLE;
1026 params[i].value.d = Double_val (Field (v, 0));
1029 params[i].type = VIR_DOMAIN_SCHED_FIELD_BOOLEAN;
1030 params[i].value.b = Int_val (Field (v, 0));
1033 caml_failwith ((char *)__FUNCTION__);
1037 WEAK_SYMBOL_CHECK (virDomainSetSchedulerParameters);
1038 r = virDomainSetSchedulerParameters (dom, params, nparams);
1039 CHECK_ERROR (r == -1, conn, "virDomainSetSchedulerParameters");
1041 CAMLreturn (Val_unit);
1043 NOT_SUPPORTED ("virDomainSetSchedulerParameters");
1048 ocaml_libvirt_domain_define_xml (value connv, value xmlv)
1050 CAMLparam2 (connv, xmlv);
1052 virConnectPtr conn = Connect_val (connv);
1053 char *xml = String_val (xmlv);
1056 r = virDomainDefineXML (conn, xml);
1057 CHECK_ERROR (!r, conn, "virDomainDefineXML");
1059 rv = Val_domain (r, connv);
1064 ocaml_libvirt_domain_undefine (value domv)
1067 virDomainPtr dom = Domain_val (domv);
1068 virConnectPtr conn = Connect_domv (domv);
1071 r = virDomainUndefine (dom);
1072 CHECK_ERROR (r == -1, conn, "virDomainUndefine");
1074 CAMLreturn (Val_unit);
1078 ocaml_libvirt_domain_create (value domv)
1081 virDomainPtr dom = Domain_val (domv);
1082 virConnectPtr conn = Connect_domv (domv);
1085 r = virDomainCreate (dom);
1086 CHECK_ERROR (r == -1, conn, "virDomainCreate");
1088 CAMLreturn (Val_unit);
1092 ocaml_libvirt_domain_get_autostart (value domv)
1095 virDomainPtr dom = Domain_val (domv);
1096 virConnectPtr conn = Connect_domv (domv);
1099 r = virDomainGetAutostart (dom, &autostart);
1100 CHECK_ERROR (r == -1, conn, "virDomainGetAutostart");
1102 CAMLreturn (autostart ? Val_true : Val_false);
1106 ocaml_libvirt_domain_set_autostart (value domv, value autostartv)
1108 CAMLparam2 (domv, autostartv);
1109 virDomainPtr dom = Domain_val (domv);
1110 virConnectPtr conn = Connect_domv (domv);
1111 int r, autostart = autostartv == Val_true ? 1 : 0;
1113 r = virDomainSetAutostart (dom, autostart);
1114 CHECK_ERROR (r == -1, conn, "virDomainSetAutostart");
1116 CAMLreturn (Val_unit);
1120 ocaml_libvirt_domain_set_vcpus (value domv, value nvcpusv)
1122 CAMLparam2 (domv, nvcpusv);
1123 virDomainPtr dom = Domain_val (domv);
1124 virConnectPtr conn = Connect_domv (domv);
1125 int r, nvcpus = Int_val (nvcpusv);
1127 r = virDomainSetVcpus (dom, nvcpus);
1128 CHECK_ERROR (r == -1, conn, "virDomainSetVcpus");
1130 CAMLreturn (Val_unit);
1134 ocaml_libvirt_domain_pin_vcpu (value domv, value vcpuv, value cpumapv)
1136 CAMLparam3 (domv, vcpuv, cpumapv);
1137 virDomainPtr dom = Domain_val (domv);
1138 virConnectPtr conn = Connect_domv (domv);
1139 int maplen = caml_string_length (cpumapv);
1140 unsigned char *cpumap = (unsigned char *) String_val (cpumapv);
1141 int vcpu = Int_val (vcpuv);
1144 r = virDomainPinVcpu (dom, vcpu, cpumap, maplen);
1145 CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
1147 CAMLreturn (Val_unit);
1151 ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv)
1153 CAMLparam3 (domv, maxinfov, maplenv);
1154 CAMLlocal5 (rv, infov, strv, v, v2);
1155 virDomainPtr dom = Domain_val (domv);
1156 virConnectPtr conn = Connect_domv (domv);
1157 int maxinfo = Int_val (maxinfov);
1158 int maplen = Int_val (maplenv);
1159 virVcpuInfo info[maxinfo];
1160 unsigned char cpumaps[maxinfo * maplen];
1163 memset (info, 0, sizeof (virVcpuInfo) * maxinfo);
1164 memset (cpumaps, 0, maxinfo * maplen);
1166 r = virDomainGetVcpus (dom, info, maxinfo, cpumaps, maplen);
1167 CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
1169 /* Copy the virVcpuInfo structures. */
1170 infov = caml_alloc (maxinfo, 0);
1171 for (i = 0; i < maxinfo; ++i) {
1172 v2 = caml_alloc (4, 0); Store_field (infov, i, v2);
1173 Store_field (v2, 0, Val_int (info[i].number));
1174 Store_field (v2, 1, Val_int (info[i].state));
1175 v = caml_copy_int64 (info[i].cpuTime); Store_field (v2, 2, v);
1176 Store_field (v2, 3, Val_int (info[i].cpu));
1179 /* Copy the bitmap. */
1180 strv = caml_alloc_string (maxinfo * maplen);
1181 memcpy (String_val (strv), cpumaps, maxinfo * maplen);
1183 /* Allocate the tuple and return it. */
1184 rv = caml_alloc_tuple (3);
1185 Store_field (rv, 0, Val_int (r)); /* number of CPUs. */
1186 Store_field (rv, 1, infov);
1187 Store_field (rv, 2, strv);
1193 ocaml_libvirt_domain_get_max_vcpus (value domv)
1196 virDomainPtr dom = Domain_val (domv);
1197 virConnectPtr conn = Connect_domv (domv);
1200 r = virDomainGetMaxVcpus (dom);
1201 CHECK_ERROR (r == -1, conn, "virDomainGetMaxVcpus");
1203 CAMLreturn (Val_int (r));
1207 ocaml_libvirt_domain_attach_device (value domv, value xmlv)
1209 CAMLparam2 (domv, xmlv);
1210 virDomainPtr dom = Domain_val (domv);
1211 virConnectPtr conn = Connect_domv (domv);
1212 char *xml = String_val (xmlv);
1215 r = virDomainAttachDevice (dom, xml);
1216 CHECK_ERROR (r == -1, conn, "virDomainAttachDevice");
1218 CAMLreturn (Val_unit);
1222 ocaml_libvirt_domain_detach_device (value domv, value xmlv)
1224 CAMLparam2 (domv, xmlv);
1225 virDomainPtr dom = Domain_val (domv);
1226 virConnectPtr conn = Connect_domv (domv);
1227 char *xml = String_val (xmlv);
1230 r = virDomainDetachDevice (dom, xml);
1231 CHECK_ERROR (r == -1, conn, "virDomainDetachDevice");
1233 CAMLreturn (Val_unit);
1237 ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, value optdnamev, value opturiv, value optbandwidthv, value unitv)
1239 #ifdef HAVE_VIRDOMAINMIGRATE
1240 CAMLparam5 (domv, dconnv, flagsv, optdnamev, opturiv);
1241 CAMLxparam2 (optbandwidthv, unitv);
1242 CAMLlocal2 (flagv, rv);
1243 virDomainPtr dom = Domain_val (domv);
1244 virConnectPtr conn = Connect_domv (domv);
1245 virConnectPtr dconn = Connect_val (dconnv);
1247 const char *dname = Optstring_val (optdnamev);
1248 const char *uri = Optstring_val (opturiv);
1249 unsigned long bandwidth;
1252 /* Iterate over the list of flags. */
1253 for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
1255 flagv = Field (flagsv, 0);
1256 if (flagv == Int_val(0))
1257 flags |= VIR_MIGRATE_LIVE;
1260 if (optbandwidthv == Val_int (0)) /* None */
1262 else /* Some bandwidth */
1263 bandwidth = Int_val (Field (optbandwidthv, 0));
1265 WEAK_SYMBOL_CHECK (virDomainMigrate);
1266 r = virDomainMigrate (dom, dconn, flags, dname, uri, bandwidth);
1267 CHECK_ERROR (!r, conn, "virDomainMigrate");
1269 rv = Val_domain (r, dconnv);
1273 #else /* virDomainMigrate not supported */
1274 NOT_SUPPORTED ("virDomainMigrate");
1279 ocaml_libvirt_domain_migrate_bytecode (value *argv, int argn)
1281 return ocaml_libvirt_domain_migrate_native (argv[0], argv[1], argv[2],
1282 argv[3], argv[4], argv[5],
1287 ocaml_libvirt_domain_block_stats (value domv, value pathv)
1289 #if HAVE_VIRDOMAINBLOCKSTATS
1290 CAMLparam2 (domv, pathv);
1292 virDomainPtr dom = Domain_val (domv);
1293 virConnectPtr conn = Connect_domv (domv);
1294 char *path = String_val (pathv);
1295 struct _virDomainBlockStats stats;
1298 WEAK_SYMBOL_CHECK (virDomainBlockStats);
1299 r = virDomainBlockStats (dom, path, &stats, sizeof stats);
1300 CHECK_ERROR (r == -1, conn, "virDomainBlockStats");
1302 rv = caml_alloc (5, 0);
1303 v = caml_copy_int64 (stats.rd_req); Store_field (rv, 0, v);
1304 v = caml_copy_int64 (stats.rd_bytes); Store_field (rv, 1, v);
1305 v = caml_copy_int64 (stats.wr_req); Store_field (rv, 2, v);
1306 v = caml_copy_int64 (stats.wr_bytes); Store_field (rv, 3, v);
1307 v = caml_copy_int64 (stats.errs); Store_field (rv, 4, v);
1311 NOT_SUPPORTED ("virDomainBlockStats");
1316 ocaml_libvirt_domain_interface_stats (value domv, value pathv)
1318 #if HAVE_VIRDOMAININTERFACESTATS
1319 CAMLparam2 (domv, pathv);
1321 virDomainPtr dom = Domain_val (domv);
1322 virConnectPtr conn = Connect_domv (domv);
1323 char *path = String_val (pathv);
1324 struct _virDomainInterfaceStats stats;
1327 WEAK_SYMBOL_CHECK (virDomainInterfaceStats);
1328 r = virDomainInterfaceStats (dom, path, &stats, sizeof stats);
1329 CHECK_ERROR (r == -1, conn, "virDomainInterfaceStats");
1331 rv = caml_alloc (8, 0);
1332 v = caml_copy_int64 (stats.rx_bytes); Store_field (rv, 0, v);
1333 v = caml_copy_int64 (stats.rx_packets); Store_field (rv, 1, v);
1334 v = caml_copy_int64 (stats.rx_errs); Store_field (rv, 2, v);
1335 v = caml_copy_int64 (stats.rx_drop); Store_field (rv, 3, v);
1336 v = caml_copy_int64 (stats.tx_bytes); Store_field (rv, 4, v);
1337 v = caml_copy_int64 (stats.tx_packets); Store_field (rv, 5, v);
1338 v = caml_copy_int64 (stats.tx_errs); Store_field (rv, 6, v);
1339 v = caml_copy_int64 (stats.tx_drop); Store_field (rv, 7, v);
1343 NOT_SUPPORTED ("virDomainInterfaceStats");
1348 ocaml_libvirt_network_lookup_by_name (value connv, value namev)
1350 CAMLparam2 (connv, namev);
1352 virConnectPtr conn = Connect_val (connv);
1353 char *name = String_val (namev);
1356 r = virNetworkLookupByName (conn, name);
1357 CHECK_ERROR (!r, conn, "virNetworkLookupByName");
1359 rv = Val_network (r, connv);
1364 ocaml_libvirt_network_lookup_by_uuid (value connv, value uuidv)
1366 CAMLparam2 (connv, uuidv);
1368 virConnectPtr conn = Connect_val (connv);
1369 char *uuid = String_val (uuidv);
1372 r = virNetworkLookupByUUID (conn, (unsigned char *) uuid);
1373 CHECK_ERROR (!r, conn, "virNetworkLookupByUUID");
1375 rv = Val_network (r, connv);
1380 ocaml_libvirt_network_lookup_by_uuid_string (value connv, value uuidv)
1382 CAMLparam2 (connv, uuidv);
1384 virConnectPtr conn = Connect_val (connv);
1385 char *uuid = String_val (uuidv);
1388 r = virNetworkLookupByUUIDString (conn, uuid);
1389 CHECK_ERROR (!r, conn, "virNetworkLookupByUUIDString");
1391 rv = Val_network (r, connv);
1396 ocaml_libvirt_network_create_xml (value connv, value xmlv)
1398 CAMLparam2 (connv, xmlv);
1400 virConnectPtr conn = Connect_val (connv);
1401 char *xml = String_val (xmlv);
1404 r = virNetworkCreateXML (conn, xml);
1405 CHECK_ERROR (!r, conn, "virNetworkCreateXML");
1407 rv = Val_network (r, connv);
1412 ocaml_libvirt_network_define_xml (value connv, value xmlv)
1414 CAMLparam2 (connv, xmlv);
1416 virConnectPtr conn = Connect_val (connv);
1417 char *xml = String_val (xmlv);
1420 r = virNetworkDefineXML (conn, xml);
1421 CHECK_ERROR (!r, conn, "virNetworkDefineXML");
1423 rv = Val_network (r, connv);
1428 ocaml_libvirt_network_undefine (value netv)
1431 virNetworkPtr net = Network_val (netv);
1432 virConnectPtr conn = Connect_netv (netv);
1435 r = virNetworkUndefine (net);
1436 CHECK_ERROR (r == -1, conn, "virNetworkUndefine");
1438 CAMLreturn (Val_unit);
1442 ocaml_libvirt_network_create (value netv)
1445 virNetworkPtr net = Network_val (netv);
1446 virConnectPtr conn = Connect_netv (netv);
1449 r = virNetworkCreate (net);
1450 CHECK_ERROR (r == -1, conn, "virNetworkCreate");
1452 CAMLreturn (Val_unit);
1456 ocaml_libvirt_network_destroy (value netv)
1459 virNetworkPtr net = Network_val (netv);
1460 virConnectPtr conn = Connect_netv (netv);
1463 r = virNetworkDestroy (net);
1464 CHECK_ERROR (r == -1, conn, "virNetworkDestroy");
1466 /* So that we don't double-free in the finalizer: */
1467 Network_val (netv) = NULL;
1469 CAMLreturn (Val_unit);
1473 ocaml_libvirt_network_free (value netv)
1476 virNetworkPtr net = Network_val (netv);
1477 virConnectPtr conn = Connect_netv (netv);
1480 r = virNetworkFree (net);
1481 CHECK_ERROR (r == -1, conn, "virNetworkFree");
1483 /* So that we don't double-free in the finalizer: */
1484 Network_val (netv) = NULL;
1486 CAMLreturn (Val_unit);
1490 ocaml_libvirt_network_get_name (value netv)
1494 virNetworkPtr net = Network_val (netv);
1495 virConnectPtr conn = Connect_netv (netv);
1498 r = virNetworkGetName (net);
1499 CHECK_ERROR (!r, conn, "virNetworkGetName");
1501 rv = caml_copy_string (r);
1506 ocaml_libvirt_network_get_uuid (value netv)
1510 virNetworkPtr net = Network_val (netv);
1511 virConnectPtr conn = Connect_netv (netv);
1512 unsigned char uuid[VIR_UUID_BUFLEN];
1515 r = virNetworkGetUUID (net, uuid);
1516 CHECK_ERROR (r == -1, conn, "virNetworkGetUUID");
1518 rv = caml_copy_string ((char *) uuid);
1523 ocaml_libvirt_network_get_uuid_string (value netv)
1527 virNetworkPtr net = Network_val (netv);
1528 virConnectPtr conn = Connect_netv (netv);
1529 char uuid[VIR_UUID_STRING_BUFLEN];
1532 r = virNetworkGetUUIDString (net, uuid);
1533 CHECK_ERROR (r == -1, conn, "virNetworkGetUUIDString");
1535 rv = caml_copy_string (uuid);
1540 ocaml_libvirt_network_get_xml_desc (value netv)
1544 virNetworkPtr net = Network_val (netv);
1545 virConnectPtr conn = Connect_netv (netv);
1548 r = virNetworkGetXMLDesc (net, 0);
1549 CHECK_ERROR (!r, conn, "virNetworkGetXMLDesc");
1551 rv = caml_copy_string (r);
1557 ocaml_libvirt_network_get_bridge_name (value netv)
1561 virNetworkPtr net = Network_val (netv);
1562 virConnectPtr conn = Connect_netv (netv);
1565 r = virNetworkGetBridgeName (net);
1566 CHECK_ERROR (!r, conn, "virNetworkGetBridgeName");
1568 rv = caml_copy_string (r);
1574 ocaml_libvirt_network_get_autostart (value netv)
1577 virNetworkPtr net = Network_val (netv);
1578 virConnectPtr conn = Connect_netv (netv);
1581 r = virNetworkGetAutostart (net, &autostart);
1582 CHECK_ERROR (r == -1, conn, "virNetworkGetAutostart");
1584 CAMLreturn (autostart ? Val_true : Val_false);
1588 ocaml_libvirt_network_set_autostart (value netv, value autostartv)
1590 CAMLparam2 (netv, autostartv);
1591 virNetworkPtr net = Network_val (netv);
1592 virConnectPtr conn = Connect_netv (netv);
1593 int r, autostart = autostartv == Val_true ? 1 : 0;
1595 r = virNetworkSetAutostart (net, autostart);
1596 CHECK_ERROR (r == -1, conn, "virNetworkSetAutostart");
1598 CAMLreturn (Val_unit);
1601 /*----------------------------------------------------------------------*/
1604 ocaml_libvirt_virterror_get_last_error (value unitv)
1608 virErrorPtr err = virGetLastError ();
1610 rv = Val_opt (err, (Val_ptr_t) Val_virterror);
1616 ocaml_libvirt_virterror_get_last_conn_error (value connv)
1620 virConnectPtr conn = Connect_val (connv);
1622 rv = Val_opt (conn, (Val_ptr_t) Val_connect);
1628 ocaml_libvirt_virterror_reset_last_error (value unitv)
1631 virResetLastError ();
1632 CAMLreturn (Val_unit);
1636 ocaml_libvirt_virterror_reset_last_conn_error (value connv)
1639 virConnectPtr conn = Connect_val (connv);
1640 virConnResetLastError (conn);
1641 CAMLreturn (Val_unit);
1644 /*----------------------------------------------------------------------*/
1646 /* Initialise the library. */
1648 ocaml_libvirt_init (value unit)
1654 r = virInitialize ();
1655 CHECK_ERROR (r == -1, NULL, "virInitialize");
1657 CAMLreturn (Val_unit);
1660 /*----------------------------------------------------------------------*/
1663 Optstring_val (value strv)
1665 if (strv == Val_int (0)) /* None */
1667 else /* Some string */
1668 return String_val (Field (strv, 0));
1672 Val_opt (void *ptr, Val_ptr_t Val_ptr)
1675 CAMLlocal2 (optv, ptrv);
1677 if (ptr) { /* Some ptr */
1678 optv = caml_alloc (1, 0);
1679 ptrv = Val_ptr (ptr);
1680 Store_field (optv, 0, ptrv);
1689 option_default (value option, value deflt)
1691 if (option == Val_int (0)) /* "None" */
1693 else /* "Some 'a" */
1694 return Field (option, 0);
1699 _raise_virterror (virConnectPtr conn, const char *fn)
1704 struct _virError err;
1706 errp = conn ? virConnGetLastError (conn) : virGetLastError ();
1709 /* Fake a _virError structure. */
1710 memset (&err, 0, sizeof err);
1711 err.code = VIR_ERR_INTERNAL_ERROR;
1712 err.domain = VIR_FROM_NONE;
1713 err.level = VIR_ERR_ERROR;
1714 err.message = (char *) fn;
1718 rv = Val_virterror (errp);
1719 caml_raise_with_arg (*caml_named_value ("ocaml_libvirt_virterror"), rv);
1722 CAMLreturn (Val_unit);
1726 Val_virterror (virErrorPtr err)
1729 CAMLlocal3 (rv, connv, optv);
1731 rv = caml_alloc (12, 0);
1732 Store_field (rv, 0, Val_int (err->code));
1733 Store_field (rv, 1, Val_int (err->domain));
1735 Val_opt (err->message, (Val_ptr_t) caml_copy_string));
1736 Store_field (rv, 3, Val_int (err->level));
1738 /* conn, dom and net fields, all optional */
1740 connv = Val_connect_no_finalize (err->conn);
1741 optv = caml_alloc (1, 0);
1742 Store_field (optv, 0, connv);
1743 Store_field (rv, 4, optv); /* Some conn */
1746 optv = caml_alloc (1, 0);
1747 Store_field (optv, 0, Val_domain_no_finalize (err->dom, connv));
1748 Store_field (rv, 5, optv); /* Some (dom, conn) */
1751 Store_field (rv, 5, Val_int (0)); /* None */
1753 optv = caml_alloc (1, 0);
1754 Store_field (optv, 0, Val_network_no_finalize (err->net, connv));
1755 Store_field (rv, 11, optv); /* Some (net, conn) */
1757 Store_field (rv, 11, Val_int (0)); /* None */
1759 Store_field (rv, 4, Val_int (0)); /* None */
1760 Store_field (rv, 5, Val_int (0)); /* None */
1761 Store_field (rv, 11, Val_int (0)); /* None */
1765 Val_opt (err->str1, (Val_ptr_t) caml_copy_string));
1767 Val_opt (err->str2, (Val_ptr_t) caml_copy_string));
1769 Val_opt (err->str3, (Val_ptr_t) caml_copy_string));
1770 Store_field (rv, 9, caml_copy_int32 (err->int1));
1771 Store_field (rv, 10, caml_copy_int32 (err->int2));
1776 static void conn_finalize (value);
1777 static void dom_finalize (value);
1778 static void net_finalize (value);
1780 static struct custom_operations conn_custom_operations = {
1781 "conn_custom_operations",
1783 custom_compare_default,
1784 custom_hash_default,
1785 custom_serialize_default,
1786 custom_deserialize_default
1789 static struct custom_operations dom_custom_operations = {
1790 "dom_custom_operations",
1792 custom_compare_default,
1793 custom_hash_default,
1794 custom_serialize_default,
1795 custom_deserialize_default
1799 static struct custom_operations net_custom_operations = {
1800 "net_custom_operations",
1802 custom_compare_default,
1803 custom_hash_default,
1804 custom_serialize_default,
1805 custom_deserialize_default
1809 Val_connect (virConnectPtr conn)
1813 rv = caml_alloc_custom (&conn_custom_operations,
1814 sizeof (virConnectPtr), 0, 1);
1815 Connect_val (rv) = conn;
1819 /* This wraps up the raw domain handle (Domain.dom). */
1821 Val_dom (virDomainPtr dom)
1825 rv = caml_alloc_custom (&dom_custom_operations,
1826 sizeof (virDomainPtr), 0, 1);
1831 /* This wraps up the raw network handle (Network.net). */
1833 Val_net (virNetworkPtr net)
1837 rv = caml_alloc_custom (&net_custom_operations,
1838 sizeof (virNetworkPtr), 0, 1);
1843 /* No-finalize versions of Val_connect, Val_dom, Val_net ONLY for use
1844 * by virterror wrappers.
1847 Val_connect_no_finalize (virConnectPtr conn)
1851 rv = caml_alloc (1, Abstract_tag);
1852 Store_field (rv, 0, (value) conn);
1857 Val_dom_no_finalize (virDomainPtr dom)
1861 rv = caml_alloc (1, Abstract_tag);
1862 Store_field (rv, 0, (value) dom);
1867 Val_net_no_finalize (virNetworkPtr net)
1871 rv = caml_alloc (1, Abstract_tag);
1872 Store_field (rv, 0, (value) net);
1876 /* This wraps up the (dom, conn) pair (Domain.t). */
1878 Val_domain (virDomainPtr dom, value connv)
1883 rv = caml_alloc_tuple (2);
1885 Store_field (rv, 0, v);
1886 Store_field (rv, 1, connv);
1890 /* This wraps up the (net, conn) pair (Network.t). */
1892 Val_network (virNetworkPtr net, value connv)
1897 rv = caml_alloc_tuple (2);
1899 Store_field (rv, 0, v);
1900 Store_field (rv, 1, connv);
1904 /* No-finalize versions of Val_domain, Val_network ONLY for use by
1905 * virterror wrappers.
1908 Val_domain_no_finalize (virDomainPtr dom, value connv)
1913 rv = caml_alloc_tuple (2);
1914 v = Val_dom_no_finalize (dom);
1915 Store_field (rv, 0, v);
1916 Store_field (rv, 1, connv);
1921 Val_network_no_finalize (virNetworkPtr net, value connv)
1926 rv = caml_alloc_tuple (2);
1927 v = Val_net_no_finalize (net);
1928 Store_field (rv, 0, v);
1929 Store_field (rv, 1, connv);
1934 conn_finalize (value connv)
1936 virConnectPtr conn = Connect_val (connv);
1937 if (conn) (void) virConnectClose (conn);
1941 dom_finalize (value domv)
1943 virDomainPtr dom = Dom_val (domv);
1944 if (dom) (void) virDomainFree (dom);
1948 net_finalize (value netv)
1950 virNetworkPtr net = Net_val (netv);
1951 if (net) (void) virNetworkFree (net);