122 lines
4.2 KiB
Diff
122 lines
4.2 KiB
Diff
From 5c5cc8b7bc2588c04dd0d0472b466f978f8ac55c Mon Sep 17 00:00:00 2001
|
|
From: "Richard W.M. Jones" <rjones@redhat.com>
|
|
Date: Thu, 6 Feb 2020 10:17:35 +0000
|
|
Subject: [PATCH] ocaml: Use caml_alloc_initialized_string instead of memcpy.
|
|
|
|
See this commit in libguestfs-common:
|
|
https://github.com/libguestfs/libguestfs-common/commit/398dc56a6cb5d6d01506338fa94ef580e668d5e9
|
|
|
|
(cherry picked from commit 9f3148c791a970b7d6adf249e949a1b7e0b4b0c1)
|
|
---
|
|
generator/OCaml.ml | 10 ++++------
|
|
m4/guestfs-ocaml.m4 | 18 ++++++++++++++++++
|
|
ocaml/guestfs-c.c | 3 +--
|
|
ocaml/guestfs-c.h | 18 ++++++++++++++++++
|
|
4 files changed, 41 insertions(+), 8 deletions(-)
|
|
|
|
diff --git a/generator/OCaml.ml b/generator/OCaml.ml
|
|
index bd4f73b85..1b6970f6d 100644
|
|
--- a/generator/OCaml.ml
|
|
+++ b/generator/OCaml.ml
|
|
@@ -504,12 +504,11 @@ copy_table (char * const * argv)
|
|
| name, FString ->
|
|
pr " v = caml_copy_string (%s->%s);\n" typ name
|
|
| name, FBuffer ->
|
|
- pr " v = caml_alloc_string (%s->%s_len);\n" typ name;
|
|
- pr " memcpy (String_val (v), %s->%s, %s->%s_len);\n"
|
|
+ pr " v = caml_alloc_initialized_string (%s->%s_len, %s->%s);\n"
|
|
typ name typ name
|
|
| name, FUUID ->
|
|
- pr " v = caml_alloc_string (32);\n";
|
|
- pr " memcpy (String_val (v), %s->%s, 32);\n" typ name
|
|
+ pr " v = caml_alloc_initialized_string (32, %s->%s);\n"
|
|
+ typ name
|
|
| name, (FBytes|FInt64|FUInt64) ->
|
|
pr " v = caml_copy_int64 (%s->%s);\n" typ name
|
|
| name, (FInt32|FUInt32) ->
|
|
@@ -757,8 +756,7 @@ copy_table (char * const * argv)
|
|
pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
|
|
pr " free (r);\n";
|
|
| RBufferOut _ ->
|
|
- pr " rv = caml_alloc_string (size);\n";
|
|
- pr " memcpy (String_val (rv), r, size);\n";
|
|
+ pr " rv = caml_alloc_initialized_string (size, r);\n";
|
|
pr " free (r);\n"
|
|
);
|
|
|
|
diff --git a/m4/guestfs-ocaml.m4 b/m4/guestfs-ocaml.m4
|
|
index 3c504ce7e..90658e8c5 100644
|
|
--- a/m4/guestfs-ocaml.m4
|
|
+++ b/m4/guestfs-ocaml.m4
|
|
@@ -221,6 +221,24 @@ AS_IF([test "x$have_Hivex_OPEN_UNSAFE" = "xno"],[
|
|
])
|
|
AC_SUBST([HIVEX_OPEN_UNSAFE_FLAG])
|
|
|
|
+dnl Check if OCaml has caml_alloc_initialized_string (added 2017).
|
|
+AS_IF([test "x$OCAMLC" != "xno" && test "x$OCAMLFIND" != "xno" && \
|
|
+ test "x$enable_ocaml" = "xyes"],[
|
|
+ AC_MSG_CHECKING([for caml_alloc_initialized_string])
|
|
+ cat >conftest.c <<'EOF'
|
|
+#include <caml/alloc.h>
|
|
+int main () { char *p = (void *) caml_alloc_initialized_string; return 0; }
|
|
+EOF
|
|
+ AS_IF([$OCAMLC conftest.c >&AS_MESSAGE_LOG_FD 2>&1],[
|
|
+ AC_MSG_RESULT([yes])
|
|
+ AC_DEFINE([HAVE_CAML_ALLOC_INITIALIZED_STRING],[1],
|
|
+ [caml_alloc_initialized_string found at compile time.])
|
|
+ ],[
|
|
+ AC_MSG_RESULT([no])
|
|
+ ])
|
|
+ rm -f conftest.c conftest.o
|
|
+])
|
|
+
|
|
dnl Flags we want to pass to every OCaml compiler call.
|
|
OCAML_WARN_ERROR="-warn-error CDEFLMPSUVYZX+52-3"
|
|
AC_SUBST([OCAML_WARN_ERROR])
|
|
diff --git a/ocaml/guestfs-c.c b/ocaml/guestfs-c.c
|
|
index 3b5fb198f..18d7dd978 100644
|
|
--- a/ocaml/guestfs-c.c
|
|
+++ b/ocaml/guestfs-c.c
|
|
@@ -360,8 +360,7 @@ event_callback_wrapper_locked (guestfs_h *g,
|
|
|
|
ehv = Val_int (event_handle);
|
|
|
|
- bufv = caml_alloc_string (buf_len);
|
|
- memcpy (String_val (bufv), buf, buf_len);
|
|
+ bufv = caml_alloc_initialized_string (buf_len, buf);
|
|
|
|
arrayv = caml_alloc (array_len, 0);
|
|
for (i = 0; i < array_len; ++i) {
|
|
diff --git a/ocaml/guestfs-c.h b/ocaml/guestfs-c.h
|
|
index f05dbd8e7..93ad3e2bf 100644
|
|
--- a/ocaml/guestfs-c.h
|
|
+++ b/ocaml/guestfs-c.h
|
|
@@ -19,6 +19,24 @@
|
|
#ifndef GUESTFS_OCAML_C_H
|
|
#define GUESTFS_OCAML_C_H
|
|
|
|
+#include "config.h"
|
|
+
|
|
+#include <caml/alloc.h>
|
|
+#include <caml/mlvalues.h>
|
|
+
|
|
+/* 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
|
|
+
|
|
#define Guestfs_val(v) (*((guestfs_h **)Data_custom_val(v)))
|
|
extern void guestfs_int_ocaml_raise_error (guestfs_h *g, const char *func)
|
|
Noreturn;
|
|
--
|
|
2.18.4
|
|
|