From 6f77926f464b6834339895e295f295953686af22 Mon Sep 17 00:00:00 2001
From: Josh Berdine <josh@berdine.net>
Date: Thu, 25 Mar 2021 23:34:04 +0000
Subject: [PATCH] [OCaml] Fix a possible crash in llvm_struct_name

The implementation of `llvm_struct_name` before this diff calls
`caml_copy_string`, which allocates, while the `result` local variable
points to a block allocated by `caml_alloc_small` that has not yet
been initialized. If the allocation in `caml_copy_string` triggers a
garbage collection, then the GC root `result` contains a pointer to
uninitialized data, which may crash the GC or lead to a memory
corruption.

This diff fixes this by allocating and initializing the string first
and then allocating and initializing the option, thereby leaving no
dangling pointers when allocations are made.

The conversion from a C string to an OCaml string option is refactored
into a function, `cstr_to_string_option`. This function is also used
to simplify the definitions of `llvm_get_mdstring` and
`llvm_string_of_const`.

Differential Revision: https://reviews.llvm.org/D99393
---
 llvm/bindings/ocaml/llvm/llvm_ocaml.c | 66 +++++++++++----------------
 1 file changed, 27 insertions(+), 39 deletions(-)

diff --git a/llvm/bindings/ocaml/llvm/llvm_ocaml.c b/llvm/bindings/ocaml/llvm/llvm_ocaml.c
index 9a05345ba64819..a7e449abcd940d 100644
--- a/llvm/bindings/ocaml/llvm/llvm_ocaml.c
+++ b/llvm/bindings/ocaml/llvm/llvm_ocaml.c
@@ -56,6 +56,18 @@ CAMLprim value cstr_to_string(const char *Str, mlsize_t Len) {
   CAMLreturn(String);
 }
 
+CAMLprim value cstr_to_string_option(const char *CStr, mlsize_t Len) {
+  CAMLparam0();
+  CAMLlocal2(Option, String);
+  if (!CStr)
+    CAMLreturn(Val_int(0));
+  String = caml_alloc_string(Len);
+  memcpy((char *)String_val(String), CStr, Len);
+  Option = caml_alloc_small(1, 0);
+  Store_field(Option, 0, (value)String);
+  CAMLreturn(Option);
+}
+
 void llvm_raise(value Prototype, char *Message) {
   CAMLparam1(Prototype);
   caml_raise_with_arg(Prototype, llvm_string_of_message(Message));
@@ -529,17 +541,13 @@ CAMLprim value llvm_struct_set_body(LLVMTypeRef Ty,
 }
 
 /* lltype -> string option */
-CAMLprim value llvm_struct_name(LLVMTypeRef Ty)
-{
-  CAMLparam0();
-  CAMLlocal1(result);
-  const char *C = LLVMGetStructName(Ty);
-  if (C) {
-    result = caml_alloc_small(1, 0);
-    Store_field(result, 0, caml_copy_string(C));
-    CAMLreturn(result);
-  }
-  CAMLreturn(Val_int(0));
+CAMLprim value llvm_struct_name(LLVMTypeRef Ty) {
+  const char *CStr = LLVMGetStructName(Ty);
+  size_t Len;
+  if (!CStr)
+    return Val_int(0);
+  Len = strlen(CStr);
+  return cstr_to_string_option(CStr, Len);
 }
 
 /* lltype -> lltype array */
@@ -877,19 +885,9 @@ CAMLprim LLVMValueRef llvm_mdnull(LLVMContextRef C) {
 
 /* llvalue -> string option */
 CAMLprim value llvm_get_mdstring(LLVMValueRef V) {
-  CAMLparam0();
-  CAMLlocal2(Option, Str);
-  const char *S;
-  unsigned Len;
-
-  if ((S = LLVMGetMDString(V, &Len))) {
-    Str = caml_alloc_string(Len);
-    memcpy((char *)String_val(Str), S, Len);
-    Option = alloc(1,0);
-    Store_field(Option, 0, Str);
-    CAMLreturn(Option);
-  }
-  CAMLreturn(Val_int(0));
+  size_t Len;
+  const char *CStr = LLVMGetMDString(V, &Len);
+  return cstr_to_string_option(CStr, Len);
 }
 
 CAMLprim value llvm_get_mdnode_operands(LLVMValueRef V) {
@@ -1045,22 +1043,12 @@ CAMLprim LLVMValueRef llvm_const_vector(value ElementVals) {
 
 /* llvalue -> string option */
 CAMLprim value llvm_string_of_const(LLVMValueRef Const) {
-  const char *S;
   size_t Len;
-  CAMLparam0();
-  CAMLlocal2(Option, Str);
-
-  if(LLVMIsAConstantDataSequential(Const) && LLVMIsConstantString(Const)) {
-    S = LLVMGetAsString(Const, &Len);
-    Str = caml_alloc_string(Len);
-    memcpy((char *)String_val(Str), S, Len);
-
-    Option = alloc(1, 0);
-    Field(Option, 0) = Str;
-    CAMLreturn(Option);
-  } else {
-    CAMLreturn(Val_int(0));
-  }
+  const char *CStr;
+  if (!LLVMIsAConstantDataSequential(Const) || !LLVMIsConstantString(Const))
+    return Val_int(0);
+  CStr = LLVMGetAsString(Const, &Len);
+  return cstr_to_string_option(CStr, Len);
 }
 
 /* llvalue -> int -> llvalue */