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