[Libguestfs] [PATCH 2/3] Convert source so it can be compiled with OCaml '-safe-string' option.
Richard W.M. Jones
rjones at redhat.com
Wed Jun 15 11:46:11 UTC 2016
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
More information about the Libguestfs
mailing list