Convert source so it can be compiled with OCaml '-safe-string' option.

OCaml 4.02 introduced the 'bytes' type, a mutable string intended to
replace the existing 'string' type for those cases where the byte
array can be mutated.  In future the 'string' type will become
immutable.  This is not the default now, but it can be forced using
the '-safe-string' compile option.

This commit changes the code so that it could be compiled using
'-safe-string' (but does not actually make that change).

If we detect OCaml < 4.02, we create a dummy 'Bytes' compatibility
module ((nearly) an alias for the 'String' module).  The only
significant difference from upstream OCaml is that you must write the
'bytes' type as 'Bytes.t' in interfaces, apart from that everything
else should work.

.gitignore

@@ -224,6 +224,7 @@ Makefile.in
 /fuse/test-guestmount-fd
 /fuse/test-guestunmount-fd
 /generator/.depend
+/generator/bytes.ml
 /generator/files-generated.txt
 /generator/generator
 /generator/.pod2text.data*
@@ -289,6 +290,7 @@ Makefile.in
 /make-fs/virt-make-fs.1
 /missing
 /mllib/.depend
+/mllib/bytes.ml
 /mllib/common_gettext.ml
 /mllib/common_utils_tests
 /mllib/dummy

builder/Makefile.am

@@ -132,6 +132,7 @@ virt_builder_CFLAGS = \
 	$(YAJL_CFLAGS)
 
 BOBJECTS = \
+	$(OCAML_BYTES_COMPAT_CMO) \
 	$(top_builddir)/mllib/libdir.cmo \
 	$(top_builddir)/mllib/guestfs_config.cmo \
 	$(top_builddir)/mllib/common_gettext.cmo \

customize/Makefile.am

@@ -92,6 +92,7 @@ virt_customize_CFLAGS = \
 	$(LIBXML2_CFLAGS)
 
 BOBJECTS = \
+	$(OCAML_BYTES_COMPAT_CMO) \
 	$(top_builddir)/mllib/guestfs_config.cmo \
 	$(top_builddir)/mllib/common_gettext.cmo \
 	$(top_builddir)/mllib/dev_t.cmo \

customize/urandom.ml

@@ -29,23 +29,23 @@ open Unix
 let open_urandom_fd () = openfile "/dev/urandom" [O_RDONLY] 0
 
 let read_byte fd =
-  let s = String.make 1 ' ' in
+  let b = Bytes.make 1 ' ' in
   fun () ->
-    if read fd s 0 1 = 0 then (
+    if read fd b 0 1 = 0 then (
       close fd;
       raise End_of_file
     );
-    Char.code s.[0]
+    Char.code (Bytes.unsafe_get b 0)
 
 let urandom_bytes n =
   assert (n > 0);
-  let ret = String.make n ' ' in
+  let ret = Bytes.make n ' ' in
   let fd = open_urandom_fd () in
   for i = 0 to n-1 do
-    ret.[i] <- Char.chr (read_byte fd ())
+    Bytes.unsafe_set ret i (Char.chr (read_byte fd ()))
   done;
   close fd;
-  ret
+  Bytes.to_string ret
 
 (* Return a random number uniformly distributed in [0, upper_bound)
  * avoiding modulo bias.
@@ -60,10 +60,10 @@ let urandom_uniform n chars =
   let nr_chars = String.length chars in
   assert (nr_chars > 0);
 
-  let ret = String.make n ' ' in
+  let ret = Bytes.make n ' ' in
   let fd = open_urandom_fd () in
   for i = 0 to n-1 do
-    ret.[i] <- chars.[uniform_random (read_byte fd) nr_chars]
+    Bytes.unsafe_set ret i (chars.[uniform_random (read_byte fd) nr_chars])
   done;
   close fd;
-  ret
+  Bytes.to_string ret

dib/Makefile.am

@@ -55,6 +55,7 @@ virt_dib_CFLAGS = \
 	$(WARN_CFLAGS) $(WERROR_CFLAGS)
 
 BOBJECTS = \
+	$(OCAML_BYTES_COMPAT_CMO) \
 	$(top_builddir)/mllib/libdir.cmo \
 	$(top_builddir)/mllib/guestfs_config.cmo \
 	$(top_builddir)/mllib/common_gettext.cmo \

generator/Makefile.am

@@ -82,6 +82,7 @@ sources = \
 
 # In build dependency order.
 objects = \
+	$(OCAML_GENERATOR_BYTES_COMPAT_CMO) \
 	types.cmo \
 	utils.cmo \
 	actions.cmo \

generator/utils.ml

@@ -59,8 +59,10 @@ let uuidgen () =
    * the UUID being zero, so we artificially rewrite such UUIDs.
    * http://article.gmane.org/gmane.linux.utilities.util-linux-ng/4273
    *)
-  if s.[0] = '0' && s.[1] = '0' then
-    s.[0] <- '1';
+  let s =
+    if s.[0] = '0' && s.[1] = '0' then
+      "1" ^ String.sub s 1 (String.length s - 1)
+    else s in
 
   String.sub s 0 8 ^ "-"
   ^ String.sub s 8 4 ^ "-"
@@ -120,15 +122,15 @@ let failwithf fs = ksprintf failwith fs
 let unique = let i = ref 0 in fun () -> incr i; !i
 
 let replace_char s c1 c2 =
-  let s2 = String.copy s in
+  let b2 = Bytes.of_string s in
   let r = ref false in
-  for i = 0 to String.length s2 - 1 do
-    if String.unsafe_get s2 i = c1 then (
-      String.unsafe_set s2 i c2;
+  for i = 0 to Bytes.length b2 - 1 do
+    if Bytes.unsafe_get b2 i = c1 then (
+      Bytes.unsafe_set b2 i c2;
       r := true
     )
   done;
-  if not !r then s else s2
+  if not !r then s else Bytes.to_string b2
 
 let isspace c =
   c = ' '

get-kernel/Makefile.am

@@ -54,6 +54,7 @@ virt_get_kernel_CFLAGS = \
 	$(LIBXML2_CFLAGS)
 
 BOBJECTS = \
+	$(OCAML_BYTES_COMPAT_CMO) \
 	$(top_builddir)/mllib/libdir.cmo \
 	$(top_builddir)/mllib/guestfs_config.cmo \
 	$(top_builddir)/mllib/common_gettext.cmo \

m4/guestfs_ocaml.m4

@@ -69,6 +69,7 @@ OCAML_PKG_gettext=no
 OCAML_PKG_libvirt=no
 OCAML_PKG_oUnit=no
 ounit_is_v2=no
+have_Bytes_module=no
 AS_IF([test "x$OCAMLC" != "xno"],[
     # Create mllib/common_gettext.ml, gettext functions or stubs.
 
@@ -85,6 +86,20 @@ AS_IF([test "x$OCAMLC" != "xno"],[
     if test "x$OCAML_PKG_oUnit" != "xno"; then
         AC_CHECK_OCAML_MODULE(ounit_is_v2,[OUnit.OUnit2],OUnit2,[+oUnit])
     fi
+
+    # Check if we have the 'Bytes' module.  If not (OCaml < 4.02) then
+    # we need to create a compatibility module.
+    # AC_CHECK_OCAML_MODULE is a bit broken, so open code this test.
+    AC_MSG_CHECKING([for OCaml module Bytes])
+    rm -f conftest.ml
+    echo 'let s = Bytes.empty' > conftest.ml
+    if $OCAMLC -c conftest.ml >&5 2>&5 ; then
+        AC_MSG_RESULT([yes])
+        have_Bytes_module=yes
+    else
+        AC_MSG_RESULT([not found])
+        have_Bytes_module=no
+    fi
 ])
 AM_CONDITIONAL([HAVE_OCAML_PKG_GETTEXT],
     [test "x$OCAMLC" != "xno" && test "x$OCAMLFIND" != "xno" && test "x$OCAML_PKG_gettext" != "xno"])
@@ -97,6 +112,28 @@ AC_CHECK_PROG([OCAML_GETTEXT],[ocaml-gettext],[ocaml-gettext],[no])
 AM_CONDITIONAL([HAVE_OCAML_GETTEXT],
     [test "x$OCAMLC" != "xno" && test "x$OCAMLFIND" != "xno" && test "x$OCAML_PKG_gettext" != "xno" && test "x$OCAML_GETTEXT" != "xno"])
 
+dnl Create the backwards compatibility Bytes module for OCaml < 4.02.
+mkdir -p generator mllib
+rm -f generator/bytes.ml mllib/bytes.ml
+AS_IF([test "x$have_Bytes_module" = "xno"],[
+    cat > generator/bytes.ml <<EOF
+include String
+let of_string = String.copy
+let to_string = String.copy
+EOF
+    ln -s ../generator/bytes.ml mllib/bytes.ml
+    OCAML_GENERATOR_BYTES_COMPAT_CMO='$(top_builddir)/generator/bytes.cmo'
+    OCAML_BYTES_COMPAT_CMO='$(top_builddir)/mllib/bytes.cmo'
+    OCAML_BYTES_COMPAT_ML='$(top_builddir)/mllib/bytes.ml'
+],[
+    OCAML_GENERATOR_BYTES_COMPAT_CMO=
+    OCAML_BYTES_COMPAT_CMO=
+    OCAML_BYTES_COMPAT_ML=
+])
+AC_SUBST([OCAML_GENERATOR_BYTES_COMPAT_CMO])
+AC_SUBST([OCAML_BYTES_COMPAT_CMO])
+AC_SUBST([OCAML_BYTES_COMPAT_ML])
+
 dnl Flags we want to pass to every OCaml compiler call.
 OCAML_WARN_ERROR="-warn-error CDEFLMPSUVYZX-3"
 AC_SUBST([OCAML_WARN_ERROR])

mllib/JSON.ml

@@ -35,9 +35,9 @@ type output_format =
 
 let spaces_for_indent level =
   let len = level * 2 in
-  let s = String.create len in
-  String.fill s 0 len ' ';
-  s
+  let b = Bytes.create len in
+  Bytes.fill b 0 len ' ';
+  Bytes.to_string b
 
 let print_dict_after_start ~fmt ~indent ~size =
   match size, fmt with

mllib/Makefile.am

@@ -39,6 +39,7 @@ SOURCES_MLI = \
 
 SOURCES_ML = \
 	guestfs_config.ml \
+	$(OCAML_BYTES_COMPAT_ML) \
 	libdir.ml \
 	common_gettext.ml \
 	dev_t.ml \

mllib/common_utils.ml

@@ -169,12 +169,12 @@ let le32_of_int i =
   let c1 = Int64.shift_right (i &^ 0xff00L) 8 in
   let c2 = Int64.shift_right (i &^ 0xff0000L) 16 in
   let c3 = Int64.shift_right (i &^ 0xff000000L) 24 in
-  let s = String.create 4 in
-  String.unsafe_set s 0 (Char.unsafe_chr (Int64.to_int c0));
-  String.unsafe_set s 1 (Char.unsafe_chr (Int64.to_int c1));
-  String.unsafe_set s 2 (Char.unsafe_chr (Int64.to_int c2));
-  String.unsafe_set s 3 (Char.unsafe_chr (Int64.to_int c3));
-  s
+  let b = Bytes.create 4 in
+  Bytes.unsafe_set b 0 (Char.unsafe_chr (Int64.to_int c0));
+  Bytes.unsafe_set b 1 (Char.unsafe_chr (Int64.to_int c1));
+  Bytes.unsafe_set b 2 (Char.unsafe_chr (Int64.to_int c2));
+  Bytes.unsafe_set b 3 (Char.unsafe_chr (Int64.to_int c3));
+  Bytes.to_string b
 
 let isdigit = function
   | '0'..'9' -> true
@@ -202,7 +202,7 @@ and _wrap chan indent column i len str =
         indent + (j-i) + 1
       )
       else column + (j-i) + 1 in
-    output chan str i (j-i);
+    output chan (Bytes.of_string str) i (j-i);
     match break with
     | WrapEOS -> ()
     | WrapSpace ->
@@ -439,11 +439,11 @@ let read_whole_file path =
   let buf = Buffer.create 16384 in
   let chan = open_in path in
   let maxlen = 16384 in
-  let s = String.create maxlen in
+  let b = Bytes.create maxlen in
   let rec loop () =
-    let r = input chan s 0 maxlen in
+    let r = input chan b 0 maxlen in
     if r > 0 then (
-      Buffer.add_substring buf s 0 r;
+      Buffer.add_substring buf (Bytes.to_string b) 0 r;
       loop ()
     )
   in
@@ -790,9 +790,9 @@ let detect_file_type filename =
   let get start size =
     try
       seek_in chan start;
-      let buf = String.create size in
-      really_input chan buf 0 size;
-      Some buf
+      let b = Bytes.create size in
+      really_input chan b 0 size;
+      Some (Bytes.to_string b)
     with End_of_file | Invalid_argument _ -> None
   in
   let ret =

mllib/common_utils.mli

@@ -31,15 +31,12 @@ end
 
 module String : sig
     type t = string
-    val blit : string -> int -> string -> int -> int -> unit
     val compare: t -> t -> int
     val concat : string -> string list -> string
     val contains : string -> char -> bool
     val contains_from : string -> int -> char -> bool
     val copy : string -> string
-    val create : int -> string
     val escaped : string -> string
-    val fill : string -> int -> int -> char -> unit
     val get : string -> int -> char
     val index : string -> char -> int
     val index_from : string -> int -> char -> int
@@ -49,12 +46,8 @@ module String : sig
     val rcontains_from : string -> int -> char -> bool
     val rindex : string -> char -> int
     val rindex_from : string -> int -> char -> int
-    val set : string -> int -> char -> unit
     val sub : string -> int -> int -> string
-    val unsafe_blit : string -> int -> string -> int -> int -> unit
-    val unsafe_fill : string -> int -> int -> char -> unit
     val unsafe_get : string -> int -> char
-    val unsafe_set : string -> int -> char -> unit
 
     val lowercase_ascii : string -> string
     val uppercase_ascii : string -> string

mllib/regedit.ml

@@ -35,11 +35,11 @@ and regtype =
 (* Take a 7 bit ASCII string and encode it as UTF16LE. *)
 let encode_utf16le str =
   let len = String.length str in
-  let copy = String.make (len*2) '\000' in
+  let copy = Bytes.make (len*2) '\000' in
   for i = 0 to len-1 do
-    String.unsafe_set copy (i*2) (String.unsafe_get str i)
+    Bytes.unsafe_set copy (i*2) (String.unsafe_get str i)
   done;
-  copy
+  Bytes.to_string copy
 
 (* Take a UTF16LE string and decode it to UTF-8.  Actually this
  * fails if the string is not 7 bit ASCII.  XXX Use iconv here.
@@ -48,15 +48,15 @@ let decode_utf16le str =
   let len = String.length str in
   if len mod 2 <> 0 then
     error (f_"decode_utf16le: Windows string does not appear to be in UTF16-LE encoding.  This could be a bug in %s.") prog;
-  let copy = String.create (len/2) in
+  let copy = Bytes.create (len/2) in
   for i = 0 to (len/2)-1 do
     let cl = String.unsafe_get str (i*2) in
     let ch = String.unsafe_get str ((i*2)+1) in
     if ch != '\000' || Char.code cl >= 127 then
       error (f_"decode_utf16le: Windows UTF16-LE string contains non-7-bit characters.  This is a bug in %s, please report it.") prog;
-    String.unsafe_set copy i cl
+    Bytes.unsafe_set copy i cl
   done;
-  copy
+  Bytes.to_string copy
 
 let rec import_key (g : Guestfs.guestfs) root (path, values) =
   (* Create the path starting at the root node. *)

resize/Makefile.am

@@ -54,6 +54,7 @@ virt_resize_CFLAGS = \
 	$(LIBXML2_CFLAGS)
 
 BOBJECTS = \
+	$(OCAML_BYTES_COMPAT_CMO) \
 	$(top_builddir)/mllib/fsync.cmo \
 	$(top_builddir)/mllib/progress.cmo \
 	$(top_builddir)/mllib/URI.cmo \

sparsify/Makefile.am

@@ -56,6 +56,7 @@ virt_sparsify_CFLAGS = \
 	$(WARN_CFLAGS) $(WERROR_CFLAGS)
 
 BOBJECTS = \
+	$(OCAML_BYTES_COMPAT_CMO) \
 	$(top_builddir)/mllib/guestfs_config.cmo \
 	$(top_builddir)/mllib/common_gettext.cmo \
 	$(top_builddir)/mllib/dev_t.cmo \

sysprep/Makefile.am

@@ -105,6 +105,7 @@ virt_sysprep_CFLAGS = \
 	$(LIBXML2_CFLAGS)
 
 BOBJECTS = \
+	$(OCAML_BYTES_COMPAT_CMO) \
 	$(top_builddir)/mllib/guestfs_config.cmo \
 	$(top_builddir)/mllib/common_gettext.cmo \
 	$(top_builddir)/mllib/dev_t.cmo \

v2v/Makefile.am

@@ -121,6 +121,7 @@ virt_v2v_CFLAGS = \
 	$(LIBVIRT_CFLAGS)
 
 BOBJECTS = \
+	$(OCAML_BYTES_COMPAT_CMO) \
 	$(top_builddir)/mllib/guestfs_config.cmo \
 	$(top_builddir)/mllib/common_gettext.cmo \
 	$(top_builddir)/mllib/dev_t.cmo \
@@ -188,6 +189,7 @@ virt_v2v_copy_to_local_CFLAGS = \
 	$(LIBVIRT_CFLAGS)
 
 COPY_TO_LOCAL_BOBJECTS = \
+	$(OCAML_BYTES_COMPAT_CMO) \
 	$(top_builddir)/mllib/guestfs_config.cmo \
 	$(top_builddir)/mllib/common_gettext.cmo \
 	$(top_builddir)/mllib/dev_t.cmo \
@@ -396,6 +398,7 @@ check_PROGRAMS += v2v_unit_tests
 endif
 
 v2v_unit_tests_BOBJECTS = \
+	$(OCAML_BYTES_COMPAT_CMO) \
 	$(top_builddir)/mllib/guestfs_config.cmo \
 	$(top_builddir)/mllib/common_gettext.cmo \
 	$(top_builddir)/mllib/dev_t.cmo \

v2v/convert_windows.ml

@@ -506,10 +506,10 @@ if errorlevel 3010 exit /b 0
          * unsigned 16 bit little-endian integer, offset 0x1a from the
          * beginning of the partition.
          *)
-        let bytes = String.create 2 in
-        bytes.[0] <- Char.chr heads;
-        bytes.[1] <- '\000';
-        ignore (g#pwrite_device rootpart bytes 0x1a_L)
+        let b = Bytes.create 2 in
+        Bytes.unsafe_set b 0 (Char.chr heads);
+        Bytes.unsafe_set b 1 '\000';
+        ignore (g#pwrite_device rootpart (Bytes.to_string b) 0x1a_L)
       )
     )
 

v2v/input_ova.ml

@@ -46,15 +46,15 @@ object
         let uncompress_head zcat file =
           let cmd = sprintf "%s %s" zcat (quote file) in
           let chan_out, chan_in, chan_err = Unix.open_process_full cmd [||] in
-          let buf = String.create 512 in
-          let len = input chan_out buf 0 (String.length buf) in
+          let b = Bytes.create 512 in
+          let len = input chan_out b 0 (Bytes.length b) in
           (* We're expecting the subprocess to fail because we close
            * the pipe early, so:
            *)
           ignore (Unix.close_process_full (chan_out, chan_in, chan_err));
 
           let tmpfile, chan = Filename.open_temp_file ~temp_dir:tmpdir "ova.file." "" in
-          output chan buf 0 len;
+          output chan b 0 len;
           close_out chan;
 
           tmpfile in

v2v/test-harness/Makefile.am

@@ -58,6 +58,7 @@ OCAMLPACKAGES = \
 OCAMLFLAGS = $(OCAML_FLAGS) $(OCAML_WARN_ERROR)
 
 BOBJECTS = \
+	$(OCAML_BYTES_COMPAT_CMO) \
 	$(top_builddir)/mllib/guestfs_config.cmo \
 	$(top_builddir)/mllib/common_gettext.cmo \
 	$(top_builddir)/mllib/dev_t.cmo \