1 /* OCaml bindings for libvirt.
2 * (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc.
4 * $Id: libvirt_c.c,v 1.6 2007/08/30 13:16:57 rjones Exp $
13 #include <libvirt/libvirt.h>
14 #include <libvirt/virterror.h>
16 #include <caml/config.h>
17 #include <caml/alloc.h>
18 #include <caml/callback.h>
19 #include <caml/custom.h>
20 #include <caml/fail.h>
21 #include <caml/memory.h>
22 #include <caml/misc.h>
23 #include <caml/mlvalues.h>
25 static char *Optstring_val (value strv);
26 typedef value (*Val_ptr_t) (void *);
27 static value Val_opt (void *ptr, Val_ptr_t Val_ptr);
28 /*static value option_default (value option, value deflt);*/
29 static value _raise_virterror (virConnectPtr conn, const char *fn);
30 static value Val_virterror (virErrorPtr err);
32 #define CHECK_ERROR(cond, conn, fn) \
33 do { if (cond) _raise_virterror (conn, fn); } while (0)
35 #define NOT_SUPPORTED(fn) \
36 caml_invalid_argument (fn " not supported")
38 /* For more about weak symbols, see:
39 * http://kolpackov.net/pipermail/notes/2004-March/000006.html
40 * We are using this to do runtime detection of library functions
41 * so that if we dynamically link with an older version of
42 * libvirt than we were compiled against, it won't fail (provided
43 * libvirt >= 0.2.1 - we don't support anything older).
47 #if (__GNUC__ == 3 && __GNUC_MINOR__ >= 3) || (__GNUC__ > 3)
48 #define HAVE_WEAK_SYMBOLS 1
53 #ifdef HAVE_WEAK_SYMBOLS
54 #define WEAK_SYMBOL_CHECK(sym) \
55 do { if (!sym) NOT_SUPPORTED(#sym); } while (0)
57 #define WEAK_SYMBOL_CHECK(sym)
58 #endif /* HAVE_WEAK_SYMBOLS */
60 #ifdef HAVE_WEAK_SYMBOLS
61 #ifdef HAVE_VIRCONNECTGETHOSTNAME
62 extern char *virConnectGetHostname (virConnectPtr conn)
63 __attribute__((weak));
65 #ifdef HAVE_VIRCONNECTGETURI
66 extern char *virConnectGetURI (virConnectPtr conn)
67 __attribute__((weak));
69 #ifdef HAVE_VIRDOMAINBLOCKSTATS
70 extern int virDomainBlockStats (virDomainPtr dom,
72 virDomainBlockStatsPtr stats,
74 __attribute__((weak));
76 #ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS
77 extern int virDomainGetSchedulerParameters (virDomainPtr domain,
78 virSchedParameterPtr params,
80 __attribute__((weak));
82 #ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE
83 extern char *virDomainGetSchedulerType(virDomainPtr domain,
85 __attribute__((weak));
87 #ifdef HAVE_VIRDOMAININTERFACESTATS
88 extern int virDomainInterfaceStats (virDomainPtr dom,
90 virDomainInterfaceStatsPtr stats,
92 __attribute__((weak));
94 #ifdef HAVE_VIRDOMAINMIGRATE
95 extern virDomainPtr virDomainMigrate (virDomainPtr domain, virConnectPtr dconn,
96 unsigned long flags, const char *dname,
97 const char *uri, unsigned long bandwidth)
98 __attribute__((weak));
100 #ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS
101 extern int virDomainSetSchedulerParameters (virDomainPtr domain,
102 virSchedParameterPtr params,
104 __attribute__((weak));
106 #endif /* HAVE_WEAK_SYMBOLS */
108 /*----------------------------------------------------------------------*/
111 ocaml_libvirt_get_version (value driverv, value unit)
113 CAMLparam2 (driverv, unit);
115 const char *driver = Optstring_val (driverv);
116 unsigned long libVer, typeVer = 0, *typeVer_ptr;
119 typeVer_ptr = driver ? &typeVer : NULL;
120 r = virGetVersion (&libVer, driver, typeVer_ptr);
121 CHECK_ERROR (r == -1, NULL, "virGetVersion");
123 rv = caml_alloc_tuple (2);
124 Store_field (rv, 0, Val_int (libVer));
125 Store_field (rv, 1, Val_int (typeVer));
129 /*----------------------------------------------------------------------*/
131 /* Some notes about the use of custom blocks to store virConnectPtr,
132 * virDomainPtr and virNetworkPtr.
133 *------------------------------------------------------------------
135 * Libvirt does some tricky reference counting to keep track of
136 * virConnectPtr's, virDomainPtr's and virNetworkPtr's.
138 * There is only one function which can return a virConnectPtr
139 * (virConnectOpen*) and that allocates a new one each time.
141 * virDomainPtr/virNetworkPtr's on the other hand can be returned
142 * repeatedly (for the same underlying domain/network), and we must
143 * keep track of each one and explicitly free it with virDomainFree
144 * or virNetworkFree. If we lose track of one then the reference
145 * counting in libvirt will keep it open. We therefore wrap these
146 * in a custom block with a finalizer function.
148 * We also have to allow the user to explicitly free them, in
149 * which case we set the pointer inside the custom block to NULL.
150 * The finalizer notices this and doesn't free the object.
152 * Domains and networks "belong to" a connection. We have to avoid
153 * the situation like this:
155 * let conn = Connect.open ... in
156 * let dom = Domain.lookup_by_id conn 0 in
157 * (* conn goes out of scope and is garbage collected *)
158 * printf "dom name = %s\n" (Domain.get_name dom)
160 * The reason is that when conn is garbage collected, virConnectClose
161 * is called and any subsequent operations on dom will fail (in fact
162 * will probably segfault). To stop this from happening, the OCaml
163 * wrappers store domains (and networks) as explicit (dom, conn)
166 * Further complication with virterror / exceptions: Virterror gives
167 * us virConnectPtr, virDomainPtr, virNetworkPtr pointers. If we
168 * follow standard practice and wrap these up in blocks with
169 * finalizers then we'll end up double-freeing (in particular, calling
170 * virConnectClose at the wrong time). So for virterror, we have
171 * "special" wrapper functions (Val_connect_no_finalize, etc.).
174 /* Unwrap a custom block. */
175 #define Connect_val(rv) (*((virConnectPtr *)Data_custom_val(rv)))
176 #define Dom_val(rv) (*((virDomainPtr *)Data_custom_val(rv)))
177 #define Net_val(rv) (*((virNetworkPtr *)Data_custom_val(rv)))
179 /* Wrap up a pointer to something in a custom block. */
180 static value Val_connect (virConnectPtr conn);
181 static value Val_dom (virDomainPtr dom);
182 static value Val_net (virNetworkPtr net);
184 /* ONLY for use by virterror wrappers. */
185 static value Val_connect_no_finalize (virConnectPtr conn);
186 static value Val_dom_no_finalize (virDomainPtr dom);
187 static value Val_net_no_finalize (virNetworkPtr net);
189 /* Domains and networks are stored as pairs (dom/net, conn), so have
190 * some convenience functions for unwrapping and wrapping them.
192 #define Domain_val(rv) (Dom_val(Field((rv),0)))
193 #define Network_val(rv) (Net_val(Field((rv),0)))
194 #define Connect_domv(rv) (Connect_val(Field((rv),1)))
195 #define Connect_netv(rv) (Connect_val(Field((rv),1)))
197 static value Val_domain (virDomainPtr dom, value connv);
198 static value Val_network (virNetworkPtr net, value connv);
200 /* ONLY for use by virterror wrappers. */
201 static value Val_domain_no_finalize (virDomainPtr dom, value connv);
202 static value Val_network_no_finalize (virNetworkPtr net, value connv);
204 /*----------------------------------------------------------------------*/
206 /* Connection object. */
209 ocaml_libvirt_connect_open (value namev, value unit)
211 CAMLparam2 (namev, unit);
213 const char *name = Optstring_val (namev);
216 conn = virConnectOpen (name);
217 CHECK_ERROR (!conn, NULL, "virConnectOpen");
219 rv = Val_connect (conn);
225 ocaml_libvirt_connect_open_readonly (value namev, value unit)
227 CAMLparam2 (namev, unit);
229 const char *name = Optstring_val (namev);
232 conn = virConnectOpenReadOnly (name);
233 CHECK_ERROR (!conn, NULL, "virConnectOpen");
235 rv = Val_connect (conn);
241 ocaml_libvirt_connect_close (value connv)
244 virConnectPtr conn = Connect_val (connv);
247 r = virConnectClose (conn);
248 CHECK_ERROR (r == -1, conn, "virConnectClose");
250 /* So that we don't double-free in the finalizer: */
251 Connect_val (connv) = NULL;
253 CAMLreturn (Val_unit);
257 ocaml_libvirt_connect_get_type (value connv)
261 virConnectPtr conn = Connect_val (connv);
264 r = virConnectGetType (conn);
265 CHECK_ERROR (!r, conn, "virConnectGetType");
267 rv = caml_copy_string (r);
272 ocaml_libvirt_connect_get_version (value connv)
275 virConnectPtr conn = Connect_val (connv);
279 r = virConnectGetVersion (conn, &hvVer);
280 CHECK_ERROR (r == -1, conn, "virConnectGetVersion");
282 CAMLreturn (Val_int (hvVer));
286 ocaml_libvirt_connect_get_hostname (value connv)
288 #ifdef HAVE_VIRCONNECTGETHOSTNAME
291 virConnectPtr conn = Connect_val (connv);
294 WEAK_SYMBOL_CHECK (virConnectGetHostname);
295 r = virConnectGetHostname (conn);
296 CHECK_ERROR (!r, conn, "virConnectGetHostname");
298 rv = caml_copy_string (r);
302 NOT_SUPPORTED ("virConnectGetHostname");
307 ocaml_libvirt_connect_get_uri (value connv)
309 #ifdef HAVE_VIRCONNECTGETURI
312 virConnectPtr conn = Connect_val (connv);
315 WEAK_SYMBOL_CHECK (virConnectGetURI);
316 r = virConnectGetURI (conn);
317 CHECK_ERROR (!r, conn, "virConnectGetURI");
319 rv = caml_copy_string (r);
323 NOT_SUPPORTED ("virConnectGetURI");
328 ocaml_libvirt_connect_get_max_vcpus (value connv, value typev)
330 CAMLparam2 (connv, typev);
331 virConnectPtr conn = Connect_val (connv);
332 const char *type = Optstring_val (typev);
335 r = virConnectGetMaxVcpus (conn, type);
336 CHECK_ERROR (r == -1, conn, "virConnectGetMaxVcpus");
338 CAMLreturn (Val_int (r));
342 ocaml_libvirt_connect_list_domains (value connv, value iv)
344 CAMLparam2 (connv, iv);
346 virConnectPtr conn = Connect_val (connv);
347 int i = Int_val (iv);
350 r = virConnectListDomains (conn, ids, i);
351 CHECK_ERROR (r == -1, conn, "virConnectListDomains");
353 rv = caml_alloc (r, 0);
354 for (i = 0; i < r; ++i)
355 Store_field (rv, i, Val_int (ids[i]));
361 ocaml_libvirt_connect_num_of_domains (value connv)
364 virConnectPtr conn = Connect_val (connv);
367 r = virConnectNumOfDomains (conn);
368 CHECK_ERROR (r == -1, conn, "virConnectNumOfDomains");
370 CAMLreturn (Val_int (r));
374 ocaml_libvirt_connect_get_capabilities (value connv)
378 virConnectPtr conn = Connect_val (connv);
381 r = virConnectGetCapabilities (conn);
382 CHECK_ERROR (!r, conn, "virConnectGetCapabilities");
384 rv = caml_copy_string (r);
391 ocaml_libvirt_connect_num_of_defined_domains (value connv)
394 virConnectPtr conn = Connect_val (connv);
397 r = virConnectNumOfDefinedDomains (conn);
398 CHECK_ERROR (r == -1, conn, "virConnectNumOfDefinedDomains");
400 CAMLreturn (Val_int (r));
404 ocaml_libvirt_connect_list_defined_domains (value connv, value iv)
406 CAMLparam2 (connv, iv);
407 CAMLlocal2 (rv, strv);
408 virConnectPtr conn = Connect_val (connv);
409 int i = Int_val (iv);
413 r = virConnectListDefinedDomains (conn, names, i);
414 CHECK_ERROR (r == -1, conn, "virConnectListDefinedDomains");
416 rv = caml_alloc (r, 0);
417 for (i = 0; i < r; ++i) {
418 strv = caml_copy_string (names[i]);
419 Store_field (rv, i, strv);
427 ocaml_libvirt_connect_num_of_networks (value connv)
430 virConnectPtr conn = Connect_val (connv);
433 r = virConnectNumOfNetworks (conn);
434 CHECK_ERROR (r == -1, conn, "virConnectNumOfNetworks");
436 CAMLreturn (Val_int (r));
440 ocaml_libvirt_connect_list_networks (value connv, value iv)
442 CAMLparam2 (connv, iv);
443 CAMLlocal2 (rv, strv);
444 virConnectPtr conn = Connect_val (connv);
445 int i = Int_val (iv);
449 r = virConnectListNetworks (conn, names, i);
450 CHECK_ERROR (r == -1, conn, "virConnectListNetworks");
452 rv = caml_alloc (r, 0);
453 for (i = 0; i < r; ++i) {
454 strv = caml_copy_string (names[i]);
455 Store_field (rv, i, strv);
463 ocaml_libvirt_connect_num_of_defined_networks (value connv)
466 virConnectPtr conn = Connect_val (connv);
469 r = virConnectNumOfDefinedNetworks (conn);
470 CHECK_ERROR (r == -1, conn, "virConnectNumOfDefinedNetworks");
472 CAMLreturn (Val_int (r));
476 ocaml_libvirt_connect_list_defined_networks (value connv, value iv)
478 CAMLparam2 (connv, iv);
479 CAMLlocal2 (rv, strv);
480 virConnectPtr conn = Connect_val (connv);
481 int i = Int_val (iv);
485 r = virConnectListDefinedNetworks (conn, names, i);
486 CHECK_ERROR (r == -1, conn, "virConnectListDefinedNetworks");
488 rv = caml_alloc (r, 0);
489 for (i = 0; i < r; ++i) {
490 strv = caml_copy_string (names[i]);
491 Store_field (rv, i, strv);
499 ocaml_libvirt_connect_get_node_info (value connv)
503 virConnectPtr conn = Connect_val (connv);
507 r = virNodeGetInfo (conn, &info);
508 CHECK_ERROR (r == -1, conn, "virNodeGetInfo");
510 rv = caml_alloc (8, 0);
511 v = caml_copy_string (info.model); Store_field (rv, 0, v);
512 v = caml_copy_int64 (info.memory); Store_field (rv, 1, v);
513 Store_field (rv, 2, Val_int (info.cpus));
514 Store_field (rv, 3, Val_int (info.mhz));
515 Store_field (rv, 4, Val_int (info.nodes));
516 Store_field (rv, 5, Val_int (info.sockets));
517 Store_field (rv, 6, Val_int (info.cores));
518 Store_field (rv, 7, Val_int (info.threads));
524 ocaml_libvirt_domain_create_linux (value connv, value xmlv)
526 CAMLparam2 (connv, xmlv);
528 virConnectPtr conn = Connect_val (connv);
529 char *xml = String_val (xmlv);
532 r = virDomainCreateLinux (conn, xml, 0);
533 CHECK_ERROR (!r, conn, "virDomainCreateLinux");
535 rv = Val_domain (r, connv);
540 ocaml_libvirt_domain_lookup_by_id (value connv, value iv)
542 CAMLparam2 (connv, iv);
544 virConnectPtr conn = Connect_val (connv);
545 int i = Int_val (iv);
548 r = virDomainLookupByID (conn, i);
549 CHECK_ERROR (!r, conn, "virDomainLookupByID");
551 rv = Val_domain (r, connv);
556 ocaml_libvirt_domain_lookup_by_uuid (value connv, value uuidv)
558 CAMLparam2 (connv, uuidv);
560 virConnectPtr conn = Connect_val (connv);
561 char *uuid = String_val (uuidv);
564 r = virDomainLookupByUUID (conn, (unsigned char *) uuid);
565 CHECK_ERROR (!r, conn, "virDomainLookupByUUID");
567 rv = Val_domain (r, connv);
572 ocaml_libvirt_domain_lookup_by_uuid_string (value connv, value uuidv)
574 CAMLparam2 (connv, uuidv);
576 virConnectPtr conn = Connect_val (connv);
577 char *uuid = String_val (uuidv);
580 r = virDomainLookupByUUIDString (conn, uuid);
581 CHECK_ERROR (!r, conn, "virDomainLookupByUUIDString");
583 rv = Val_domain (r, connv);
588 ocaml_libvirt_domain_lookup_by_name (value connv, value namev)
590 CAMLparam2 (connv, namev);
592 virConnectPtr conn = Connect_val (connv);
593 char *name = String_val (namev);
596 r = virDomainLookupByName (conn, name);
597 CHECK_ERROR (!r, conn, "virDomainLookupByName");
599 rv = Val_domain (r, connv);
604 ocaml_libvirt_domain_destroy (value domv)
607 virDomainPtr dom = Domain_val (domv);
608 virConnectPtr conn = Connect_domv (domv);
611 r = virDomainDestroy (dom);
612 CHECK_ERROR (r == -1, conn, "virDomainDestroy");
614 /* So that we don't double-free in the finalizer: */
615 Domain_val (domv) = NULL;
617 CAMLreturn (Val_unit);
621 ocaml_libvirt_domain_free (value domv)
624 virDomainPtr dom = Domain_val (domv);
625 virConnectPtr conn = Connect_domv (domv);
628 r = virDomainFree (dom);
629 CHECK_ERROR (r == -1, conn, "virDomainFree");
631 /* So that we don't double-free in the finalizer: */
632 Domain_val (domv) = NULL;
634 CAMLreturn (Val_unit);
638 ocaml_libvirt_domain_suspend (value domv)
641 virDomainPtr dom = Domain_val (domv);
642 virConnectPtr conn = Connect_domv (domv);
645 r = virDomainSuspend (dom);
646 CHECK_ERROR (r == -1, conn, "virDomainSuspend");
648 CAMLreturn (Val_unit);
652 ocaml_libvirt_domain_resume (value domv)
655 virDomainPtr dom = Domain_val (domv);
656 virConnectPtr conn = Connect_domv (domv);
659 r = virDomainResume (dom);
660 CHECK_ERROR (r == -1, conn, "virDomainResume");
662 CAMLreturn (Val_unit);
666 ocaml_libvirt_domain_save (value domv, value pathv)
668 CAMLparam2 (domv, pathv);
669 virDomainPtr dom = Domain_val (domv);
670 virConnectPtr conn = Connect_domv (domv);
671 char *path = String_val (pathv);
674 r = virDomainSave (dom, path);
675 CHECK_ERROR (r == -1, conn, "virDomainSave");
677 CAMLreturn (Val_unit);
681 ocaml_libvirt_domain_restore (value connv, value pathv)
683 CAMLparam2 (connv, pathv);
684 virConnectPtr conn = Connect_val (connv);
685 char *path = String_val (pathv);
688 r = virDomainRestore (conn, path);
689 CHECK_ERROR (r == -1, conn, "virDomainRestore");
691 CAMLreturn (Val_unit);
695 ocaml_libvirt_domain_core_dump (value domv, value pathv)
697 CAMLparam2 (domv, pathv);
698 virDomainPtr dom = Domain_val (domv);
699 virConnectPtr conn = Connect_domv (domv);
700 char *path = String_val (pathv);
703 r = virDomainCoreDump (dom, path, 0);
704 CHECK_ERROR (r == -1, conn, "virDomainCoreDump");
706 CAMLreturn (Val_unit);
710 ocaml_libvirt_domain_shutdown (value domv)
713 virDomainPtr dom = Domain_val (domv);
714 virConnectPtr conn = Connect_domv (domv);
717 r = virDomainShutdown (dom);
718 CHECK_ERROR (r == -1, conn, "virDomainShutdown");
720 CAMLreturn (Val_unit);
724 ocaml_libvirt_domain_reboot (value domv)
727 virDomainPtr dom = Domain_val (domv);
728 virConnectPtr conn = Connect_domv (domv);
731 r = virDomainReboot (dom, 0);
732 CHECK_ERROR (r == -1, conn, "virDomainReboot");
734 CAMLreturn (Val_unit);
738 ocaml_libvirt_domain_get_name (value domv)
742 virDomainPtr dom = Domain_val (domv);
743 virConnectPtr conn = Connect_domv (domv);
746 r = virDomainGetName (dom);
747 CHECK_ERROR (!r, conn, "virDomainGetName");
749 rv = caml_copy_string (r);
754 ocaml_libvirt_domain_get_uuid (value domv)
758 virDomainPtr dom = Domain_val (domv);
759 virConnectPtr conn = Connect_domv (domv);
760 unsigned char uuid[VIR_UUID_BUFLEN];
763 r = virDomainGetUUID (dom, uuid);
764 CHECK_ERROR (r == -1, conn, "virDomainGetUUID");
766 rv = caml_copy_string ((char *) uuid);
771 ocaml_libvirt_domain_get_uuid_string (value domv)
775 virDomainPtr dom = Domain_val (domv);
776 virConnectPtr conn = Connect_domv (domv);
777 char uuid[VIR_UUID_STRING_BUFLEN];
780 r = virDomainGetUUIDString (dom, uuid);
781 CHECK_ERROR (r == -1, conn, "virDomainGetUUIDString");
783 rv = caml_copy_string (uuid);
788 ocaml_libvirt_domain_get_id (value domv)
791 virDomainPtr dom = Domain_val (domv);
792 virConnectPtr conn = Connect_domv (domv);
795 r = virDomainGetID (dom);
796 /* There's a bug in libvirt which means that if you try to get
797 * the ID of a defined-but-not-running domain, it returns -1,
798 * and there's no way to distinguish that from an error.
800 CHECK_ERROR (r == (unsigned int) -1, conn, "virDomainGetID");
802 CAMLreturn (Val_int ((int) r));
806 ocaml_libvirt_domain_get_os_type (value domv)
810 virDomainPtr dom = Domain_val (domv);
811 virConnectPtr conn = Connect_domv (domv);
814 r = virDomainGetOSType (dom);
815 CHECK_ERROR (!r, conn, "virDomainGetOSType");
817 rv = caml_copy_string (r);
823 ocaml_libvirt_domain_get_max_memory (value domv)
827 virDomainPtr dom = Domain_val (domv);
828 virConnectPtr conn = Connect_domv (domv);
831 r = virDomainGetMaxMemory (dom);
832 CHECK_ERROR (r == 0 /* [sic] */, conn, "virDomainGetMaxMemory");
834 rv = caml_copy_int64 (r);
839 ocaml_libvirt_domain_set_max_memory (value domv, value memv)
841 CAMLparam2 (domv, memv);
842 virDomainPtr dom = Domain_val (domv);
843 virConnectPtr conn = Connect_domv (domv);
844 unsigned long mem = Int64_val (memv);
847 r = virDomainSetMaxMemory (dom, mem);
848 CHECK_ERROR (r == -1, conn, "virDomainSetMaxMemory");
850 CAMLreturn (Val_unit);
854 ocaml_libvirt_domain_set_memory (value domv, value memv)
856 CAMLparam2 (domv, memv);
857 virDomainPtr dom = Domain_val (domv);
858 virConnectPtr conn = Connect_domv (domv);
859 unsigned long mem = Int64_val (memv);
862 r = virDomainSetMemory (dom, mem);
863 CHECK_ERROR (r == -1, conn, "virDomainSetMemory");
865 CAMLreturn (Val_unit);
869 ocaml_libvirt_domain_get_info (value domv)
873 virDomainPtr dom = Domain_val (domv);
874 virConnectPtr conn = Connect_domv (domv);
878 r = virDomainGetInfo (dom, &info);
879 CHECK_ERROR (r == -1, conn, "virDomainGetInfo");
881 rv = caml_alloc (5, 0);
882 Store_field (rv, 0, Val_int (info.state)); // These flags are compatible.
883 v = caml_copy_int64 (info.maxMem); Store_field (rv, 1, v);
884 v = caml_copy_int64 (info.memory); Store_field (rv, 2, v);
885 Store_field (rv, 3, Val_int (info.nrVirtCpu));
886 v = caml_copy_int64 (info.cpuTime); Store_field (rv, 4, v);
892 ocaml_libvirt_domain_get_xml_desc (value domv)
896 virDomainPtr dom = Domain_val (domv);
897 virConnectPtr conn = Connect_domv (domv);
900 r = virDomainGetXMLDesc (dom, 0);
901 CHECK_ERROR (!r, conn, "virDomainGetXMLDesc");
903 rv = caml_copy_string (r);
909 ocaml_libvirt_domain_get_scheduler_type (value domv)
911 #ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE
913 CAMLlocal2 (rv, strv);
914 virDomainPtr dom = Domain_val (domv);
915 virConnectPtr conn = Connect_domv (domv);
919 WEAK_SYMBOL_CHECK (virDomainGetSchedulerType);
920 r = virDomainGetSchedulerType (dom, &nparams);
921 CHECK_ERROR (!r, conn, "virDomainGetSchedulerType");
923 rv = caml_alloc_tuple (2);
924 strv = caml_copy_string (r); Store_field (rv, 0, strv);
926 Store_field (rv, 1, nparams);
929 NOT_SUPPORTED ("virDomainGetSchedulerType");
934 ocaml_libvirt_domain_get_scheduler_parameters (value domv, value nparamsv)
936 #ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS
937 CAMLparam2 (domv, nparamsv);
938 CAMLlocal4 (rv, v, v2, v3);
939 virDomainPtr dom = Domain_val (domv);
940 virConnectPtr conn = Connect_domv (domv);
941 int nparams = Int_val (nparamsv);
942 virSchedParameter params[nparams];
945 WEAK_SYMBOL_CHECK (virDomainGetSchedulerParameters);
946 r = virDomainGetSchedulerParameters (dom, params, &nparams);
947 CHECK_ERROR (r == -1, conn, "virDomainGetSchedulerParameters");
949 rv = caml_alloc (nparams, 0);
950 for (i = 0; i < nparams; ++i) {
951 v = caml_alloc_tuple (2); Store_field (rv, i, v);
952 v2 = caml_copy_string (params[i].field); Store_field (v, 0, v2);
953 switch (params[i].type) {
954 case VIR_DOMAIN_SCHED_FIELD_INT:
955 v2 = caml_alloc (1, 0);
956 v3 = caml_copy_int32 (params[i].value.i); Store_field (v2, 0, v3);
958 case VIR_DOMAIN_SCHED_FIELD_UINT:
959 v2 = caml_alloc (1, 1);
960 v3 = caml_copy_int32 (params[i].value.ui); Store_field (v2, 0, v3);
962 case VIR_DOMAIN_SCHED_FIELD_LLONG:
963 v2 = caml_alloc (1, 2);
964 v3 = caml_copy_int64 (params[i].value.l); Store_field (v2, 0, v3);
966 case VIR_DOMAIN_SCHED_FIELD_ULLONG:
967 v2 = caml_alloc (1, 3);
968 v3 = caml_copy_int64 (params[i].value.ul); Store_field (v2, 0, v3);
970 case VIR_DOMAIN_SCHED_FIELD_DOUBLE:
971 v2 = caml_alloc (1, 4);
972 v3 = caml_copy_double (params[i].value.d); Store_field (v2, 0, v3);
974 case VIR_DOMAIN_SCHED_FIELD_BOOLEAN:
975 v2 = caml_alloc (1, 5);
976 Store_field (v2, 0, Val_int (params[i].value.b));
979 caml_failwith ((char *)__FUNCTION__);
981 Store_field (v, 1, v2);
985 NOT_SUPPORTED ("virDomainGetSchedulerParameters");
990 ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv)
992 #ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS
993 CAMLparam2 (domv, paramsv);
995 virDomainPtr dom = Domain_val (domv);
996 virConnectPtr conn = Connect_domv (domv);
997 int nparams = Wosize_val (paramsv);
998 virSchedParameter params[nparams];
1002 for (i = 0; i < nparams; ++i) {
1003 v = Field (paramsv, i); /* Points to the two-element tuple. */
1004 name = String_val (Field (v, 0));
1005 strncpy (params[i].field, name, VIR_DOMAIN_SCHED_FIELD_LENGTH);
1006 params[i].field[VIR_DOMAIN_SCHED_FIELD_LENGTH-1] = '\0';
1007 v = Field (v, 1); /* Points to the sched_param_value block. */
1008 switch (Tag_val (v)) {
1010 params[i].type = VIR_DOMAIN_SCHED_FIELD_INT;
1011 params[i].value.i = Int32_val (Field (v, 0));
1014 params[i].type = VIR_DOMAIN_SCHED_FIELD_UINT;
1015 params[i].value.ui = Int32_val (Field (v, 0));
1018 params[i].type = VIR_DOMAIN_SCHED_FIELD_LLONG;
1019 params[i].value.l = Int64_val (Field (v, 0));
1022 params[i].type = VIR_DOMAIN_SCHED_FIELD_ULLONG;
1023 params[i].value.ul = Int64_val (Field (v, 0));
1026 params[i].type = VIR_DOMAIN_SCHED_FIELD_DOUBLE;
1027 params[i].value.d = Double_val (Field (v, 0));
1030 params[i].type = VIR_DOMAIN_SCHED_FIELD_BOOLEAN;
1031 params[i].value.b = Int_val (Field (v, 0));
1034 caml_failwith ((char *)__FUNCTION__);
1038 WEAK_SYMBOL_CHECK (virDomainSetSchedulerParameters);
1039 r = virDomainSetSchedulerParameters (dom, params, nparams);
1040 CHECK_ERROR (r == -1, conn, "virDomainSetSchedulerParameters");
1042 CAMLreturn (Val_unit);
1044 NOT_SUPPORTED ("virDomainSetSchedulerParameters");
1049 ocaml_libvirt_domain_define_xml (value connv, value xmlv)
1051 CAMLparam2 (connv, xmlv);
1053 virConnectPtr conn = Connect_val (connv);
1054 char *xml = String_val (xmlv);
1057 r = virDomainDefineXML (conn, xml);
1058 CHECK_ERROR (!r, conn, "virDomainDefineXML");
1060 rv = Val_domain (r, connv);
1065 ocaml_libvirt_domain_undefine (value domv)
1068 virDomainPtr dom = Domain_val (domv);
1069 virConnectPtr conn = Connect_domv (domv);
1072 r = virDomainUndefine (dom);
1073 CHECK_ERROR (r == -1, conn, "virDomainUndefine");
1075 CAMLreturn (Val_unit);
1079 ocaml_libvirt_domain_create (value domv)
1082 virDomainPtr dom = Domain_val (domv);
1083 virConnectPtr conn = Connect_domv (domv);
1086 r = virDomainCreate (dom);
1087 CHECK_ERROR (r == -1, conn, "virDomainCreate");
1089 CAMLreturn (Val_unit);
1093 ocaml_libvirt_domain_get_autostart (value domv)
1096 virDomainPtr dom = Domain_val (domv);
1097 virConnectPtr conn = Connect_domv (domv);
1100 r = virDomainGetAutostart (dom, &autostart);
1101 CHECK_ERROR (r == -1, conn, "virDomainGetAutostart");
1103 CAMLreturn (autostart ? Val_true : Val_false);
1107 ocaml_libvirt_domain_set_autostart (value domv, value autostartv)
1109 CAMLparam2 (domv, autostartv);
1110 virDomainPtr dom = Domain_val (domv);
1111 virConnectPtr conn = Connect_domv (domv);
1112 int r, autostart = autostartv == Val_true ? 1 : 0;
1114 r = virDomainSetAutostart (dom, autostart);
1115 CHECK_ERROR (r == -1, conn, "virDomainSetAutostart");
1117 CAMLreturn (Val_unit);
1121 ocaml_libvirt_domain_set_vcpus (value domv, value nvcpusv)
1123 CAMLparam2 (domv, nvcpusv);
1124 virDomainPtr dom = Domain_val (domv);
1125 virConnectPtr conn = Connect_domv (domv);
1126 int r, nvcpus = Int_val (nvcpusv);
1128 r = virDomainSetVcpus (dom, nvcpus);
1129 CHECK_ERROR (r == -1, conn, "virDomainSetVcpus");
1131 CAMLreturn (Val_unit);
1135 ocaml_libvirt_domain_pin_vcpu (value domv, value vcpuv, value cpumapv)
1137 CAMLparam3 (domv, vcpuv, cpumapv);
1138 virDomainPtr dom = Domain_val (domv);
1139 virConnectPtr conn = Connect_domv (domv);
1140 int maplen = caml_string_length (cpumapv);
1141 unsigned char *cpumap = (unsigned char *) String_val (cpumapv);
1142 int vcpu = Int_val (vcpuv);
1145 r = virDomainPinVcpu (dom, vcpu, cpumap, maplen);
1146 CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
1148 CAMLreturn (Val_unit);
1152 ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv)
1154 CAMLparam3 (domv, maxinfov, maplenv);
1155 CAMLlocal5 (rv, infov, strv, v, v2);
1156 virDomainPtr dom = Domain_val (domv);
1157 virConnectPtr conn = Connect_domv (domv);
1158 int maxinfo = Int_val (maxinfov);
1159 int maplen = Int_val (maplenv);
1160 virVcpuInfo info[maxinfo];
1161 unsigned char cpumaps[maxinfo * maplen];
1164 memset (info, 0, sizeof (virVcpuInfo) * maxinfo);
1165 memset (cpumaps, 0, maxinfo * maplen);
1167 r = virDomainGetVcpus (dom, info, maxinfo, cpumaps, maplen);
1168 CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
1170 /* Copy the virVcpuInfo structures. */
1171 infov = caml_alloc (maxinfo, 0);
1172 for (i = 0; i < maxinfo; ++i) {
1173 v2 = caml_alloc (4, 0); Store_field (infov, i, v2);
1174 Store_field (v2, 0, Val_int (info[i].number));
1175 Store_field (v2, 1, Val_int (info[i].state));
1176 v = caml_copy_int64 (info[i].cpuTime); Store_field (v2, 2, v);
1177 Store_field (v2, 3, Val_int (info[i].cpu));
1180 /* Copy the bitmap. */
1181 strv = caml_alloc_string (maxinfo * maplen);
1182 memcpy (String_val (strv), cpumaps, maxinfo * maplen);
1184 /* Allocate the tuple and return it. */
1185 rv = caml_alloc_tuple (3);
1186 Store_field (rv, 0, Val_int (r)); /* number of CPUs. */
1187 Store_field (rv, 1, infov);
1188 Store_field (rv, 2, strv);
1194 ocaml_libvirt_domain_get_max_vcpus (value domv)
1197 virDomainPtr dom = Domain_val (domv);
1198 virConnectPtr conn = Connect_domv (domv);
1201 r = virDomainGetMaxVcpus (dom);
1202 CHECK_ERROR (r == -1, conn, "virDomainGetMaxVcpus");
1204 CAMLreturn (Val_int (r));
1208 ocaml_libvirt_domain_attach_device (value domv, value xmlv)
1210 CAMLparam2 (domv, xmlv);
1211 virDomainPtr dom = Domain_val (domv);
1212 virConnectPtr conn = Connect_domv (domv);
1213 char *xml = String_val (xmlv);
1216 r = virDomainAttachDevice (dom, xml);
1217 CHECK_ERROR (r == -1, conn, "virDomainAttachDevice");
1219 CAMLreturn (Val_unit);
1223 ocaml_libvirt_domain_detach_device (value domv, value xmlv)
1225 CAMLparam2 (domv, xmlv);
1226 virDomainPtr dom = Domain_val (domv);
1227 virConnectPtr conn = Connect_domv (domv);
1228 char *xml = String_val (xmlv);
1231 r = virDomainDetachDevice (dom, xml);
1232 CHECK_ERROR (r == -1, conn, "virDomainDetachDevice");
1234 CAMLreturn (Val_unit);
1238 ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, value optdnamev, value opturiv, value optbandwidthv, value unitv)
1240 #ifdef HAVE_VIRDOMAINMIGRATE
1241 CAMLparam5 (domv, dconnv, flagsv, optdnamev, opturiv);
1242 CAMLxparam2 (optbandwidthv, unitv);
1243 CAMLlocal2 (flagv, rv);
1244 virDomainPtr dom = Domain_val (domv);
1245 virConnectPtr conn = Connect_domv (domv);
1246 virConnectPtr dconn = Connect_val (dconnv);
1248 const char *dname = Optstring_val (optdnamev);
1249 const char *uri = Optstring_val (opturiv);
1250 unsigned long bandwidth;
1253 /* Iterate over the list of flags. */
1254 for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
1256 flagv = Field (flagsv, 0);
1257 if (flagv == Int_val(0))
1258 flags |= VIR_MIGRATE_LIVE;
1261 if (optbandwidthv == Val_int (0)) /* None */
1263 else /* Some bandwidth */
1264 bandwidth = Int_val (Field (optbandwidthv, 0));
1266 WEAK_SYMBOL_CHECK (virDomainMigrate);
1267 r = virDomainMigrate (dom, dconn, flags, dname, uri, bandwidth);
1268 CHECK_ERROR (!r, conn, "virDomainMigrate");
1270 rv = Val_domain (r, dconnv);
1274 #else /* virDomainMigrate not supported */
1275 NOT_SUPPORTED ("virDomainMigrate");
1280 ocaml_libvirt_domain_migrate_bytecode (value *argv, int argn)
1282 return ocaml_libvirt_domain_migrate_native (argv[0], argv[1], argv[2],
1283 argv[3], argv[4], argv[5],
1288 ocaml_libvirt_domain_block_stats (value domv, value pathv)
1290 #if HAVE_VIRDOMAINBLOCKSTATS
1291 CAMLparam2 (domv, pathv);
1293 virDomainPtr dom = Domain_val (domv);
1294 virConnectPtr conn = Connect_domv (domv);
1295 char *path = String_val (pathv);
1296 struct _virDomainBlockStats stats;
1299 WEAK_SYMBOL_CHECK (virDomainBlockStats);
1300 r = virDomainBlockStats (dom, path, &stats, sizeof stats);
1301 CHECK_ERROR (r == -1, conn, "virDomainBlockStats");
1303 rv = caml_alloc (5, 0);
1304 v = caml_copy_int64 (stats.rd_req); Store_field (rv, 0, v);
1305 v = caml_copy_int64 (stats.rd_bytes); Store_field (rv, 1, v);
1306 v = caml_copy_int64 (stats.wr_req); Store_field (rv, 2, v);
1307 v = caml_copy_int64 (stats.wr_bytes); Store_field (rv, 3, v);
1308 v = caml_copy_int64 (stats.errs); Store_field (rv, 4, v);
1312 NOT_SUPPORTED ("virDomainBlockStats");
1317 ocaml_libvirt_domain_interface_stats (value domv, value pathv)
1319 #if HAVE_VIRDOMAININTERFACESTATS
1320 CAMLparam2 (domv, pathv);
1322 virDomainPtr dom = Domain_val (domv);
1323 virConnectPtr conn = Connect_domv (domv);
1324 char *path = String_val (pathv);
1325 struct _virDomainInterfaceStats stats;
1328 WEAK_SYMBOL_CHECK (virDomainInterfaceStats);
1329 r = virDomainInterfaceStats (dom, path, &stats, sizeof stats);
1330 CHECK_ERROR (r == -1, conn, "virDomainInterfaceStats");
1332 rv = caml_alloc (8, 0);
1333 v = caml_copy_int64 (stats.rx_bytes); Store_field (rv, 0, v);
1334 v = caml_copy_int64 (stats.rx_packets); Store_field (rv, 1, v);
1335 v = caml_copy_int64 (stats.rx_errs); Store_field (rv, 2, v);
1336 v = caml_copy_int64 (stats.rx_drop); Store_field (rv, 3, v);
1337 v = caml_copy_int64 (stats.tx_bytes); Store_field (rv, 4, v);
1338 v = caml_copy_int64 (stats.tx_packets); Store_field (rv, 5, v);
1339 v = caml_copy_int64 (stats.tx_errs); Store_field (rv, 6, v);
1340 v = caml_copy_int64 (stats.tx_drop); Store_field (rv, 7, v);
1344 NOT_SUPPORTED ("virDomainInterfaceStats");
1349 ocaml_libvirt_network_lookup_by_name (value connv, value namev)
1351 CAMLparam2 (connv, namev);
1353 virConnectPtr conn = Connect_val (connv);
1354 char *name = String_val (namev);
1357 r = virNetworkLookupByName (conn, name);
1358 CHECK_ERROR (!r, conn, "virNetworkLookupByName");
1360 rv = Val_network (r, connv);
1365 ocaml_libvirt_network_lookup_by_uuid (value connv, value uuidv)
1367 CAMLparam2 (connv, uuidv);
1369 virConnectPtr conn = Connect_val (connv);
1370 char *uuid = String_val (uuidv);
1373 r = virNetworkLookupByUUID (conn, (unsigned char *) uuid);
1374 CHECK_ERROR (!r, conn, "virNetworkLookupByUUID");
1376 rv = Val_network (r, connv);
1381 ocaml_libvirt_network_lookup_by_uuid_string (value connv, value uuidv)
1383 CAMLparam2 (connv, uuidv);
1385 virConnectPtr conn = Connect_val (connv);
1386 char *uuid = String_val (uuidv);
1389 r = virNetworkLookupByUUIDString (conn, uuid);
1390 CHECK_ERROR (!r, conn, "virNetworkLookupByUUIDString");
1392 rv = Val_network (r, connv);
1397 ocaml_libvirt_network_create_xml (value connv, value xmlv)
1399 CAMLparam2 (connv, xmlv);
1401 virConnectPtr conn = Connect_val (connv);
1402 char *xml = String_val (xmlv);
1405 r = virNetworkCreateXML (conn, xml);
1406 CHECK_ERROR (!r, conn, "virNetworkCreateXML");
1408 rv = Val_network (r, connv);
1413 ocaml_libvirt_network_define_xml (value connv, value xmlv)
1415 CAMLparam2 (connv, xmlv);
1417 virConnectPtr conn = Connect_val (connv);
1418 char *xml = String_val (xmlv);
1421 r = virNetworkDefineXML (conn, xml);
1422 CHECK_ERROR (!r, conn, "virNetworkDefineXML");
1424 rv = Val_network (r, connv);
1429 ocaml_libvirt_network_undefine (value netv)
1432 virNetworkPtr net = Network_val (netv);
1433 virConnectPtr conn = Connect_netv (netv);
1436 r = virNetworkUndefine (net);
1437 CHECK_ERROR (r == -1, conn, "virNetworkUndefine");
1439 CAMLreturn (Val_unit);
1443 ocaml_libvirt_network_create (value netv)
1446 virNetworkPtr net = Network_val (netv);
1447 virConnectPtr conn = Connect_netv (netv);
1450 r = virNetworkCreate (net);
1451 CHECK_ERROR (r == -1, conn, "virNetworkCreate");
1453 CAMLreturn (Val_unit);
1457 ocaml_libvirt_network_destroy (value netv)
1460 virNetworkPtr net = Network_val (netv);
1461 virConnectPtr conn = Connect_netv (netv);
1464 r = virNetworkDestroy (net);
1465 CHECK_ERROR (r == -1, conn, "virNetworkDestroy");
1467 /* So that we don't double-free in the finalizer: */
1468 Network_val (netv) = NULL;
1470 CAMLreturn (Val_unit);
1474 ocaml_libvirt_network_free (value netv)
1477 virNetworkPtr net = Network_val (netv);
1478 virConnectPtr conn = Connect_netv (netv);
1481 r = virNetworkFree (net);
1482 CHECK_ERROR (r == -1, conn, "virNetworkFree");
1484 /* So that we don't double-free in the finalizer: */
1485 Network_val (netv) = NULL;
1487 CAMLreturn (Val_unit);
1491 ocaml_libvirt_network_get_name (value netv)
1495 virNetworkPtr net = Network_val (netv);
1496 virConnectPtr conn = Connect_netv (netv);
1499 r = virNetworkGetName (net);
1500 CHECK_ERROR (!r, conn, "virNetworkGetName");
1502 rv = caml_copy_string (r);
1507 ocaml_libvirt_network_get_uuid (value netv)
1511 virNetworkPtr net = Network_val (netv);
1512 virConnectPtr conn = Connect_netv (netv);
1513 unsigned char uuid[VIR_UUID_BUFLEN];
1516 r = virNetworkGetUUID (net, uuid);
1517 CHECK_ERROR (r == -1, conn, "virNetworkGetUUID");
1519 rv = caml_copy_string ((char *) uuid);
1524 ocaml_libvirt_network_get_uuid_string (value netv)
1528 virNetworkPtr net = Network_val (netv);
1529 virConnectPtr conn = Connect_netv (netv);
1530 char uuid[VIR_UUID_STRING_BUFLEN];
1533 r = virNetworkGetUUIDString (net, uuid);
1534 CHECK_ERROR (r == -1, conn, "virNetworkGetUUIDString");
1536 rv = caml_copy_string (uuid);
1541 ocaml_libvirt_network_get_xml_desc (value netv)
1545 virNetworkPtr net = Network_val (netv);
1546 virConnectPtr conn = Connect_netv (netv);
1549 r = virNetworkGetXMLDesc (net, 0);
1550 CHECK_ERROR (!r, conn, "virNetworkGetXMLDesc");
1552 rv = caml_copy_string (r);
1558 ocaml_libvirt_network_get_bridge_name (value netv)
1562 virNetworkPtr net = Network_val (netv);
1563 virConnectPtr conn = Connect_netv (netv);
1566 r = virNetworkGetBridgeName (net);
1567 CHECK_ERROR (!r, conn, "virNetworkGetBridgeName");
1569 rv = caml_copy_string (r);
1575 ocaml_libvirt_network_get_autostart (value netv)
1578 virNetworkPtr net = Network_val (netv);
1579 virConnectPtr conn = Connect_netv (netv);
1582 r = virNetworkGetAutostart (net, &autostart);
1583 CHECK_ERROR (r == -1, conn, "virNetworkGetAutostart");
1585 CAMLreturn (autostart ? Val_true : Val_false);
1589 ocaml_libvirt_network_set_autostart (value netv, value autostartv)
1591 CAMLparam2 (netv, autostartv);
1592 virNetworkPtr net = Network_val (netv);
1593 virConnectPtr conn = Connect_netv (netv);
1594 int r, autostart = autostartv == Val_true ? 1 : 0;
1596 r = virNetworkSetAutostart (net, autostart);
1597 CHECK_ERROR (r == -1, conn, "virNetworkSetAutostart");
1599 CAMLreturn (Val_unit);
1602 /*----------------------------------------------------------------------*/
1605 ocaml_libvirt_virterror_get_last_error (value unitv)
1609 virErrorPtr err = virGetLastError ();
1611 rv = Val_opt (err, (Val_ptr_t) Val_virterror);
1617 ocaml_libvirt_virterror_get_last_conn_error (value connv)
1621 virConnectPtr conn = Connect_val (connv);
1623 rv = Val_opt (conn, (Val_ptr_t) Val_connect);
1629 ocaml_libvirt_virterror_reset_last_error (value unitv)
1632 virResetLastError ();
1633 CAMLreturn (Val_unit);
1637 ocaml_libvirt_virterror_reset_last_conn_error (value connv)
1640 virConnectPtr conn = Connect_val (connv);
1641 virConnResetLastError (conn);
1642 CAMLreturn (Val_unit);
1645 /*----------------------------------------------------------------------*/
1647 /* Initialise the library. */
1649 ocaml_libvirt_init (value unit)
1655 r = virInitialize ();
1656 CHECK_ERROR (r == -1, NULL, "virInitialize");
1658 CAMLreturn (Val_unit);
1661 /*----------------------------------------------------------------------*/
1664 Optstring_val (value strv)
1666 if (strv == Val_int (0)) /* None */
1668 else /* Some string */
1669 return String_val (Field (strv, 0));
1673 Val_opt (void *ptr, Val_ptr_t Val_ptr)
1676 CAMLlocal2 (optv, ptrv);
1678 if (ptr) { /* Some ptr */
1679 optv = caml_alloc (1, 0);
1680 ptrv = Val_ptr (ptr);
1681 Store_field (optv, 0, ptrv);
1690 option_default (value option, value deflt)
1692 if (option == Val_int (0)) /* "None" */
1694 else /* "Some 'a" */
1695 return Field (option, 0);
1700 _raise_virterror (virConnectPtr conn, const char *fn)
1705 struct _virError err;
1707 errp = conn ? virConnGetLastError (conn) : virGetLastError ();
1710 /* Fake a _virError structure. */
1711 memset (&err, 0, sizeof err);
1712 err.code = VIR_ERR_INTERNAL_ERROR;
1713 err.domain = VIR_FROM_NONE;
1714 err.level = VIR_ERR_ERROR;
1715 err.message = (char *) fn;
1719 rv = Val_virterror (errp);
1720 caml_raise_with_arg (*caml_named_value ("ocaml_libvirt_virterror"), rv);
1723 CAMLreturn (Val_unit);
1727 Val_virterror (virErrorPtr err)
1730 CAMLlocal3 (rv, connv, optv);
1732 rv = caml_alloc (12, 0);
1733 Store_field (rv, 0, Val_int (err->code));
1734 Store_field (rv, 1, Val_int (err->domain));
1736 Val_opt (err->message, (Val_ptr_t) caml_copy_string));
1737 Store_field (rv, 3, Val_int (err->level));
1739 /* conn, dom and net fields, all optional */
1741 connv = Val_connect_no_finalize (err->conn);
1742 optv = caml_alloc (1, 0);
1743 Store_field (optv, 0, connv);
1744 Store_field (rv, 4, optv); /* Some conn */
1747 optv = caml_alloc (1, 0);
1748 Store_field (optv, 0, Val_domain_no_finalize (err->dom, connv));
1749 Store_field (rv, 5, optv); /* Some (dom, conn) */
1752 Store_field (rv, 5, Val_int (0)); /* None */
1754 optv = caml_alloc (1, 0);
1755 Store_field (optv, 0, Val_network_no_finalize (err->net, connv));
1756 Store_field (rv, 11, optv); /* Some (net, conn) */
1758 Store_field (rv, 11, Val_int (0)); /* None */
1760 Store_field (rv, 4, Val_int (0)); /* None */
1761 Store_field (rv, 5, Val_int (0)); /* None */
1762 Store_field (rv, 11, Val_int (0)); /* None */
1766 Val_opt (err->str1, (Val_ptr_t) caml_copy_string));
1768 Val_opt (err->str2, (Val_ptr_t) caml_copy_string));
1770 Val_opt (err->str3, (Val_ptr_t) caml_copy_string));
1771 Store_field (rv, 9, caml_copy_int32 (err->int1));
1772 Store_field (rv, 10, caml_copy_int32 (err->int2));
1777 static void conn_finalize (value);
1778 static void dom_finalize (value);
1779 static void net_finalize (value);
1781 static struct custom_operations conn_custom_operations = {
1782 "conn_custom_operations",
1784 custom_compare_default,
1785 custom_hash_default,
1786 custom_serialize_default,
1787 custom_deserialize_default
1790 static struct custom_operations dom_custom_operations = {
1791 "dom_custom_operations",
1793 custom_compare_default,
1794 custom_hash_default,
1795 custom_serialize_default,
1796 custom_deserialize_default
1800 static struct custom_operations net_custom_operations = {
1801 "net_custom_operations",
1803 custom_compare_default,
1804 custom_hash_default,
1805 custom_serialize_default,
1806 custom_deserialize_default
1810 Val_connect (virConnectPtr conn)
1814 rv = caml_alloc_custom (&conn_custom_operations,
1815 sizeof (virConnectPtr), 0, 1);
1816 Connect_val (rv) = conn;
1820 /* This wraps up the raw domain handle (Domain.dom). */
1822 Val_dom (virDomainPtr dom)
1826 rv = caml_alloc_custom (&dom_custom_operations,
1827 sizeof (virDomainPtr), 0, 1);
1832 /* This wraps up the raw network handle (Network.net). */
1834 Val_net (virNetworkPtr net)
1838 rv = caml_alloc_custom (&net_custom_operations,
1839 sizeof (virNetworkPtr), 0, 1);
1844 /* No-finalize versions of Val_connect, Val_dom, Val_net ONLY for use
1845 * by virterror wrappers.
1848 Val_connect_no_finalize (virConnectPtr conn)
1852 rv = caml_alloc (1, Abstract_tag);
1853 Store_field (rv, 0, (value) conn);
1858 Val_dom_no_finalize (virDomainPtr dom)
1862 rv = caml_alloc (1, Abstract_tag);
1863 Store_field (rv, 0, (value) dom);
1868 Val_net_no_finalize (virNetworkPtr net)
1872 rv = caml_alloc (1, Abstract_tag);
1873 Store_field (rv, 0, (value) net);
1877 /* This wraps up the (dom, conn) pair (Domain.t). */
1879 Val_domain (virDomainPtr dom, value connv)
1884 rv = caml_alloc_tuple (2);
1886 Store_field (rv, 0, v);
1887 Store_field (rv, 1, connv);
1891 /* This wraps up the (net, conn) pair (Network.t). */
1893 Val_network (virNetworkPtr net, value connv)
1898 rv = caml_alloc_tuple (2);
1900 Store_field (rv, 0, v);
1901 Store_field (rv, 1, connv);
1905 /* No-finalize versions of Val_domain, Val_network ONLY for use by
1906 * virterror wrappers.
1909 Val_domain_no_finalize (virDomainPtr dom, value connv)
1914 rv = caml_alloc_tuple (2);
1915 v = Val_dom_no_finalize (dom);
1916 Store_field (rv, 0, v);
1917 Store_field (rv, 1, connv);
1922 Val_network_no_finalize (virNetworkPtr net, value connv)
1927 rv = caml_alloc_tuple (2);
1928 v = Val_net_no_finalize (net);
1929 Store_field (rv, 0, v);
1930 Store_field (rv, 1, connv);
1935 conn_finalize (value connv)
1937 virConnectPtr conn = Connect_val (connv);
1938 if (conn) (void) virConnectClose (conn);
1942 dom_finalize (value domv)
1944 virDomainPtr dom = Dom_val (domv);
1945 if (dom) (void) virDomainFree (dom);
1949 net_finalize (value netv)
1951 virNetworkPtr net = Net_val (netv);
1952 if (net) (void) virNetworkFree (net);