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,
9 * with the OCaml linking exception described in ../COPYING.LIB.
11 * This library is distributed in the hope that it will be useful,
12 * but WITHOUT ANY WARRANTY; without even the implied warranty of
13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 * Lesser General Public License for more details.
16 * You should have received a copy of the GNU Lesser General Public
17 * License along with this library; if not, write to the Free Software
18 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
21 /* Please read libvirt/README file. */
23 static char *Optstring_val (value strv);
24 typedef value (*Val_ptr_t) (void *);
25 static value Val_opt (void *ptr, Val_ptr_t Val_ptr);
26 typedef value (*Val_const_ptr_t) (const void *);
27 static value Val_opt_const (const void *ptr, Val_const_ptr_t Val_ptr);
28 /*static value option_default (value option, value deflt);*/
29 static void _raise_virterror (const char *fn) Noreturn;
30 static value Val_virterror (virErrorPtr err);
31 static int _list_length (value listv);
32 static value Val_virconnectcredential (const virConnectCredentialPtr cred);
34 /* Use this around synchronous libvirt API calls to release the OCaml
35 * lock, allowing other threads to run simultaneously. 'code' must not
36 * perform any caml_* calls, run any OCaml code, or raise any exception.
37 * http://web.archive.org/web/20030521020915/http://caml.inria.fr/archives/200106/msg00199.html
39 #define NONBLOCKING(code) \
41 caml_enter_blocking_section (); \
43 caml_leave_blocking_section (); \
46 /* Empty macro to use as empty parameter for other macros, since
47 * a null token as parameter when calling a macro is not allowed
51 /* Check error condition from a libvirt function, and automatically raise
52 * an exception if one is found.
54 #define CHECK_ERROR_CLEANUP(cond, cleanup, fn) \
55 do { if (cond) { cleanup; _raise_virterror (fn); } } while (0)
56 #define CHECK_ERROR(cond, fn) \
57 CHECK_ERROR_CLEANUP(cond, EMPTY, fn)
59 /*----------------------------------------------------------------------*/
61 /* Some notes about the use of custom blocks to store virConnectPtr,
62 * virDomainPtr and virNetworkPtr.
63 *------------------------------------------------------------------
65 * Libvirt does some tricky reference counting to keep track of
66 * virConnectPtr's, virDomainPtr's and virNetworkPtr's.
68 * There is only one function which can return a virConnectPtr
69 * (virConnectOpen*) and that allocates a new one each time.
71 * virDomainPtr/virNetworkPtr's on the other hand can be returned
72 * repeatedly (for the same underlying domain/network), and we must
73 * keep track of each one and explicitly free it with virDomainFree
74 * or virNetworkFree. If we lose track of one then the reference
75 * counting in libvirt will keep it open. We therefore wrap these
76 * in a custom block with a finalizer function.
78 * We also have to allow the user to explicitly free them, in
79 * which case we set the pointer inside the custom block to NULL.
80 * The finalizer notices this and doesn't free the object.
82 * Domains and networks "belong to" a connection. We have to avoid
83 * the situation like this:
85 * let conn = Connect.open ... in
86 * let dom = Domain.lookup_by_id conn 0 in
87 * (* conn goes out of scope and is garbage collected *)
88 * printf "dom name = %s\n" (Domain.get_name dom)
90 * The reason is that when conn is garbage collected, virConnectClose
91 * is called and any subsequent operations on dom will fail (in fact
92 * will probably segfault). To stop this from happening, the OCaml
93 * wrappers store domains (and networks) as explicit (dom, conn)
96 * Update 2008/01: Storage pools and volumes work the same way as
97 * domains and networks.
100 /* Unwrap a custom block. */
101 #define Connect_val(rv) (*((virConnectPtr *)Data_custom_val(rv)))
102 #define Dom_val(rv) (*((virDomainPtr *)Data_custom_val(rv)))
103 #define Net_val(rv) (*((virNetworkPtr *)Data_custom_val(rv)))
104 #define Pol_val(rv) (*((virStoragePoolPtr *)Data_custom_val(rv)))
105 #define Vol_val(rv) (*((virStorageVolPtr *)Data_custom_val(rv)))
107 /* Wrap up a pointer to something in a custom block. */
108 static value Val_connect (virConnectPtr conn);
109 static value Val_dom (virDomainPtr dom);
110 static value Val_net (virNetworkPtr net);
111 static value Val_pol (virStoragePoolPtr pool);
112 static value Val_vol (virStorageVolPtr vol);
114 /* Domains and networks are stored as pairs (dom/net, conn), so have
115 * some convenience functions for unwrapping and wrapping them.
117 #define Domain_val(rv) (Dom_val(Field((rv),0)))
118 #define Network_val(rv) (Net_val(Field((rv),0)))
119 #define Pool_val(rv) (Pol_val(Field((rv),0)))
120 #define Volume_val(rv) (Vol_val(Field((rv),0)))
121 #define Connect_domv(rv) (Connect_val(Field((rv),1)))
122 #define Connect_netv(rv) (Connect_val(Field((rv),1)))
123 #define Connect_polv(rv) (Connect_val(Field((rv),1)))
124 #define Connect_volv(rv) (Connect_val(Field((rv),1)))
126 static value Val_domain (virDomainPtr dom, value connv);
127 static value Val_network (virNetworkPtr net, value connv);
128 static value Val_pool (virStoragePoolPtr pol, value connv);
129 static value Val_volume (virStorageVolPtr vol, value connv);