From 6e79a3c84d2bc048b2213c87cc9e96f620f754c5 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 14 Jun 2016 17:21:47 +0100 Subject: [PATCH] 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 | 2 ++ builder/Makefile.am | 1 + customize/Makefile.am | 1 + customize/urandom.ml | 18 +++++++++--------- dib/Makefile.am | 1 + generator/Makefile.am | 1 + generator/utils.ml | 16 +++++++++------- get-kernel/Makefile.am | 1 + m4/guestfs_ocaml.m4 | 37 ++++++++++++++++++++++++++++++++++++ mllib/JSON.ml | 6 +++--- mllib/Makefile.am | 1 + mllib/common_utils.ml | 26 ++++++++++++------------- mllib/common_utils.mli | 7 ------- mllib/regedit.ml | 12 ++++++------ resize/Makefile.am | 1 + sparsify/Makefile.am | 1 + sysprep/Makefile.am | 1 + v2v/Makefile.am | 3 +++ v2v/convert_windows.ml | 8 ++++---- v2v/input_ova.ml | 6 +++--- v2v/test-harness/Makefile.am | 1 + 21 files changed, 99 insertions(+), 52 deletions(-) diff --git a/.gitignore b/.gitignore index 8509a9ddc..b537231c9 100644 --- a/.gitignore +++ b/.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 diff --git a/builder/Makefile.am b/builder/Makefile.am index 720ebb4f8..ad32940ec 100644 --- a/builder/Makefile.am +++ b/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 \ diff --git a/customize/Makefile.am b/customize/Makefile.am index 661917a24..de3d7e0be 100644 --- a/customize/Makefile.am +++ b/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 \ diff --git a/customize/urandom.ml b/customize/urandom.ml index 9b613e83d..3686f77d2 100644 --- a/customize/urandom.ml +++ b/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 diff --git a/dib/Makefile.am b/dib/Makefile.am index d1674a994..ae6e87887 100644 --- a/dib/Makefile.am +++ b/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 \ diff --git a/generator/Makefile.am b/generator/Makefile.am index 393c56684..fdb6c0e45 100644 --- a/generator/Makefile.am +++ b/generator/Makefile.am @@ -82,6 +82,7 @@ sources = \ # In build dependency order. objects = \ + $(OCAML_GENERATOR_BYTES_COMPAT_CMO) \ types.cmo \ utils.cmo \ actions.cmo \ diff --git a/generator/utils.ml b/generator/utils.ml index 6fb04dcdb..eee8d59ef 100644 --- a/generator/utils.ml +++ b/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 = ' ' diff --git a/get-kernel/Makefile.am b/get-kernel/Makefile.am index 9d8fc61b2..6892fbbe7 100644 --- a/get-kernel/Makefile.am +++ b/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 \ diff --git a/m4/guestfs_ocaml.m4 b/m4/guestfs_ocaml.m4 index 346779ce5..ec83c5efa 100644 --- a/m4/guestfs_ocaml.m4 +++ b/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 < 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 = diff --git a/mllib/common_utils.mli b/mllib/common_utils.mli index 24162ba0f..5b0b9bb07 100644 --- a/mllib/common_utils.mli +++ b/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 diff --git a/mllib/regedit.ml b/mllib/regedit.ml index 389dd82c6..1ec7d4b46 100644 --- a/mllib/regedit.ml +++ b/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. *) diff --git a/resize/Makefile.am b/resize/Makefile.am index e9f48da61..da5d42daa 100644 --- a/resize/Makefile.am +++ b/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 \ diff --git a/sparsify/Makefile.am b/sparsify/Makefile.am index 9df3e1fb3..9593dd5cf 100644 --- a/sparsify/Makefile.am +++ b/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 \ diff --git a/sysprep/Makefile.am b/sysprep/Makefile.am index e439a8891..d4f117339 100644 --- a/sysprep/Makefile.am +++ b/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 \ diff --git a/v2v/Makefile.am b/v2v/Makefile.am index 933a7ec7b..4ae0ebbce 100644 --- a/v2v/Makefile.am +++ b/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 \ diff --git a/v2v/convert_windows.ml b/v2v/convert_windows.ml index 87d72e69a..abb83cb63 100644 --- a/v2v/convert_windows.ml +++ b/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) ) ) diff --git a/v2v/input_ova.ml b/v2v/input_ova.ml index 215eed61a..8a5886c7f 100644 --- a/v2v/input_ova.ml +++ b/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 diff --git a/v2v/test-harness/Makefile.am b/v2v/test-harness/Makefile.am index cba5b418b..97d62f07f 100644 --- a/v2v/test-harness/Makefile.am +++ b/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 \