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 #endif /* HAVE_WEAK_SYMBOLS */
121 /*----------------------------------------------------------------------*/
124 ocaml_libvirt_get_version (value driverv, value unit)
126 CAMLparam2 (driverv, unit);
128 const char *driver = Optstring_val (driverv);
129 unsigned long libVer, typeVer = 0, *typeVer_ptr;
132 typeVer_ptr = driver ? &typeVer : NULL;
133 r = virGetVersion (&libVer, driver, typeVer_ptr);
134 CHECK_ERROR (r == -1, NULL, "virGetVersion");
136 rv = caml_alloc_tuple (2);
137 Store_field (rv, 0, Val_int (libVer));
138 Store_field (rv, 1, Val_int (typeVer));
142 /*----------------------------------------------------------------------*/
144 /* Some notes about the use of custom blocks to store virConnectPtr,
145 * virDomainPtr and virNetworkPtr.
146 *------------------------------------------------------------------
148 * Libvirt does some tricky reference counting to keep track of
149 * virConnectPtr's, virDomainPtr's and virNetworkPtr's.
151 * There is only one function which can return a virConnectPtr
152 * (virConnectOpen*) and that allocates a new one each time.
154 * virDomainPtr/virNetworkPtr's on the other hand can be returned
155 * repeatedly (for the same underlying domain/network), and we must
156 * keep track of each one and explicitly free it with virDomainFree
157 * or virNetworkFree. If we lose track of one then the reference
158 * counting in libvirt will keep it open. We therefore wrap these
159 * in a custom block with a finalizer function.
161 * We also have to allow the user to explicitly free them, in
162 * which case we set the pointer inside the custom block to NULL.
163 * The finalizer notices this and doesn't free the object.
165 * Domains and networks "belong to" a connection. We have to avoid
166 * the situation like this:
168 * let conn = Connect.open ... in
169 * let dom = Domain.lookup_by_id conn 0 in
170 * (* conn goes out of scope and is garbage collected *)
171 * printf "dom name = %s\n" (Domain.get_name dom)
173 * The reason is that when conn is garbage collected, virConnectClose
174 * is called and any subsequent operations on dom will fail (in fact
175 * will probably segfault). To stop this from happening, the OCaml
176 * wrappers store domains (and networks) as explicit (dom, conn)
179 * Further complication with virterror / exceptions: Virterror gives
180 * us virConnectPtr, virDomainPtr, virNetworkPtr pointers. If we
181 * follow standard practice and wrap these up in blocks with
182 * finalizers then we'll end up double-freeing (in particular, calling
183 * virConnectClose at the wrong time). So for virterror, we have
184 * "special" wrapper functions (Val_connect_no_finalize, etc.).
187 /* Unwrap a custom block. */
188 #define Connect_val(rv) (*((virConnectPtr *)Data_custom_val(rv)))
189 #define Dom_val(rv) (*((virDomainPtr *)Data_custom_val(rv)))
190 #define Net_val(rv) (*((virNetworkPtr *)Data_custom_val(rv)))
192 /* Wrap up a pointer to something in a custom block. */
193 static value Val_connect (virConnectPtr conn);
194 static value Val_dom (virDomainPtr dom);
195 static value Val_net (virNetworkPtr net);
197 /* ONLY for use by virterror wrappers. */
198 static value Val_connect_no_finalize (virConnectPtr conn);
199 static value Val_dom_no_finalize (virDomainPtr dom);
200 static value Val_net_no_finalize (virNetworkPtr net);
202 /* Domains and networks are stored as pairs (dom/net, conn), so have
203 * some convenience functions for unwrapping and wrapping them.
205 #define Domain_val(rv) (Dom_val(Field((rv),0)))
206 #define Network_val(rv) (Net_val(Field((rv),0)))
207 #define Connect_domv(rv) (Connect_val(Field((rv),1)))
208 #define Connect_netv(rv) (Connect_val(Field((rv),1)))
210 static value Val_domain (virDomainPtr dom, value connv);
211 static value Val_network (virNetworkPtr net, value connv);
213 /* ONLY for use by virterror wrappers. */
214 static value Val_domain_no_finalize (virDomainPtr dom, value connv);
215 static value Val_network_no_finalize (virNetworkPtr net, value connv);
217 /*----------------------------------------------------------------------*/
219 /* Connection object. */
222 ocaml_libvirt_connect_open (value namev, value unit)
224 CAMLparam2 (namev, unit);
226 const char *name = Optstring_val (namev);
229 conn = virConnectOpen (name);
230 CHECK_ERROR (!conn, NULL, "virConnectOpen");
232 rv = Val_connect (conn);
238 ocaml_libvirt_connect_open_readonly (value namev, value unit)
240 CAMLparam2 (namev, unit);
242 const char *name = Optstring_val (namev);
245 conn = virConnectOpenReadOnly (name);
246 CHECK_ERROR (!conn, NULL, "virConnectOpen");
248 rv = Val_connect (conn);
254 ocaml_libvirt_connect_close (value connv)
257 virConnectPtr conn = Connect_val (connv);
260 r = virConnectClose (conn);
261 CHECK_ERROR (r == -1, conn, "virConnectClose");
263 /* So that we don't double-free in the finalizer: */
264 Connect_val (connv) = NULL;
266 CAMLreturn (Val_unit);
270 ocaml_libvirt_connect_get_type (value connv)
274 virConnectPtr conn = Connect_val (connv);
277 r = virConnectGetType (conn);
278 CHECK_ERROR (!r, conn, "virConnectGetType");
280 rv = caml_copy_string (r);
285 ocaml_libvirt_connect_get_version (value connv)
288 virConnectPtr conn = Connect_val (connv);
292 r = virConnectGetVersion (conn, &hvVer);
293 CHECK_ERROR (r == -1, conn, "virConnectGetVersion");
295 CAMLreturn (Val_int (hvVer));
299 ocaml_libvirt_connect_get_hostname (value connv)
301 #ifdef HAVE_VIRCONNECTGETHOSTNAME
304 virConnectPtr conn = Connect_val (connv);
307 WEAK_SYMBOL_CHECK (virConnectGetHostname);
308 r = virConnectGetHostname (conn);
309 CHECK_ERROR (!r, conn, "virConnectGetHostname");
311 rv = caml_copy_string (r);
315 NOT_SUPPORTED ("virConnectGetHostname");
320 ocaml_libvirt_connect_get_uri (value connv)
322 #ifdef HAVE_VIRCONNECTGETURI
325 virConnectPtr conn = Connect_val (connv);
328 WEAK_SYMBOL_CHECK (virConnectGetURI);
329 r = virConnectGetURI (conn);
330 CHECK_ERROR (!r, conn, "virConnectGetURI");
332 rv = caml_copy_string (r);
336 NOT_SUPPORTED ("virConnectGetURI");
341 ocaml_libvirt_connect_get_max_vcpus (value connv, value typev)
343 CAMLparam2 (connv, typev);
344 virConnectPtr conn = Connect_val (connv);
345 const char *type = Optstring_val (typev);
348 r = virConnectGetMaxVcpus (conn, type);
349 CHECK_ERROR (r == -1, conn, "virConnectGetMaxVcpus");
351 CAMLreturn (Val_int (r));
355 ocaml_libvirt_connect_list_domains (value connv, value iv)
357 CAMLparam2 (connv, iv);
359 virConnectPtr conn = Connect_val (connv);
360 int i = Int_val (iv);
363 r = virConnectListDomains (conn, ids, i);
364 CHECK_ERROR (r == -1, conn, "virConnectListDomains");
366 rv = caml_alloc (r, 0);
367 for (i = 0; i < r; ++i)
368 Store_field (rv, i, Val_int (ids[i]));
374 ocaml_libvirt_connect_num_of_domains (value connv)
377 virConnectPtr conn = Connect_val (connv);
380 r = virConnectNumOfDomains (conn);
381 CHECK_ERROR (r == -1, conn, "virConnectNumOfDomains");
383 CAMLreturn (Val_int (r));
387 ocaml_libvirt_connect_get_capabilities (value connv)
391 virConnectPtr conn = Connect_val (connv);
394 r = virConnectGetCapabilities (conn);
395 CHECK_ERROR (!r, conn, "virConnectGetCapabilities");
397 rv = caml_copy_string (r);
404 ocaml_libvirt_connect_num_of_defined_domains (value connv)
407 virConnectPtr conn = Connect_val (connv);
410 r = virConnectNumOfDefinedDomains (conn);
411 CHECK_ERROR (r == -1, conn, "virConnectNumOfDefinedDomains");
413 CAMLreturn (Val_int (r));
417 ocaml_libvirt_connect_list_defined_domains (value connv, value iv)
419 CAMLparam2 (connv, iv);
420 CAMLlocal2 (rv, strv);
421 virConnectPtr conn = Connect_val (connv);
422 int i = Int_val (iv);
426 r = virConnectListDefinedDomains (conn, names, i);
427 CHECK_ERROR (r == -1, conn, "virConnectListDefinedDomains");
429 rv = caml_alloc (r, 0);
430 for (i = 0; i < r; ++i) {
431 strv = caml_copy_string (names[i]);
432 Store_field (rv, i, strv);
440 ocaml_libvirt_connect_num_of_networks (value connv)
443 virConnectPtr conn = Connect_val (connv);
446 r = virConnectNumOfNetworks (conn);
447 CHECK_ERROR (r == -1, conn, "virConnectNumOfNetworks");
449 CAMLreturn (Val_int (r));
453 ocaml_libvirt_connect_list_networks (value connv, value iv)
455 CAMLparam2 (connv, iv);
456 CAMLlocal2 (rv, strv);
457 virConnectPtr conn = Connect_val (connv);
458 int i = Int_val (iv);
462 r = virConnectListNetworks (conn, names, i);
463 CHECK_ERROR (r == -1, conn, "virConnectListNetworks");
465 rv = caml_alloc (r, 0);
466 for (i = 0; i < r; ++i) {
467 strv = caml_copy_string (names[i]);
468 Store_field (rv, i, strv);
476 ocaml_libvirt_connect_num_of_defined_networks (value connv)
479 virConnectPtr conn = Connect_val (connv);
482 r = virConnectNumOfDefinedNetworks (conn);
483 CHECK_ERROR (r == -1, conn, "virConnectNumOfDefinedNetworks");
485 CAMLreturn (Val_int (r));
489 ocaml_libvirt_connect_list_defined_networks (value connv, value iv)
491 CAMLparam2 (connv, iv);
492 CAMLlocal2 (rv, strv);
493 virConnectPtr conn = Connect_val (connv);
494 int i = Int_val (iv);
498 r = virConnectListDefinedNetworks (conn, names, i);
499 CHECK_ERROR (r == -1, conn, "virConnectListDefinedNetworks");
501 rv = caml_alloc (r, 0);
502 for (i = 0; i < r; ++i) {
503 strv = caml_copy_string (names[i]);
504 Store_field (rv, i, strv);
512 ocaml_libvirt_connect_get_node_info (value connv)
516 virConnectPtr conn = Connect_val (connv);
520 r = virNodeGetInfo (conn, &info);
521 CHECK_ERROR (r == -1, conn, "virNodeGetInfo");
523 rv = caml_alloc (8, 0);
524 v = caml_copy_string (info.model); Store_field (rv, 0, v);
525 v = caml_copy_int64 (info.memory); Store_field (rv, 1, v);
526 Store_field (rv, 2, Val_int (info.cpus));
527 Store_field (rv, 3, Val_int (info.mhz));
528 Store_field (rv, 4, Val_int (info.nodes));
529 Store_field (rv, 5, Val_int (info.sockets));
530 Store_field (rv, 6, Val_int (info.cores));
531 Store_field (rv, 7, Val_int (info.threads));
537 ocaml_libvirt_domain_create_linux (value connv, value xmlv)
539 CAMLparam2 (connv, xmlv);
541 virConnectPtr conn = Connect_val (connv);
542 char *xml = String_val (xmlv);
545 r = virDomainCreateLinux (conn, xml, 0);
546 CHECK_ERROR (!r, conn, "virDomainCreateLinux");
548 rv = Val_domain (r, connv);
553 ocaml_libvirt_domain_lookup_by_id (value connv, value iv)
555 CAMLparam2 (connv, iv);
557 virConnectPtr conn = Connect_val (connv);
558 int i = Int_val (iv);
561 r = virDomainLookupByID (conn, i);
562 CHECK_ERROR (!r, conn, "virDomainLookupByID");
564 rv = Val_domain (r, connv);
569 ocaml_libvirt_domain_lookup_by_uuid (value connv, value uuidv)
571 CAMLparam2 (connv, uuidv);
573 virConnectPtr conn = Connect_val (connv);
574 char *uuid = String_val (uuidv);
577 r = virDomainLookupByUUID (conn, (unsigned char *) uuid);
578 CHECK_ERROR (!r, conn, "virDomainLookupByUUID");
580 rv = Val_domain (r, connv);
585 ocaml_libvirt_domain_lookup_by_uuid_string (value connv, value uuidv)
587 CAMLparam2 (connv, uuidv);
589 virConnectPtr conn = Connect_val (connv);
590 char *uuid = String_val (uuidv);
593 r = virDomainLookupByUUIDString (conn, uuid);
594 CHECK_ERROR (!r, conn, "virDomainLookupByUUIDString");
596 rv = Val_domain (r, connv);
601 ocaml_libvirt_domain_lookup_by_name (value connv, value namev)
603 CAMLparam2 (connv, namev);
605 virConnectPtr conn = Connect_val (connv);
606 char *name = String_val (namev);
609 r = virDomainLookupByName (conn, name);
610 CHECK_ERROR (!r, conn, "virDomainLookupByName");
612 rv = Val_domain (r, connv);
617 ocaml_libvirt_domain_destroy (value domv)
620 virDomainPtr dom = Domain_val (domv);
621 virConnectPtr conn = Connect_domv (domv);
624 r = virDomainDestroy (dom);
625 CHECK_ERROR (r == -1, conn, "virDomainDestroy");
627 /* So that we don't double-free in the finalizer: */
628 Domain_val (domv) = NULL;
630 CAMLreturn (Val_unit);
634 ocaml_libvirt_domain_free (value domv)
637 virDomainPtr dom = Domain_val (domv);
638 virConnectPtr conn = Connect_domv (domv);
641 r = virDomainFree (dom);
642 CHECK_ERROR (r == -1, conn, "virDomainFree");
644 /* So that we don't double-free in the finalizer: */
645 Domain_val (domv) = NULL;
647 CAMLreturn (Val_unit);
651 ocaml_libvirt_domain_suspend (value domv)
654 virDomainPtr dom = Domain_val (domv);
655 virConnectPtr conn = Connect_domv (domv);
658 r = virDomainSuspend (dom);
659 CHECK_ERROR (r == -1, conn, "virDomainSuspend");
661 CAMLreturn (Val_unit);
665 ocaml_libvirt_domain_resume (value domv)
668 virDomainPtr dom = Domain_val (domv);
669 virConnectPtr conn = Connect_domv (domv);
672 r = virDomainResume (dom);
673 CHECK_ERROR (r == -1, conn, "virDomainResume");
675 CAMLreturn (Val_unit);
679 ocaml_libvirt_domain_save (value domv, value pathv)
681 CAMLparam2 (domv, pathv);
682 virDomainPtr dom = Domain_val (domv);
683 virConnectPtr conn = Connect_domv (domv);
684 char *path = String_val (pathv);
687 r = virDomainSave (dom, path);
688 CHECK_ERROR (r == -1, conn, "virDomainSave");
690 CAMLreturn (Val_unit);
694 ocaml_libvirt_domain_restore (value connv, value pathv)
696 CAMLparam2 (connv, pathv);
697 virConnectPtr conn = Connect_val (connv);
698 char *path = String_val (pathv);
701 r = virDomainRestore (conn, path);
702 CHECK_ERROR (r == -1, conn, "virDomainRestore");
704 CAMLreturn (Val_unit);
708 ocaml_libvirt_domain_core_dump (value domv, value pathv)
710 CAMLparam2 (domv, pathv);
711 virDomainPtr dom = Domain_val (domv);
712 virConnectPtr conn = Connect_domv (domv);
713 char *path = String_val (pathv);
716 r = virDomainCoreDump (dom, path, 0);
717 CHECK_ERROR (r == -1, conn, "virDomainCoreDump");
719 CAMLreturn (Val_unit);
723 ocaml_libvirt_domain_shutdown (value domv)
726 virDomainPtr dom = Domain_val (domv);
727 virConnectPtr conn = Connect_domv (domv);
730 r = virDomainShutdown (dom);
731 CHECK_ERROR (r == -1, conn, "virDomainShutdown");
733 CAMLreturn (Val_unit);
737 ocaml_libvirt_domain_reboot (value domv)
740 virDomainPtr dom = Domain_val (domv);
741 virConnectPtr conn = Connect_domv (domv);
744 r = virDomainReboot (dom, 0);
745 CHECK_ERROR (r == -1, conn, "virDomainReboot");
747 CAMLreturn (Val_unit);
751 ocaml_libvirt_domain_get_name (value domv)
755 virDomainPtr dom = Domain_val (domv);
756 virConnectPtr conn = Connect_domv (domv);
759 r = virDomainGetName (dom);
760 CHECK_ERROR (!r, conn, "virDomainGetName");
762 rv = caml_copy_string (r);
767 ocaml_libvirt_domain_get_uuid (value domv)
771 virDomainPtr dom = Domain_val (domv);
772 virConnectPtr conn = Connect_domv (domv);
773 unsigned char uuid[VIR_UUID_BUFLEN];
776 r = virDomainGetUUID (dom, uuid);
777 CHECK_ERROR (r == -1, conn, "virDomainGetUUID");
779 rv = caml_copy_string ((char *) uuid);
784 ocaml_libvirt_domain_get_uuid_string (value domv)
788 virDomainPtr dom = Domain_val (domv);
789 virConnectPtr conn = Connect_domv (domv);
790 char uuid[VIR_UUID_STRING_BUFLEN];
793 r = virDomainGetUUIDString (dom, uuid);
794 CHECK_ERROR (r == -1, conn, "virDomainGetUUIDString");
796 rv = caml_copy_string (uuid);
801 ocaml_libvirt_domain_get_id (value domv)
804 virDomainPtr dom = Domain_val (domv);
805 virConnectPtr conn = Connect_domv (domv);
808 r = virDomainGetID (dom);
809 /* There's a bug in libvirt which means that if you try to get
810 * the ID of a defined-but-not-running domain, it returns -1,
811 * and there's no way to distinguish that from an error.
813 CHECK_ERROR (r == (unsigned int) -1, conn, "virDomainGetID");
815 CAMLreturn (Val_int ((int) r));
819 ocaml_libvirt_domain_get_os_type (value domv)
823 virDomainPtr dom = Domain_val (domv);
824 virConnectPtr conn = Connect_domv (domv);
827 r = virDomainGetOSType (dom);
828 CHECK_ERROR (!r, conn, "virDomainGetOSType");
830 rv = caml_copy_string (r);
836 ocaml_libvirt_domain_get_max_memory (value domv)
840 virDomainPtr dom = Domain_val (domv);
841 virConnectPtr conn = Connect_domv (domv);
844 r = virDomainGetMaxMemory (dom);
845 CHECK_ERROR (r == 0 /* [sic] */, conn, "virDomainGetMaxMemory");
847 rv = caml_copy_int64 (r);
852 ocaml_libvirt_domain_set_max_memory (value domv, value memv)
854 CAMLparam2 (domv, memv);
855 virDomainPtr dom = Domain_val (domv);
856 virConnectPtr conn = Connect_domv (domv);
857 unsigned long mem = Int64_val (memv);
860 r = virDomainSetMaxMemory (dom, mem);
861 CHECK_ERROR (r == -1, conn, "virDomainSetMaxMemory");
863 CAMLreturn (Val_unit);
867 ocaml_libvirt_domain_set_memory (value domv, value memv)
869 CAMLparam2 (domv, memv);
870 virDomainPtr dom = Domain_val (domv);
871 virConnectPtr conn = Connect_domv (domv);
872 unsigned long mem = Int64_val (memv);
875 r = virDomainSetMemory (dom, mem);
876 CHECK_ERROR (r == -1, conn, "virDomainSetMemory");
878 CAMLreturn (Val_unit);
882 ocaml_libvirt_domain_get_info (value domv)
886 virDomainPtr dom = Domain_val (domv);
887 virConnectPtr conn = Connect_domv (domv);
891 r = virDomainGetInfo (dom, &info);
892 CHECK_ERROR (r == -1, conn, "virDomainGetInfo");
894 rv = caml_alloc (5, 0);
895 Store_field (rv, 0, Val_int (info.state)); // These flags are compatible.
896 v = caml_copy_int64 (info.maxMem); Store_field (rv, 1, v);
897 v = caml_copy_int64 (info.memory); Store_field (rv, 2, v);
898 Store_field (rv, 3, Val_int (info.nrVirtCpu));
899 v = caml_copy_int64 (info.cpuTime); Store_field (rv, 4, v);
905 ocaml_libvirt_domain_get_xml_desc (value domv)
909 virDomainPtr dom = Domain_val (domv);
910 virConnectPtr conn = Connect_domv (domv);
913 r = virDomainGetXMLDesc (dom, 0);
914 CHECK_ERROR (!r, conn, "virDomainGetXMLDesc");
916 rv = caml_copy_string (r);
922 ocaml_libvirt_domain_get_scheduler_type (value domv)
924 #ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE
926 CAMLlocal2 (rv, strv);
927 virDomainPtr dom = Domain_val (domv);
928 virConnectPtr conn = Connect_domv (domv);
932 WEAK_SYMBOL_CHECK (virDomainGetSchedulerType);
933 r = virDomainGetSchedulerType (dom, &nparams);
934 CHECK_ERROR (!r, conn, "virDomainGetSchedulerType");
936 rv = caml_alloc_tuple (2);
937 strv = caml_copy_string (r); Store_field (rv, 0, strv);
939 Store_field (rv, 1, nparams);
942 NOT_SUPPORTED ("virDomainGetSchedulerType");
947 ocaml_libvirt_domain_get_scheduler_parameters (value domv, value nparamsv)
949 #ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS
950 CAMLparam2 (domv, nparamsv);
951 CAMLlocal4 (rv, v, v2, v3);
952 virDomainPtr dom = Domain_val (domv);
953 virConnectPtr conn = Connect_domv (domv);
954 int nparams = Int_val (nparamsv);
955 virSchedParameter params[nparams];
958 WEAK_SYMBOL_CHECK (virDomainGetSchedulerParameters);
959 r = virDomainGetSchedulerParameters (dom, params, &nparams);
960 CHECK_ERROR (r == -1, conn, "virDomainGetSchedulerParameters");
962 rv = caml_alloc (nparams, 0);
963 for (i = 0; i < nparams; ++i) {
964 v = caml_alloc_tuple (2); Store_field (rv, i, v);
965 v2 = caml_copy_string (params[i].field); Store_field (v, 0, v2);
966 switch (params[i].type) {
967 case VIR_DOMAIN_SCHED_FIELD_INT:
968 v2 = caml_alloc (1, 0);
969 v3 = caml_copy_int32 (params[i].value.i); Store_field (v2, 0, v3);
971 case VIR_DOMAIN_SCHED_FIELD_UINT:
972 v2 = caml_alloc (1, 1);
973 v3 = caml_copy_int32 (params[i].value.ui); Store_field (v2, 0, v3);
975 case VIR_DOMAIN_SCHED_FIELD_LLONG:
976 v2 = caml_alloc (1, 2);
977 v3 = caml_copy_int64 (params[i].value.l); Store_field (v2, 0, v3);
979 case VIR_DOMAIN_SCHED_FIELD_ULLONG:
980 v2 = caml_alloc (1, 3);
981 v3 = caml_copy_int64 (params[i].value.ul); Store_field (v2, 0, v3);
983 case VIR_DOMAIN_SCHED_FIELD_DOUBLE:
984 v2 = caml_alloc (1, 4);
985 v3 = caml_copy_double (params[i].value.d); Store_field (v2, 0, v3);
987 case VIR_DOMAIN_SCHED_FIELD_BOOLEAN:
988 v2 = caml_alloc (1, 5);
989 Store_field (v2, 0, Val_int (params[i].value.b));
992 caml_failwith ((char *)__FUNCTION__);
994 Store_field (v, 1, v2);
998 NOT_SUPPORTED ("virDomainGetSchedulerParameters");
1003 ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv)
1005 #ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS
1006 CAMLparam2 (domv, paramsv);
1008 virDomainPtr dom = Domain_val (domv);
1009 virConnectPtr conn = Connect_domv (domv);
1010 int nparams = Wosize_val (paramsv);
1011 virSchedParameter params[nparams];
1015 for (i = 0; i < nparams; ++i) {
1016 v = Field (paramsv, i); /* Points to the two-element tuple. */
1017 name = String_val (Field (v, 0));
1018 strncpy (params[i].field, name, VIR_DOMAIN_SCHED_FIELD_LENGTH);
1019 params[i].field[VIR_DOMAIN_SCHED_FIELD_LENGTH-1] = '\0';
1020 v = Field (v, 1); /* Points to the sched_param_value block. */
1021 switch (Tag_val (v)) {
1023 params[i].type = VIR_DOMAIN_SCHED_FIELD_INT;
1024 params[i].value.i = Int32_val (Field (v, 0));
1027 params[i].type = VIR_DOMAIN_SCHED_FIELD_UINT;
1028 params[i].value.ui = Int32_val (Field (v, 0));
1031 params[i].type = VIR_DOMAIN_SCHED_FIELD_LLONG;
1032 params[i].value.l = Int64_val (Field (v, 0));
1035 params[i].type = VIR_DOMAIN_SCHED_FIELD_ULLONG;
1036 params[i].value.ul = Int64_val (Field (v, 0));
1039 params[i].type = VIR_DOMAIN_SCHED_FIELD_DOUBLE;
1040 params[i].value.d = Double_val (Field (v, 0));
1043 params[i].type = VIR_DOMAIN_SCHED_FIELD_BOOLEAN;
1044 params[i].value.b = Int_val (Field (v, 0));
1047 caml_failwith ((char *)__FUNCTION__);
1051 WEAK_SYMBOL_CHECK (virDomainSetSchedulerParameters);
1052 r = virDomainSetSchedulerParameters (dom, params, nparams);
1053 CHECK_ERROR (r == -1, conn, "virDomainSetSchedulerParameters");
1055 CAMLreturn (Val_unit);
1057 NOT_SUPPORTED ("virDomainSetSchedulerParameters");
1062 ocaml_libvirt_domain_define_xml (value connv, value xmlv)
1064 CAMLparam2 (connv, xmlv);
1066 virConnectPtr conn = Connect_val (connv);
1067 char *xml = String_val (xmlv);
1070 r = virDomainDefineXML (conn, xml);
1071 CHECK_ERROR (!r, conn, "virDomainDefineXML");
1073 rv = Val_domain (r, connv);
1078 ocaml_libvirt_domain_undefine (value domv)
1081 virDomainPtr dom = Domain_val (domv);
1082 virConnectPtr conn = Connect_domv (domv);
1085 r = virDomainUndefine (dom);
1086 CHECK_ERROR (r == -1, conn, "virDomainUndefine");
1088 CAMLreturn (Val_unit);
1092 ocaml_libvirt_domain_create (value domv)
1095 virDomainPtr dom = Domain_val (domv);
1096 virConnectPtr conn = Connect_domv (domv);
1099 r = virDomainCreate (dom);
1100 CHECK_ERROR (r == -1, conn, "virDomainCreate");
1102 CAMLreturn (Val_unit);
1106 ocaml_libvirt_domain_get_autostart (value domv)
1109 virDomainPtr dom = Domain_val (domv);
1110 virConnectPtr conn = Connect_domv (domv);
1113 r = virDomainGetAutostart (dom, &autostart);
1114 CHECK_ERROR (r == -1, conn, "virDomainGetAutostart");
1116 CAMLreturn (autostart ? Val_true : Val_false);
1120 ocaml_libvirt_domain_set_autostart (value domv, value autostartv)
1122 CAMLparam2 (domv, autostartv);
1123 virDomainPtr dom = Domain_val (domv);
1124 virConnectPtr conn = Connect_domv (domv);
1125 int r, autostart = autostartv == Val_true ? 1 : 0;
1127 r = virDomainSetAutostart (dom, autostart);
1128 CHECK_ERROR (r == -1, conn, "virDomainSetAutostart");
1130 CAMLreturn (Val_unit);
1134 ocaml_libvirt_domain_set_vcpus (value domv, value nvcpusv)
1136 CAMLparam2 (domv, nvcpusv);
1137 virDomainPtr dom = Domain_val (domv);
1138 virConnectPtr conn = Connect_domv (domv);
1139 int r, nvcpus = Int_val (nvcpusv);
1141 r = virDomainSetVcpus (dom, nvcpus);
1142 CHECK_ERROR (r == -1, conn, "virDomainSetVcpus");
1144 CAMLreturn (Val_unit);
1148 ocaml_libvirt_domain_pin_vcpu (value domv, value vcpuv, value cpumapv)
1150 CAMLparam3 (domv, vcpuv, cpumapv);
1151 virDomainPtr dom = Domain_val (domv);
1152 virConnectPtr conn = Connect_domv (domv);
1153 int maplen = caml_string_length (cpumapv);
1154 unsigned char *cpumap = (unsigned char *) String_val (cpumapv);
1155 int vcpu = Int_val (vcpuv);
1158 r = virDomainPinVcpu (dom, vcpu, cpumap, maplen);
1159 CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
1161 CAMLreturn (Val_unit);
1165 ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv)
1167 CAMLparam3 (domv, maxinfov, maplenv);
1168 CAMLlocal5 (rv, infov, strv, v, v2);
1169 virDomainPtr dom = Domain_val (domv);
1170 virConnectPtr conn = Connect_domv (domv);
1171 int maxinfo = Int_val (maxinfov);
1172 int maplen = Int_val (maplenv);
1173 virVcpuInfo info[maxinfo];
1174 unsigned char cpumaps[maxinfo * maplen];
1177 memset (info, 0, sizeof (virVcpuInfo) * maxinfo);
1178 memset (cpumaps, 0, maxinfo * maplen);
1180 r = virDomainGetVcpus (dom, info, maxinfo, cpumaps, maplen);
1181 CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
1183 /* Copy the virVcpuInfo structures. */
1184 infov = caml_alloc (maxinfo, 0);
1185 for (i = 0; i < maxinfo; ++i) {
1186 v2 = caml_alloc (4, 0); Store_field (infov, i, v2);
1187 Store_field (v2, 0, Val_int (info[i].number));
1188 Store_field (v2, 1, Val_int (info[i].state));
1189 v = caml_copy_int64 (info[i].cpuTime); Store_field (v2, 2, v);
1190 Store_field (v2, 3, Val_int (info[i].cpu));
1193 /* Copy the bitmap. */
1194 strv = caml_alloc_string (maxinfo * maplen);
1195 memcpy (String_val (strv), cpumaps, maxinfo * maplen);
1197 /* Allocate the tuple and return it. */
1198 rv = caml_alloc_tuple (3);
1199 Store_field (rv, 0, Val_int (r)); /* number of CPUs. */
1200 Store_field (rv, 1, infov);
1201 Store_field (rv, 2, strv);
1207 ocaml_libvirt_domain_get_max_vcpus (value domv)
1210 virDomainPtr dom = Domain_val (domv);
1211 virConnectPtr conn = Connect_domv (domv);
1214 r = virDomainGetMaxVcpus (dom);
1215 CHECK_ERROR (r == -1, conn, "virDomainGetMaxVcpus");
1217 CAMLreturn (Val_int (r));
1221 ocaml_libvirt_domain_attach_device (value domv, value xmlv)
1223 CAMLparam2 (domv, xmlv);
1224 virDomainPtr dom = Domain_val (domv);
1225 virConnectPtr conn = Connect_domv (domv);
1226 char *xml = String_val (xmlv);
1229 r = virDomainAttachDevice (dom, xml);
1230 CHECK_ERROR (r == -1, conn, "virDomainAttachDevice");
1232 CAMLreturn (Val_unit);
1236 ocaml_libvirt_domain_detach_device (value domv, value xmlv)
1238 CAMLparam2 (domv, xmlv);
1239 virDomainPtr dom = Domain_val (domv);
1240 virConnectPtr conn = Connect_domv (domv);
1241 char *xml = String_val (xmlv);
1244 r = virDomainDetachDevice (dom, xml);
1245 CHECK_ERROR (r == -1, conn, "virDomainDetachDevice");
1247 CAMLreturn (Val_unit);
1251 ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, value optdnamev, value opturiv, value optbandwidthv, value unitv)
1253 #ifdef HAVE_VIRDOMAINMIGRATE
1254 CAMLparam5 (domv, dconnv, flagsv, optdnamev, opturiv);
1255 CAMLxparam2 (optbandwidthv, unitv);
1256 CAMLlocal2 (flagv, rv);
1257 virDomainPtr dom = Domain_val (domv);
1258 virConnectPtr conn = Connect_domv (domv);
1259 virConnectPtr dconn = Connect_val (dconnv);
1261 const char *dname = Optstring_val (optdnamev);
1262 const char *uri = Optstring_val (opturiv);
1263 unsigned long bandwidth;
1266 /* Iterate over the list of flags. */
1267 for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
1269 flagv = Field (flagsv, 0);
1270 if (flagv == Int_val(0))
1271 flags |= VIR_MIGRATE_LIVE;
1274 if (optbandwidthv == Val_int (0)) /* None */
1276 else /* Some bandwidth */
1277 bandwidth = Int_val (Field (optbandwidthv, 0));
1279 WEAK_SYMBOL_CHECK (virDomainMigrate);
1280 r = virDomainMigrate (dom, dconn, flags, dname, uri, bandwidth);
1281 CHECK_ERROR (!r, conn, "virDomainMigrate");
1283 rv = Val_domain (r, dconnv);
1287 #else /* virDomainMigrate not supported */
1288 NOT_SUPPORTED ("virDomainMigrate");
1293 ocaml_libvirt_domain_migrate_bytecode (value *argv, int argn)
1295 return ocaml_libvirt_domain_migrate_native (argv[0], argv[1], argv[2],
1296 argv[3], argv[4], argv[5],
1301 ocaml_libvirt_domain_block_stats (value domv, value pathv)
1303 #if HAVE_VIRDOMAINBLOCKSTATS
1304 CAMLparam2 (domv, pathv);
1306 virDomainPtr dom = Domain_val (domv);
1307 virConnectPtr conn = Connect_domv (domv);
1308 char *path = String_val (pathv);
1309 struct _virDomainBlockStats stats;
1312 WEAK_SYMBOL_CHECK (virDomainBlockStats);
1313 r = virDomainBlockStats (dom, path, &stats, sizeof stats);
1314 CHECK_ERROR (r == -1, conn, "virDomainBlockStats");
1316 rv = caml_alloc (5, 0);
1317 v = caml_copy_int64 (stats.rd_req); Store_field (rv, 0, v);
1318 v = caml_copy_int64 (stats.rd_bytes); Store_field (rv, 1, v);
1319 v = caml_copy_int64 (stats.wr_req); Store_field (rv, 2, v);
1320 v = caml_copy_int64 (stats.wr_bytes); Store_field (rv, 3, v);
1321 v = caml_copy_int64 (stats.errs); Store_field (rv, 4, v);
1325 NOT_SUPPORTED ("virDomainBlockStats");
1330 ocaml_libvirt_domain_interface_stats (value domv, value pathv)
1332 #if HAVE_VIRDOMAININTERFACESTATS
1333 CAMLparam2 (domv, pathv);
1335 virDomainPtr dom = Domain_val (domv);
1336 virConnectPtr conn = Connect_domv (domv);
1337 char *path = String_val (pathv);
1338 struct _virDomainInterfaceStats stats;
1341 WEAK_SYMBOL_CHECK (virDomainInterfaceStats);
1342 r = virDomainInterfaceStats (dom, path, &stats, sizeof stats);
1343 CHECK_ERROR (r == -1, conn, "virDomainInterfaceStats");
1345 rv = caml_alloc (8, 0);
1346 v = caml_copy_int64 (stats.rx_bytes); Store_field (rv, 0, v);
1347 v = caml_copy_int64 (stats.rx_packets); Store_field (rv, 1, v);
1348 v = caml_copy_int64 (stats.rx_errs); Store_field (rv, 2, v);
1349 v = caml_copy_int64 (stats.rx_drop); Store_field (rv, 3, v);
1350 v = caml_copy_int64 (stats.tx_bytes); Store_field (rv, 4, v);
1351 v = caml_copy_int64 (stats.tx_packets); Store_field (rv, 5, v);
1352 v = caml_copy_int64 (stats.tx_errs); Store_field (rv, 6, v);
1353 v = caml_copy_int64 (stats.tx_drop); Store_field (rv, 7, v);
1357 NOT_SUPPORTED ("virDomainInterfaceStats");
1362 ocaml_libvirt_network_lookup_by_name (value connv, value namev)
1364 CAMLparam2 (connv, namev);
1366 virConnectPtr conn = Connect_val (connv);
1367 char *name = String_val (namev);
1370 r = virNetworkLookupByName (conn, name);
1371 CHECK_ERROR (!r, conn, "virNetworkLookupByName");
1373 rv = Val_network (r, connv);
1378 ocaml_libvirt_network_lookup_by_uuid (value connv, value uuidv)
1380 CAMLparam2 (connv, uuidv);
1382 virConnectPtr conn = Connect_val (connv);
1383 char *uuid = String_val (uuidv);
1386 r = virNetworkLookupByUUID (conn, (unsigned char *) uuid);
1387 CHECK_ERROR (!r, conn, "virNetworkLookupByUUID");
1389 rv = Val_network (r, connv);
1394 ocaml_libvirt_network_lookup_by_uuid_string (value connv, value uuidv)
1396 CAMLparam2 (connv, uuidv);
1398 virConnectPtr conn = Connect_val (connv);
1399 char *uuid = String_val (uuidv);
1402 r = virNetworkLookupByUUIDString (conn, uuid);
1403 CHECK_ERROR (!r, conn, "virNetworkLookupByUUIDString");
1405 rv = Val_network (r, connv);
1410 ocaml_libvirt_network_create_xml (value connv, value xmlv)
1412 CAMLparam2 (connv, xmlv);
1414 virConnectPtr conn = Connect_val (connv);
1415 char *xml = String_val (xmlv);
1418 r = virNetworkCreateXML (conn, xml);
1419 CHECK_ERROR (!r, conn, "virNetworkCreateXML");
1421 rv = Val_network (r, connv);
1426 ocaml_libvirt_network_define_xml (value connv, value xmlv)
1428 CAMLparam2 (connv, xmlv);
1430 virConnectPtr conn = Connect_val (connv);
1431 char *xml = String_val (xmlv);
1434 r = virNetworkDefineXML (conn, xml);
1435 CHECK_ERROR (!r, conn, "virNetworkDefineXML");
1437 rv = Val_network (r, connv);
1442 ocaml_libvirt_network_undefine (value netv)
1445 virNetworkPtr net = Network_val (netv);
1446 virConnectPtr conn = Connect_netv (netv);
1449 r = virNetworkUndefine (net);
1450 CHECK_ERROR (r == -1, conn, "virNetworkUndefine");
1452 CAMLreturn (Val_unit);
1456 ocaml_libvirt_network_create (value netv)
1459 virNetworkPtr net = Network_val (netv);
1460 virConnectPtr conn = Connect_netv (netv);
1463 r = virNetworkCreate (net);
1464 CHECK_ERROR (r == -1, conn, "virNetworkCreate");
1466 CAMLreturn (Val_unit);
1470 ocaml_libvirt_network_destroy (value netv)
1473 virNetworkPtr net = Network_val (netv);
1474 virConnectPtr conn = Connect_netv (netv);
1477 r = virNetworkDestroy (net);
1478 CHECK_ERROR (r == -1, conn, "virNetworkDestroy");
1480 /* So that we don't double-free in the finalizer: */
1481 Network_val (netv) = NULL;
1483 CAMLreturn (Val_unit);
1487 ocaml_libvirt_network_free (value netv)
1490 virNetworkPtr net = Network_val (netv);
1491 virConnectPtr conn = Connect_netv (netv);
1494 r = virNetworkFree (net);
1495 CHECK_ERROR (r == -1, conn, "virNetworkFree");
1497 /* So that we don't double-free in the finalizer: */
1498 Network_val (netv) = NULL;
1500 CAMLreturn (Val_unit);
1504 ocaml_libvirt_network_get_name (value netv)
1508 virNetworkPtr net = Network_val (netv);
1509 virConnectPtr conn = Connect_netv (netv);
1512 r = virNetworkGetName (net);
1513 CHECK_ERROR (!r, conn, "virNetworkGetName");
1515 rv = caml_copy_string (r);
1520 ocaml_libvirt_network_get_uuid (value netv)
1524 virNetworkPtr net = Network_val (netv);
1525 virConnectPtr conn = Connect_netv (netv);
1526 unsigned char uuid[VIR_UUID_BUFLEN];
1529 r = virNetworkGetUUID (net, uuid);
1530 CHECK_ERROR (r == -1, conn, "virNetworkGetUUID");
1532 rv = caml_copy_string ((char *) uuid);
1537 ocaml_libvirt_network_get_uuid_string (value netv)
1541 virNetworkPtr net = Network_val (netv);
1542 virConnectPtr conn = Connect_netv (netv);
1543 char uuid[VIR_UUID_STRING_BUFLEN];
1546 r = virNetworkGetUUIDString (net, uuid);
1547 CHECK_ERROR (r == -1, conn, "virNetworkGetUUIDString");
1549 rv = caml_copy_string (uuid);
1554 ocaml_libvirt_network_get_xml_desc (value netv)
1558 virNetworkPtr net = Network_val (netv);
1559 virConnectPtr conn = Connect_netv (netv);
1562 r = virNetworkGetXMLDesc (net, 0);
1563 CHECK_ERROR (!r, conn, "virNetworkGetXMLDesc");
1565 rv = caml_copy_string (r);
1571 ocaml_libvirt_network_get_bridge_name (value netv)
1575 virNetworkPtr net = Network_val (netv);
1576 virConnectPtr conn = Connect_netv (netv);
1579 r = virNetworkGetBridgeName (net);
1580 CHECK_ERROR (!r, conn, "virNetworkGetBridgeName");
1582 rv = caml_copy_string (r);
1588 ocaml_libvirt_network_get_autostart (value netv)
1591 virNetworkPtr net = Network_val (netv);
1592 virConnectPtr conn = Connect_netv (netv);
1595 r = virNetworkGetAutostart (net, &autostart);
1596 CHECK_ERROR (r == -1, conn, "virNetworkGetAutostart");
1598 CAMLreturn (autostart ? Val_true : Val_false);
1602 ocaml_libvirt_network_set_autostart (value netv, value autostartv)
1604 CAMLparam2 (netv, autostartv);
1605 virNetworkPtr net = Network_val (netv);
1606 virConnectPtr conn = Connect_netv (netv);
1607 int r, autostart = autostartv == Val_true ? 1 : 0;
1609 r = virNetworkSetAutostart (net, autostart);
1610 CHECK_ERROR (r == -1, conn, "virNetworkSetAutostart");
1612 CAMLreturn (Val_unit);
1615 /*----------------------------------------------------------------------*/
1618 ocaml_libvirt_virterror_get_last_error (value unitv)
1622 virErrorPtr err = virGetLastError ();
1624 rv = Val_opt (err, (Val_ptr_t) Val_virterror);
1630 ocaml_libvirt_virterror_get_last_conn_error (value connv)
1634 virConnectPtr conn = Connect_val (connv);
1636 rv = Val_opt (conn, (Val_ptr_t) Val_connect);
1642 ocaml_libvirt_virterror_reset_last_error (value unitv)
1645 virResetLastError ();
1646 CAMLreturn (Val_unit);
1650 ocaml_libvirt_virterror_reset_last_conn_error (value connv)
1653 virConnectPtr conn = Connect_val (connv);
1654 virConnResetLastError (conn);
1655 CAMLreturn (Val_unit);
1658 /*----------------------------------------------------------------------*/
1660 /* Initialise the library. */
1662 ocaml_libvirt_init (value unit)
1668 r = virInitialize ();
1669 CHECK_ERROR (r == -1, NULL, "virInitialize");
1671 CAMLreturn (Val_unit);
1674 /*----------------------------------------------------------------------*/
1677 Optstring_val (value strv)
1679 if (strv == Val_int (0)) /* None */
1681 else /* Some string */
1682 return String_val (Field (strv, 0));
1686 Val_opt (void *ptr, Val_ptr_t Val_ptr)
1689 CAMLlocal2 (optv, ptrv);
1691 if (ptr) { /* Some ptr */
1692 optv = caml_alloc (1, 0);
1693 ptrv = Val_ptr (ptr);
1694 Store_field (optv, 0, ptrv);
1703 option_default (value option, value deflt)
1705 if (option == Val_int (0)) /* "None" */
1707 else /* "Some 'a" */
1708 return Field (option, 0);
1713 _raise_virterror (virConnectPtr conn, const char *fn)
1718 struct _virError err;
1720 errp = conn ? virConnGetLastError (conn) : virGetLastError ();
1723 /* Fake a _virError structure. */
1724 memset (&err, 0, sizeof err);
1725 err.code = VIR_ERR_INTERNAL_ERROR;
1726 err.domain = VIR_FROM_NONE;
1727 err.level = VIR_ERR_ERROR;
1728 err.message = (char *) fn;
1732 rv = Val_virterror (errp);
1733 caml_raise_with_arg (*caml_named_value ("ocaml_libvirt_virterror"), rv);
1736 CAMLreturn (Val_unit);
1740 Val_virterror (virErrorPtr err)
1743 CAMLlocal3 (rv, connv, optv);
1745 rv = caml_alloc (12, 0);
1746 Store_field (rv, 0, Val_int (err->code));
1747 Store_field (rv, 1, Val_int (err->domain));
1749 Val_opt (err->message, (Val_ptr_t) caml_copy_string));
1750 Store_field (rv, 3, Val_int (err->level));
1752 /* conn, dom and net fields, all optional */
1754 connv = Val_connect_no_finalize (err->conn);
1755 optv = caml_alloc (1, 0);
1756 Store_field (optv, 0, connv);
1757 Store_field (rv, 4, optv); /* Some conn */
1760 optv = caml_alloc (1, 0);
1761 Store_field (optv, 0, Val_domain_no_finalize (err->dom, connv));
1762 Store_field (rv, 5, optv); /* Some (dom, conn) */
1765 Store_field (rv, 5, Val_int (0)); /* None */
1767 optv = caml_alloc (1, 0);
1768 Store_field (optv, 0, Val_network_no_finalize (err->net, connv));
1769 Store_field (rv, 11, optv); /* Some (net, conn) */
1771 Store_field (rv, 11, Val_int (0)); /* None */
1773 Store_field (rv, 4, Val_int (0)); /* None */
1774 Store_field (rv, 5, Val_int (0)); /* None */
1775 Store_field (rv, 11, Val_int (0)); /* None */
1779 Val_opt (err->str1, (Val_ptr_t) caml_copy_string));
1781 Val_opt (err->str2, (Val_ptr_t) caml_copy_string));
1783 Val_opt (err->str3, (Val_ptr_t) caml_copy_string));
1784 Store_field (rv, 9, caml_copy_int32 (err->int1));
1785 Store_field (rv, 10, caml_copy_int32 (err->int2));
1790 static void conn_finalize (value);
1791 static void dom_finalize (value);
1792 static void net_finalize (value);
1794 static struct custom_operations conn_custom_operations = {
1795 "conn_custom_operations",
1797 custom_compare_default,
1798 custom_hash_default,
1799 custom_serialize_default,
1800 custom_deserialize_default
1803 static struct custom_operations dom_custom_operations = {
1804 "dom_custom_operations",
1806 custom_compare_default,
1807 custom_hash_default,
1808 custom_serialize_default,
1809 custom_deserialize_default
1813 static struct custom_operations net_custom_operations = {
1814 "net_custom_operations",
1816 custom_compare_default,
1817 custom_hash_default,
1818 custom_serialize_default,
1819 custom_deserialize_default
1823 Val_connect (virConnectPtr conn)
1827 rv = caml_alloc_custom (&conn_custom_operations,
1828 sizeof (virConnectPtr), 0, 1);
1829 Connect_val (rv) = conn;
1833 /* This wraps up the raw domain handle (Domain.dom). */
1835 Val_dom (virDomainPtr dom)
1839 rv = caml_alloc_custom (&dom_custom_operations,
1840 sizeof (virDomainPtr), 0, 1);
1845 /* This wraps up the raw network handle (Network.net). */
1847 Val_net (virNetworkPtr net)
1851 rv = caml_alloc_custom (&net_custom_operations,
1852 sizeof (virNetworkPtr), 0, 1);
1857 /* No-finalize versions of Val_connect, Val_dom, Val_net ONLY for use
1858 * by virterror wrappers.
1861 Val_connect_no_finalize (virConnectPtr conn)
1865 rv = caml_alloc (1, Abstract_tag);
1866 Store_field (rv, 0, (value) conn);
1871 Val_dom_no_finalize (virDomainPtr dom)
1875 rv = caml_alloc (1, Abstract_tag);
1876 Store_field (rv, 0, (value) dom);
1881 Val_net_no_finalize (virNetworkPtr net)
1885 rv = caml_alloc (1, Abstract_tag);
1886 Store_field (rv, 0, (value) net);
1890 /* This wraps up the (dom, conn) pair (Domain.t). */
1892 Val_domain (virDomainPtr dom, value connv)
1897 rv = caml_alloc_tuple (2);
1899 Store_field (rv, 0, v);
1900 Store_field (rv, 1, connv);
1904 /* This wraps up the (net, conn) pair (Network.t). */
1906 Val_network (virNetworkPtr net, value connv)
1911 rv = caml_alloc_tuple (2);
1913 Store_field (rv, 0, v);
1914 Store_field (rv, 1, connv);
1918 /* No-finalize versions of Val_domain, Val_network ONLY for use by
1919 * virterror wrappers.
1922 Val_domain_no_finalize (virDomainPtr dom, value connv)
1927 rv = caml_alloc_tuple (2);
1928 v = Val_dom_no_finalize (dom);
1929 Store_field (rv, 0, v);
1930 Store_field (rv, 1, connv);
1935 Val_network_no_finalize (virNetworkPtr net, value connv)
1940 rv = caml_alloc_tuple (2);
1941 v = Val_net_no_finalize (net);
1942 Store_field (rv, 0, v);
1943 Store_field (rv, 1, connv);
1948 conn_finalize (value connv)
1950 virConnectPtr conn = Connect_val (connv);
1951 if (conn) (void) virConnectClose (conn);
1955 dom_finalize (value domv)
1957 virDomainPtr dom = Dom_val (domv);
1958 if (dom) (void) virDomainFree (dom);
1962 net_finalize (value netv)
1964 virNetworkPtr net = Net_val (netv);
1965 if (net) (void) virNetworkFree (net);