diff --git a/0001-block_peek-memory_peek-Use-bytes-for-return-buffer.patch b/0001-block_peek-memory_peek-Use-bytes-for-return-buffer.patch new file mode 100644 index 0000000..f3b93af --- /dev/null +++ b/0001-block_peek-memory_peek-Use-bytes-for-return-buffer.patch @@ -0,0 +1,74 @@ +From 29709872404fad20a9822c43a831f30b7b09f34a Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Sun, 19 Jan 2020 12:58:17 +0000 +Subject: [PATCH 1/3] block_peek, memory_peek: Use bytes for return buffer. + +Strings are immutable in modern OCaml. +--- + libvirt/libvirt.ml | 4 ++-- + libvirt/libvirt.mli | 4 ++-- + libvirt/libvirt_c_oneoffs.c | 4 ++-- + 3 files changed, 6 insertions(+), 6 deletions(-) + +diff --git a/libvirt/libvirt.ml b/libvirt/libvirt.ml +index 7f9d0e4..bdb9460 100644 +--- a/libvirt/libvirt.ml ++++ b/libvirt/libvirt.ml +@@ -731,8 +731,8 @@ struct + 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 : [>`W] t -> string -> int64 -> int -> string -> int -> unit = "ocaml_libvirt_domain_block_peek_bytecode" "ocaml_libvirt_domain_block_peek_native" +- external memory_peek : [>`W] t -> memory_flag list -> int64 -> int -> string -> int -> unit = "ocaml_libvirt_domain_memory_peek_bytecode" "ocaml_libvirt_domain_memory_peek_native" ++ external block_peek : [>`W] t -> string -> int64 -> int -> bytes -> int -> unit = "ocaml_libvirt_domain_block_peek_bytecode" "ocaml_libvirt_domain_block_peek_native" ++ external memory_peek : [>`W] t -> memory_flag list -> int64 -> int -> bytes -> int -> unit = "ocaml_libvirt_domain_memory_peek_bytecode" "ocaml_libvirt_domain_memory_peek_native" + + external get_all_domain_stats : [>`R] Connect.t -> stats_type list -> get_all_domain_stats_flag list -> domain_stats_record array = "ocaml_libvirt_domain_get_all_domain_stats" + +diff --git a/libvirt/libvirt.mli b/libvirt/libvirt.mli +index 0d74199..7900392 100644 +--- a/libvirt/libvirt.mli ++++ b/libvirt/libvirt.mli +@@ -708,7 +708,7 @@ sig + val interface_stats : [>`R] t -> string -> interface_stats + (** Returns network interface stats. *) + +- val block_peek : [>`W] t -> string -> int64 -> int -> string -> int -> unit ++ val block_peek : [>`W] t -> string -> int64 -> int -> bytes -> int -> unit + (** [block_peek dom path offset size buf boff] reads [size] bytes at + [offset] in the domain's [path] block device. + +@@ -717,7 +717,7 @@ sig + + See also {!max_peek}. *) + val memory_peek : [>`W] t -> memory_flag list -> int64 -> int -> +- string -> int -> unit ++ bytes -> int -> unit + (** [memory_peek dom Virtual offset size] reads [size] bytes + at [offset] in the domain's virtual memory. + +diff --git a/libvirt/libvirt_c_oneoffs.c b/libvirt/libvirt_c_oneoffs.c +index 40384e8..8468c73 100644 +--- a/libvirt/libvirt_c_oneoffs.c ++++ b/libvirt/libvirt_c_oneoffs.c +@@ -1057,7 +1057,7 @@ ocaml_libvirt_domain_block_peek_native (value domv, value pathv, value offsetv, + const char *path = String_val (pathv); + unsigned long long offset = Int64_val (offsetv); + size_t size = Int_val (sizev); +- char *buffer = String_val (bufferv); ++ unsigned char *buffer = Bytes_val (bufferv); + int boff = Int_val (boffv); + int r; + +@@ -1089,7 +1089,7 @@ ocaml_libvirt_domain_memory_peek_native (value domv, value flagsv, value offsetv + int flags = 0; + unsigned long long offset = Int64_val (offsetv); + size_t size = Int_val (sizev); +- char *buffer = String_val (bufferv); ++ unsigned char *buffer = Bytes_val (bufferv); + int boff = Int_val (boffv); + int r; + +-- +2.24.1 + diff --git a/0002-String_val-returns-const-char-in-OCaml-4.10.patch b/0002-String_val-returns-const-char-in-OCaml-4.10.patch new file mode 100644 index 0000000..4f547cb --- /dev/null +++ b/0002-String_val-returns-const-char-in-OCaml-4.10.patch @@ -0,0 +1,113 @@ +From 3705b9bdcd04dc86474c62e1c8dd8759669842bc Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Sun, 19 Jan 2020 12:59:09 +0000 +Subject: [PATCH 2/3] String_val returns const char * in OCaml 4.10. + +This should be compatible with earlier versions of OCaml +too since we are just assigning a char * to a const char *. +--- + libvirt/generator.pl | 14 +++++++------- + libvirt/libvirt_c_oneoffs.c | 6 +++--- + 2 files changed, 10 insertions(+), 10 deletions(-) + +diff --git a/libvirt/generator.pl b/libvirt/generator.pl +index ac3dd65..aff371b 100755 +--- a/libvirt/generator.pl ++++ b/libvirt/generator.pl +@@ -593,7 +593,7 @@ sub gen_c_code + } elsif ($sig =~ /^(\w+), string : unit$/) { + "\ + " . gen_unpack_args ($1) . " +- char *str = String_val (strv); ++ const char *str = String_val (strv); + int r; + + NONBLOCKING (r = $c_name ($1, str)); +@@ -605,7 +605,7 @@ sub gen_c_code + "\ + CAMLlocal1 (rv); + " . gen_unpack_args ($1) . " +- char *str = String_val (strv); ++ const char *str = String_val (strv); + int r; + + NONBLOCKING (r = $c_name ($1, str, 0)); +@@ -618,7 +618,7 @@ sub gen_c_code + "\ + CAMLlocal1 (rv); + " . gen_unpack_args ($1) . " +- char *str = String_val (strv); ++ const char *str = String_val (strv); + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1, str)); +@@ -633,7 +633,7 @@ sub gen_c_code + "\ + CAMLlocal1 (rv); + " . gen_unpack_args ($1) . " +- char *str = String_val (strv); ++ const char *str = String_val (strv); + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1, str, 0)); +@@ -648,7 +648,7 @@ sub gen_c_code + "\ + CAMLlocal1 (rv); + " . gen_unpack_args ($1) . " +- char *str = String_val (strv); ++ const char *str = String_val (strv); + unsigned int u = Int_val (uv); + $c_ret_type r; + +@@ -735,7 +735,7 @@ sub gen_c_code + "\ + CAMLlocal2 (rv, connv); + " . gen_unpack_args ($1) . " +- char *str = String_val (strv); ++ const char *str = String_val (strv); + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1, str)); +@@ -751,7 +751,7 @@ sub gen_c_code + "\ + CAMLlocal2 (rv, connv); + " . gen_unpack_args ($1) . " +- char *str = String_val (strv); ++ const char *str = String_val (strv); + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1, str, 0)); +diff --git a/libvirt/libvirt_c_oneoffs.c b/libvirt/libvirt_c_oneoffs.c +index 8468c73..fc2ac13 100644 +--- a/libvirt/libvirt_c_oneoffs.c ++++ b/libvirt/libvirt_c_oneoffs.c +@@ -601,7 +601,7 @@ ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv) + int nparams = Wosize_val (paramsv); + virSchedParameterPtr params; + int r, i; +- char *name; ++ const char *name; + + params = malloc (sizeof (*params) * nparams); + if (params == NULL) +@@ -1005,7 +1005,7 @@ ocaml_libvirt_domain_block_stats (value domv, value pathv) + CAMLparam2 (domv, pathv); + CAMLlocal2 (rv,v); + virDomainPtr dom = Domain_val (domv); +- char *path = String_val (pathv); ++ const char *path = String_val (pathv); + struct _virDomainBlockStats stats; + int r; + +@@ -1028,7 +1028,7 @@ ocaml_libvirt_domain_interface_stats (value domv, value pathv) + CAMLparam2 (domv, pathv); + CAMLlocal2 (rv,v); + virDomainPtr dom = Domain_val (domv); +- char *path = String_val (pathv); ++ const char *path = String_val (pathv); + struct _virDomainInterfaceStats stats; + int r; + +-- +2.24.1 + diff --git a/0003-Don-t-try-to-memcpy-into-a-String_val.patch b/0003-Don-t-try-to-memcpy-into-a-String_val.patch new file mode 100644 index 0000000..720787f --- /dev/null +++ b/0003-Don-t-try-to-memcpy-into-a-String_val.patch @@ -0,0 +1,68 @@ +From 3d3d6af425d369200a7a62a127adf640d94a38a3 Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Sun, 19 Jan 2020 13:02:16 +0000 +Subject: [PATCH 3/3] Don't try to memcpy into a String_val. + +In OCaml 4.10 String_val returns const char *, so we cannot use it as +the destination for memcpy. Use Bytes_val instead. +--- + libvirt/generator.pl | 2 +- + libvirt/libvirt_c_oneoffs.c | 8 ++++---- + 2 files changed, 5 insertions(+), 5 deletions(-) + +diff --git a/libvirt/generator.pl b/libvirt/generator.pl +index aff371b..463a19b 100755 +--- a/libvirt/generator.pl ++++ b/libvirt/generator.pl +@@ -440,7 +440,7 @@ sub gen_c_code + + /* UUIDs are byte arrays with a fixed length. */ + rv = caml_alloc_string (VIR_UUID_BUFLEN); +- memcpy (String_val (rv), uuid, VIR_UUID_BUFLEN); ++ memcpy (Bytes_val (rv), uuid, VIR_UUID_BUFLEN); + CAMLreturn (rv); + " + } elsif ($sig =~ /^(\w+) : uuid string$/) { +diff --git a/libvirt/libvirt_c_oneoffs.c b/libvirt/libvirt_c_oneoffs.c +index fc2ac13..e8472b7 100644 +--- a/libvirt/libvirt_c_oneoffs.c ++++ b/libvirt/libvirt_c_oneoffs.c +@@ -394,7 +394,7 @@ ocaml_libvirt_connect_call_auth_default_callback (value listv) + elemv = caml_alloc (2, 0); + if (cred->result != NULL && cred->resultlen > 0) { + v = caml_alloc_string (cred->resultlen); +- memcpy (String_val (v), cred->result, cred->resultlen); ++ memcpy (Bytes_val (v), cred->result, cred->resultlen); + optv = caml_alloc (1, 0); + Store_field (optv, 0, v); + } else +@@ -715,7 +715,7 @@ ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv) + + /* Copy the bitmap. */ + strv = caml_alloc_string (maxinfo * maplen); +- memcpy (String_val (strv), cpumaps, maxinfo * maplen); ++ memcpy (Bytes_val (strv), cpumaps, maxinfo * maplen); + + /* Allocate the tuple and return it. */ + rv = caml_alloc_tuple (3); +@@ -900,7 +900,7 @@ ocaml_libvirt_domain_get_all_domain_stats (value connv, + */ + v = caml_alloc_string (VIR_UUID_BUFLEN); + virDomainGetUUID (rstats[i]->dom, uuid); +- memcpy (String_val (v), uuid, VIR_UUID_BUFLEN); ++ memcpy (Bytes_val (v), uuid, VIR_UUID_BUFLEN); + Store_field (dsv, 0, v); + + tpv = caml_alloc (rstats[i]->nparams, 0); /* typed_param array */ +@@ -1646,7 +1646,7 @@ ocaml_libvirt_secret_get_value (value secv) + CHECK_ERROR (secval == NULL, "virSecretGetValue"); + + rv = caml_alloc_string (size); +- memcpy (String_val (rv), secval, size); ++ memcpy (Bytes_val (rv), secval, size); + free (secval); + + CAMLreturn (rv); +-- +2.24.1 + diff --git a/ocaml-libvirt.spec b/ocaml-libvirt.spec index 8b7b84c..dbbf946 100644 --- a/ocaml-libvirt.spec +++ b/ocaml-libvirt.spec @@ -11,6 +11,11 @@ Source0: http://libvirt.org/sources/ocaml/%{name}-%{version}.tar.gz # Upstream commit 75b13978f85b32c7a121aa289d8ebf41ba14ee5a. Patch1: 0001-Make-const-the-return-value-of-caml_named_value.patch +# Fixes for OCaml 4.10, sent upstream 2020-01-19. +Patch2: 0001-block_peek-memory_peek-Use-bytes-for-return-buffer.patch +Patch3: 0002-String_val-returns-const-char-in-OCaml-4.10.patch +Patch4: 0003-Don-t-try-to-memcpy-into-a-String_val.patch + BuildRequires: ocaml >= 3.10.0 BuildRequires: ocaml-ocamldoc BuildRequires: ocaml-findlib-devel