remove the deprecated conn/dom/net fields in virterror.
/* Define to 1 if you have the `virConnectNumOfStoragePools' function. */
#undef HAVE_VIRCONNECTNUMOFSTORAGEPOOLS
+/* Define to 1 if you have the `virDomainBlockPeek' function. */
+#undef HAVE_VIRDOMAINBLOCKPEEK
+
/* Define to 1 if you have the `virDomainBlockStats' function. */
#undef HAVE_VIRDOMAINBLOCKSTATS
/* Define to 1 if you have the `virDomainInterfaceStats' function. */
#undef HAVE_VIRDOMAININTERFACESTATS
+/* Define to 1 if you have the `virDomainMemoryPeek' function. */
+#undef HAVE_VIRDOMAINMEMORYPEEK
+
/* Define to 1 if you have the `virDomainMigrate' function. */
#undef HAVE_VIRDOMAINMIGRATE
dnl Process this file with autoconf to produce a configure script.
-AC_INIT(ocaml-libvirt,0.4.2.1)
+AC_INIT(ocaml-libvirt,0.4.2.2)
dnl Check for basic C environment.
AC_PROG_CC
virStorageVolGetInfo \
virStorageVolGetXMLDesc \
virStorageVolGetPath \
+ virDomainBlockPeek \
+ virDomainMemoryPeek \
])
# This jobs API was never published and is due to get overhauled
type migrate_flag = Live
+ type memory_flag = Virtual
+
type block_stats = {
rd_req : int64;
rd_bytes : int64;
external migrate : [>`W] t -> [>`W] Connect.t -> migrate_flag list -> ?dname:string -> ?uri:string -> ?bandwidth:int -> unit -> rw t = "ocaml_libvirt_domain_migrate_bytecode" "ocaml_libvirt_domain_migrate_native"
external block_stats : [>`R] t -> string -> block_stats = "ocaml_libvirt_domain_block_stats"
external interface_stats : [>`R] t -> string -> interface_stats = "ocaml_libvirt_domain_interface_stats"
+ external block_peek : [>`R] t -> string -> int64 -> int -> string -> int -> unit = "ocaml_libvirt_domain_block_peek_bytecode" "ocaml_libvirt_domain_block_peek_native"
+ external memory_peek : [>`R] t -> memory_flag -> int64 -> int -> string -> int -> unit = "ocaml_libvirt_domain_memory_peek_bytecode" "ocaml_libvirt_domain_memory_peek_native"
external const : [>`R] t -> ro t = "%identity"
end
domain : domain;
message : string option;
level : level;
- conn : ro Connect.t option;
- dom : ro Domain.t option;
str1 : string option;
str2 : string option;
str3 : string option;
int1 : int32;
int2 : int32;
- net : ro Network.t option;
}
let to_string { code = code; domain = domain; message = message } =
external reset_last_conn_error : [>`R] Connect.t -> unit = "ocaml_libvirt_virterror_reset_last_conn_error"
let no_error () =
- { code = VIR_ERR_OK; domain = VIR_FROM_NONE; message = None;
- level = VIR_ERR_NONE; conn = None; dom = None;
+ { code = VIR_ERR_OK; domain = VIR_FROM_NONE;
+ message = None; level = VIR_ERR_NONE;
str1 = None; str2 = None; str3 = None;
- int1 = 0_l; int2 = 0_l; net = None }
+ int1 = 0_l; int2 = 0_l }
end
exception Virterror of Virterror.t
{3 General safety issues}
Memory allocation / automatic garbage collection of all libvirt
- objects should be completely safe (except in the specific
- virterror case noted below). If you find any safety issues or if your
- pure OCaml program ever segfaults, please contact the author.
+ objects should be completely safe. If you find any safety issues
+ or if your pure OCaml program ever segfaults, please contact the author.
You can force a libvirt object to be freed early by calling
the [close] function on the object. This shouldn't affect
Thus domain objects can through odd exceptions at any time.
This is just the nature of virtualisation.
- Virterror has a specific design error which means that the
- objects embedded in a virterror exception message are only
- valid as long as the connection handle is still open. This
- is a design flaw in the C code of libvirt and we cannot fix
- or work around it in the OCaml bindings.
-
{3 Backwards and forwards compatibility}
OCaml-libvirt is backwards and forwards compatible with
type migrate_flag = Live
+ type memory_flag = Virtual
+
type block_stats = {
rd_req : int64;
rd_bytes : int64;
val interface_stats : [>`R] t -> string -> interface_stats
(** Returns network interface stats. *)
+ val block_peek : [>`R] t -> string -> int64 -> int -> string -> int -> unit
+ (** [block_peek dom path offset size buf boff] reads [size] bytes at
+ [offset] in the domain's [path] block device.
+
+ If successful then the data is written into [buf] starting
+ at offset [boff], for [size] bytes. *)
+ val memory_peek : [>`R] t -> memory_flag -> int64 -> int -> string -> int ->
+ unit
+ (** [memory_peek dom Virtual offset size] reads [size] bytes
+ at [offset] in the domain's virtual memory.
+
+ If successful then the data is written into [buf] starting
+ at offset [boff], for [size] bytes. *)
+
external const : [>`R] t -> ro t = "%identity"
(** [const dom] turns a read/write domain handle into a read-only
domain handle. Note that the opposite operation is impossible.
domain : domain; (** Origin of the error. *)
message : string option; (** Human-readable message. *)
level : level; (** Error or warning. *)
- conn : ro Connect.t option; (** Associated connection. *)
- dom : ro Domain.t option; (** Associated domain. *)
str1 : string option; (** Informational string. *)
str2 : string option; (** Informational string. *)
str3 : string option; (** Informational string. *)
int1 : int32; (** Informational integer. *)
int2 : int32; (** Informational integer. *)
- net : ro Network.t option; (** Associated network. *)
}
(** An error object. *)
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);
}
}
#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);
- CAMLreturn (rv);
-}
-
/* This wraps up the (dom, conn) pair (Domain.t). */
static value
Val_domain (virDomainPtr dom, value connv)
}
#endif
-/* No-finalize versions of Val_domain, Val_network ONLY for use by
- * virterror wrappers.
- */
-static value
-Val_domain_no_finalize (virDomainPtr dom, 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);
- Store_field (rv, 0, v);
- Store_field (rv, 1, connv);
- CAMLreturn (rv);
-}
-
static void
conn_finalize (value connv)
{
}
#ifdef HAVE_WEAK_SYMBOLS
+#ifdef HAVE_VIRDOMAINBLOCKPEEK
+extern int virDomainBlockPeek (virDomainPtr domain,
+ const char *path,
+ unsigned long long offset,
+ size_t size,
+ void *buffer,
+ unsigned int flags)
+ __attribute__((weak));
+#endif
+#endif
+
+CAMLprim value
+ocaml_libvirt_domain_block_peek_native (value domv, value pathv, value offsetv, value sizev, value bufferv, value boffv)
+{
+#ifdef HAVE_VIRDOMAINBLOCKPEEK
+ CAMLparam5 (domv, pathv, offsetv, sizev, bufferv);
+ CAMLxparam1 (boffv);
+ virDomainPtr dom = Domain_val (domv);
+ virConnectPtr conn = Connect_domv (domv);
+ const char *path = String_val (pathv);
+ unsigned long long offset = Int64_val (offsetv);
+ size_t size = Int_val (sizev);
+ char *buffer = String_val (bufferv);
+ int boff = Int_val (boffv);
+ int r;
+
+ /* Check that the return buffer is big enough. */
+ if (caml_string_length (bufferv) < boff + size)
+ caml_failwith ("virDomainBlockPeek: return buffer too short");
+
+ WEAK_SYMBOL_CHECK (virDomainBlockPeek);
+ /* NB. not NONBLOCKING because buffer might move (XXX) */
+ r = virDomainBlockPeek (dom, path, offset, size, buffer+boff, 0);
+ CHECK_ERROR (r == -1, conn, "virDomainBlockPeek");
+
+ CAMLreturn (Val_unit);
+
+#else /* virDomainBlockPeek not supported */
+ not_supported ("virDomainBlockPeek");
+#endif
+}
+
+CAMLprim value
+ocaml_libvirt_domain_block_peek_bytecode (value *argv, int argn)
+{
+ return ocaml_libvirt_domain_block_peek_native (argv[0], argv[1], argv[2],
+ argv[3], argv[4], argv[5]);
+}
+
+#ifdef HAVE_WEAK_SYMBOLS
+#ifdef HAVE_VIRDOMAINMEMORYPEEK
+extern int virDomainMemoryPeek (virDomainPtr domain,
+ unsigned long long offset,
+ size_t size,
+ void *buffer,
+ unsigned int flags)
+ __attribute__((weak));
+#endif
+#endif
+
+CAMLprim value
+ocaml_libvirt_domain_memory_peek_native (value domv, int flagsv, value offsetv, value sizev, value bufferv, value boffv)
+{
+#ifdef HAVE_VIRDOMAINMEMORYPEEK
+ CAMLparam5 (domv, flagsv, offsetv, sizev, bufferv);
+ CAMLxparam1 (boffv);
+ CAMLlocal1 (flagv);
+ virDomainPtr dom = Domain_val (domv);
+ virConnectPtr conn = Connect_domv (domv);
+ int flags = 0;
+ unsigned long long offset = Int64_val (offsetv);
+ size_t size = Int_val (sizev);
+ char *buffer = String_val (bufferv);
+ int boff = Int_val (boffv);
+ int r;
+
+ /* Check that the return buffer is big enough. */
+ if (caml_string_length (bufferv) < boff + size)
+ caml_failwith ("virDomainBlockPeek: return buffer too short");
+
+ /* Do flags. */
+ for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
+ {
+ flagv = Field (flagsv, 0);
+ if (flagv == Int_val (0))
+ flags |= VIR_MEMORY_VIRTUAL;
+ }
+
+ WEAK_SYMBOL_CHECK (virDomainMemoryPeek);
+ /* NB. not NONBLOCKING because buffer might move (XXX) */
+ r = virDomainMemoryPeek (dom, offset, size, buffer+boff, flags);
+ CHECK_ERROR (r == -1, conn, "virDomainMemoryPeek");
+
+ CAMLreturn (Val_unit);
+
+#else /* virDomainMemoryPeek not supported */
+ not_supported ("virDomainMemoryPeek");
+#endif
+}
+
+CAMLprim value
+ocaml_libvirt_domain_memory_peek_bytecode (value *argv, int argn)
+{
+ return ocaml_libvirt_domain_memory_peek_native (argv[0], argv[1], argv[2],
+ argv[3], argv[4], argv[5]);
+}
+
+#ifdef HAVE_WEAK_SYMBOLS
#ifdef HAVE_VIRSTORAGEPOOLGETINFO
extern int virStoragePoolGetInfo(virStoragePoolPtr pool, virStoragePoolInfoPtr info)
__attribute__((weak));
* wrappers store domains (and networks) as explicit (dom, conn)
* pairs.
*
- * Further complication with virterror / exceptions: Virterror gives
- * us virConnectPtr, virDomainPtr, virNetworkPtr pointers. If we
- * follow standard practice and wrap these up in blocks with
- * finalizers then we'll end up double-freeing (in particular, calling
- * virConnectClose at the wrong time). So for virterror, we have
- * "special" wrapper functions (Val_connect_no_finalize, etc.).
- *
* Update 2008/01: Storage pools and volumes work the same way as
* domains and networks. And jobs.
*/
static value Val_jb (virJobPtr jb);
#endif
-/* ONLY for use by virterror wrappers. */
-static value Val_connect_no_finalize (virConnectPtr conn);
-static value Val_dom_no_finalize (virDomainPtr dom);
-static value Val_net_no_finalize (virNetworkPtr net);
-
/* Domains and networks are stored as pairs (dom/net, conn), so have
* some convenience functions for unwrapping and wrapping them.
*/
#ifdef HAVE_VIRJOBPTR
static value Val_job (virJobPtr jb, value connv);
#endif
-
-/* ONLY for use by virterror wrappers. */
-static value Val_domain_no_finalize (virDomainPtr dom, value connv);
-static value Val_network_no_finalize (virNetworkPtr net, value connv);
git.annexia.org / ocaml-libvirt.git / commitdiff