/* OCaml bindings for libvirt.
* (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc.
- * http://libvirt.org/
+ * https://libvirt.org/
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
- * version 2 of the License, or (at your option) any later version.
+ * version 2 of the License, or (at your option) any later version,
+ * with the OCaml linking exception described in ../COPYING.LIB.
*
* This library is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
/* Please read libvirt/README file. */
-static char *
+static const char *
Optstring_val (value strv)
{
if (strv == Val_int (0)) /* None */
CAMLreturn (optv);
}
+static value
+Val_opt_const (const void *ptr, Val_const_ptr_t Val_ptr)
+{
+ CAMLparam0 ();
+ CAMLlocal2 (optv, ptrv);
+
+ if (ptr) { /* Some ptr */
+ optv = caml_alloc (1, 0);
+ ptrv = Val_ptr (ptr);
+ Store_field (optv, 0, ptrv);
+ } else /* None */
+ optv = Val_int (0);
+
+ CAMLreturn (optv);
+}
+
#if 0
static value
option_default (value option, value deflt)
#endif
static void
-_raise_virterror (virConnectPtr conn, const char *fn)
+_raise_virterror (const char *fn)
{
CAMLparam0 ();
CAMLlocal1 (rv);
virErrorPtr errp;
struct _virError err;
- errp = conn ? virConnGetLastError (conn) : virGetLastError ();
+ errp = virGetLastError ();
if (!errp) {
/* Fake a _virError structure. */
(void) caml__frame;
}
-/* Raise an error if a function is not supported. */
-static void
-not_supported (const char *fn)
+static int
+_list_length (value listv)
+{
+ CAMLparam1 (listv);
+ int len = 0;
+
+ for (; listv != Val_emptylist; listv = Field (listv, 1), ++len) {}
+
+ CAMLreturnT (int, len);
+}
+
+static value
+Val_virconnectcredential (const virConnectCredentialPtr cred)
{
CAMLparam0 ();
- CAMLlocal1 (fnv);
+ CAMLlocal1 (rv);
- fnv = caml_copy_string (fn);
- caml_raise_with_arg (*caml_named_value ("ocaml_libvirt_not_supported"), fnv);
+ rv = caml_alloc (4, 0);
+ Store_field (rv, 0, Val_int (cred->type - 1));
+ Store_field (rv, 1, caml_copy_string (cred->prompt));
+ Store_field (rv, 2,
+ Val_opt_const (cred->challenge,
+ (Val_const_ptr_t) caml_copy_string));
+ Store_field (rv, 3,
+ Val_opt_const (cred->defresult,
+ (Val_const_ptr_t) caml_copy_string));
- /*NOTREACHED*/
- /* Suppresses a compiler warning. */
- (void) caml__frame;
+ CAMLreturn (rv);
}
/* Convert the virErrorNumber, virErrorDomain and virErrorLevel enums
* to convert it into VIR_*_UNKNOWN (code).
*/
-#define MAX_VIR_CODE 50 /* VIR_ERR_NO_STORAGE_VOL */
-#define MAX_VIR_DOMAIN 17 /* VIR_FROM_STORAGE */
+#define MAX_VIR_CODE 101 /* VIR_ERR_NO_NWFILTER_BINDING */
+#define MAX_VIR_DOMAIN 67 /* VIR_FROM_RESCTRL */
#define MAX_VIR_LEVEL VIR_ERR_ERROR
static inline value
CAMLparam0 ();
CAMLlocal3 (rv, connv, optv);
- rv = caml_alloc (12, 0);
+ rv = caml_alloc (9, 0);
Store_field (rv, 0, Val_err_number (err->code));
Store_field (rv, 1, Val_err_domain (err->domain));
Store_field (rv, 2,
Val_opt (err->message, (Val_ptr_t) caml_copy_string));
Store_field (rv, 3, Val_err_level (err->level));
- /* conn, dom and net fields, all optional */
- if (err->conn) {
- connv = Val_connect_no_finalize (err->conn);
- optv = caml_alloc (1, 0);
- Store_field (optv, 0, connv);
- Store_field (rv, 4, optv); /* Some conn */
-
- if (err->dom) {
- optv = caml_alloc (1, 0);
- Store_field (optv, 0, Val_domain_no_finalize (err->dom, connv));
- Store_field (rv, 5, optv); /* Some (dom, conn) */
- }
- else
- Store_field (rv, 5, Val_int (0)); /* None */
- if (err->net) {
- optv = caml_alloc (1, 0);
- Store_field (optv, 0, Val_network_no_finalize (err->net, connv));
- Store_field (rv, 11, optv); /* Some (net, conn) */
- } else
- Store_field (rv, 11, Val_int (0)); /* None */
- } else {
- Store_field (rv, 4, Val_int (0)); /* None */
- Store_field (rv, 5, Val_int (0)); /* None */
- Store_field (rv, 11, Val_int (0)); /* None */
- }
-
- Store_field (rv, 6,
+ Store_field (rv, 4,
Val_opt (err->str1, (Val_ptr_t) caml_copy_string));
- Store_field (rv, 7,
+ Store_field (rv, 5,
Val_opt (err->str2, (Val_ptr_t) caml_copy_string));
- Store_field (rv, 8,
+ Store_field (rv, 6,
Val_opt (err->str3, (Val_ptr_t) caml_copy_string));
- Store_field (rv, 9, caml_copy_int32 (err->int1));
- Store_field (rv, 10, caml_copy_int32 (err->int2));
+ Store_field (rv, 7, caml_copy_int32 (err->int1));
+ Store_field (rv, 8, caml_copy_int32 (err->int2));
CAMLreturn (rv);
}
static void conn_finalize (value);
static void dom_finalize (value);
static void net_finalize (value);
-#ifdef HAVE_VIRSTORAGEPOOLPTR
static void pol_finalize (value);
-#endif
-#ifdef HAVE_VIRSTORAGEVOLPTR
static void vol_finalize (value);
-#endif
-#ifdef HAVE_VIRJOBPTR
-static void jb_finalize (value);
-#endif
+static void sec_finalize (value);
static struct custom_operations conn_custom_operations = {
- "conn_custom_operations",
+ (char *) "conn_custom_operations",
conn_finalize,
custom_compare_default,
custom_hash_default,
};
static struct custom_operations dom_custom_operations = {
- "dom_custom_operations",
+ (char *) "dom_custom_operations",
dom_finalize,
custom_compare_default,
custom_hash_default,
};
static struct custom_operations net_custom_operations = {
- "net_custom_operations",
+ (char *) "net_custom_operations",
net_finalize,
custom_compare_default,
custom_hash_default,
custom_deserialize_default
};
-#ifdef HAVE_VIRSTORAGEPOOLPTR
static struct custom_operations pol_custom_operations = {
- "pol_custom_operations",
+ (char *) "pol_custom_operations",
pol_finalize,
custom_compare_default,
custom_hash_default,
custom_serialize_default,
custom_deserialize_default
};
-#endif
-#ifdef HAVE_VIRSTORAGEVOLPTR
static struct custom_operations vol_custom_operations = {
- "vol_custom_operations",
+ (char *) "vol_custom_operations",
vol_finalize,
custom_compare_default,
custom_hash_default,
custom_serialize_default,
custom_deserialize_default
};
-#endif
-#ifdef HAVE_VIRJOBPTR
-static struct custom_operations jb_custom_operations = {
- "jb_custom_operations",
- jb_finalize,
+static struct custom_operations sec_custom_operations = {
+ (char *) "sec_custom_operations",
+ sec_finalize,
custom_compare_default,
custom_hash_default,
custom_serialize_default,
custom_deserialize_default
};
-#endif
static value
Val_connect (virConnectPtr conn)
CAMLreturn (rv);
}
-#ifdef HAVE_VIRSTORAGEPOOLPTR
static value
Val_pol (virStoragePoolPtr pol)
{
Pol_val (rv) = pol;
CAMLreturn (rv);
}
-#endif
-#ifdef HAVE_VIRSTORAGEVOLPTR
static value
Val_vol (virStorageVolPtr vol)
{
Vol_val (rv) = vol;
CAMLreturn (rv);
}
-#endif
-#ifdef HAVE_VIRJOBPTR
static value
-Val_jb (virJobPtr jb)
+Val_sec (virSecretPtr sec)
{
CAMLparam0 ();
CAMLlocal1 (rv);
- rv = caml_alloc_custom (&jb_custom_operations,
- sizeof (virJobPtr), 0, 1);
- Jb_val (rv) = jb;
- CAMLreturn (rv);
-}
-#endif
-
-/* No-finalize versions of Val_connect, Val_dom, Val_net ONLY for use
- * by virterror wrappers.
- */
-static value
-Val_connect_no_finalize (virConnectPtr conn)
-{
- CAMLparam0 ();
- CAMLlocal1 (rv);
- rv = caml_alloc (1, Abstract_tag);
- Store_field (rv, 0, (value) conn);
- CAMLreturn (rv);
-}
-
-static value
-Val_dom_no_finalize (virDomainPtr dom)
-{
- CAMLparam0 ();
- CAMLlocal1 (rv);
- rv = caml_alloc (1, Abstract_tag);
- Store_field (rv, 0, (value) dom);
- CAMLreturn (rv);
-}
-
-static value
-Val_net_no_finalize (virNetworkPtr net)
-{
- CAMLparam0 ();
- CAMLlocal1 (rv);
- rv = caml_alloc (1, Abstract_tag);
- Store_field (rv, 0, (value) net);
+ rv = caml_alloc_custom (&sec_custom_operations,
+ sizeof (virSecretPtr), 0, 1);
+ Sec_val (rv) = sec;
CAMLreturn (rv);
}
CAMLreturn (rv);
}
-#ifdef HAVE_VIRSTORAGEPOOLPTR
/* This wraps up the (pol, conn) pair (Pool.t). */
static value
Val_pool (virStoragePoolPtr pol, value connv)
Store_field (rv, 1, connv);
CAMLreturn (rv);
}
-#endif
-#ifdef HAVE_VIRSTORAGEVOLPTR
/* This wraps up the (vol, conn) pair (Volume.t). */
static value
Val_volume (virStorageVolPtr vol, value connv)
Store_field (rv, 1, connv);
CAMLreturn (rv);
}
-#endif
-
-#ifdef HAVE_VIRJOBPTR
-/* This wraps up the (jb, conn) pair (Job.t). */
-static value
-Val_job (virJobPtr jb, value connv)
-{
- CAMLparam1 (connv);
- CAMLlocal2 (rv, v);
-
- rv = caml_alloc_tuple (2);
- v = Val_jb (jb);
- Store_field (rv, 0, v);
- Store_field (rv, 1, connv);
- CAMLreturn (rv);
-}
-#endif
-/* No-finalize versions of Val_domain, Val_network ONLY for use by
- * virterror wrappers.
- */
+/* This wraps up the (sec, conn) pair (Secret.t). */
static value
-Val_domain_no_finalize (virDomainPtr dom, value connv)
+Val_secret (virSecretPtr sec, value connv)
{
CAMLparam1 (connv);
CAMLlocal2 (rv, v);
rv = caml_alloc_tuple (2);
- v = Val_dom_no_finalize (dom);
- Store_field (rv, 0, v);
- Store_field (rv, 1, connv);
- CAMLreturn (rv);
-}
-
-static value
-Val_network_no_finalize (virNetworkPtr net, value connv)
-{
- CAMLparam1 (connv);
- CAMLlocal2 (rv, v);
-
- rv = caml_alloc_tuple (2);
- v = Val_net_no_finalize (net);
+ v = Val_sec (sec);
Store_field (rv, 0, v);
Store_field (rv, 1, connv);
CAMLreturn (rv);
if (net) (void) virNetworkFree (net);
}
-#ifdef HAVE_VIRSTORAGEPOOLPTR
static void
pol_finalize (value polv)
{
virStoragePoolPtr pol = Pol_val (polv);
if (pol) (void) virStoragePoolFree (pol);
}
-#endif
-#ifdef HAVE_VIRSTORAGEVOLPTR
static void
vol_finalize (value volv)
{
virStorageVolPtr vol = Vol_val (volv);
if (vol) (void) virStorageVolFree (vol);
}
-#endif
-#ifdef HAVE_VIRJOBPTR
static void
-jb_finalize (value jbv)
+sec_finalize (value secv)
{
- virJobPtr jb = Jb_val (jbv);
- if (jb) (void) virJobFree (jb);
+ virSecretPtr sec = Sec_val (secv);
+ if (sec) (void) virSecretFree (sec);
}
-#endif
git.annexia.org / ocaml-libvirt.git / blobdiff