From 3b4082b239ec0976b366293067e42f91d56cfcd5 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Thu, 6 Feb 2020 10:15:29 +0000
Subject: [PATCH] ocaml: Use caml_alloc_initialized_string instead of memcpy.

Since about 2017 OCaml has had a function for creating an initialized
string.  This uses the function instead of caml_alloc_string + memcpy
(which doesn't work for OCaml 4.10) and defines a replacement if the
function is missing.

Note this requires configure.ac in libguestfs.git and virt-v2v.git to
define HAVE_CAML_ALLOC_INITIALIZED_STRING.

(cherry picked from commit 398dc56a6cb5d6d01506338fa94ef580e668d5e9)
---
 common/mlpcre/pcre-c.c   | 16 ++++++++++++++--
 common/mlvisit/visit-c.c | 16 ++++++++++++++--
 common/mlxml/xml-c.c     | 16 ++++++++++++++--
 3 files changed, 42 insertions(+), 6 deletions(-)

diff --git a/common/mlpcre/pcre-c.c b/common/mlpcre/pcre-c.c
index 07f99b8d6..7dbba5857 100644
--- a/common/mlpcre/pcre-c.c
+++ b/common/mlpcre/pcre-c.c
@@ -39,6 +39,19 @@
 
 #pragma GCC diagnostic ignored "-Wmissing-prototypes"
 
+/* Replacement if caml_alloc_initialized_string is missing, added
+ * to OCaml runtime in 2017.
+ */
+#ifndef HAVE_CAML_ALLOC_INITIALIZED_STRING
+static inline value
+caml_alloc_initialized_string (mlsize_t len, const char *p)
+{
+  value sv = caml_alloc_string (len);
+  memcpy ((char *) String_val (sv), p, len);
+  return sv;
+}
+#endif
+
 /* Data on the most recent match is stored in this thread-local
  * variable.  It is freed either by the next call to PCRE.matches or
  * by (clean) thread exit.
@@ -257,8 +270,7 @@ guestfs_int_pcre_sub (value nv)
   if (len < 0)
     raise_pcre_error ("pcre_get_substring", len);
 
-  strv = caml_alloc_string (len);
-  memcpy (String_val (strv), str, len);
+  strv = caml_alloc_initialized_string (len, str);
   CAMLreturn (strv);
 }
 
diff --git a/common/mlvisit/visit-c.c b/common/mlvisit/visit-c.c
index 201f6d762..d5585ca94 100644
--- a/common/mlvisit/visit-c.c
+++ b/common/mlvisit/visit-c.c
@@ -35,6 +35,19 @@
 
 #pragma GCC diagnostic ignored "-Wmissing-prototypes"
 
+/* Replacement if caml_alloc_initialized_string is missing, added
+ * to OCaml runtime in 2017.
+ */
+#ifndef HAVE_CAML_ALLOC_INITIALIZED_STRING
+static inline value
+caml_alloc_initialized_string (mlsize_t len, const char *p)
+{
+  value sv = caml_alloc_string (len);
+  memcpy ((char *) String_val (sv), p, len);
+  return sv;
+}
+#endif
+
 struct visitor_function_wrapper_args {
   /* In both case we are pointing to local roots, hence why these are
    * value* not value.
@@ -198,8 +211,7 @@ copy_xattr (const struct guestfs_xattr *xattr)
   rv = caml_alloc (2, 0);
   v = caml_copy_string (xattr->attrname);
   Store_field (rv, 0, v);
-  v = caml_alloc_string (xattr->attrval_len);
-  memcpy (String_val (v), xattr->attrval, xattr->attrval_len);
+  v = caml_alloc_initialized_string (xattr->attrval_len, xattr->attrval);
   Store_field (rv, 1, v);
   CAMLreturn (rv);
 }
diff --git a/common/mlxml/xml-c.c b/common/mlxml/xml-c.c
index d3db7e227..a0fa0fc3d 100644
--- a/common/mlxml/xml-c.c
+++ b/common/mlxml/xml-c.c
@@ -40,6 +40,19 @@
 
 #pragma GCC diagnostic ignored "-Wmissing-prototypes"
 
+/* Replacement if caml_alloc_initialized_string is missing, added
+ * to OCaml runtime in 2017.
+ */
+#ifndef HAVE_CAML_ALLOC_INITIALIZED_STRING
+static inline value
+caml_alloc_initialized_string (mlsize_t len, const char *p)
+{
+  value sv = caml_alloc_string (len);
+  memcpy ((char *) String_val (sv), p, len);
+  return sv;
+}
+#endif
+
 /* xmlDocPtr type */
 #define docptr_val(v) (*((xmlDocPtr *)Data_custom_val(v)))
 
@@ -183,8 +196,7 @@ mllib_xml_to_string (value docv, value formatv)
   doc = docptr_val (docv);
   xmlDocDumpFormatMemory (doc, &mem, &size, Bool_val (formatv));
 
-  strv = caml_alloc_string (size);
-  memcpy (String_val (strv), mem, size);
+  strv = caml_alloc_initialized_string (size, mem);
   free (mem);
 
   CAMLreturn (strv);
-- 
2.18.4