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
20 /* Please read libvirt/README file. */
23 Optstring_val (value strv)
25 if (strv == Val_int (0)) /* None */
27 else /* Some string */
28 return String_val (Field (strv, 0));
32 Val_opt (void *ptr, Val_ptr_t Val_ptr)
35 CAMLlocal2 (optv, ptrv);
37 if (ptr) { /* Some ptr */
38 optv = caml_alloc (1, 0);
40 Store_field (optv, 0, ptrv);
49 option_default (value option, value deflt)
51 if (option == Val_int (0)) /* "None" */
54 return Field (option, 0);
59 _raise_virterror (virConnectPtr conn, const char *fn)
66 errp = conn ? virConnGetLastError (conn) : virGetLastError ();
69 /* Fake a _virError structure. */
70 memset (&err, 0, sizeof err);
71 err.code = VIR_ERR_INTERNAL_ERROR;
72 err.domain = VIR_FROM_NONE;
73 err.level = VIR_ERR_ERROR;
74 err.message = (char *) fn;
78 rv = Val_virterror (errp);
79 caml_raise_with_arg (*caml_named_value ("ocaml_libvirt_virterror"), rv);
82 /* Suppresses a compiler warning. */
86 /* Raise an error if a function is not supported. */
88 not_supported (const char *fn)
93 fnv = caml_copy_string (fn);
94 caml_raise_with_arg (*caml_named_value ("ocaml_libvirt_not_supported"), fnv);
97 /* Suppresses a compiler warning. */
101 /* Convert the virErrorNumber, virErrorDomain and virErrorLevel enums
102 * into values (longs because they are variants in OCaml).
104 * The enum values are part of the libvirt ABI so they cannot change,
105 * which means that we can convert these numbers directly into
106 * OCaml variants (which use the same ordering) very fast.
108 * The tricky part here is when we are linked to a newer version of
109 * libvirt than the one we were compiled against. If the newer libvirt
110 * generates an error code which we don't know about then we need
111 * to convert it into VIR_*_UNKNOWN (code).
114 #define MAX_VIR_CODE 50 /* VIR_ERR_NO_STORAGE_VOL */
115 #define MAX_VIR_DOMAIN 17 /* VIR_FROM_STORAGE */
116 #define MAX_VIR_LEVEL VIR_ERR_ERROR
119 Val_err_number (virErrorNumber code)
124 if (0 <= code && code <= MAX_VIR_CODE)
127 rv = caml_alloc (1, 0); /* VIR_ERR_UNKNOWN (code) */
128 Store_field (rv, 0, Val_int (code));
135 Val_err_domain (virErrorDomain code)
140 if (0 <= code && code <= MAX_VIR_DOMAIN)
143 rv = caml_alloc (1, 0); /* VIR_FROM_UNKNOWN (code) */
144 Store_field (rv, 0, Val_int (code));
151 Val_err_level (virErrorLevel code)
156 if (0 <= code && code <= MAX_VIR_LEVEL)
159 rv = caml_alloc (1, 0); /* VIR_ERR_UNKNOWN_LEVEL (code) */
160 Store_field (rv, 0, Val_int (code));
166 /* Convert a virterror to a value. */
168 Val_virterror (virErrorPtr err)
171 CAMLlocal3 (rv, connv, optv);
173 rv = caml_alloc (12, 0);
174 Store_field (rv, 0, Val_err_number (err->code));
175 Store_field (rv, 1, Val_err_domain (err->domain));
177 Val_opt (err->message, (Val_ptr_t) caml_copy_string));
178 Store_field (rv, 3, Val_err_level (err->level));
180 /* conn, dom and net fields, all optional */
182 connv = Val_connect_no_finalize (err->conn);
183 optv = caml_alloc (1, 0);
184 Store_field (optv, 0, connv);
185 Store_field (rv, 4, optv); /* Some conn */
188 optv = caml_alloc (1, 0);
189 Store_field (optv, 0, Val_domain_no_finalize (err->dom, connv));
190 Store_field (rv, 5, optv); /* Some (dom, conn) */
193 Store_field (rv, 5, Val_int (0)); /* None */
195 optv = caml_alloc (1, 0);
196 Store_field (optv, 0, Val_network_no_finalize (err->net, connv));
197 Store_field (rv, 11, optv); /* Some (net, conn) */
199 Store_field (rv, 11, Val_int (0)); /* None */
201 Store_field (rv, 4, Val_int (0)); /* None */
202 Store_field (rv, 5, Val_int (0)); /* None */
203 Store_field (rv, 11, Val_int (0)); /* None */
207 Val_opt (err->str1, (Val_ptr_t) caml_copy_string));
209 Val_opt (err->str2, (Val_ptr_t) caml_copy_string));
211 Val_opt (err->str3, (Val_ptr_t) caml_copy_string));
212 Store_field (rv, 9, caml_copy_int32 (err->int1));
213 Store_field (rv, 10, caml_copy_int32 (err->int2));
218 static void conn_finalize (value);
219 static void dom_finalize (value);
220 static void net_finalize (value);
221 #ifdef HAVE_VIRSTORAGEPOOLPTR
222 static void pol_finalize (value);
224 #ifdef HAVE_VIRSTORAGEVOLPTR
225 static void vol_finalize (value);
227 #ifdef HAVE_VIRJOBPTR
228 static void jb_finalize (value);
231 static struct custom_operations conn_custom_operations = {
232 "conn_custom_operations",
234 custom_compare_default,
236 custom_serialize_default,
237 custom_deserialize_default
240 static struct custom_operations dom_custom_operations = {
241 "dom_custom_operations",
243 custom_compare_default,
245 custom_serialize_default,
246 custom_deserialize_default
250 static struct custom_operations net_custom_operations = {
251 "net_custom_operations",
253 custom_compare_default,
255 custom_serialize_default,
256 custom_deserialize_default
259 #ifdef HAVE_VIRSTORAGEPOOLPTR
260 static struct custom_operations pol_custom_operations = {
261 "pol_custom_operations",
263 custom_compare_default,
265 custom_serialize_default,
266 custom_deserialize_default
270 #ifdef HAVE_VIRSTORAGEVOLPTR
271 static struct custom_operations vol_custom_operations = {
272 "vol_custom_operations",
274 custom_compare_default,
276 custom_serialize_default,
277 custom_deserialize_default
281 #ifdef HAVE_VIRJOBPTR
282 static struct custom_operations jb_custom_operations = {
283 "jb_custom_operations",
285 custom_compare_default,
287 custom_serialize_default,
288 custom_deserialize_default
293 Val_connect (virConnectPtr conn)
297 rv = caml_alloc_custom (&conn_custom_operations,
298 sizeof (virConnectPtr), 0, 1);
299 Connect_val (rv) = conn;
304 Val_dom (virDomainPtr dom)
308 rv = caml_alloc_custom (&dom_custom_operations,
309 sizeof (virDomainPtr), 0, 1);
315 Val_net (virNetworkPtr net)
319 rv = caml_alloc_custom (&net_custom_operations,
320 sizeof (virNetworkPtr), 0, 1);
325 #ifdef HAVE_VIRSTORAGEPOOLPTR
327 Val_pol (virStoragePoolPtr pol)
331 rv = caml_alloc_custom (&pol_custom_operations,
332 sizeof (virStoragePoolPtr), 0, 1);
338 #ifdef HAVE_VIRSTORAGEVOLPTR
340 Val_vol (virStorageVolPtr vol)
344 rv = caml_alloc_custom (&vol_custom_operations,
345 sizeof (virStorageVolPtr), 0, 1);
351 #ifdef HAVE_VIRJOBPTR
353 Val_jb (virJobPtr jb)
357 rv = caml_alloc_custom (&jb_custom_operations,
358 sizeof (virJobPtr), 0, 1);
364 /* No-finalize versions of Val_connect, Val_dom, Val_net ONLY for use
365 * by virterror wrappers.
368 Val_connect_no_finalize (virConnectPtr conn)
372 rv = caml_alloc (1, Abstract_tag);
373 Store_field (rv, 0, (value) conn);
378 Val_dom_no_finalize (virDomainPtr dom)
382 rv = caml_alloc (1, Abstract_tag);
383 Store_field (rv, 0, (value) dom);
388 Val_net_no_finalize (virNetworkPtr net)
392 rv = caml_alloc (1, Abstract_tag);
393 Store_field (rv, 0, (value) net);
397 /* This wraps up the (dom, conn) pair (Domain.t). */
399 Val_domain (virDomainPtr dom, value connv)
404 rv = caml_alloc_tuple (2);
406 Store_field (rv, 0, v);
407 Store_field (rv, 1, connv);
411 /* This wraps up the (net, conn) pair (Network.t). */
413 Val_network (virNetworkPtr net, value connv)
418 rv = caml_alloc_tuple (2);
420 Store_field (rv, 0, v);
421 Store_field (rv, 1, connv);
425 #ifdef HAVE_VIRSTORAGEPOOLPTR
426 /* This wraps up the (pol, conn) pair (Pool.t). */
428 Val_pool (virStoragePoolPtr pol, value connv)
433 rv = caml_alloc_tuple (2);
435 Store_field (rv, 0, v);
436 Store_field (rv, 1, connv);
441 #ifdef HAVE_VIRSTORAGEVOLPTR
442 /* This wraps up the (vol, conn) pair (Volume.t). */
444 Val_volume (virStorageVolPtr vol, value connv)
449 rv = caml_alloc_tuple (2);
451 Store_field (rv, 0, v);
452 Store_field (rv, 1, connv);
457 #ifdef HAVE_VIRJOBPTR
458 /* This wraps up the (jb, conn) pair (Job.t). */
460 Val_job (virJobPtr jb, value connv)
465 rv = caml_alloc_tuple (2);
467 Store_field (rv, 0, v);
468 Store_field (rv, 1, connv);
473 /* No-finalize versions of Val_domain, Val_network ONLY for use by
474 * virterror wrappers.
477 Val_domain_no_finalize (virDomainPtr dom, value connv)
482 rv = caml_alloc_tuple (2);
483 v = Val_dom_no_finalize (dom);
484 Store_field (rv, 0, v);
485 Store_field (rv, 1, connv);
490 Val_network_no_finalize (virNetworkPtr net, value connv)
495 rv = caml_alloc_tuple (2);
496 v = Val_net_no_finalize (net);
497 Store_field (rv, 0, v);
498 Store_field (rv, 1, connv);
503 conn_finalize (value connv)
505 virConnectPtr conn = Connect_val (connv);
506 if (conn) (void) virConnectClose (conn);
510 dom_finalize (value domv)
512 virDomainPtr dom = Dom_val (domv);
513 if (dom) (void) virDomainFree (dom);
517 net_finalize (value netv)
519 virNetworkPtr net = Net_val (netv);
520 if (net) (void) virNetworkFree (net);
523 #ifdef HAVE_VIRSTORAGEPOOLPTR
525 pol_finalize (value polv)
527 virStoragePoolPtr pol = Pol_val (polv);
528 if (pol) (void) virStoragePoolFree (pol);
532 #ifdef HAVE_VIRSTORAGEVOLPTR
534 vol_finalize (value volv)
536 virStorageVolPtr vol = Vol_val (volv);
537 if (vol) (void) virStorageVolFree (vol);
541 #ifdef HAVE_VIRJOBPTR
543 jb_finalize (value jbv)
545 virJobPtr jb = Jb_val (jbv);
546 if (jb) (void) virJobFree (jb);