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 * Please see the file ../COPYING.LIB.
18 /* Please read libvirt/README file. */
20 static char *Optstring_val (value strv);
21 typedef value (*Val_ptr_t) (void *);
22 static value Val_opt (void *ptr, Val_ptr_t Val_ptr);
23 /*static value option_default (value option, value deflt);*/
24 static void _raise_virterror (virConnectPtr conn, const char *fn) Noreturn;
25 static void not_supported (const char *fn) Noreturn;
26 static value Val_virterror (virErrorPtr err);
28 /* Use this around synchronous libvirt API calls to release the OCaml
29 * lock, allowing other threads to run simultaneously. 'code' must not
30 * perform any caml_* calls, run any OCaml code, or raise any exception.
31 * http://web.archive.org/web/20030521020915/http://caml.inria.fr/archives/200106/msg00199.html
33 #define NONBLOCKING(code) \
35 caml_enter_blocking_section (); \
37 caml_leave_blocking_section (); \
40 /* Check error condition from a libvirt function, and automatically raise
41 * an exception if one is found.
43 #define CHECK_ERROR(cond, conn, fn) \
44 do { if (cond) _raise_virterror (conn, fn); } while (0)
46 /* For more about weak symbols, see:
47 * http://kolpackov.net/pipermail/notes/2004-March/000006.html
48 * We are using this to do runtime detection of library functions
49 * so that if we dynamically link with an older version of
50 * libvirt than we were compiled against, it won't fail (provided
51 * libvirt >= 0.2.1 - we don't support anything older).
55 #if (__GNUC__ == 3 && __GNUC_MINOR__ >= 3) || (__GNUC__ > 3)
56 #define HAVE_WEAK_SYMBOLS 1
61 #ifdef HAVE_WEAK_SYMBOLS
62 #define WEAK_SYMBOL_CHECK(sym) \
63 do { if (!sym) not_supported(#sym); } while (0)
65 #define WEAK_SYMBOL_CHECK(sym)
66 #endif /* HAVE_WEAK_SYMBOLS */
68 /*----------------------------------------------------------------------*/
70 /* Some notes about the use of custom blocks to store virConnectPtr,
71 * virDomainPtr and virNetworkPtr.
72 *------------------------------------------------------------------
74 * Libvirt does some tricky reference counting to keep track of
75 * virConnectPtr's, virDomainPtr's and virNetworkPtr's.
77 * There is only one function which can return a virConnectPtr
78 * (virConnectOpen*) and that allocates a new one each time.
80 * virDomainPtr/virNetworkPtr's on the other hand can be returned
81 * repeatedly (for the same underlying domain/network), and we must
82 * keep track of each one and explicitly free it with virDomainFree
83 * or virNetworkFree. If we lose track of one then the reference
84 * counting in libvirt will keep it open. We therefore wrap these
85 * in a custom block with a finalizer function.
87 * We also have to allow the user to explicitly free them, in
88 * which case we set the pointer inside the custom block to NULL.
89 * The finalizer notices this and doesn't free the object.
91 * Domains and networks "belong to" a connection. We have to avoid
92 * the situation like this:
94 * let conn = Connect.open ... in
95 * let dom = Domain.lookup_by_id conn 0 in
96 * (* conn goes out of scope and is garbage collected *)
97 * printf "dom name = %s\n" (Domain.get_name dom)
99 * The reason is that when conn is garbage collected, virConnectClose
100 * is called and any subsequent operations on dom will fail (in fact
101 * will probably segfault). To stop this from happening, the OCaml
102 * wrappers store domains (and networks) as explicit (dom, conn)
105 * Update 2008/01: Storage pools and volumes work the same way as
106 * domains and networks. And jobs.
109 /* Unwrap a custom block. */
110 #define Connect_val(rv) (*((virConnectPtr *)Data_custom_val(rv)))
111 #define Dom_val(rv) (*((virDomainPtr *)Data_custom_val(rv)))
112 #define Net_val(rv) (*((virNetworkPtr *)Data_custom_val(rv)))
113 #ifdef HAVE_VIRSTORAGEPOOLPTR
114 #define Pol_val(rv) (*((virStoragePoolPtr *)Data_custom_val(rv)))
116 #ifdef HAVE_VIRSTORAGEVOLPTR
117 #define Vol_val(rv) (*((virStorageVolPtr *)Data_custom_val(rv)))
119 #ifdef HAVE_VIRJOBPTR
120 #define Jb_val(rv) (*((virJobPtr *)Data_custom_val(rv)))
123 /* Wrap up a pointer to something in a custom block. */
124 static value Val_connect (virConnectPtr conn);
125 static value Val_dom (virDomainPtr dom);
126 static value Val_net (virNetworkPtr net);
127 #ifdef HAVE_VIRSTORAGEPOOLPTR
128 static value Val_pol (virStoragePoolPtr pool);
130 #ifdef HAVE_VIRSTORAGEVOLPTR
131 static value Val_vol (virStorageVolPtr vol);
133 #ifdef HAVE_VIRJOBPTR
134 static value Val_jb (virJobPtr jb);
137 /* Domains and networks are stored as pairs (dom/net, conn), so have
138 * some convenience functions for unwrapping and wrapping them.
140 #define Domain_val(rv) (Dom_val(Field((rv),0)))
141 #define Network_val(rv) (Net_val(Field((rv),0)))
142 #ifdef HAVE_VIRSTORAGEPOOLPTR
143 #define Pool_val(rv) (Pol_val(Field((rv),0)))
145 #ifdef HAVE_VIRSTORAGEVOLPTR
146 #define Volume_val(rv) (Vol_val(Field((rv),0)))
148 #ifdef HAVE_VIRJOBPTR
149 #define Job_val(rv) (Jb_val(Field((rv),0)))
151 #define Connect_domv(rv) (Connect_val(Field((rv),1)))
152 #define Connect_netv(rv) (Connect_val(Field((rv),1)))
153 #ifdef HAVE_VIRSTORAGEPOOLPTR
154 #define Connect_polv(rv) (Connect_val(Field((rv),1)))
156 #ifdef HAVE_VIRSTORAGEVOLPTR
157 #define Connect_volv(rv) (Connect_val(Field((rv),1)))
159 #ifdef HAVE_VIRJOBPTR
160 #define Connect_jobv(rv) (Connect_val(Field((rv),1)))
163 static value Val_domain (virDomainPtr dom, value connv);
164 static value Val_network (virNetworkPtr net, value connv);
165 #ifdef HAVE_VIRSTORAGEPOOLPTR
166 static value Val_pool (virStoragePoolPtr pol, value connv);
168 #ifdef HAVE_VIRSTORAGEVOLPTR
169 static value Val_volume (virStorageVolPtr vol, value connv);
171 #ifdef HAVE_VIRJOBPTR
172 static value Val_job (virJobPtr jb, value connv);