Using Ctypes with strings

ctypes_strings.ml

#require "base,stdio,ctypes.foreign";;

open Base
open Stdio
open Ctypes
open Foreign

(* getenv

   A string is passed and a string, which doesn't require deallocation, is
   returned. *)

let getenv = foreign "getenv" (string @-> returning string)
let () = printf "USER=%s\n" (getenv "USER")

(* better yet, dont core dump if null is returned. *)
let getenv_opt = foreign "getenv" (string @-> returning string_opt)
let () = printf "foobar=%s\n"
    (Option.value ~default:"???" (getenv_opt "foobar"))

(* strdup

   A string is passed and C allocates a new copy. *)

(* This leaks the C-string. *)
let strdup = foreign "strdup" (string @-> returning string)
let () = printf "%s\n" (strdup "hello world, leaky.")

(* Free the C-string manually. *)
let free = foreign "free" (ptr void @-> returning void)
let strdup = foreign "strdup" (string @-> returning (ptr char))
let read x =
  let y = coerce (ptr char) string x in
  free (to_voidp x); (* should really check for null *)
  y
let strdup x = read (strdup x)
let () = printf "%s\n" (strdup "hello world, free'd.")

(* Use a view to make this pattern generic. *)
let string_with_freed_c_buffer =
  view ~write:(fun _ -> failwith "write") ~read (ptr char)
let strdup = foreign "strdup" (string @-> returning string_with_freed_c_buffer)
let () = printf "%s\n" (strdup "hello world, view.")

(* index

   A string is passed and returned pointing to the first occurrence of a
   character.  This is potentially subtle because a pointer into the input
   string is returned. *)

let index = foreign "index" (string @-> int @-> returning string_opt)
let () = printf "%s\n"
    (Option.value ~default:"???"
       (index "    hello world, index" (Char.to_int 'h')))

(* It would be interesting to know if the string passed as input is totally
   guaranteed to live long enough to be copied into the output string.  If not
   we can do this to hold a reference to the argument until the value is
   used. *)
let index = foreign "index" (ptr char @-> int @-> returning (ptr char))
let index x p =
  let x = ref (coerce string (ptr char) x) in
  let y = index !x p in
  let z = coerce (ptr char) string_opt y in
  x := from_voidp char null;
  z
let () = printf "%s\n"
    (Option.value ~default:"???"
       (index "    hello world, index safe?" (Char.to_int 'h')))