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>
38 static char *Optstring_val (value strv);
39 typedef value (*Val_ptr_t) (void *);
40 static value Val_opt (void *ptr, Val_ptr_t Val_ptr);
41 /*static value option_default (value option, value deflt);*/
42 static value _raise_virterror (virConnectPtr conn, const char *fn);
43 static value Val_virterror (virErrorPtr err);
45 #define CHECK_ERROR(cond, conn, fn) \
46 do { if (cond) _raise_virterror (conn, fn); } while (0)
48 #define NOT_SUPPORTED(fn) \
49 caml_invalid_argument (fn " not supported")
51 /* For more about weak symbols, see:
52 * http://kolpackov.net/pipermail/notes/2004-March/000006.html
53 * We are using this to do runtime detection of library functions
54 * so that if we dynamically link with an older version of
55 * libvirt than we were compiled against, it won't fail (provided
56 * libvirt >= 0.2.1 - we don't support anything older).
60 #if (__GNUC__ == 3 && __GNUC_MINOR__ >= 3) || (__GNUC__ > 3)
61 #define HAVE_WEAK_SYMBOLS 1
66 #ifdef HAVE_WEAK_SYMBOLS
67 #define WEAK_SYMBOL_CHECK(sym) \
68 do { if (!sym) NOT_SUPPORTED(#sym); } while (0)
70 #define WEAK_SYMBOL_CHECK(sym)
71 #endif /* HAVE_WEAK_SYMBOLS */
73 #ifdef HAVE_WEAK_SYMBOLS
74 #ifdef HAVE_VIRCONNECTGETHOSTNAME
75 extern char *virConnectGetHostname (virConnectPtr conn)
76 __attribute__((weak));
78 #ifdef HAVE_VIRCONNECTGETURI
79 extern char *virConnectGetURI (virConnectPtr conn)
80 __attribute__((weak));
82 #ifdef HAVE_VIRDOMAINBLOCKSTATS
83 extern int virDomainBlockStats (virDomainPtr dom,
85 virDomainBlockStatsPtr stats,
87 __attribute__((weak));
89 #ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS
90 extern int virDomainGetSchedulerParameters (virDomainPtr domain,
91 virSchedParameterPtr params,
93 __attribute__((weak));
95 #ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE
96 extern char *virDomainGetSchedulerType(virDomainPtr domain,
98 __attribute__((weak));
100 #ifdef HAVE_VIRDOMAININTERFACESTATS
101 extern int virDomainInterfaceStats (virDomainPtr dom,
103 virDomainInterfaceStatsPtr stats,
105 __attribute__((weak));
107 #ifdef HAVE_VIRDOMAINMIGRATE
108 extern virDomainPtr virDomainMigrate (virDomainPtr domain, virConnectPtr dconn,
109 unsigned long flags, const char *dname,
110 const char *uri, unsigned long bandwidth)
111 __attribute__((weak));
113 #ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS
114 extern int virDomainSetSchedulerParameters (virDomainPtr domain,
115 virSchedParameterPtr params,
117 __attribute__((weak));
119 #ifdef HAVE_VIRNODEGETFREEMEMORY
120 extern unsigned long long virNodeGetFreeMemory (virConnectPtr conn)
121 __attribute__((weak));
123 #ifdef HAVE_VIRNODEGETCELLSFREEMEMORY
124 extern int virNodeGetCellsFreeMemory (virConnectPtr conn,
125 unsigned long long *freeMems,
126 int startCell, int maxCells)
127 __attribute__((weak));
129 #endif /* HAVE_WEAK_SYMBOLS */
131 /*----------------------------------------------------------------------*/
134 ocaml_libvirt_get_version (value driverv, value unit)
136 CAMLparam2 (driverv, unit);
138 const char *driver = Optstring_val (driverv);
139 unsigned long libVer, typeVer = 0, *typeVer_ptr;
142 typeVer_ptr = driver ? &typeVer : NULL;
143 r = virGetVersion (&libVer, driver, typeVer_ptr);
144 CHECK_ERROR (r == -1, NULL, "virGetVersion");
146 rv = caml_alloc_tuple (2);
147 Store_field (rv, 0, Val_int (libVer));
148 Store_field (rv, 1, Val_int (typeVer));
152 /*----------------------------------------------------------------------*/
154 /* Some notes about the use of custom blocks to store virConnectPtr,
155 * virDomainPtr and virNetworkPtr.
156 *------------------------------------------------------------------
158 * Libvirt does some tricky reference counting to keep track of
159 * virConnectPtr's, virDomainPtr's and virNetworkPtr's.
161 * There is only one function which can return a virConnectPtr
162 * (virConnectOpen*) and that allocates a new one each time.
164 * virDomainPtr/virNetworkPtr's on the other hand can be returned
165 * repeatedly (for the same underlying domain/network), and we must
166 * keep track of each one and explicitly free it with virDomainFree
167 * or virNetworkFree. If we lose track of one then the reference
168 * counting in libvirt will keep it open. We therefore wrap these
169 * in a custom block with a finalizer function.
171 * We also have to allow the user to explicitly free them, in
172 * which case we set the pointer inside the custom block to NULL.
173 * The finalizer notices this and doesn't free the object.
175 * Domains and networks "belong to" a connection. We have to avoid
176 * the situation like this:
178 * let conn = Connect.open ... in
179 * let dom = Domain.lookup_by_id conn 0 in
180 * (* conn goes out of scope and is garbage collected *)
181 * printf "dom name = %s\n" (Domain.get_name dom)
183 * The reason is that when conn is garbage collected, virConnectClose
184 * is called and any subsequent operations on dom will fail (in fact
185 * will probably segfault). To stop this from happening, the OCaml
186 * wrappers store domains (and networks) as explicit (dom, conn)
189 * Further complication with virterror / exceptions: Virterror gives
190 * us virConnectPtr, virDomainPtr, virNetworkPtr pointers. If we
191 * follow standard practice and wrap these up in blocks with
192 * finalizers then we'll end up double-freeing (in particular, calling
193 * virConnectClose at the wrong time). So for virterror, we have
194 * "special" wrapper functions (Val_connect_no_finalize, etc.).
197 /* Unwrap a custom block. */
198 #define Connect_val(rv) (*((virConnectPtr *)Data_custom_val(rv)))
199 #define Dom_val(rv) (*((virDomainPtr *)Data_custom_val(rv)))
200 #define Net_val(rv) (*((virNetworkPtr *)Data_custom_val(rv)))
202 /* Wrap up a pointer to something in a custom block. */
203 static value Val_connect (virConnectPtr conn);
204 static value Val_dom (virDomainPtr dom);
205 static value Val_net (virNetworkPtr net);
207 /* ONLY for use by virterror wrappers. */
208 static value Val_connect_no_finalize (virConnectPtr conn);
209 static value Val_dom_no_finalize (virDomainPtr dom);
210 static value Val_net_no_finalize (virNetworkPtr net);
212 /* Domains and networks are stored as pairs (dom/net, conn), so have
213 * some convenience functions for unwrapping and wrapping them.
215 #define Domain_val(rv) (Dom_val(Field((rv),0)))
216 #define Network_val(rv) (Net_val(Field((rv),0)))
217 #define Connect_domv(rv) (Connect_val(Field((rv),1)))
218 #define Connect_netv(rv) (Connect_val(Field((rv),1)))
220 static value Val_domain (virDomainPtr dom, value connv);
221 static value Val_network (virNetworkPtr net, value connv);
223 /* ONLY for use by virterror wrappers. */
224 static value Val_domain_no_finalize (virDomainPtr dom, value connv);
225 static value Val_network_no_finalize (virNetworkPtr net, value connv);
227 /*----------------------------------------------------------------------*/
229 /* Connection object. */
232 ocaml_libvirt_connect_open (value namev, value unit)
234 CAMLparam2 (namev, unit);
236 const char *name = Optstring_val (namev);
239 conn = virConnectOpen (name);
240 CHECK_ERROR (!conn, NULL, "virConnectOpen");
242 rv = Val_connect (conn);
248 ocaml_libvirt_connect_open_readonly (value namev, value unit)
250 CAMLparam2 (namev, unit);
252 const char *name = Optstring_val (namev);
255 conn = virConnectOpenReadOnly (name);
256 CHECK_ERROR (!conn, NULL, "virConnectOpen");
258 rv = Val_connect (conn);
264 ocaml_libvirt_connect_close (value connv)
267 virConnectPtr conn = Connect_val (connv);
270 r = virConnectClose (conn);
271 CHECK_ERROR (r == -1, conn, "virConnectClose");
273 /* So that we don't double-free in the finalizer: */
274 Connect_val (connv) = NULL;
276 CAMLreturn (Val_unit);
280 ocaml_libvirt_connect_get_type (value connv)
284 virConnectPtr conn = Connect_val (connv);
287 r = virConnectGetType (conn);
288 CHECK_ERROR (!r, conn, "virConnectGetType");
290 rv = caml_copy_string (r);
295 ocaml_libvirt_connect_get_version (value connv)
298 virConnectPtr conn = Connect_val (connv);
302 r = virConnectGetVersion (conn, &hvVer);
303 CHECK_ERROR (r == -1, conn, "virConnectGetVersion");
305 CAMLreturn (Val_int (hvVer));
309 ocaml_libvirt_connect_get_hostname (value connv)
311 #ifdef HAVE_VIRCONNECTGETHOSTNAME
314 virConnectPtr conn = Connect_val (connv);
317 WEAK_SYMBOL_CHECK (virConnectGetHostname);
318 r = virConnectGetHostname (conn);
319 CHECK_ERROR (!r, conn, "virConnectGetHostname");
321 rv = caml_copy_string (r);
325 NOT_SUPPORTED ("virConnectGetHostname");
330 ocaml_libvirt_connect_get_uri (value connv)
332 #ifdef HAVE_VIRCONNECTGETURI
335 virConnectPtr conn = Connect_val (connv);
338 WEAK_SYMBOL_CHECK (virConnectGetURI);
339 r = virConnectGetURI (conn);
340 CHECK_ERROR (!r, conn, "virConnectGetURI");
342 rv = caml_copy_string (r);
346 NOT_SUPPORTED ("virConnectGetURI");
351 ocaml_libvirt_connect_get_max_vcpus (value connv, value typev)
353 CAMLparam2 (connv, typev);
354 virConnectPtr conn = Connect_val (connv);
355 const char *type = Optstring_val (typev);
358 r = virConnectGetMaxVcpus (conn, type);
359 CHECK_ERROR (r == -1, conn, "virConnectGetMaxVcpus");
361 CAMLreturn (Val_int (r));
365 ocaml_libvirt_connect_list_domains (value connv, value iv)
367 CAMLparam2 (connv, iv);
369 virConnectPtr conn = Connect_val (connv);
370 int i = Int_val (iv);
373 r = virConnectListDomains (conn, ids, i);
374 CHECK_ERROR (r == -1, conn, "virConnectListDomains");
376 rv = caml_alloc (r, 0);
377 for (i = 0; i < r; ++i)
378 Store_field (rv, i, Val_int (ids[i]));
384 ocaml_libvirt_connect_num_of_domains (value connv)
387 virConnectPtr conn = Connect_val (connv);
390 r = virConnectNumOfDomains (conn);
391 CHECK_ERROR (r == -1, conn, "virConnectNumOfDomains");
393 CAMLreturn (Val_int (r));
397 ocaml_libvirt_connect_get_capabilities (value connv)
401 virConnectPtr conn = Connect_val (connv);
404 r = virConnectGetCapabilities (conn);
405 CHECK_ERROR (!r, conn, "virConnectGetCapabilities");
407 rv = caml_copy_string (r);
414 ocaml_libvirt_connect_num_of_defined_domains (value connv)
417 virConnectPtr conn = Connect_val (connv);
420 r = virConnectNumOfDefinedDomains (conn);
421 CHECK_ERROR (r == -1, conn, "virConnectNumOfDefinedDomains");
423 CAMLreturn (Val_int (r));
427 ocaml_libvirt_connect_list_defined_domains (value connv, value iv)
429 CAMLparam2 (connv, iv);
430 CAMLlocal2 (rv, strv);
431 virConnectPtr conn = Connect_val (connv);
432 int i = Int_val (iv);
436 r = virConnectListDefinedDomains (conn, names, i);
437 CHECK_ERROR (r == -1, conn, "virConnectListDefinedDomains");
439 rv = caml_alloc (r, 0);
440 for (i = 0; i < r; ++i) {
441 strv = caml_copy_string (names[i]);
442 Store_field (rv, i, strv);
450 ocaml_libvirt_connect_num_of_networks (value connv)
453 virConnectPtr conn = Connect_val (connv);
456 r = virConnectNumOfNetworks (conn);
457 CHECK_ERROR (r == -1, conn, "virConnectNumOfNetworks");
459 CAMLreturn (Val_int (r));
463 ocaml_libvirt_connect_list_networks (value connv, value iv)
465 CAMLparam2 (connv, iv);
466 CAMLlocal2 (rv, strv);
467 virConnectPtr conn = Connect_val (connv);
468 int i = Int_val (iv);
472 r = virConnectListNetworks (conn, names, i);
473 CHECK_ERROR (r == -1, conn, "virConnectListNetworks");
475 rv = caml_alloc (r, 0);
476 for (i = 0; i < r; ++i) {
477 strv = caml_copy_string (names[i]);
478 Store_field (rv, i, strv);
486 ocaml_libvirt_connect_num_of_defined_networks (value connv)
489 virConnectPtr conn = Connect_val (connv);
492 r = virConnectNumOfDefinedNetworks (conn);
493 CHECK_ERROR (r == -1, conn, "virConnectNumOfDefinedNetworks");
495 CAMLreturn (Val_int (r));
499 ocaml_libvirt_connect_list_defined_networks (value connv, value iv)
501 CAMLparam2 (connv, iv);
502 CAMLlocal2 (rv, strv);
503 virConnectPtr conn = Connect_val (connv);
504 int i = Int_val (iv);
508 r = virConnectListDefinedNetworks (conn, names, i);
509 CHECK_ERROR (r == -1, conn, "virConnectListDefinedNetworks");
511 rv = caml_alloc (r, 0);
512 for (i = 0; i < r; ++i) {
513 strv = caml_copy_string (names[i]);
514 Store_field (rv, i, strv);
522 ocaml_libvirt_connect_get_node_info (value connv)
526 virConnectPtr conn = Connect_val (connv);
530 r = virNodeGetInfo (conn, &info);
531 CHECK_ERROR (r == -1, conn, "virNodeGetInfo");
533 rv = caml_alloc (8, 0);
534 v = caml_copy_string (info.model); Store_field (rv, 0, v);
535 v = caml_copy_int64 (info.memory); Store_field (rv, 1, v);
536 Store_field (rv, 2, Val_int (info.cpus));
537 Store_field (rv, 3, Val_int (info.mhz));
538 Store_field (rv, 4, Val_int (info.nodes));
539 Store_field (rv, 5, Val_int (info.sockets));
540 Store_field (rv, 6, Val_int (info.cores));
541 Store_field (rv, 7, Val_int (info.threads));
547 ocaml_libvirt_connect_node_get_free_memory (value connv)
549 #ifdef HAVE_VIRNODEGETFREEMEMORY
552 virConnectPtr conn = Connect_val (connv);
553 unsigned long long r;
555 WEAK_SYMBOL_CHECK (virNodeGetFreeMemory);
556 r = virNodeGetFreeMemory (conn);
557 CHECK_ERROR (r == 0, conn, "virNodeGetFreeMemory");
559 rv = caml_copy_int64 ((int64) r);
562 NOT_SUPPORTED ("virNodeGetFreeMemory");
567 ocaml_libvirt_connect_node_get_cells_free_memory (value connv,
568 value startv, value maxv)
570 #ifdef HAVE_VIRNODEGETCELLSFREEMEMORY
571 CAMLparam3 (connv, startv, maxv);
573 virConnectPtr conn = Connect_val (connv);
574 int start = Int_val (startv);
575 int max = Int_val (maxv);
577 unsigned long long freemems[max];
579 WEAK_SYMBOL_CHECK (virNodeGetCellsFreeMemory);
580 r = virNodeGetCellsFreeMemory (conn, freemems, start, max);
581 CHECK_ERROR (r == -1, conn, "virNodeGetCellsFreeMemory");
583 rv = caml_alloc (r, 0);
584 for (i = 0; i < r; ++i) {
585 iv = caml_copy_int64 ((int64) freemems[i]);
586 Store_field (rv, i, iv);
591 NOT_SUPPORTED ("virNodeGetCellsFreeMemory");
596 ocaml_libvirt_domain_create_linux (value connv, value xmlv)
598 CAMLparam2 (connv, xmlv);
600 virConnectPtr conn = Connect_val (connv);
601 char *xml = String_val (xmlv);
604 r = virDomainCreateLinux (conn, xml, 0);
605 CHECK_ERROR (!r, conn, "virDomainCreateLinux");
607 rv = Val_domain (r, connv);
612 ocaml_libvirt_domain_lookup_by_id (value connv, value iv)
614 CAMLparam2 (connv, iv);
616 virConnectPtr conn = Connect_val (connv);
617 int i = Int_val (iv);
620 r = virDomainLookupByID (conn, i);
621 CHECK_ERROR (!r, conn, "virDomainLookupByID");
623 rv = Val_domain (r, connv);
628 ocaml_libvirt_domain_lookup_by_uuid (value connv, value uuidv)
630 CAMLparam2 (connv, uuidv);
632 virConnectPtr conn = Connect_val (connv);
633 char *uuid = String_val (uuidv);
636 r = virDomainLookupByUUID (conn, (unsigned char *) uuid);
637 CHECK_ERROR (!r, conn, "virDomainLookupByUUID");
639 rv = Val_domain (r, connv);
644 ocaml_libvirt_domain_lookup_by_uuid_string (value connv, value uuidv)
646 CAMLparam2 (connv, uuidv);
648 virConnectPtr conn = Connect_val (connv);
649 char *uuid = String_val (uuidv);
652 r = virDomainLookupByUUIDString (conn, uuid);
653 CHECK_ERROR (!r, conn, "virDomainLookupByUUIDString");
655 rv = Val_domain (r, connv);
660 ocaml_libvirt_domain_lookup_by_name (value connv, value namev)
662 CAMLparam2 (connv, namev);
664 virConnectPtr conn = Connect_val (connv);
665 char *name = String_val (namev);
668 r = virDomainLookupByName (conn, name);
669 CHECK_ERROR (!r, conn, "virDomainLookupByName");
671 rv = Val_domain (r, connv);
676 ocaml_libvirt_domain_destroy (value domv)
679 virDomainPtr dom = Domain_val (domv);
680 virConnectPtr conn = Connect_domv (domv);
683 r = virDomainDestroy (dom);
684 CHECK_ERROR (r == -1, conn, "virDomainDestroy");
686 /* So that we don't double-free in the finalizer: */
687 Domain_val (domv) = NULL;
689 CAMLreturn (Val_unit);
693 ocaml_libvirt_domain_free (value domv)
696 virDomainPtr dom = Domain_val (domv);
697 virConnectPtr conn = Connect_domv (domv);
700 r = virDomainFree (dom);
701 CHECK_ERROR (r == -1, conn, "virDomainFree");
703 /* So that we don't double-free in the finalizer: */
704 Domain_val (domv) = NULL;
706 CAMLreturn (Val_unit);
710 ocaml_libvirt_domain_suspend (value domv)
713 virDomainPtr dom = Domain_val (domv);
714 virConnectPtr conn = Connect_domv (domv);
717 r = virDomainSuspend (dom);
718 CHECK_ERROR (r == -1, conn, "virDomainSuspend");
720 CAMLreturn (Val_unit);
724 ocaml_libvirt_domain_resume (value domv)
727 virDomainPtr dom = Domain_val (domv);
728 virConnectPtr conn = Connect_domv (domv);
731 r = virDomainResume (dom);
732 CHECK_ERROR (r == -1, conn, "virDomainResume");
734 CAMLreturn (Val_unit);
738 ocaml_libvirt_domain_save (value domv, value pathv)
740 CAMLparam2 (domv, pathv);
741 virDomainPtr dom = Domain_val (domv);
742 virConnectPtr conn = Connect_domv (domv);
743 char *path = String_val (pathv);
746 r = virDomainSave (dom, path);
747 CHECK_ERROR (r == -1, conn, "virDomainSave");
749 CAMLreturn (Val_unit);
753 ocaml_libvirt_domain_restore (value connv, value pathv)
755 CAMLparam2 (connv, pathv);
756 virConnectPtr conn = Connect_val (connv);
757 char *path = String_val (pathv);
760 r = virDomainRestore (conn, path);
761 CHECK_ERROR (r == -1, conn, "virDomainRestore");
763 CAMLreturn (Val_unit);
767 ocaml_libvirt_domain_core_dump (value domv, value pathv)
769 CAMLparam2 (domv, pathv);
770 virDomainPtr dom = Domain_val (domv);
771 virConnectPtr conn = Connect_domv (domv);
772 char *path = String_val (pathv);
775 r = virDomainCoreDump (dom, path, 0);
776 CHECK_ERROR (r == -1, conn, "virDomainCoreDump");
778 CAMLreturn (Val_unit);
782 ocaml_libvirt_domain_shutdown (value domv)
785 virDomainPtr dom = Domain_val (domv);
786 virConnectPtr conn = Connect_domv (domv);
789 r = virDomainShutdown (dom);
790 CHECK_ERROR (r == -1, conn, "virDomainShutdown");
792 CAMLreturn (Val_unit);
796 ocaml_libvirt_domain_reboot (value domv)
799 virDomainPtr dom = Domain_val (domv);
800 virConnectPtr conn = Connect_domv (domv);
803 r = virDomainReboot (dom, 0);
804 CHECK_ERROR (r == -1, conn, "virDomainReboot");
806 CAMLreturn (Val_unit);
810 ocaml_libvirt_domain_get_name (value domv)
814 virDomainPtr dom = Domain_val (domv);
815 virConnectPtr conn = Connect_domv (domv);
818 r = virDomainGetName (dom);
819 CHECK_ERROR (!r, conn, "virDomainGetName");
821 rv = caml_copy_string (r);
826 ocaml_libvirt_domain_get_uuid (value domv)
830 virDomainPtr dom = Domain_val (domv);
831 virConnectPtr conn = Connect_domv (domv);
832 unsigned char uuid[VIR_UUID_BUFLEN];
835 r = virDomainGetUUID (dom, uuid);
836 CHECK_ERROR (r == -1, conn, "virDomainGetUUID");
838 rv = caml_copy_string ((char *) uuid);
843 ocaml_libvirt_domain_get_uuid_string (value domv)
847 virDomainPtr dom = Domain_val (domv);
848 virConnectPtr conn = Connect_domv (domv);
849 char uuid[VIR_UUID_STRING_BUFLEN];
852 r = virDomainGetUUIDString (dom, uuid);
853 CHECK_ERROR (r == -1, conn, "virDomainGetUUIDString");
855 rv = caml_copy_string (uuid);
860 ocaml_libvirt_domain_get_id (value domv)
863 virDomainPtr dom = Domain_val (domv);
864 virConnectPtr conn = Connect_domv (domv);
867 r = virDomainGetID (dom);
868 /* There's a bug in libvirt which means that if you try to get
869 * the ID of a defined-but-not-running domain, it returns -1,
870 * and there's no way to distinguish that from an error.
872 CHECK_ERROR (r == (unsigned int) -1, conn, "virDomainGetID");
874 CAMLreturn (Val_int ((int) r));
878 ocaml_libvirt_domain_get_os_type (value domv)
882 virDomainPtr dom = Domain_val (domv);
883 virConnectPtr conn = Connect_domv (domv);
886 r = virDomainGetOSType (dom);
887 CHECK_ERROR (!r, conn, "virDomainGetOSType");
889 rv = caml_copy_string (r);
895 ocaml_libvirt_domain_get_max_memory (value domv)
899 virDomainPtr dom = Domain_val (domv);
900 virConnectPtr conn = Connect_domv (domv);
903 r = virDomainGetMaxMemory (dom);
904 CHECK_ERROR (r == 0 /* [sic] */, conn, "virDomainGetMaxMemory");
906 rv = caml_copy_int64 (r);
911 ocaml_libvirt_domain_set_max_memory (value domv, value memv)
913 CAMLparam2 (domv, memv);
914 virDomainPtr dom = Domain_val (domv);
915 virConnectPtr conn = Connect_domv (domv);
916 unsigned long mem = Int64_val (memv);
919 r = virDomainSetMaxMemory (dom, mem);
920 CHECK_ERROR (r == -1, conn, "virDomainSetMaxMemory");
922 CAMLreturn (Val_unit);
926 ocaml_libvirt_domain_set_memory (value domv, value memv)
928 CAMLparam2 (domv, memv);
929 virDomainPtr dom = Domain_val (domv);
930 virConnectPtr conn = Connect_domv (domv);
931 unsigned long mem = Int64_val (memv);
934 r = virDomainSetMemory (dom, mem);
935 CHECK_ERROR (r == -1, conn, "virDomainSetMemory");
937 CAMLreturn (Val_unit);
941 ocaml_libvirt_domain_get_info (value domv)
945 virDomainPtr dom = Domain_val (domv);
946 virConnectPtr conn = Connect_domv (domv);
950 r = virDomainGetInfo (dom, &info);
951 CHECK_ERROR (r == -1, conn, "virDomainGetInfo");
953 rv = caml_alloc (5, 0);
954 Store_field (rv, 0, Val_int (info.state)); // These flags are compatible.
955 v = caml_copy_int64 (info.maxMem); Store_field (rv, 1, v);
956 v = caml_copy_int64 (info.memory); Store_field (rv, 2, v);
957 Store_field (rv, 3, Val_int (info.nrVirtCpu));
958 v = caml_copy_int64 (info.cpuTime); Store_field (rv, 4, v);
964 ocaml_libvirt_domain_get_xml_desc (value domv)
968 virDomainPtr dom = Domain_val (domv);
969 virConnectPtr conn = Connect_domv (domv);
972 r = virDomainGetXMLDesc (dom, 0);
973 CHECK_ERROR (!r, conn, "virDomainGetXMLDesc");
975 rv = caml_copy_string (r);
981 ocaml_libvirt_domain_get_scheduler_type (value domv)
983 #ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE
985 CAMLlocal2 (rv, strv);
986 virDomainPtr dom = Domain_val (domv);
987 virConnectPtr conn = Connect_domv (domv);
991 WEAK_SYMBOL_CHECK (virDomainGetSchedulerType);
992 r = virDomainGetSchedulerType (dom, &nparams);
993 CHECK_ERROR (!r, conn, "virDomainGetSchedulerType");
995 rv = caml_alloc_tuple (2);
996 strv = caml_copy_string (r); Store_field (rv, 0, strv);
998 Store_field (rv, 1, nparams);
1001 NOT_SUPPORTED ("virDomainGetSchedulerType");
1006 ocaml_libvirt_domain_get_scheduler_parameters (value domv, value nparamsv)
1008 #ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS
1009 CAMLparam2 (domv, nparamsv);
1010 CAMLlocal4 (rv, v, v2, v3);
1011 virDomainPtr dom = Domain_val (domv);
1012 virConnectPtr conn = Connect_domv (domv);
1013 int nparams = Int_val (nparamsv);
1014 virSchedParameter params[nparams];
1017 WEAK_SYMBOL_CHECK (virDomainGetSchedulerParameters);
1018 r = virDomainGetSchedulerParameters (dom, params, &nparams);
1019 CHECK_ERROR (r == -1, conn, "virDomainGetSchedulerParameters");
1021 rv = caml_alloc (nparams, 0);
1022 for (i = 0; i < nparams; ++i) {
1023 v = caml_alloc_tuple (2); Store_field (rv, i, v);
1024 v2 = caml_copy_string (params[i].field); Store_field (v, 0, v2);
1025 switch (params[i].type) {
1026 case VIR_DOMAIN_SCHED_FIELD_INT:
1027 v2 = caml_alloc (1, 0);
1028 v3 = caml_copy_int32 (params[i].value.i); Store_field (v2, 0, v3);
1030 case VIR_DOMAIN_SCHED_FIELD_UINT:
1031 v2 = caml_alloc (1, 1);
1032 v3 = caml_copy_int32 (params[i].value.ui); Store_field (v2, 0, v3);
1034 case VIR_DOMAIN_SCHED_FIELD_LLONG:
1035 v2 = caml_alloc (1, 2);
1036 v3 = caml_copy_int64 (params[i].value.l); Store_field (v2, 0, v3);
1038 case VIR_DOMAIN_SCHED_FIELD_ULLONG:
1039 v2 = caml_alloc (1, 3);
1040 v3 = caml_copy_int64 (params[i].value.ul); Store_field (v2, 0, v3);
1042 case VIR_DOMAIN_SCHED_FIELD_DOUBLE:
1043 v2 = caml_alloc (1, 4);
1044 v3 = caml_copy_double (params[i].value.d); Store_field (v2, 0, v3);
1046 case VIR_DOMAIN_SCHED_FIELD_BOOLEAN:
1047 v2 = caml_alloc (1, 5);
1048 Store_field (v2, 0, Val_int (params[i].value.b));
1051 caml_failwith ((char *)__FUNCTION__);
1053 Store_field (v, 1, v2);
1057 NOT_SUPPORTED ("virDomainGetSchedulerParameters");
1062 ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv)
1064 #ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS
1065 CAMLparam2 (domv, paramsv);
1067 virDomainPtr dom = Domain_val (domv);
1068 virConnectPtr conn = Connect_domv (domv);
1069 int nparams = Wosize_val (paramsv);
1070 virSchedParameter params[nparams];
1074 for (i = 0; i < nparams; ++i) {
1075 v = Field (paramsv, i); /* Points to the two-element tuple. */
1076 name = String_val (Field (v, 0));
1077 strncpy (params[i].field, name, VIR_DOMAIN_SCHED_FIELD_LENGTH);
1078 params[i].field[VIR_DOMAIN_SCHED_FIELD_LENGTH-1] = '\0';
1079 v = Field (v, 1); /* Points to the sched_param_value block. */
1080 switch (Tag_val (v)) {
1082 params[i].type = VIR_DOMAIN_SCHED_FIELD_INT;
1083 params[i].value.i = Int32_val (Field (v, 0));
1086 params[i].type = VIR_DOMAIN_SCHED_FIELD_UINT;
1087 params[i].value.ui = Int32_val (Field (v, 0));
1090 params[i].type = VIR_DOMAIN_SCHED_FIELD_LLONG;
1091 params[i].value.l = Int64_val (Field (v, 0));
1094 params[i].type = VIR_DOMAIN_SCHED_FIELD_ULLONG;
1095 params[i].value.ul = Int64_val (Field (v, 0));
1098 params[i].type = VIR_DOMAIN_SCHED_FIELD_DOUBLE;
1099 params[i].value.d = Double_val (Field (v, 0));
1102 params[i].type = VIR_DOMAIN_SCHED_FIELD_BOOLEAN;
1103 params[i].value.b = Int_val (Field (v, 0));
1106 caml_failwith ((char *)__FUNCTION__);
1110 WEAK_SYMBOL_CHECK (virDomainSetSchedulerParameters);
1111 r = virDomainSetSchedulerParameters (dom, params, nparams);
1112 CHECK_ERROR (r == -1, conn, "virDomainSetSchedulerParameters");
1114 CAMLreturn (Val_unit);
1116 NOT_SUPPORTED ("virDomainSetSchedulerParameters");
1121 ocaml_libvirt_domain_define_xml (value connv, value xmlv)
1123 CAMLparam2 (connv, xmlv);
1125 virConnectPtr conn = Connect_val (connv);
1126 char *xml = String_val (xmlv);
1129 r = virDomainDefineXML (conn, xml);
1130 CHECK_ERROR (!r, conn, "virDomainDefineXML");
1132 rv = Val_domain (r, connv);
1137 ocaml_libvirt_domain_undefine (value domv)
1140 virDomainPtr dom = Domain_val (domv);
1141 virConnectPtr conn = Connect_domv (domv);
1144 r = virDomainUndefine (dom);
1145 CHECK_ERROR (r == -1, conn, "virDomainUndefine");
1147 CAMLreturn (Val_unit);
1151 ocaml_libvirt_domain_create (value domv)
1154 virDomainPtr dom = Domain_val (domv);
1155 virConnectPtr conn = Connect_domv (domv);
1158 r = virDomainCreate (dom);
1159 CHECK_ERROR (r == -1, conn, "virDomainCreate");
1161 CAMLreturn (Val_unit);
1165 ocaml_libvirt_domain_get_autostart (value domv)
1168 virDomainPtr dom = Domain_val (domv);
1169 virConnectPtr conn = Connect_domv (domv);
1172 r = virDomainGetAutostart (dom, &autostart);
1173 CHECK_ERROR (r == -1, conn, "virDomainGetAutostart");
1175 CAMLreturn (autostart ? Val_true : Val_false);
1179 ocaml_libvirt_domain_set_autostart (value domv, value autostartv)
1181 CAMLparam2 (domv, autostartv);
1182 virDomainPtr dom = Domain_val (domv);
1183 virConnectPtr conn = Connect_domv (domv);
1184 int r, autostart = autostartv == Val_true ? 1 : 0;
1186 r = virDomainSetAutostart (dom, autostart);
1187 CHECK_ERROR (r == -1, conn, "virDomainSetAutostart");
1189 CAMLreturn (Val_unit);
1193 ocaml_libvirt_domain_set_vcpus (value domv, value nvcpusv)
1195 CAMLparam2 (domv, nvcpusv);
1196 virDomainPtr dom = Domain_val (domv);
1197 virConnectPtr conn = Connect_domv (domv);
1198 int r, nvcpus = Int_val (nvcpusv);
1200 r = virDomainSetVcpus (dom, nvcpus);
1201 CHECK_ERROR (r == -1, conn, "virDomainSetVcpus");
1203 CAMLreturn (Val_unit);
1207 ocaml_libvirt_domain_pin_vcpu (value domv, value vcpuv, value cpumapv)
1209 CAMLparam3 (domv, vcpuv, cpumapv);
1210 virDomainPtr dom = Domain_val (domv);
1211 virConnectPtr conn = Connect_domv (domv);
1212 int maplen = caml_string_length (cpumapv);
1213 unsigned char *cpumap = (unsigned char *) String_val (cpumapv);
1214 int vcpu = Int_val (vcpuv);
1217 r = virDomainPinVcpu (dom, vcpu, cpumap, maplen);
1218 CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
1220 CAMLreturn (Val_unit);
1224 ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv)
1226 CAMLparam3 (domv, maxinfov, maplenv);
1227 CAMLlocal5 (rv, infov, strv, v, v2);
1228 virDomainPtr dom = Domain_val (domv);
1229 virConnectPtr conn = Connect_domv (domv);
1230 int maxinfo = Int_val (maxinfov);
1231 int maplen = Int_val (maplenv);
1232 virVcpuInfo info[maxinfo];
1233 unsigned char cpumaps[maxinfo * maplen];
1236 memset (info, 0, sizeof (virVcpuInfo) * maxinfo);
1237 memset (cpumaps, 0, maxinfo * maplen);
1239 r = virDomainGetVcpus (dom, info, maxinfo, cpumaps, maplen);
1240 CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
1242 /* Copy the virVcpuInfo structures. */
1243 infov = caml_alloc (maxinfo, 0);
1244 for (i = 0; i < maxinfo; ++i) {
1245 v2 = caml_alloc (4, 0); Store_field (infov, i, v2);
1246 Store_field (v2, 0, Val_int (info[i].number));
1247 Store_field (v2, 1, Val_int (info[i].state));
1248 v = caml_copy_int64 (info[i].cpuTime); Store_field (v2, 2, v);
1249 Store_field (v2, 3, Val_int (info[i].cpu));
1252 /* Copy the bitmap. */
1253 strv = caml_alloc_string (maxinfo * maplen);
1254 memcpy (String_val (strv), cpumaps, maxinfo * maplen);
1256 /* Allocate the tuple and return it. */
1257 rv = caml_alloc_tuple (3);
1258 Store_field (rv, 0, Val_int (r)); /* number of CPUs. */
1259 Store_field (rv, 1, infov);
1260 Store_field (rv, 2, strv);
1266 ocaml_libvirt_domain_get_max_vcpus (value domv)
1269 virDomainPtr dom = Domain_val (domv);
1270 virConnectPtr conn = Connect_domv (domv);
1273 r = virDomainGetMaxVcpus (dom);
1274 CHECK_ERROR (r == -1, conn, "virDomainGetMaxVcpus");
1276 CAMLreturn (Val_int (r));
1280 ocaml_libvirt_domain_attach_device (value domv, value xmlv)
1282 CAMLparam2 (domv, xmlv);
1283 virDomainPtr dom = Domain_val (domv);
1284 virConnectPtr conn = Connect_domv (domv);
1285 char *xml = String_val (xmlv);
1288 r = virDomainAttachDevice (dom, xml);
1289 CHECK_ERROR (r == -1, conn, "virDomainAttachDevice");
1291 CAMLreturn (Val_unit);
1295 ocaml_libvirt_domain_detach_device (value domv, value xmlv)
1297 CAMLparam2 (domv, xmlv);
1298 virDomainPtr dom = Domain_val (domv);
1299 virConnectPtr conn = Connect_domv (domv);
1300 char *xml = String_val (xmlv);
1303 r = virDomainDetachDevice (dom, xml);
1304 CHECK_ERROR (r == -1, conn, "virDomainDetachDevice");
1306 CAMLreturn (Val_unit);
1310 ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, value optdnamev, value opturiv, value optbandwidthv, value unitv)
1312 #ifdef HAVE_VIRDOMAINMIGRATE
1313 CAMLparam5 (domv, dconnv, flagsv, optdnamev, opturiv);
1314 CAMLxparam2 (optbandwidthv, unitv);
1315 CAMLlocal2 (flagv, rv);
1316 virDomainPtr dom = Domain_val (domv);
1317 virConnectPtr conn = Connect_domv (domv);
1318 virConnectPtr dconn = Connect_val (dconnv);
1320 const char *dname = Optstring_val (optdnamev);
1321 const char *uri = Optstring_val (opturiv);
1322 unsigned long bandwidth;
1325 /* Iterate over the list of flags. */
1326 for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
1328 flagv = Field (flagsv, 0);
1329 if (flagv == Int_val(0))
1330 flags |= VIR_MIGRATE_LIVE;
1333 if (optbandwidthv == Val_int (0)) /* None */
1335 else /* Some bandwidth */
1336 bandwidth = Int_val (Field (optbandwidthv, 0));
1338 WEAK_SYMBOL_CHECK (virDomainMigrate);
1339 r = virDomainMigrate (dom, dconn, flags, dname, uri, bandwidth);
1340 CHECK_ERROR (!r, conn, "virDomainMigrate");
1342 rv = Val_domain (r, dconnv);
1346 #else /* virDomainMigrate not supported */
1347 NOT_SUPPORTED ("virDomainMigrate");
1352 ocaml_libvirt_domain_migrate_bytecode (value *argv, int argn)
1354 return ocaml_libvirt_domain_migrate_native (argv[0], argv[1], argv[2],
1355 argv[3], argv[4], argv[5],
1360 ocaml_libvirt_domain_block_stats (value domv, value pathv)
1362 #if HAVE_VIRDOMAINBLOCKSTATS
1363 CAMLparam2 (domv, pathv);
1365 virDomainPtr dom = Domain_val (domv);
1366 virConnectPtr conn = Connect_domv (domv);
1367 char *path = String_val (pathv);
1368 struct _virDomainBlockStats stats;
1371 WEAK_SYMBOL_CHECK (virDomainBlockStats);
1372 r = virDomainBlockStats (dom, path, &stats, sizeof stats);
1373 CHECK_ERROR (r == -1, conn, "virDomainBlockStats");
1375 rv = caml_alloc (5, 0);
1376 v = caml_copy_int64 (stats.rd_req); Store_field (rv, 0, v);
1377 v = caml_copy_int64 (stats.rd_bytes); Store_field (rv, 1, v);
1378 v = caml_copy_int64 (stats.wr_req); Store_field (rv, 2, v);
1379 v = caml_copy_int64 (stats.wr_bytes); Store_field (rv, 3, v);
1380 v = caml_copy_int64 (stats.errs); Store_field (rv, 4, v);
1384 NOT_SUPPORTED ("virDomainBlockStats");
1389 ocaml_libvirt_domain_interface_stats (value domv, value pathv)
1391 #if HAVE_VIRDOMAININTERFACESTATS
1392 CAMLparam2 (domv, pathv);
1394 virDomainPtr dom = Domain_val (domv);
1395 virConnectPtr conn = Connect_domv (domv);
1396 char *path = String_val (pathv);
1397 struct _virDomainInterfaceStats stats;
1400 WEAK_SYMBOL_CHECK (virDomainInterfaceStats);
1401 r = virDomainInterfaceStats (dom, path, &stats, sizeof stats);
1402 CHECK_ERROR (r == -1, conn, "virDomainInterfaceStats");
1404 rv = caml_alloc (8, 0);
1405 v = caml_copy_int64 (stats.rx_bytes); Store_field (rv, 0, v);
1406 v = caml_copy_int64 (stats.rx_packets); Store_field (rv, 1, v);
1407 v = caml_copy_int64 (stats.rx_errs); Store_field (rv, 2, v);
1408 v = caml_copy_int64 (stats.rx_drop); Store_field (rv, 3, v);
1409 v = caml_copy_int64 (stats.tx_bytes); Store_field (rv, 4, v);
1410 v = caml_copy_int64 (stats.tx_packets); Store_field (rv, 5, v);
1411 v = caml_copy_int64 (stats.tx_errs); Store_field (rv, 6, v);
1412 v = caml_copy_int64 (stats.tx_drop); Store_field (rv, 7, v);
1416 NOT_SUPPORTED ("virDomainInterfaceStats");
1421 ocaml_libvirt_network_lookup_by_name (value connv, value namev)
1423 CAMLparam2 (connv, namev);
1425 virConnectPtr conn = Connect_val (connv);
1426 char *name = String_val (namev);
1429 r = virNetworkLookupByName (conn, name);
1430 CHECK_ERROR (!r, conn, "virNetworkLookupByName");
1432 rv = Val_network (r, connv);
1437 ocaml_libvirt_network_lookup_by_uuid (value connv, value uuidv)
1439 CAMLparam2 (connv, uuidv);
1441 virConnectPtr conn = Connect_val (connv);
1442 char *uuid = String_val (uuidv);
1445 r = virNetworkLookupByUUID (conn, (unsigned char *) uuid);
1446 CHECK_ERROR (!r, conn, "virNetworkLookupByUUID");
1448 rv = Val_network (r, connv);
1453 ocaml_libvirt_network_lookup_by_uuid_string (value connv, value uuidv)
1455 CAMLparam2 (connv, uuidv);
1457 virConnectPtr conn = Connect_val (connv);
1458 char *uuid = String_val (uuidv);
1461 r = virNetworkLookupByUUIDString (conn, uuid);
1462 CHECK_ERROR (!r, conn, "virNetworkLookupByUUIDString");
1464 rv = Val_network (r, connv);
1469 ocaml_libvirt_network_create_xml (value connv, value xmlv)
1471 CAMLparam2 (connv, xmlv);
1473 virConnectPtr conn = Connect_val (connv);
1474 char *xml = String_val (xmlv);
1477 r = virNetworkCreateXML (conn, xml);
1478 CHECK_ERROR (!r, conn, "virNetworkCreateXML");
1480 rv = Val_network (r, connv);
1485 ocaml_libvirt_network_define_xml (value connv, value xmlv)
1487 CAMLparam2 (connv, xmlv);
1489 virConnectPtr conn = Connect_val (connv);
1490 char *xml = String_val (xmlv);
1493 r = virNetworkDefineXML (conn, xml);
1494 CHECK_ERROR (!r, conn, "virNetworkDefineXML");
1496 rv = Val_network (r, connv);
1501 ocaml_libvirt_network_undefine (value netv)
1504 virNetworkPtr net = Network_val (netv);
1505 virConnectPtr conn = Connect_netv (netv);
1508 r = virNetworkUndefine (net);
1509 CHECK_ERROR (r == -1, conn, "virNetworkUndefine");
1511 CAMLreturn (Val_unit);
1515 ocaml_libvirt_network_create (value netv)
1518 virNetworkPtr net = Network_val (netv);
1519 virConnectPtr conn = Connect_netv (netv);
1522 r = virNetworkCreate (net);
1523 CHECK_ERROR (r == -1, conn, "virNetworkCreate");
1525 CAMLreturn (Val_unit);
1529 ocaml_libvirt_network_destroy (value netv)
1532 virNetworkPtr net = Network_val (netv);
1533 virConnectPtr conn = Connect_netv (netv);
1536 r = virNetworkDestroy (net);
1537 CHECK_ERROR (r == -1, conn, "virNetworkDestroy");
1539 /* So that we don't double-free in the finalizer: */
1540 Network_val (netv) = NULL;
1542 CAMLreturn (Val_unit);
1546 ocaml_libvirt_network_free (value netv)
1549 virNetworkPtr net = Network_val (netv);
1550 virConnectPtr conn = Connect_netv (netv);
1553 r = virNetworkFree (net);
1554 CHECK_ERROR (r == -1, conn, "virNetworkFree");
1556 /* So that we don't double-free in the finalizer: */
1557 Network_val (netv) = NULL;
1559 CAMLreturn (Val_unit);
1563 ocaml_libvirt_network_get_name (value netv)
1567 virNetworkPtr net = Network_val (netv);
1568 virConnectPtr conn = Connect_netv (netv);
1571 r = virNetworkGetName (net);
1572 CHECK_ERROR (!r, conn, "virNetworkGetName");
1574 rv = caml_copy_string (r);
1579 ocaml_libvirt_network_get_uuid (value netv)
1583 virNetworkPtr net = Network_val (netv);
1584 virConnectPtr conn = Connect_netv (netv);
1585 unsigned char uuid[VIR_UUID_BUFLEN];
1588 r = virNetworkGetUUID (net, uuid);
1589 CHECK_ERROR (r == -1, conn, "virNetworkGetUUID");
1591 rv = caml_copy_string ((char *) uuid);
1596 ocaml_libvirt_network_get_uuid_string (value netv)
1600 virNetworkPtr net = Network_val (netv);
1601 virConnectPtr conn = Connect_netv (netv);
1602 char uuid[VIR_UUID_STRING_BUFLEN];
1605 r = virNetworkGetUUIDString (net, uuid);
1606 CHECK_ERROR (r == -1, conn, "virNetworkGetUUIDString");
1608 rv = caml_copy_string (uuid);
1613 ocaml_libvirt_network_get_xml_desc (value netv)
1617 virNetworkPtr net = Network_val (netv);
1618 virConnectPtr conn = Connect_netv (netv);
1621 r = virNetworkGetXMLDesc (net, 0);
1622 CHECK_ERROR (!r, conn, "virNetworkGetXMLDesc");
1624 rv = caml_copy_string (r);
1630 ocaml_libvirt_network_get_bridge_name (value netv)
1634 virNetworkPtr net = Network_val (netv);
1635 virConnectPtr conn = Connect_netv (netv);
1638 r = virNetworkGetBridgeName (net);
1639 CHECK_ERROR (!r, conn, "virNetworkGetBridgeName");
1641 rv = caml_copy_string (r);
1647 ocaml_libvirt_network_get_autostart (value netv)
1650 virNetworkPtr net = Network_val (netv);
1651 virConnectPtr conn = Connect_netv (netv);
1654 r = virNetworkGetAutostart (net, &autostart);
1655 CHECK_ERROR (r == -1, conn, "virNetworkGetAutostart");
1657 CAMLreturn (autostart ? Val_true : Val_false);
1661 ocaml_libvirt_network_set_autostart (value netv, value autostartv)
1663 CAMLparam2 (netv, autostartv);
1664 virNetworkPtr net = Network_val (netv);
1665 virConnectPtr conn = Connect_netv (netv);
1666 int r, autostart = autostartv == Val_true ? 1 : 0;
1668 r = virNetworkSetAutostart (net, autostart);
1669 CHECK_ERROR (r == -1, conn, "virNetworkSetAutostart");
1671 CAMLreturn (Val_unit);
1674 /*----------------------------------------------------------------------*/
1677 ocaml_libvirt_virterror_get_last_error (value unitv)
1681 virErrorPtr err = virGetLastError ();
1683 rv = Val_opt (err, (Val_ptr_t) Val_virterror);
1689 ocaml_libvirt_virterror_get_last_conn_error (value connv)
1693 virConnectPtr conn = Connect_val (connv);
1695 rv = Val_opt (conn, (Val_ptr_t) Val_connect);
1701 ocaml_libvirt_virterror_reset_last_error (value unitv)
1704 virResetLastError ();
1705 CAMLreturn (Val_unit);
1709 ocaml_libvirt_virterror_reset_last_conn_error (value connv)
1712 virConnectPtr conn = Connect_val (connv);
1713 virConnResetLastError (conn);
1714 CAMLreturn (Val_unit);
1717 /*----------------------------------------------------------------------*/
1719 /* Initialise the library. */
1721 ocaml_libvirt_init (value unit)
1727 r = virInitialize ();
1728 CHECK_ERROR (r == -1, NULL, "virInitialize");
1730 CAMLreturn (Val_unit);
1733 /*----------------------------------------------------------------------*/
1736 Optstring_val (value strv)
1738 if (strv == Val_int (0)) /* None */
1740 else /* Some string */
1741 return String_val (Field (strv, 0));
1745 Val_opt (void *ptr, Val_ptr_t Val_ptr)
1748 CAMLlocal2 (optv, ptrv);
1750 if (ptr) { /* Some ptr */
1751 optv = caml_alloc (1, 0);
1752 ptrv = Val_ptr (ptr);
1753 Store_field (optv, 0, ptrv);
1762 option_default (value option, value deflt)
1764 if (option == Val_int (0)) /* "None" */
1766 else /* "Some 'a" */
1767 return Field (option, 0);
1772 _raise_virterror (virConnectPtr conn, const char *fn)
1777 struct _virError err;
1779 errp = conn ? virConnGetLastError (conn) : virGetLastError ();
1782 /* Fake a _virError structure. */
1783 memset (&err, 0, sizeof err);
1784 err.code = VIR_ERR_INTERNAL_ERROR;
1785 err.domain = VIR_FROM_NONE;
1786 err.level = VIR_ERR_ERROR;
1787 err.message = (char *) fn;
1791 rv = Val_virterror (errp);
1792 caml_raise_with_arg (*caml_named_value ("ocaml_libvirt_virterror"), rv);
1795 CAMLreturn (Val_unit);
1798 /* Convert the virErrorNumber, virErrorDomain and virErrorLevel enums
1799 * into values (longs because they are variants in OCaml).
1801 * The enum values are part of the libvirt ABI so they cannot change,
1802 * which means that we can convert these numbers directly into
1803 * OCaml variants (which use the same ordering) very fast.
1805 * The tricky part here is when we are linked to a newer version of
1806 * libvirt than the one we were compiled against. If the newer libvirt
1807 * generates an error code which we don't know about then we need
1808 * to convert it into VIR_*_UNKNOWN (code).
1811 #define MAX_VIR_CODE 44 /* VIR_ERR_INVALID_MAC */
1812 #define MAX_VIR_DOMAIN 16 /* VIR_FROM_STATS_LINUX */
1813 #define MAX_VIR_LEVEL VIR_ERR_ERROR
1816 Val_err_number (virErrorNumber code)
1821 if (0 <= code && code <= MAX_VIR_CODE)
1822 rv = Val_int (code);
1824 rv = caml_alloc (1, 0); /* VIR_ERR_UNKNOWN (code) */
1825 Store_field (rv, 0, Val_int (code));
1832 Val_err_domain (virErrorDomain code)
1837 if (0 <= code && code <= MAX_VIR_DOMAIN)
1838 rv = Val_int (code);
1840 rv = caml_alloc (1, 0); /* VIR_FROM_UNKNOWN (code) */
1841 Store_field (rv, 0, Val_int (code));
1848 Val_err_level (virErrorLevel code)
1853 if (0 <= code && code <= MAX_VIR_LEVEL)
1854 rv = Val_int (code);
1856 rv = caml_alloc (1, 0); /* VIR_ERR_UNKNOWN_LEVEL (code) */
1857 Store_field (rv, 0, Val_int (code));
1863 /* Convert a virterror to a value. */
1865 Val_virterror (virErrorPtr err)
1868 CAMLlocal3 (rv, connv, optv);
1870 rv = caml_alloc (12, 0);
1871 Store_field (rv, 0, Val_err_number (err->code));
1872 Store_field (rv, 1, Val_err_domain (err->domain));
1874 Val_opt (err->message, (Val_ptr_t) caml_copy_string));
1875 Store_field (rv, 3, Val_err_level (err->level));
1877 /* conn, dom and net fields, all optional */
1879 connv = Val_connect_no_finalize (err->conn);
1880 optv = caml_alloc (1, 0);
1881 Store_field (optv, 0, connv);
1882 Store_field (rv, 4, optv); /* Some conn */
1885 optv = caml_alloc (1, 0);
1886 Store_field (optv, 0, Val_domain_no_finalize (err->dom, connv));
1887 Store_field (rv, 5, optv); /* Some (dom, conn) */
1890 Store_field (rv, 5, Val_int (0)); /* None */
1892 optv = caml_alloc (1, 0);
1893 Store_field (optv, 0, Val_network_no_finalize (err->net, connv));
1894 Store_field (rv, 11, optv); /* Some (net, conn) */
1896 Store_field (rv, 11, Val_int (0)); /* None */
1898 Store_field (rv, 4, Val_int (0)); /* None */
1899 Store_field (rv, 5, Val_int (0)); /* None */
1900 Store_field (rv, 11, Val_int (0)); /* None */
1904 Val_opt (err->str1, (Val_ptr_t) caml_copy_string));
1906 Val_opt (err->str2, (Val_ptr_t) caml_copy_string));
1908 Val_opt (err->str3, (Val_ptr_t) caml_copy_string));
1909 Store_field (rv, 9, caml_copy_int32 (err->int1));
1910 Store_field (rv, 10, caml_copy_int32 (err->int2));
1915 static void conn_finalize (value);
1916 static void dom_finalize (value);
1917 static void net_finalize (value);
1919 static struct custom_operations conn_custom_operations = {
1920 "conn_custom_operations",
1922 custom_compare_default,
1923 custom_hash_default,
1924 custom_serialize_default,
1925 custom_deserialize_default
1928 static struct custom_operations dom_custom_operations = {
1929 "dom_custom_operations",
1931 custom_compare_default,
1932 custom_hash_default,
1933 custom_serialize_default,
1934 custom_deserialize_default
1938 static struct custom_operations net_custom_operations = {
1939 "net_custom_operations",
1941 custom_compare_default,
1942 custom_hash_default,
1943 custom_serialize_default,
1944 custom_deserialize_default
1948 Val_connect (virConnectPtr conn)
1952 rv = caml_alloc_custom (&conn_custom_operations,
1953 sizeof (virConnectPtr), 0, 1);
1954 Connect_val (rv) = conn;
1958 /* This wraps up the raw domain handle (Domain.dom). */
1960 Val_dom (virDomainPtr dom)
1964 rv = caml_alloc_custom (&dom_custom_operations,
1965 sizeof (virDomainPtr), 0, 1);
1970 /* This wraps up the raw network handle (Network.net). */
1972 Val_net (virNetworkPtr net)
1976 rv = caml_alloc_custom (&net_custom_operations,
1977 sizeof (virNetworkPtr), 0, 1);
1982 /* No-finalize versions of Val_connect, Val_dom, Val_net ONLY for use
1983 * by virterror wrappers.
1986 Val_connect_no_finalize (virConnectPtr conn)
1990 rv = caml_alloc (1, Abstract_tag);
1991 Store_field (rv, 0, (value) conn);
1996 Val_dom_no_finalize (virDomainPtr dom)
2000 rv = caml_alloc (1, Abstract_tag);
2001 Store_field (rv, 0, (value) dom);
2006 Val_net_no_finalize (virNetworkPtr net)
2010 rv = caml_alloc (1, Abstract_tag);
2011 Store_field (rv, 0, (value) net);
2015 /* This wraps up the (dom, conn) pair (Domain.t). */
2017 Val_domain (virDomainPtr dom, value connv)
2022 rv = caml_alloc_tuple (2);
2024 Store_field (rv, 0, v);
2025 Store_field (rv, 1, connv);
2029 /* This wraps up the (net, conn) pair (Network.t). */
2031 Val_network (virNetworkPtr net, value connv)
2036 rv = caml_alloc_tuple (2);
2038 Store_field (rv, 0, v);
2039 Store_field (rv, 1, connv);
2043 /* No-finalize versions of Val_domain, Val_network ONLY for use by
2044 * virterror wrappers.
2047 Val_domain_no_finalize (virDomainPtr dom, value connv)
2052 rv = caml_alloc_tuple (2);
2053 v = Val_dom_no_finalize (dom);
2054 Store_field (rv, 0, v);
2055 Store_field (rv, 1, connv);
2060 Val_network_no_finalize (virNetworkPtr net, value connv)
2065 rv = caml_alloc_tuple (2);
2066 v = Val_net_no_finalize (net);
2067 Store_field (rv, 0, v);
2068 Store_field (rv, 1, connv);
2073 conn_finalize (value connv)
2075 virConnectPtr conn = Connect_val (connv);
2076 if (conn) (void) virConnectClose (conn);
2080 dom_finalize (value domv)
2082 virDomainPtr dom = Dom_val (domv);
2083 if (dom) (void) virDomainFree (dom);
2087 net_finalize (value netv)
2089 virNetworkPtr net = Net_val (netv);
2090 if (net) (void) virNetworkFree (net);