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. */
24 Optstring_val (value strv)
26 if (strv == Val_int (0)) /* None */
28 else /* Some string */
29 return String_val (Field (strv, 0));
33 Val_opt (void *ptr, Val_ptr_t Val_ptr)
36 CAMLlocal2 (optv, ptrv);
38 if (ptr) { /* Some ptr */
39 optv = caml_alloc (1, 0);
41 Store_field (optv, 0, ptrv);
49 Val_opt_const (const void *ptr, Val_const_ptr_t Val_ptr)
52 CAMLlocal2 (optv, ptrv);
54 if (ptr) { /* Some ptr */
55 optv = caml_alloc (1, 0);
57 Store_field (optv, 0, ptrv);
66 option_default (value option, value deflt)
68 if (option == Val_int (0)) /* "None" */
71 return Field (option, 0);
76 _raise_virterror (const char *fn)
83 errp = virGetLastError ();
86 /* Fake a _virError structure. */
87 memset (&err, 0, sizeof err);
88 err.code = VIR_ERR_INTERNAL_ERROR;
89 err.domain = VIR_FROM_NONE;
90 err.level = VIR_ERR_ERROR;
91 err.message = (char *) fn;
95 rv = Val_virterror (errp);
96 caml_raise_with_arg (*caml_named_value ("ocaml_libvirt_virterror"), rv);
99 /* Suppresses a compiler warning. */
104 _list_length (value listv)
109 for (; listv != Val_emptylist; listv = Field (listv, 1), ++len) {}
111 CAMLreturnT (int, len);
115 Val_virconnectcredential (const virConnectCredentialPtr cred)
120 rv = caml_alloc (4, 0);
121 Store_field (rv, 0, Val_int (cred->type - 1));
122 Store_field (rv, 1, caml_copy_string (cred->prompt));
124 Val_opt_const (cred->challenge,
125 (Val_const_ptr_t) caml_copy_string));
127 Val_opt_const (cred->defresult,
128 (Val_const_ptr_t) caml_copy_string));
133 /* Convert the virErrorNumber, virErrorDomain and virErrorLevel enums
134 * into values (longs because they are variants in OCaml).
136 * The enum values are part of the libvirt ABI so they cannot change,
137 * which means that we can convert these numbers directly into
138 * OCaml variants (which use the same ordering) very fast.
140 * The tricky part here is when we are linked to a newer version of
141 * libvirt than the one we were compiled against. If the newer libvirt
142 * generates an error code which we don't know about then we need
143 * to convert it into VIR_*_UNKNOWN (code).
146 #define MAX_VIR_CODE 101 /* VIR_ERR_NO_NWFILTER_BINDING */
147 #define MAX_VIR_DOMAIN 67 /* VIR_FROM_RESCTRL */
148 #define MAX_VIR_LEVEL VIR_ERR_ERROR
151 Val_err_number (virErrorNumber code)
156 if (0 <= code && code <= MAX_VIR_CODE)
159 rv = caml_alloc (1, 0); /* VIR_ERR_UNKNOWN (code) */
160 Store_field (rv, 0, Val_int (code));
167 Val_err_domain (virErrorDomain code)
172 if (0 <= code && code <= MAX_VIR_DOMAIN)
175 rv = caml_alloc (1, 0); /* VIR_FROM_UNKNOWN (code) */
176 Store_field (rv, 0, Val_int (code));
183 Val_err_level (virErrorLevel code)
188 if (0 <= code && code <= MAX_VIR_LEVEL)
191 rv = caml_alloc (1, 0); /* VIR_ERR_UNKNOWN_LEVEL (code) */
192 Store_field (rv, 0, Val_int (code));
198 /* Convert a virterror to a value. */
200 Val_virterror (virErrorPtr err)
203 CAMLlocal3 (rv, connv, optv);
205 rv = caml_alloc (9, 0);
206 Store_field (rv, 0, Val_err_number (err->code));
207 Store_field (rv, 1, Val_err_domain (err->domain));
209 Val_opt (err->message, (Val_ptr_t) caml_copy_string));
210 Store_field (rv, 3, Val_err_level (err->level));
213 Val_opt (err->str1, (Val_ptr_t) caml_copy_string));
215 Val_opt (err->str2, (Val_ptr_t) caml_copy_string));
217 Val_opt (err->str3, (Val_ptr_t) caml_copy_string));
218 Store_field (rv, 7, caml_copy_int32 (err->int1));
219 Store_field (rv, 8, caml_copy_int32 (err->int2));
224 static void conn_finalize (value);
225 static void dom_finalize (value);
226 static void net_finalize (value);
227 static void pol_finalize (value);
228 static void vol_finalize (value);
229 static void sec_finalize (value);
231 static struct custom_operations conn_custom_operations = {
232 (char *) "conn_custom_operations",
234 custom_compare_default,
236 custom_serialize_default,
237 custom_deserialize_default
240 static struct custom_operations dom_custom_operations = {
241 (char *) "dom_custom_operations",
243 custom_compare_default,
245 custom_serialize_default,
246 custom_deserialize_default
250 static struct custom_operations net_custom_operations = {
251 (char *) "net_custom_operations",
253 custom_compare_default,
255 custom_serialize_default,
256 custom_deserialize_default
259 static struct custom_operations pol_custom_operations = {
260 (char *) "pol_custom_operations",
262 custom_compare_default,
264 custom_serialize_default,
265 custom_deserialize_default
268 static struct custom_operations vol_custom_operations = {
269 (char *) "vol_custom_operations",
271 custom_compare_default,
273 custom_serialize_default,
274 custom_deserialize_default
277 static struct custom_operations sec_custom_operations = {
278 (char *) "sec_custom_operations",
280 custom_compare_default,
282 custom_serialize_default,
283 custom_deserialize_default
287 Val_connect (virConnectPtr conn)
291 rv = caml_alloc_custom (&conn_custom_operations,
292 sizeof (virConnectPtr), 0, 1);
293 Connect_val (rv) = conn;
298 Val_dom (virDomainPtr dom)
302 rv = caml_alloc_custom (&dom_custom_operations,
303 sizeof (virDomainPtr), 0, 1);
309 Val_net (virNetworkPtr net)
313 rv = caml_alloc_custom (&net_custom_operations,
314 sizeof (virNetworkPtr), 0, 1);
320 Val_pol (virStoragePoolPtr pol)
324 rv = caml_alloc_custom (&pol_custom_operations,
325 sizeof (virStoragePoolPtr), 0, 1);
331 Val_vol (virStorageVolPtr vol)
335 rv = caml_alloc_custom (&vol_custom_operations,
336 sizeof (virStorageVolPtr), 0, 1);
342 Val_sec (virSecretPtr sec)
346 rv = caml_alloc_custom (&sec_custom_operations,
347 sizeof (virSecretPtr), 0, 1);
352 /* This wraps up the (dom, conn) pair (Domain.t). */
354 Val_domain (virDomainPtr dom, value connv)
359 rv = caml_alloc_tuple (2);
361 Store_field (rv, 0, v);
362 Store_field (rv, 1, connv);
366 /* This wraps up the (net, conn) pair (Network.t). */
368 Val_network (virNetworkPtr net, value connv)
373 rv = caml_alloc_tuple (2);
375 Store_field (rv, 0, v);
376 Store_field (rv, 1, connv);
380 /* This wraps up the (pol, conn) pair (Pool.t). */
382 Val_pool (virStoragePoolPtr pol, value connv)
387 rv = caml_alloc_tuple (2);
389 Store_field (rv, 0, v);
390 Store_field (rv, 1, connv);
394 /* This wraps up the (vol, conn) pair (Volume.t). */
396 Val_volume (virStorageVolPtr vol, value connv)
401 rv = caml_alloc_tuple (2);
403 Store_field (rv, 0, v);
404 Store_field (rv, 1, connv);
408 /* This wraps up the (sec, conn) pair (Secret.t). */
410 Val_secret (virSecretPtr sec, value connv)
415 rv = caml_alloc_tuple (2);
417 Store_field (rv, 0, v);
418 Store_field (rv, 1, connv);
423 conn_finalize (value connv)
425 virConnectPtr conn = Connect_val (connv);
426 if (conn) (void) virConnectClose (conn);
430 dom_finalize (value domv)
432 virDomainPtr dom = Dom_val (domv);
433 if (dom) (void) virDomainFree (dom);
437 net_finalize (value netv)
439 virNetworkPtr net = Net_val (netv);
440 if (net) (void) virNetworkFree (net);
444 pol_finalize (value polv)
446 virStoragePoolPtr pol = Pol_val (polv);
447 if (pol) (void) virStoragePoolFree (pol);
451 vol_finalize (value volv)
453 virStorageVolPtr vol = Vol_val (volv);
454 if (vol) (void) virStorageVolFree (vol);
458 sec_finalize (value secv)
460 virSecretPtr sec = Sec_val (secv);
461 if (sec) (void) virSecretFree (sec);