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 8509a9d..b537231 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 720ebb4..ad32940 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 661917a..de3d7e0 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 9b613e8..3686f77 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 d1674a9..ae6e878 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 393c566..fdb6c0e 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 6fb04dc..eee8d59 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 9d8fc61..6892fbb 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 346779c..62a06fc 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. +rm -f generator/bytes.ml mllib/bytes.ml +AS_IF([test "x$have_Bytes_module" = "xno"],[ + mkdir -p generator + 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]) diff --git a/mllib/JSON.ml b/mllib/JSON.ml index 90c8932..1198983 100644 --- a/mllib/JSON.ml +++ b/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 diff --git a/mllib/Makefile.am b/mllib/Makefile.am index 3b3f86b..f3fcf48 100644 --- a/mllib/Makefile.am +++ b/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 \ diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml index d687ebd..64bf3d3 100644 --- a/mllib/common_utils.ml +++ b/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 = diff --git a/mllib/common_utils.mli b/mllib/common_utils.mli index 24162ba..5b0b9bb 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 389dd82..1ec7d4b 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 e9f48da..da5d42d 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 9df3e1f..9593dd5 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 e439a88..d4f1173 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 933a7ec..4ae0ebb 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 87d72e6..abb83cb 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 215eed6..8a5886c 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 cba5b41..97d62f0 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 \ -- 2.7.4