[Libguestfs] [PATCH v6 04/41] mllib: Split ‘Common_utils’ into ‘Std_utils’ + ‘Common_utils’.

The new module ‘Std_utils’ contains only functions which are pure OCaml and depend only on the OCaml stdlib. Therefore these functions may be used by the generator. The new module is moved to ‘common/mlstdutils’. This also removes the "<stdlib>" hack, and the code which copied the library around. Also ‘Guestfs_config’, ‘Libdir’ and ‘StringMap’ modules are moved since these are essentially the same. The bulk of this change is just updating files which use ‘open Common_utils’ to add ‘open Std_utils’ where necessary. --- .gitignore | 8 +- Makefile.am | 2 +- builder/Makefile.am | 12 +- builder/builder.ml | 1 + builder/cache.ml | 3 +- builder/cmdline.ml | 3 +- builder/downloader.ml | 3 +- builder/index.ml | 3 +- builder/index_parser.ml | 3 +- builder/ini_reader.ml | 1 + builder/languages.ml | 1 + builder/list_entries.ml | 3 +- builder/paths.ml | 1 + builder/sigchecker.ml | 3 +- builder/simplestreams_parser.ml | 3 +- builder/sources.ml | 3 +- builder/yajl.ml | 3 +- common/mlstdutils/Makefile.am | 151 +++++ common/mlstdutils/dummy.c | 2 + {mllib => common/mlstdutils}/guestfs_config.ml.in | 0 common/mlstdutils/std_utils.ml | 664 +++++++++++++++++++++ common/mlstdutils/std_utils.mli | 338 +++++++++++ common/mlstdutils/std_utils_tests.ml | 95 +++ {mllib => common/mlstdutils}/stringMap.ml | 0 {mllib => common/mlstdutils}/stringMap.mli | 0 configure.ac | 3 +- customize/Makefile.am | 8 +- customize/SELinux_relabel.ml | 3 +- customize/append_line.ml | 1 + customize/customize_main.ml | 3 +- customize/customize_run.ml | 3 +- customize/firstboot.ml | 1 + customize/hostname.ml | 1 + customize/password.ml | 3 +- customize/perl_edit.ml | 1 + customize/ssh_key.ml | 7 +- customize/subscription_manager.ml | 3 +- dib/Makefile.am | 10 +- dib/cmdline.ml | 3 +- dib/dib.ml | 3 +- dib/elements.ml | 3 +- dib/output_format.ml | 1 + dib/output_format_qcow2.ml | 1 + dib/utils.ml | 3 +- docs/C_SOURCE_FILES | 1 + docs/guestfs-hacking.pod | 4 + generator/GObject.ml | 2 +- generator/Makefile.am | 34 +- generator/OCaml.ml | 2 +- generator/UEFI.ml | 2 +- generator/XDR.ml | 2 +- generator/actions.ml | 2 +- generator/authors.ml | 2 +- generator/bindtests.ml | 2 +- generator/c.ml | 2 +- generator/checks.ml | 2 +- generator/csharp.ml | 2 +- generator/customize.ml | 3 +- generator/daemon.ml | 2 +- generator/docstrings.ml | 2 +- generator/erlang.ml | 2 +- generator/errnostring.ml | 2 +- generator/events.ml | 2 +- generator/fish.ml | 2 +- generator/golang.ml | 2 +- generator/haskell.ml | 2 +- generator/java.ml | 2 +- generator/lua.ml | 2 +- generator/main.ml | 2 +- generator/optgroups.ml | 2 +- generator/perl.ml | 2 +- generator/php.ml | 2 +- generator/pr.ml | 2 +- generator/python.ml | 2 +- generator/ruby.ml | 2 +- generator/structs.ml | 2 +- generator/tests_c_api.ml | 2 +- generator/utils.ml | 2 +- get-kernel/Makefile.am | 10 +- get-kernel/get_kernel.ml | 3 +- mllib/Makefile.am | 25 +- mllib/checksums.ml | 3 +- mllib/common_utils.ml | 676 +--------------------- mllib/common_utils.mli | 347 ----------- mllib/common_utils_tests.ml | 62 +- mllib/curl.ml | 1 + mllib/getopt_tests.ml | 1 + mllib/regedit.ml | 1 + mllib/registry.ml | 3 +- mllib/xpath_helpers.ml | 3 +- resize/Makefile.am | 5 +- resize/resize.ml | 1 + sparsify/Makefile.am | 5 +- sparsify/cmdline.ml | 3 +- sparsify/copying.ml | 1 + sparsify/in_place.ml | 1 + sparsify/utils.ml | 2 +- sysprep/Makefile.am | 5 +- sysprep/main.ml | 1 + sysprep/sysprep_operation.ml | 4 +- sysprep/sysprep_operation_backup_files.ml | 3 +- sysprep/sysprep_operation_cron_spool.ml | 6 +- sysprep/sysprep_operation_net_hostname.ml | 4 +- sysprep/sysprep_operation_net_hwaddr.ml | 4 +- sysprep/sysprep_operation_script.ml | 3 +- sysprep/sysprep_operation_user_account.ml | 1 + v2v/DOM.ml | 1 + v2v/Makefile.am | 6 +- v2v/changeuid.ml | 3 +- v2v/cmdline.ml | 3 +- v2v/convert_linux.ml | 3 +- v2v/convert_windows.ml | 3 +- v2v/copy_to_local.ml | 3 +- v2v/create_libvirt_xml.ml | 3 +- v2v/create_ovf.ml | 7 +- v2v/input_disk.ml | 3 +- v2v/input_libvirtxml.ml | 3 +- v2v/input_ova.ml | 3 +- v2v/input_vmx.ml | 3 +- v2v/inspect_source.ml | 1 + v2v/linux.ml | 3 +- v2v/linux_bootloaders.ml | 3 +- v2v/linux_kernels.ml | 3 +- v2v/modules_list.ml | 2 +- v2v/output_glance.ml | 3 +- v2v/output_libvirt.ml | 3 +- v2v/output_local.ml | 3 +- v2v/output_null.ml | 3 +- v2v/output_qemu.ml | 3 +- v2v/output_rhv.ml | 3 +- v2v/output_vdsm.ml | 3 +- v2v/parse_libvirt_xml.ml | 7 +- v2v/parse_ovf_from_ova.ml | 3 +- v2v/parse_vmx.ml | 1 + v2v/target_bus_assignment.ml | 1 + v2v/test-harness/Makefile.am | 3 +- v2v/test-harness/v2v_test_harness.ml | 1 + v2v/utils.ml | 3 +- v2v/v2v.ml | 3 +- v2v/v2v_unit_tests.ml | 8 +- v2v/vCenter.ml | 1 + v2v/windows_virtio.ml | 3 +- 142 files changed, 1526 insertions(+), 1238 deletions(-) diff --git a/.gitignore b/.gitignore index a82a1f674..991b1ab94 100644 --- a/.gitignore +++ b/.gitignore @@ -125,6 +125,11 @@ Makefile.in /common/errnostring/errnostring.h /common/miniexpect/miniexpect.3 /common/mlprogress/.depend +/common/mlstdutils/.depend +/common/mlstdutils/guestfs_config.ml +/common/mlstdutils/libdir.ml +/common/mlstdutils/oUnit-* +/common/mlstdutils/std_utils_tests /common/mlvisit/.depend /common/mlvisit/visit_tests /common/mlxml/.depend @@ -276,7 +281,6 @@ Makefile.in /generator/common_utils.mli /generator/files-generated.txt /generator/generator -/generator/guestfs_config.ml /generator/.pod2text.data* /generator/stamp-generator /get-kernel/.depend @@ -366,9 +370,7 @@ Makefile.in /mllib/common_utils_tests /mllib/dummy /mllib/getopt_tests -/mllib/guestfs_config.ml /mllib/JSON_tests -/mllib/libdir.ml /mllib/oUnit-* /ocaml/bindtests.bc /ocaml/bindtests.opt diff --git a/Makefile.am b/Makefile.am index 48f538475..64ac23f2e 100644 --- a/Makefile.am +++ b/Makefile.am @@ -20,7 +20,7 @@ include $(top_srcdir)/common-rules.mk ACLOCAL_AMFLAGS = -I m4 # The generator - must be before anything else. -SUBDIRS = generator +SUBDIRS = common/mlstdutils generator # Must be the first tests that run. if ENABLE_APPLIANCE diff --git a/builder/Makefile.am b/builder/Makefile.am index d56b394b7..5f0606ca4 100644 --- a/builder/Makefile.am +++ b/builder/Makefile.am @@ -124,6 +124,7 @@ OCAMLPACKAGES = \ -I $(top_builddir)/lib/.libs \ -I $(top_builddir)/gnulib/lib/.libs \ -I $(top_builddir)/ocaml \ + -I $(top_builddir)/common/mlstdutils \ -I $(top_builddir)/mllib \ -I $(top_builddir)/customize OCAMLPACKAGES_TESTS = @@ -153,10 +154,16 @@ else OBJECTS = $(XOBJECTS) endif -OCAMLLINKFLAGS = mlguestfs.$(MLARCHIVE) mllib.$(MLARCHIVE) customize.$(MLARCHIVE) $(LINK_CUSTOM_OCAMLC_ONLY) +OCAMLLINKFLAGS = \ + mlstdutils.$(MLARCHIVE) \ + mlguestfs.$(MLARCHIVE) \ + mllib.$(MLARCHIVE) \ + customize.$(MLARCHIVE) \ + $(LINK_CUSTOM_OCAMLC_ONLY) virt_builder_DEPENDENCIES = \ $(OBJECTS) \ + ../common/mlstdutils/mlstdutils.$(MLARCHIVE) \ ../mllib/mllib.$(MLARCHIVE) \ ../customize/customize.$(MLARCHIVE) \ $(top_srcdir)/ocaml-link.sh @@ -228,6 +235,7 @@ endif yajl_tests_DEPENDENCIES = \ $(yajl_tests_THEOBJECTS) \ + ../common/mlstdutils/mlstdutils.$(MLARCHIVE) \ ../mllib/mllib.$(MLARCHIVE) \ ../customize/customize.$(MLARCHIVE) \ $(top_srcdir)/ocaml-link.sh @@ -299,7 +307,7 @@ depend: .depend .depend: $(wildcard $(abs_srcdir)/*.mli) $(wildcard $(abs_srcdir)/*.ml) rm -f $@ $@-t - $(OCAMLFIND) ocamldep -I ../ocaml -I $(abs_srcdir) -I $(abs_top_builddir)/mllib -I $(abs_top_builddir)/customize $^ | \ + $(OCAMLFIND) ocamldep -I ../ocaml -I $(abs_srcdir) -I $(abs_top_builddir)/mlstdutils -I $(abs_top_builddir)/mllib -I $(abs_top_builddir)/customize $^ | \ $(SED) 's/ *$$//' | \ $(SED) -e :a -e '/ *\\$$/N; s/ *\\\n */ /; ta' | \ $(SED) -e 's,$(abs_srcdir)/,$(builddir)/,g' | \ diff --git a/builder/builder.ml b/builder/builder.ml index b0a48ea89..0e02bab3b 100644 --- a/builder/builder.ml +++ b/builder/builder.ml @@ -20,6 +20,7 @@ open Common_gettext.Gettext module G = Guestfs +open Std_utils open Common_utils open Unix_utils open Password diff --git a/builder/cache.ml b/builder/cache.ml index 19fcd15e2..494796edb 100644 --- a/builder/cache.ml +++ b/builder/cache.ml @@ -16,8 +16,9 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Utils diff --git a/builder/cmdline.ml b/builder/cmdline.ml index f20c0936c..a1f901144 100644 --- a/builder/cmdline.ml +++ b/builder/cmdline.ml @@ -18,8 +18,9 @@ (* Command line argument parsing. *) -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Getopt.OptionName open Customize_cmdline diff --git a/builder/downloader.ml b/builder/downloader.ml index ef3cd67cb..d6b27c8c7 100644 --- a/builder/downloader.ml +++ b/builder/downloader.ml @@ -16,8 +16,9 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Utils diff --git a/builder/index.ml b/builder/index.ml index 8c59de651..54af6e719 100644 --- a/builder/index.ml +++ b/builder/index.ml @@ -16,8 +16,9 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Utils diff --git a/builder/index_parser.ml b/builder/index_parser.ml index 468805cf8..fb546831f 100644 --- a/builder/index_parser.ml +++ b/builder/index_parser.ml @@ -16,8 +16,9 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Utils diff --git a/builder/ini_reader.ml b/builder/ini_reader.ml index 0470d173d..2d8ff7e59 100644 --- a/builder/ini_reader.ml +++ b/builder/ini_reader.ml @@ -16,6 +16,7 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) +open Std_utils open Common_utils type sections = section list diff --git a/builder/languages.ml b/builder/languages.ml index 66f49cb06..d94f97c5c 100644 --- a/builder/languages.ml +++ b/builder/languages.ml @@ -16,6 +16,7 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) +open Std_utils open Common_utils let split_locale loc = diff --git a/builder/list_entries.ml b/builder/list_entries.ml index 2a1aef4c8..ea607107c 100644 --- a/builder/list_entries.ml +++ b/builder/list_entries.ml @@ -16,8 +16,9 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Printf diff --git a/builder/paths.ml b/builder/paths.ml index cbd9d4bd0..e0fb9a024 100644 --- a/builder/paths.ml +++ b/builder/paths.ml @@ -16,6 +16,7 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) +open Std_utils open Common_utils let xdg_cache_home = diff --git a/builder/sigchecker.ml b/builder/sigchecker.ml index 6c1e691ee..f72c21ab0 100644 --- a/builder/sigchecker.ml +++ b/builder/sigchecker.ml @@ -16,9 +16,10 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) -open Common_gettext.Gettext +open Std_utils open Common_utils open Unix_utils +open Common_gettext.Gettext open Utils diff --git a/builder/simplestreams_parser.ml b/builder/simplestreams_parser.ml index 8844d476b..c550675ba 100644 --- a/builder/simplestreams_parser.ml +++ b/builder/simplestreams_parser.ml @@ -16,8 +16,9 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Yajl open Utils diff --git a/builder/sources.ml b/builder/sources.ml index 290151c3a..4c9ea0fff 100644 --- a/builder/sources.ml +++ b/builder/sources.ml @@ -16,8 +16,9 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Printf open Unix diff --git a/builder/yajl.ml b/builder/yajl.ml index d933b5246..5ae1c5d9b 100644 --- a/builder/yajl.ml +++ b/builder/yajl.ml @@ -16,8 +16,9 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext type yajl_val = | Yajl_null diff --git a/common/mlstdutils/Makefile.am b/common/mlstdutils/Makefile.am new file mode 100644 index 000000000..9e0b34d42 --- /dev/null +++ b/common/mlstdutils/Makefile.am @@ -0,0 +1,151 @@ +# libguestfs OCaml tools common code +# Copyright (C) 2011-2017 Red Hat Inc. +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +include $(top_srcdir)/subdir-rules.mk + +EXTRA_DIST = \ + $(SOURCES_MLI) \ + $(SOURCES_ML) \ + std_utils_tests.ml + +SOURCES_MLI = \ + std_utils.mli \ + stringMap.mli + +SOURCES_ML = \ + guestfs_config.ml \ + $(OCAML_BYTES_COMPAT_ML) \ + libdir.ml \ + stringMap.ml \ + std_utils.ml + +if HAVE_OCAML + +# We pretend that we're building a C library. automake handles the +# compilation of the C sources for us. At the end we take the C +# objects and OCaml objects and link them into the OCaml library. +# This C library is never used. + +noinst_LIBRARIES = libmlstdutils.a + +if !HAVE_OCAMLOPT +MLSTDUTILS_CMA = mlstdutils.cma +else +MLSTDUTILS_CMA = mlstdutils.cmxa +endif + +noinst_DATA = $(MLSTDUTILS_CMA) + +libmlstdutils_a_SOURCES = dummy.c +libmlstdutils_a_CPPFLAGS = \ + -I. \ + -I$(top_builddir) +libmlstdutils_a_CFLAGS = \ + $(WARN_CFLAGS) $(WERROR_CFLAGS) \ + -fPIC + +BOBJECTS = $(SOURCES_ML:.ml=.cmo) +XOBJECTS = $(BOBJECTS:.cmo=.cmx) + +OCAMLPACKAGES = \ + -package str,unix \ + -I $(builddir) +OCAMLPACKAGES_TESTS = $(MLSTDUTILS_CMA) +if HAVE_OCAML_PKG_OUNIT +OCAMLPACKAGES_TESTS += -package oUnit +endif + +OCAMLFLAGS = $(OCAML_FLAGS) $(OCAML_WARN_ERROR) + +if !HAVE_OCAMLOPT +OBJECTS = $(BOBJECTS) +else +OBJECTS = $(XOBJECTS) +endif + +libmlstdutils_a_DEPENDENCIES = $(OBJECTS) + +$(MLSTDUTILS_CMA): $(OBJECTS) + $(OCAMLFIND) mklib $(OCAMLPACKAGES) $(OBJECTS) -o mlstdutils + +# This OCaml module has to be generated by make (configure will put +# unexpanded prefix macro in). + +libdir.ml: Makefile + echo 'let libdir = "$(libdir)"' > $@-t + mv $@-t $@ + +# Tests. + +std_utils_tests_SOURCES = dummy.c +std_utils_tests_CPPFLAGS = \ + -I. \ + -I$(top_builddir) +std_utils_tests_BOBJECTS = std_utils_tests.cmo +std_utils_tests_XOBJECTS = $(std_utils_tests_BOBJECTS:.cmo=.cmx) + +# Can't call the following as <test>_OBJECTS because automake gets confused. +if !HAVE_OCAMLOPT +std_utils_tests_THEOBJECTS = $(std_utils_tests_BOBJECTS) +std_utils_tests.cmo: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS) +else +std_utils_tests_THEOBJECTS = $(std_utils_tests_XOBJECTS) +std_utils_tests.cmx: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS) +endif + +OCAMLLINKFLAGS = $(LINK_CUSTOM_OCAMLC_ONLY) + +std_utils_tests_DEPENDENCIES = \ + $(std_utils_tests_THEOBJECTS) \ + $(MLSTDUTILS_CMA) \ + $(top_srcdir)/ocaml-link.sh +std_utils_tests_LINK = \ + $(top_srcdir)/ocaml-link.sh -- \ + $(OCAMLFIND) $(BEST) $(OCAMLFLAGS) $(OCAMLLINKFLAGS) \ + $(OCAMLPACKAGES) $(OCAMLPACKAGES_TESTS) \ + $(std_utils_tests_THEOBJECTS) -o $@ + +TESTS_ENVIRONMENT = $(top_builddir)/run --test + +TESTS = +check_PROGRAMS = + +if HAVE_OCAML_PKG_OUNIT +check_PROGRAMS += std_utils_tests +TESTS += std_utils_tests +endif + +check-valgrind: + $(MAKE) VG="@VG@" check + +# Dependencies. +depend: .depend + +.depend: $(wildcard $(abs_srcdir)/*.mli) $(wildcard $(abs_srcdir)/*.ml) + rm -f $@ $@-t + $(OCAMLFIND) ocamldep -I $(abs_srcdir) $^ | \ + $(SED) 's/ *$$//' | \ + $(SED) -e :a -e '/ *\\$$/N; s/ *\\\n */ /; ta' | \ + $(SED) -e 's,$(abs_srcdir)/,$(builddir)/,g' | \ + sort > $@-t + mv $@-t $@ + +-include .depend + +endif + +.PHONY: depend docs diff --git a/common/mlstdutils/dummy.c b/common/mlstdutils/dummy.c new file mode 100644 index 000000000..ebab6198c --- /dev/null +++ b/common/mlstdutils/dummy.c @@ -0,0 +1,2 @@ +/* Dummy source, to be used for OCaml-based tools with no C sources. */ +enum { foo = 1 }; diff --git a/mllib/guestfs_config.ml.in b/common/mlstdutils/guestfs_config.ml.in similarity index 100% rename from mllib/guestfs_config.ml.in rename to common/mlstdutils/guestfs_config.ml.in diff --git a/common/mlstdutils/std_utils.ml b/common/mlstdutils/std_utils.ml new file mode 100644 index 000000000..7b8d65f66 --- /dev/null +++ b/common/mlstdutils/std_utils.ml @@ -0,0 +1,664 @@ +(* Common utilities for OCaml tools in libguestfs. + * Copyright (C) 2010-2017 Red Hat Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License along + * with this program; if not, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +open Printf + +module Char = struct + include Char + + let lowercase_ascii c = + if (c >= 'A' && c <= 'Z') + then unsafe_chr (code c + 32) + else c + + let uppercase_ascii c = + if (c >= 'a' && c <= 'z') + then unsafe_chr (code c - 32) + else c + + let isspace c = + c = ' ' + (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *) + + let isdigit = function + | '0'..'9' -> true + | _ -> false + + let isxdigit = function + | '0'..'9' -> true + | 'a'..'f' -> true + | 'A'..'F' -> true + | _ -> false + + let isalpha = function + | 'a'..'z' -> true + | 'A'..'Z' -> true + | _ -> false + + let isalnum = function + | '0'..'9' -> true + | 'a'..'z' -> true + | 'A'..'Z' -> true + | _ -> false + + let hexdigit = function + | '0' -> 0 + | '1' -> 1 + | '2' -> 2 + | '3' -> 3 + | '4' -> 4 + | '5' -> 5 + | '6' -> 6 + | '7' -> 7 + | '8' -> 8 + | '9' -> 9 + | 'a' | 'A' -> 10 + | 'b' | 'B' -> 11 + | 'c' | 'C' -> 12 + | 'd' | 'D' -> 13 + | 'e' | 'E' -> 14 + | 'f' | 'F' -> 15 + | _ -> -1 +end + +module String = struct + include String + + let map f s = + let len = String.length s in + let b = Bytes.create len in + for i = 0 to len-1 do + Bytes.unsafe_set b i (f (unsafe_get s i)) + done; + Bytes.to_string b + + let lowercase_ascii s = map Char.lowercase_ascii s + let uppercase_ascii s = map Char.uppercase_ascii s + + let capitalize_ascii s = + let b = Bytes.of_string s in + Bytes.unsafe_set b 0 (Char.uppercase_ascii (Bytes.unsafe_get b 0)); + Bytes.to_string b + + let is_prefix str prefix = + let n = length prefix in + length str >= n && sub str 0 n = prefix + + let is_suffix str suffix = + let sufflen = length suffix + and len = length str in + len >= sufflen && sub str (len - sufflen) sufflen = suffix + + let rec find s sub = + let len = length s in + let sublen = length sub in + let rec loop i = + if i <= len-sublen then ( + let rec loop2 j = + if j < sublen then ( + if s.[i+j] = sub.[j] then loop2 (j+1) + else -1 + ) else + i (* found *) + in + let r = loop2 0 in + if r = -1 then loop (i+1) else r + ) else + -1 (* not found *) + in + loop 0 + + let rec replace s s1 s2 = + let len = length s in + let sublen = length s1 in + let i = find s s1 in + if i = -1 then s + else ( + let s' = sub s 0 i in + let s'' = sub s (i+sublen) (len-i-sublen) in + s' ^ s2 ^ replace s'' s1 s2 + ) + + let replace_char s c1 c2 = + let b2 = Bytes.of_string s in + let r = ref false in + 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 Bytes.to_string b2 + + let rec nsplit sep str = + let len = length str in + let seplen = length sep in + let i = find str sep in + if i = -1 then [str] + else ( + let s' = sub str 0 i in + let s'' = sub str (i+seplen) (len-i-seplen) in + s' :: nsplit sep s'' + ) + + let split sep str = + let len = length sep in + let seplen = length str in + let i = find str sep in + if i = -1 then str, "" + else ( + sub str 0 i, sub str (i + len) (seplen - i - len) + ) + + let rec lines_split str = + let buf = Buffer.create 16 in + let len = length str in + let rec loop start len = + try + let i = index_from str start '\n' in + if i > 0 && str.[i-1] = '\\' then ( + Buffer.add_substring buf str start (i-start-1); + Buffer.add_char buf '\n'; + loop (i+1) len + ) else ( + Buffer.add_substring buf str start (i-start); + i+1 + ) + with Not_found -> + if len > 0 && str.[len-1] = '\\' then ( + Buffer.add_substring buf str start (len-start-1); + Buffer.add_char buf '\n' + ) else + Buffer.add_substring buf str start (len-start); + len+1 + in + let endi = loop 0 len in + let line = Buffer.contents buf in + if endi > len then + [line] + else + line :: lines_split (sub str endi (len-endi)) + + let random8 = + let chars = "abcdefghijklmnopqrstuvwxyz0123456789" in + fun () -> + concat "" ( + List.map ( + fun _ -> + let c = Random.int 36 in + let c = chars.[c] in + make 1 c + ) [1;2;3;4;5;6;7;8] + ) + + let triml ?(test = Char.isspace) str = + let i = ref 0 in + let n = ref (String.length str) in + while !n > 0 && test str.[!i]; do + decr n; + incr i + done; + if !i = 0 then str + else String.sub str !i !n + + let trimr ?(test = Char.isspace) str = + let n = ref (String.length str) in + while !n > 0 && test str.[!n-1]; do + decr n + done; + if !n = String.length str then str + else String.sub str 0 !n + + let trim ?(test = Char.isspace) str = + trimr ~test (triml ~test str) + + let count_chars c str = + let count = ref 0 in + for i = 0 to String.length str - 1 do + if c = String.unsafe_get str i then incr count + done; + !count + + let explode str = + let r = ref [] in + for i = 0 to String.length str - 1 do + let c = String.unsafe_get str i in + r := c :: !r; + done; + List.rev !r + + let map_chars f str = + List.map f (explode str) + + let spaces n = String.make n ' ' +end + +let (//) = Filename.concat +let quote = Filename.quote + +let subdirectory parent path = + if path = parent then + "" + else if String.is_prefix path (parent // "") then ( + let len = String.length parent in + String.sub path (len+1) (String.length path - len-1) + ) else + invalid_arg (sprintf "%S is not a path prefix of %S" parent path) + +let ( +^ ) = Int64.add +let ( -^ ) = Int64.sub +let ( *^ ) = Int64.mul +let ( /^ ) = Int64.div +let ( &^ ) = Int64.logand +let ( ~^ ) = Int64.lognot + +external identity : 'a -> 'a = "%identity" + +let roundup64 i a = let a = a -^ 1L in (i +^ a) &^ (~^ a) +let div_roundup64 i a = (i +^ a -^ 1L) /^ a + +let int_of_le32 str = + assert (String.length str = 4); + let c0 = Char.code (String.unsafe_get str 0) in + let c1 = Char.code (String.unsafe_get str 1) in + let c2 = Char.code (String.unsafe_get str 2) in + let c3 = Char.code (String.unsafe_get str 3) in + Int64.of_int c0 +^ + (Int64.shift_left (Int64.of_int c1) 8) +^ + (Int64.shift_left (Int64.of_int c2) 16) +^ + (Int64.shift_left (Int64.of_int c3) 24) + +let le32_of_int i = + let c0 = i &^ 0xffL in + 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 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 + +type wrap_break_t = WrapEOS | WrapSpace | WrapNL + +let rec wrap ?(chan = stdout) ?(indent = 0) str = + let len = String.length str in + _wrap chan indent 0 0 len str + +and _wrap chan indent column i len str = + if i < len then ( + let (j, break) = _wrap_find_next_break i len str in + let next_column = + if column + (j-i) >= 76 then ( + output_char chan '\n'; + output_spaces chan indent; + indent + (j-i) + 1 + ) + else column + (j-i) + 1 in + output chan (Bytes.of_string str) i (j-i); + match break with + | WrapEOS -> () + | WrapSpace -> + output_char chan ' '; + _wrap chan indent next_column (j+1) len str + | WrapNL -> + output_char chan '\n'; + output_spaces chan indent; + _wrap chan indent indent (j+1) len str + ) + +and _wrap_find_next_break i len str = + if i >= len then (len, WrapEOS) + else if String.unsafe_get str i = ' ' then (i, WrapSpace) + else if String.unsafe_get str i = '\n' then (i, WrapNL) + else _wrap_find_next_break (i+1) len str + +and output_spaces chan n = for i = 0 to n-1 do output_char chan ' ' done + +let (|>) x f = f x + +(* Drop elements from a list while a predicate is true. *) +let rec dropwhile f = function + | [] -> [] + | x :: xs when f x -> dropwhile f xs + | xs -> xs + +(* Take elements from a list while a predicate is true. *) +let rec takewhile f = function + | x :: xs when f x -> x :: takewhile f xs + | _ -> [] + +let rec filter_map f = function + | [] -> [] + | x :: xs -> + match f x with + | Some y -> y :: filter_map f xs + | None -> filter_map f xs + +let rec find_map f = function + | [] -> raise Not_found + | x :: xs -> + match f x with + | Some y -> y + | None -> find_map f xs + +let iteri f xs = + let rec loop i = function + | [] -> () + | x :: xs -> f i x; loop (i+1) xs + in + loop 0 xs + +let rec mapi i f = + function + | [] -> [] + | a::l -> + let r = f i a in + r :: mapi (i + 1) f l +let mapi f l = mapi 0 f l + +let rec combine3 xs ys zs = + match xs, ys, zs with + | [], [], [] -> [] + | x::xs, y::ys, z::zs -> (x, y, z) :: combine3 xs ys zs + | _ -> invalid_arg "combine3" + +let rec assoc ?(cmp = compare) ~default x = function + | [] -> default + | (y, y') :: _ when cmp x y = 0 -> y' + | _ :: ys -> assoc ~cmp ~default x ys + +let uniq ?(cmp = Pervasives.compare) xs = + let rec loop acc = function + | [] -> acc + | [x] -> x :: acc + | x :: (y :: _ as xs) when cmp x y = 0 -> + loop acc xs + | x :: (y :: _ as xs) -> + loop (x :: acc) xs + in + List.rev (loop [] xs) + +let sort_uniq ?(cmp = Pervasives.compare) xs = + let xs = List.sort cmp xs in + let xs = uniq ~cmp xs in + xs + +let remove_duplicates xs = + let h = Hashtbl.create (List.length xs) in + let rec loop = function + | [] -> [] + | x :: xs when Hashtbl.mem h x -> xs + | x :: xs -> Hashtbl.add h x true; x :: loop xs + in + loop xs + +let push_back xsp x = xsp := !xsp @ [x] +let push_front x xsp = xsp := x :: !xsp +let pop_back xsp = + let x, xs = + match List.rev !xsp with + | x :: xs -> x, xs + | [] -> failwith "pop" in + xsp := List.rev xs; + x +let pop_front xsp = + let x, xs = + match !xsp with + | x :: xs -> x, xs + | [] -> failwith "shift" in + xsp := xs; + x + +let append xsp xs = xsp := !xsp @ xs +let prepend xs xsp = xsp := xs @ !xsp + +let unique = let i = ref 0 in fun () -> incr i; !i + +let may f = function + | None -> () + | Some x -> f x + +type ('a, 'b) maybe = Either of 'a | Or of 'b + +let protect ~f ~finally = + let r = + try Either (f ()) + with exn -> Or exn in + finally (); + match r with Either ret -> ret | Or exn -> raise exn + +let failwithf fs = ksprintf failwith fs + +exception Executable_not_found of string (* executable *) + +let which executable = + let paths = + try String.nsplit ":" (Sys.getenv "PATH") + with Not_found -> [] in + let paths = filter_map ( + fun p -> + let path = p // executable in + try Unix.access path [Unix.X_OK]; Some path + with Unix.Unix_error _ -> None + ) paths in + match paths with + | [] -> raise (Executable_not_found executable) + | x :: _ -> x + +(* Program name. *) +let prog = Filename.basename Sys.executable_name + +(* Stores the colours (--colours), quiet (--quiet), trace (-x) and + * verbose (-v) flags in a global variable. + *) +let colours = ref false +let set_colours () = colours := true +let colours () = !colours + +let quiet = ref false +let set_quiet () = quiet := true +let quiet () = !quiet + +let trace = ref false +let set_trace () = trace := true +let trace () = !trace + +let verbose = ref false +let set_verbose () = verbose := true +let verbose () = !verbose + +let read_whole_file path = + let buf = Buffer.create 16384 in + let chan = open_in path in + let maxlen = 16384 in + let b = Bytes.create maxlen in + let rec loop () = + let r = input chan b 0 maxlen in + if r > 0 then ( + Buffer.add_substring buf (Bytes.to_string b) 0 r; + loop () + ) + in + loop (); + close_in chan; + Buffer.contents buf + +(* Compare two version strings intelligently. *) +let rex_numbers = Str.regexp "^\\([0-9]+\\)\\(.*\\)$" +let rex_letters = Str.regexp_case_fold "^\\([a-z]+\\)\\(.*\\)$" + +let compare_version v1 v2 = + let rec split_version = function + | "" -> [] + | str -> + let first, rest = + if Str.string_match rex_numbers str 0 then ( + let n = Str.matched_group 1 str in + let rest = Str.matched_group 2 str in + let n = + try `Number (int_of_string n) + with Failure _ -> `String n in + n, rest + ) + else if Str.string_match rex_letters str 0 then + `String (Str.matched_group 1 str), Str.matched_group 2 str + else ( + let len = String.length str in + `Char str.[0], String.sub str 1 (len-1) + ) in + first :: split_version rest + in + compare (split_version v1) (split_version v2) + +(* Annoying LVM2 returns a differing UUID strings for different + * function calls (sometimes containing or not containing '-' + * characters), so we have to normalize each string before + * comparison. c.f. 'compare_pvuuids' in virt-filesystem. + *) +let compare_lvm2_uuids uuid1 uuid2 = + let n1 = String.length uuid1 and n2 = String.length uuid2 in + let rec loop i1 i2 = + if i1 = n1 && i2 = n2 then 0 (* matching *) + else if i1 >= n1 then 1 (* different lengths *) + else if i2 >= n2 then -1 + else if uuid1.[i1] = '-' then loop (i1+1) i2 (* ignore '-' characters *) + else if uuid2.[i2] = '-' then loop i1 (i2+1) + else ( + let c = compare uuid1.[i1] uuid2.[i2] in + if c <> 0 then c (* not matching *) + else loop (i1+1) (i2+1) + ) + in + loop 0 0 + +let stringify_args args = + let rec quote_args = function + | [] -> "" + | x :: xs -> " " ^ Filename.quote x ^ quote_args xs + in + match args with + | [] -> "" + | app :: xs -> app ^ quote_args xs + +(* Unlink a temporary file on exit. *) +let unlink_on_exit = + let files = ref [] in + let registered_handlers = ref false in + + let rec unlink_files () = + List.iter ( + fun file -> try Unix.unlink file with _ -> () + ) !files + and register_handlers () = + (* Unlink on exit. *) + at_exit unlink_files + in + + fun file -> + files := file :: !files; + if not !registered_handlers then ( + register_handlers (); + registered_handlers := true + ) + +let is_block_device file = + try (Unix.stat file).Unix.st_kind = Unix.S_BLK + with Unix.Unix_error _ -> false + +let is_char_device file = + try (Unix.stat file).Unix.st_kind = Unix.S_CHR + with Unix.Unix_error _ -> false + +(* Annoyingly Sys.is_directory throws an exception on failure + * (RHBZ#1022431). + *) +let is_directory path = + try Sys.is_directory path + with Sys_error _ -> false + +let absolute_path path = + if not (Filename.is_relative path) then path + else Sys.getcwd () // path + +let qemu_input_filename filename = + (* If the filename is something like "file:foo" then qemu-img will + * try to interpret that as "foo" in the file:/// protocol. To + * avoid that, if the path is relative prefix it with "./" since + * qemu-img won't try to interpret such a path. + *) + if String.length filename > 0 && filename.[0] <> '/' then + "./" ^ filename + else + filename + +let rec mkdir_p path permissions = + try Unix.mkdir path permissions + with + | Unix.Unix_error (Unix.EEXIST, _, _) -> () + | Unix.Unix_error (Unix.ENOENT, _, _) -> + (* A component in the path does not exist, so first try + * creating the parent directory, and then again the requested + * directory. *) + mkdir_p (Filename.dirname path) permissions; + Unix.mkdir path permissions + +let normalize_arch = function + | "i486" | "i586" | "i686" -> "i386" + | "amd64" -> "x86_64" + | "powerpc" -> "ppc" + | "powerpc64" -> "ppc64" + | "powerpc64le" -> "ppc64le" + | arch -> arch + +(* Are guest arch and host_cpu compatible, in terms of being able + * to run commands in the libguestfs appliance? + *) +let guest_arch_compatible guest_arch = + let own = normalize_arch Guestfs_config.host_cpu in + let guest_arch = normalize_arch guest_arch in + match own, guest_arch with + | x, y when x = y -> true + | "x86_64", "i386" -> true + | _ -> false + +(* Is the guest OS "Unix-like"? *) +let unix_like = function + | "hurd" + | "linux" + | "minix" -> true + | typ when String.is_suffix typ "bsd" -> true + | _ -> false + +(** Return the last part of a string, after the specified separator. *) +let last_part_of str sep = + try + let i = String.rindex str sep in + Some (String.sub str (i+1) (String.length str - (i+1))) + with Not_found -> None + +let read_first_line_from_file filename = + let chan = open_in filename in + let line = input_line chan in + close_in chan; + line + +let is_regular_file path = (* NB: follows symlinks. *) + try (Unix.stat path).Unix.st_kind = Unix.S_REG + with Unix.Unix_error _ -> false diff --git a/common/mlstdutils/std_utils.mli b/common/mlstdutils/std_utils.mli new file mode 100644 index 000000000..820673764 --- /dev/null +++ b/common/mlstdutils/std_utils.mli @@ -0,0 +1,338 @@ +(* Common utilities for OCaml tools in libguestfs. + * Copyright (C) 2010-2017 Red Hat Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License along + * with this program; if not, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +module Char : sig + type t = char + val chr : int -> char + val code : char -> int + val compare: t -> t -> int + val escaped : char -> string + val unsafe_chr : int -> char + + val lowercase_ascii : char -> char + val uppercase_ascii : char -> char + + val isspace : char -> bool + (** Return true if char is a whitespace character. *) + val isdigit : char -> bool + (** Return true if the character is a digit [[0-9]]. *) + val isxdigit : char -> bool + (** Return true if the character is a hex digit [[0-9a-fA-F]]. *) + val isalpha : char -> bool + (** Return true if the character is a US ASCII 7 bit alphabetic. *) + val isalnum : char -> bool + (** Return true if the character is a US ASCII 7 bit alphanumeric. *) + + val hexdigit : char -> int + (** Return the value of a hex digit. If the char is not in + the set [[0-9a-fA-F]] then this returns [-1]. *) +end +(** Override the Char module from stdlib. *) + +module String : sig + type t = string + 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 escaped : string -> string + val get : string -> int -> char + val index : string -> char -> int + val index_from : string -> int -> char -> int + val iter : (char -> unit) -> string -> unit + val length : string -> int + val make : int -> char -> string + val rcontains_from : string -> int -> char -> bool + val rindex : string -> char -> int + val rindex_from : string -> int -> char -> int + val sub : string -> int -> int -> string + val unsafe_get : string -> int -> char + + val map : (char -> char) -> string -> string + + val lowercase_ascii : string -> string + val uppercase_ascii : string -> string + val capitalize_ascii : string -> string + + val is_prefix : string -> string -> bool + (** [is_prefix str prefix] returns true if [prefix] is a prefix of [str]. *) + val is_suffix : string -> string -> bool + (** [is_suffix str suffix] returns true if [suffix] is a suffix of [str]. *) + val find : string -> string -> int + (** [find str sub] searches for [sub] as a substring of [str]. If + found it returns the index. If not found, it returns [-1]. *) + val replace : string -> string -> string -> string + (** [replace str s1 s2] replaces all instances of [s1] appearing in + [str] with [s2]. *) + val replace_char : string -> char -> char -> string + (** Replace character in string. *) + val nsplit : string -> string -> string list + (** [nsplit sep str] splits [str] into multiple strings at each + separator [sep]. *) + val split : string -> string -> string * string + (** [split sep str] splits [str] at the first occurrence of the + separator [sep], returning the part before and the part after. + If separator is not found, return the whole string and an + empty string. *) + val lines_split : string -> string list + (** [lines_split str] splits [str] into lines, keeping continuation + characters (i.e. [\] at the end of lines) into account. *) + val random8 : unit -> string + (** Return a string of 8 random printable characters. *) + val triml : ?test:(char -> bool) -> string -> string + (** Trim left. *) + val trimr : ?test:(char -> bool) -> string -> string + (** Trim right. *) + val trim : ?test:(char -> bool) -> string -> string + (** Trim left and right. *) + val count_chars : char -> string -> int + (** Count number of times the character occurs in string. *) + val explode : string -> char list + (** Explode a string into a list of characters. *) + val map_chars : (char -> 'a) -> string -> 'a list + (** Explode string, then map function over the characters. *) + val spaces : int -> string + (** [spaces n] creates a string of n spaces. *) +end +(** Override the String module from stdlib. *) + +val ( // ) : string -> string -> string +(** Concatenate directory and filename. *) + +val quote : string -> string +(** Shell-safe quoting of a string (alias for {!Filename.quote}). *) + +val subdirectory : string -> string -> string +(** [subdirectory parent path] returns subdirectory part of [path] relative + to the [parent]. If [path] and [parent] point to the same directory empty + string is returned. + + Note: path normalization on arguments is {b not} performed! + + If [parent] is not a path prefix of [path] the function raises + [Invalid_argument]. *) + +val ( +^ ) : int64 -> int64 -> int64 +val ( -^ ) : int64 -> int64 -> int64 +val ( *^ ) : int64 -> int64 -> int64 +val ( /^ ) : int64 -> int64 -> int64 +val ( &^ ) : int64 -> int64 -> int64 +val ( ~^ ) : int64 -> int64 +(** Various int64 operators. *) + +external identity : 'a -> 'a = "%identity" + +val roundup64 : int64 -> int64 -> int64 +(** [roundup64 i a] returns [i] rounded up to the next multiple of [a]. *) +val div_roundup64 : int64 -> int64 -> int64 +(** [div_roundup64 i a] returns [i] rounded up to the next multiple of [a], + with the result divided by [a]. *) +val int_of_le32 : string -> int64 +(** Unpack a 4 byte string as a little endian 32 bit integer. *) +val le32_of_int : int64 -> string +(** Pack a 32 bit integer a 4 byte string stored little endian. *) + +val wrap : ?chan:out_channel -> ?indent:int -> string -> unit +(** Wrap text. *) + +val output_spaces : out_channel -> int -> unit +(** Write [n] spaces to [out_channel]. *) + +val (|>) : 'a -> ('a -> 'b) -> 'b +(** Added in OCaml 4.01, we can remove our definition when we + can assume this minimum version of OCaml. *) + +val dropwhile : ('a -> bool) -> 'a list -> 'a list +(** [dropwhile f xs] drops leading elements from [xs] until + [f] returns false. *) +val takewhile : ('a -> bool) -> 'a list -> 'a list +(** [takewhile f xs] takes leading elements from [xs] until + [f] returns false. + + For any list [xs] and function [f], + [xs = takewhile f xs @ dropwhile f xs] *) +val filter_map : ('a -> 'b option) -> 'a list -> 'b list +(** [filter_map f xs] applies [f] to each element of [xs]. If + [f x] returns [Some y] then [y] is added to the returned list. *) +val find_map : ('a -> 'b option) -> 'a list -> 'b +(** [find_map f xs] applies [f] to each element of [xs] until + [f x] returns [Some y]. It returns [y]. If we exhaust the + list then this raises [Not_found]. *) +val iteri : (int -> 'a -> 'b) -> 'a list -> unit +(** [iteri f xs] calls [f i x] for each element, with [i] counting from [0]. *) +val mapi : (int -> 'a -> 'b) -> 'a list -> 'b list +(** [mapi f xs] calls [f i x] for each element, with [i] counting from [0], + forming the return values from [f] into another list. *) + +val combine3 : 'a list -> 'b list -> 'c list -> ('a * 'b * 'c) list +(** Like {!List.combine} but for triples. All lists must be the same length. *) + +val assoc : ?cmp:('a -> 'a -> int) -> default:'b -> 'a -> ('a * 'b) list -> 'b +(** Like {!List.assoc} but with a user-defined comparison function, and + instead of raising [Not_found], it returns the [~default] value. *) + +val uniq : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list +(** Uniquify a list (the list must be sorted first). *) + +val sort_uniq : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list +(** Sort and uniquify a list. *) + +val remove_duplicates : 'a list -> 'a list +(** Remove duplicates from an unsorted list; useful when the order + of the elements matter. + + Please use [sort_uniq] when the order does not matter. *) + +val push_back : 'a list ref -> 'a -> unit +val push_front : 'a -> 'a list ref -> unit +val pop_back : 'a list ref -> 'a +val pop_front : 'a list ref -> 'a +(** Imperative list manipulation functions, similar to C++ STL + functions with the same names. (Although the names are similar, + the computational complexity of the functions is quite different.) + + These operate on list references, and each function modifies the + list reference that is passed to it. + + [push_back xsp x] appends the element [x] to the end of the list + [xsp]. This function is not tail-recursive. + + [push_front x xsp] prepends the element [x] to the head of the + list [xsp]. (The arguments are reversed compared to the same Perl + function, but OCaml is type safe so that's OK.) + + [pop_back xsp] removes the last element of the list [xsp] and + returns it. The list is modified to become the list minus the + final element. If a zero-length list is passed in, this raises + [Failure "pop_back"]. This function is not tail-recursive. + + [pop_front xsp] removes the head element of the list [xsp] and + returns it. The list is modified to become the tail of the list. + If a zero-length list is passed in, this raises [Failure + "pop_front"]. *) + +val append : 'a list ref -> 'a list -> unit +val prepend : 'a list -> 'a list ref -> unit +(** More imperative list manipulation functions. + + [append] is like {!push_back} above, except it appends a list to + the list reference. This function is not tail-recursive. + + [prepend] is like {!push_front} above, except it prepends a list + to the list reference. *) + +val unique : unit -> int +(** Returns a unique number each time called. *) + +val may : ('a -> unit) -> 'a option -> unit +(** [may f (Some x)] runs [f x]. [may f None] does nothing. *) + +type ('a, 'b) maybe = Either of 'a | Or of 'b +(** Like the Haskell [Either] type. *) + +val protect : f:(unit -> 'a) -> finally:(unit -> unit) -> 'a +(** Execute [~f] and afterwards execute [~finally]. + + If [~f] throws an exception then [~finally] is run and the + original exception from [~f] is re-raised. + + If [~finally] throws an exception, then the original exception + is lost. (NB: Janestreet core {!Exn.protectx}, on which this + function is modelled, doesn't throw away the exception in this + case, but requires a lot more work by the caller. Perhaps we + will change this in future.) *) + +val failwithf : ('a, unit, string, 'b) format4 -> 'a +(** Like [failwith] but supports printf-like arguments. *) + +exception Executable_not_found of string (* executable *) +(** Exception thrown by [which] when the specified executable is not found + in [$PATH]. *) + +val which : string -> string +(** Return the full path of the specified executable from [$PATH]. + + Throw [Executable_not_found] if not available. *) + +val prog : string +(** The program name (derived from {!Sys.executable_name}). *) + +val set_colours : unit -> unit +val colours : unit -> bool +val set_quiet : unit -> unit +val quiet : unit -> bool +val set_trace : unit -> unit +val trace : unit -> bool +val set_verbose : unit -> unit +val verbose : unit -> bool +(** Stores the colours ([--colours]), quiet ([--quiet]), trace ([-x]) + and verbose ([-v]) flags in global variables. *) + +val read_whole_file : string -> string +(** Read in the whole file as a string. *) + +val compare_version : string -> string -> int +(** Compare two version strings. *) + +val compare_lvm2_uuids : string -> string -> int +(** Compare two LVM2 UUIDs, ignoring '-' characters. *) + +val stringify_args : string list -> string +(** Create a "pretty-print" representation of a program invocation + (i.e. executable and its arguments). *) + +val unlink_on_exit : string -> unit +(** Unlink a temporary file on exit. *) + +val is_block_device : string -> bool +val is_char_device : string -> bool +val is_directory : string -> bool +(** These don't throw exceptions, unlike the [Sys] functions. *) + +val absolute_path : string -> string +(** Convert any path to an absolute path. *) + +val qemu_input_filename : string -> string +(** Sanitizes a filename for passing it safely to qemu/qemu-img. *) + +val mkdir_p : string -> int -> unit +(** Creates a directory, and its parents if missing. *) + +val normalize_arch : string -> string +(** Normalize the architecture name, i.e. maps it into a defined + identifier for it -- e.g. i386, i486, i586, and i686 are + normalized as i386. *) + +val guest_arch_compatible : string -> bool +(** Are guest arch and host_cpu compatible, in terms of being able + to run commands in the libguestfs appliance? *) + +val unix_like : string -> bool +(** Is the guest OS "Unix-like"? Call this with the result of + {!Guestfs.inspect_get_type}. *) + +val last_part_of : string -> char -> string option +(** Return the last part of a string, after the specified separator. *) + +val read_first_line_from_file : string -> string +(** Read only the first line (i.e. until the first newline character) + of a file. *) + +val is_regular_file : string -> bool +(** Checks whether the file is a regular file. *) diff --git a/common/mlstdutils/std_utils_tests.ml b/common/mlstdutils/std_utils_tests.ml new file mode 100644 index 000000000..1003f931c --- /dev/null +++ b/common/mlstdutils/std_utils_tests.ml @@ -0,0 +1,95 @@ +(* Utilities for OCaml tools in libguestfs. + * Copyright (C) 2011-2017 Red Hat Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License along + * with this program; if not, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +(* This file tests the Std_utils module. *) + +open OUnit2 +open Std_utils + +(* Utils. *) +let assert_equal_string = assert_equal ~printer:(fun x -> x) +let assert_equal_int = assert_equal ~printer:(fun x -> string_of_int x) +let assert_equal_int64 = assert_equal ~printer:(fun x -> Int64.to_string x) +let assert_equal_stringlist = assert_equal ~printer:(fun x -> "(" ^ (String.escaped (String.concat "," x)) ^ ")") + +let test_subdirectory ctx = + assert_equal_string "" (subdirectory "/foo" "/foo"); + assert_equal_string "" (subdirectory "/foo" "/foo/"); + assert_equal_string "bar" (subdirectory "/foo" "/foo/bar"); + assert_equal_string "bar/baz" (subdirectory "/foo" "/foo/bar/baz") + +(* Test Common_utils.int_of_le32 and Common_utils.le32_of_int. *) +let test_le32 ctx = + assert_equal_int64 0x20406080L (int_of_le32 "\x80\x60\x40\x20"); + assert_equal_string "\x80\x60\x40\x20" (le32_of_int 0x20406080L) + +(* Test Std_utils.String.is_prefix. *) +let test_string_is_prefix ctx = + assert_bool "String.is_prefix,," (String.is_prefix "" ""); + assert_bool "String.is_prefix,foo," (String.is_prefix "foo" ""); + assert_bool "String.is_prefix,foo,foo" (String.is_prefix "foo" "foo"); + assert_bool "String.is_prefix,foo123,foo" (String.is_prefix "foo123" "foo"); + assert_bool "not (String.is_prefix,,foo" (not (String.is_prefix "" "foo")) + +(* Test Std_utils.String.is_suffix. *) +let test_string_is_suffix ctx = + assert_bool "String.is_suffix,," (String.is_suffix "" ""); + assert_bool "String.is_suffix,foo," (String.is_suffix "foo" ""); + assert_bool "String.is_suffix,foo,foo" (String.is_suffix "foo" "foo"); + assert_bool "String.is_suffix,123foo,foo" (String.is_suffix "123foo" "foo"); + assert_bool "not String.is_suffix,,foo" (not (String.is_suffix "" "foo")) + +(* Test Std_utils.String.find. *) +let test_string_find ctx = + assert_equal_int 0 (String.find "" ""); + assert_equal_int 0 (String.find "foo" ""); + assert_equal_int 1 (String.find "foo" "o"); + assert_equal_int 3 (String.find "foobar" "bar"); + assert_equal_int (-1) (String.find "" "baz"); + assert_equal_int (-1) (String.find "foobar" "baz") + +(* Test Std_utils.String.lines_split. *) +let test_string_lines_split ctx = + assert_equal_stringlist [""] (String.lines_split ""); + assert_equal_stringlist ["A"] (String.lines_split "A"); + assert_equal_stringlist ["A"; ""] (String.lines_split "A\n"); + assert_equal_stringlist ["A"; "B"] (String.lines_split "A\nB"); + assert_equal_stringlist ["A"; "B"; "C"] (String.lines_split "A\nB\nC"); + assert_equal_stringlist ["A"; "B"; "C"; "D"] (String.lines_split "A\nB\nC\nD"); + assert_equal_stringlist ["A\n"] (String.lines_split "A\\"); + assert_equal_stringlist ["A\nB"] (String.lines_split "A\\\nB"); + assert_equal_stringlist ["A"; "B\nC"] (String.lines_split "A\nB\\\nC"); + assert_equal_stringlist ["A"; "B\nC"; "D"] (String.lines_split "A\nB\\\nC\nD"); + assert_equal_stringlist ["A"; "B\nC\nD"] (String.lines_split "A\nB\\\nC\\\nD"); + assert_equal_stringlist ["A\nB"; ""] (String.lines_split "A\\\nB\n"); + assert_equal_stringlist ["A\nB\n"] (String.lines_split "A\\\nB\\\n") + +(* Suites declaration. *) +let suite = + "mllib Std_utils" >::: + [ + "subdirectory" >:: test_subdirectory; + "numeric.le32" >:: test_le32; + "strings.is_prefix" >:: test_string_is_prefix; + "strings.is_suffix" >:: test_string_is_suffix; + "strings.find" >:: test_string_find; + "strings.lines_split" >:: test_string_lines_split; + ] + +let () = + run_test_tt_main suite diff --git a/mllib/stringMap.ml b/common/mlstdutils/stringMap.ml similarity index 100% rename from mllib/stringMap.ml rename to common/mlstdutils/stringMap.ml diff --git a/mllib/stringMap.mli b/common/mlstdutils/stringMap.mli similarity index 100% rename from mllib/stringMap.mli rename to common/mlstdutils/stringMap.mli diff --git a/configure.ac b/configure.ac index 7d0f0a1dd..eba149241 100644 --- a/configure.ac +++ b/configure.ac @@ -186,6 +186,8 @@ AC_CONFIG_FILES([Makefile common/edit/Makefile common/miniexpect/Makefile common/mlprogress/Makefile + common/mlstdutils/Makefile + common/mlstdutils/guestfs_config.ml common/mlvisit/Makefile common/mlxml/Makefile common/options/Makefile @@ -230,7 +232,6 @@ AC_CONFIG_FILES([Makefile lua/examples/Makefile make-fs/Makefile mllib/Makefile - mllib/guestfs_config.ml ocaml/META ocaml/Makefile ocaml/examples/Makefile diff --git a/customize/Makefile.am b/customize/Makefile.am index 07398b2e8..674134b70 100644 --- a/customize/Makefile.am +++ b/customize/Makefile.am @@ -123,6 +123,7 @@ OCAMLPACKAGES = \ -I $(top_builddir)/lib/.libs \ -I $(top_builddir)/gnulib/lib/.libs \ -I $(top_builddir)/ocaml \ + -I $(top_builddir)/common/mlstdutils \ -I $(top_builddir)/mllib \ -I $(builddir) if HAVE_OCAML_PKG_GETTEXT @@ -149,7 +150,12 @@ else CUSTOMIZE_THEOBJECTS = $(CUSTOMIZE_XOBJECTS) endif -OCAMLLINKFLAGS = mlguestfs.$(MLARCHIVE) mllib.$(MLARCHIVE) customize.$(MLARCHIVE) $(LINK_CUSTOM_OCAMLC_ONLY) +OCAMLLINKFLAGS = \ + mlstdutils.$(MLARCHIVE) \ + mlguestfs.$(MLARCHIVE) \ + mllib.$(MLARCHIVE) \ + customize.$(MLARCHIVE) \ + $(LINK_CUSTOM_OCAMLC_ONLY) OCAMLCLIBS = \ -lutils \ diff --git a/customize/SELinux_relabel.ml b/customize/SELinux_relabel.ml index 11999299b..ab373b33a 100644 --- a/customize/SELinux_relabel.ml +++ b/customize/SELinux_relabel.ml @@ -16,8 +16,9 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Printf diff --git a/customize/append_line.ml b/customize/append_line.ml index e967b4201..405080617 100644 --- a/customize/append_line.ml +++ b/customize/append_line.ml @@ -16,6 +16,7 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) +open Std_utils open Common_utils open Common_gettext.Gettext diff --git a/customize/customize_main.ml b/customize/customize_main.ml index 5b4641237..55ec3cb78 100644 --- a/customize/customize_main.ml +++ b/customize/customize_main.ml @@ -16,8 +16,9 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Getopt.OptionName open Customize_cmdline diff --git a/customize/customize_run.ml b/customize/customize_run.ml index f71ae3535..5564684b4 100644 --- a/customize/customize_run.ml +++ b/customize/customize_run.ml @@ -19,8 +19,9 @@ open Unix open Printf -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Customize_cmdline open Password diff --git a/customize/firstboot.ml b/customize/firstboot.ml index 9208daa0a..41aa52dac 100644 --- a/customize/firstboot.ml +++ b/customize/firstboot.ml @@ -18,6 +18,7 @@ open Printf +open Std_utils open Common_utils open Common_gettext.Gettext diff --git a/customize/hostname.ml b/customize/hostname.ml index 23c149402..b49db8714 100644 --- a/customize/hostname.ml +++ b/customize/hostname.ml @@ -16,6 +16,7 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) +open Std_utils open Common_utils open Printf diff --git a/customize/password.ml b/customize/password.ml index 4ab5a14d1..d26b94865 100644 --- a/customize/password.ml +++ b/customize/password.ml @@ -16,8 +16,9 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Printf diff --git a/customize/perl_edit.ml b/customize/perl_edit.ml index 5cd250b49..bb44ea062 100644 --- a/customize/perl_edit.ml +++ b/customize/perl_edit.ml @@ -16,6 +16,7 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) +open Std_utils open Common_utils external c_edit_file : verbose:bool -> Guestfs.t -> int64 -> string -> string -> unit diff --git a/customize/ssh_key.ml b/customize/ssh_key.ml index 4302a8e92..185536d1d 100644 --- a/customize/ssh_key.ml +++ b/customize/ssh_key.ml @@ -16,13 +16,14 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) -open Common_gettext.Gettext -open Common_utils - open Printf open Sys open Unix +open Std_utils +open Common_utils +open Common_gettext.Gettext + module G = Guestfs type ssh_key_selector = diff --git a/customize/subscription_manager.ml b/customize/subscription_manager.ml index a23efe546..56ba28ab9 100644 --- a/customize/subscription_manager.ml +++ b/customize/subscription_manager.ml @@ -16,8 +16,9 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext type sm_credentials = { sm_username : string; diff --git a/dib/Makefile.am b/dib/Makefile.am index 6780ee249..b10fa94c9 100644 --- a/dib/Makefile.am +++ b/dib/Makefile.am @@ -79,6 +79,7 @@ OCAMLPACKAGES = \ -I $(top_builddir)/lib/.libs \ -I $(top_builddir)/gnulib/lib/.libs \ -I $(top_builddir)/ocaml \ + -I $(top_builddir)/common/mlstdutils \ -I $(top_builddir)/mllib if HAVE_OCAML_PKG_GETTEXT OCAMLPACKAGES += -package gettext-stub @@ -99,10 +100,15 @@ else OBJECTS = $(XOBJECTS) endif -OCAMLLINKFLAGS = mlguestfs.$(MLARCHIVE) mllib.$(MLARCHIVE) $(LINK_CUSTOM_OCAMLC_ONLY) +OCAMLLINKFLAGS = \ + mlstdutils.$(MLARCHIVE) \ + mlguestfs.$(MLARCHIVE) \ + mllib.$(MLARCHIVE) \ + $(LINK_CUSTOM_OCAMLC_ONLY) virt_dib_DEPENDENCIES = \ $(OBJECTS) \ + ../common/mlstdutils/mlstdutils.$(MLARCHIVE) \ ../mllib/mllib.$(MLARCHIVE) \ $(top_srcdir)/ocaml-link.sh virt_dib_LINK = \ @@ -138,7 +144,7 @@ depend: .depend .depend: $(wildcard $(abs_srcdir)/*.mli) $(wildcard $(abs_srcdir)/*.ml) rm -f $@ $@-t - $(OCAMLFIND) ocamldep -I ../ocaml -I $(abs_srcdir) -I $(abs_top_builddir)/mllib $^ | \ + $(OCAMLFIND) ocamldep -I ../ocaml -I $(abs_srcdir) -I $(abs_top_builddir)/common/mlstdutils -I $(abs_top_builddir)/mllib $^ | \ $(SED) 's/ *$$//' | \ $(SED) -e :a -e '/ *\\$$/N; s/ *\\\n */ /; ta' | \ $(SED) -e 's,$(abs_srcdir)/,$(builddir)/,g' | \ diff --git a/dib/cmdline.ml b/dib/cmdline.ml index 67194704e..549f01546 100644 --- a/dib/cmdline.ml +++ b/dib/cmdline.ml @@ -18,8 +18,9 @@ (* Command line argument parsing. *) -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Getopt.OptionName open Utils diff --git a/dib/dib.ml b/dib/dib.ml index 8d078aabb..78b109da8 100644 --- a/dib/dib.ml +++ b/dib/dib.ml @@ -16,9 +16,10 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) -open Common_gettext.Gettext +open Std_utils open Common_utils open Unix_utils +open Common_gettext.Gettext open Cmdline open Utils diff --git a/dib/elements.ml b/dib/elements.ml index 4c2875ae1..d237eeb7f 100644 --- a/dib/elements.ml +++ b/dib/elements.ml @@ -18,8 +18,9 @@ (* Parsing and handling of elements. *) -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Utils diff --git a/dib/output_format.ml b/dib/output_format.ml index 851cefc43..6499ee259 100644 --- a/dib/output_format.ml +++ b/dib/output_format.ml @@ -16,6 +16,7 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) +open Std_utils open Common_utils open Common_gettext.Gettext open Getopt.OptionName diff --git a/dib/output_format_qcow2.ml b/dib/output_format_qcow2.ml index afb564ce7..a32b2a4f9 100644 --- a/dib/output_format_qcow2.ml +++ b/dib/output_format_qcow2.ml @@ -16,6 +16,7 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) +open Std_utils open Common_utils open Common_gettext.Gettext open Getopt.OptionName diff --git a/dib/utils.ml b/dib/utils.ml index afa2ec944..8b6bb1576 100644 --- a/dib/utils.ml +++ b/dib/utils.ml @@ -16,8 +16,9 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Printf diff --git a/docs/C_SOURCE_FILES b/docs/C_SOURCE_FILES index f6ac73047..71c17603f 100644 --- a/docs/C_SOURCE_FILES +++ b/docs/C_SOURCE_FILES @@ -16,6 +16,7 @@ common/edit/file-edit.h common/miniexpect/miniexpect.c common/miniexpect/miniexpect.h common/mlprogress/progress-c.c +common/mlstdutils/dummy.c common/mlvisit/dummy.c common/mlvisit/visit-c.c common/mlxml/xml-c.c diff --git a/docs/guestfs-hacking.pod b/docs/guestfs-hacking.pod index 1ff496381..beb44d2dc 100644 --- a/docs/guestfs-hacking.pod +++ b/docs/guestfs-hacking.pod @@ -100,6 +100,10 @@ A copy of the miniexpect library from L<http://git.annexia.org/?p=miniexpect.git;a=summary>;. This is used in virt-p2v. +=item F<common/mlstdutils> + +A library of pure OCaml utility functions used in many places. + =item F<common/mlprogress> OCaml bindings for the progress bar functions (see F<common/progress>). diff --git a/generator/GObject.ml b/generator/GObject.ml index bb95b170c..8fa17c219 100644 --- a/generator/GObject.ml +++ b/generator/GObject.ml @@ -22,7 +22,7 @@ open Printf -open Common_utils +open Std_utils open Actions open Docstrings open Events diff --git a/generator/Makefile.am b/generator/Makefile.am index 81b49cab1..401029d34 100644 --- a/generator/Makefile.am +++ b/generator/Makefile.am @@ -53,8 +53,6 @@ sources = \ c.mli \ checks.ml \ checks.mli \ - common_utils.ml \ - common_utils.mli \ csharp.ml \ csharp.mli \ customize.ml \ @@ -77,7 +75,6 @@ sources = \ GObject.mli \ golang.ml \ golang.mli \ - guestfs_config.ml \ haskell.ml \ haskell.mli \ java.ml \ @@ -118,8 +115,8 @@ sources = \ # In build dependency order. objects = \ $(OCAML_GENERATOR_BYTES_COMPAT_CMO) \ - guestfs_config.cmo \ - common_utils.cmo \ + ../common/mlstdutils/guestfs_config.cmo \ + ../common/mlstdutils/std_utils.cmo \ types.cmo \ utils.cmo \ proc_nr.cmo \ @@ -170,7 +167,12 @@ objects = \ EXTRA_DIST = $(sources) files-generated.txt -OCAMLPACKAGES = -package unix,str -I $(srcdir) -I . +OCAMLPACKAGES = \ + -package unix,str \ + -I $(srcdir) \ + -I . \ + -I $(top_srcdir)/common/mlstdutils \ + -I $(top_builddir)/common/mlstdutils OCAMLFLAGS = $(OCAML_FLAGS) $(OCAML_WARN_ERROR) noinst_PROGRAM = generator @@ -183,9 +185,9 @@ generator: $(objects) # Dependencies. depend: .depend -.depend: $(wildcard $(abs_srcdir)/*.mli) $(wildcard $(abs_srcdir)/*.ml) common_utils.ml common_utils.mli guestfs_config.ml +.depend: $(wildcard $(abs_srcdir)/*.mli) $(wildcard $(abs_srcdir)/*.ml) $(wildcard $(abs_srcdir)/common/mlstdutils/*.mli) $(wildcard $(abs_srcdir)/common/mlstdutils/*.ml) rm -f $@ $@-t - $(OCAMLFIND) ocamldep -I ../ocaml -I $(abs_srcdir) $^ | \ + $(OCAMLFIND) ocamldep -I ../common/mlstdutils -I $(abs_srcdir) $^ | \ $(SED) 's/ *$$//' | \ $(SED) -e :a -e '/ *\\$$/N; s/ *\\\n */ /; ta' | \ $(SED) -e 's,$(abs_srcdir)/,$(builddir)/,g' | \ @@ -224,22 +226,6 @@ stamp-generator: generator cd $(top_srcdir) && $(abs_builddir)/generator touch $@ -# We share common_utils.ml{,i} with the mllib directory. However we -# have to remove functions which depend on any modules which are not -# part of the OCaml stdlib. -common_utils.ml: $(top_srcdir)/mllib/common_utils.ml - rm -f $@ $@-t - echo '(* This file is generated from mllib/common_utils.ml *)' > $@-t - sed -n '/^(\*<stdlib>\*)$$/,/^(\*<\/stdlib>\*)$$/p' $< >> $@-t - mv $@-t $@ -common_utils.mli: $(top_srcdir)/mllib/common_utils.mli - rm -f $@ $@-t - echo '(* This file is generated from mllib/common_utils.mli *)' > $@-t - sed -n '/^(\*<stdlib>\*)$$/,/^(\*<\/stdlib>\*)$$/p' $< >> $@-t - mv $@-t $@ -guestfs_config.ml: ../mllib/guestfs_config.ml - cp $< $@ - CLEANFILES += $(noinst_DATA) $(noinst_PROGRAM) DISTCLEANFILES += .pod2text.data.version.2 diff --git a/generator/OCaml.ml b/generator/OCaml.ml index 955da6f09..f6a4292b9 100644 --- a/generator/OCaml.ml +++ b/generator/OCaml.ml @@ -20,7 +20,7 @@ open Printf -open Common_utils +open Std_utils open Types open Utils open Pr diff --git a/generator/UEFI.ml b/generator/UEFI.ml index 95797aad9..5c5e02bab 100644 --- a/generator/UEFI.ml +++ b/generator/UEFI.ml @@ -18,7 +18,7 @@ (* Please read generator/README first. *) -open Common_utils +open Std_utils open Utils open Pr open Docstrings diff --git a/generator/XDR.ml b/generator/XDR.ml index 2d799929b..4b0a552d1 100644 --- a/generator/XDR.ml +++ b/generator/XDR.ml @@ -20,7 +20,7 @@ open Printf -open Common_utils +open Std_utils open Types open Utils open Pr diff --git a/generator/actions.ml b/generator/actions.ml index 2722f3dcd..a9b3b5906 100644 --- a/generator/actions.ml +++ b/generator/actions.ml @@ -18,7 +18,7 @@ (* Please read generator/README first. *) -open Common_utils +open Std_utils open Types open Utils diff --git a/generator/authors.ml b/generator/authors.ml index d4547bdb1..ca5242983 100644 --- a/generator/authors.ml +++ b/generator/authors.ml @@ -18,7 +18,7 @@ (* Please read generator/README first. *) -open Common_utils +open Std_utils open Utils open Pr open Docstrings diff --git a/generator/bindtests.ml b/generator/bindtests.ml index c3caebfce..d225146c0 100644 --- a/generator/bindtests.ml +++ b/generator/bindtests.ml @@ -20,7 +20,7 @@ open Printf -open Common_utils +open Std_utils open Types open Utils open Pr diff --git a/generator/c.ml b/generator/c.ml index 1f099a221..27bf1ebf9 100644 --- a/generator/c.ml +++ b/generator/c.ml @@ -20,7 +20,7 @@ open Printf -open Common_utils +open Std_utils open Types open Utils open Pr diff --git a/generator/checks.ml b/generator/checks.ml index 881069489..be7b272a3 100644 --- a/generator/checks.ml +++ b/generator/checks.ml @@ -18,7 +18,7 @@ (* Please read generator/README first. *) -open Common_utils +open Std_utils open Types open Utils open Actions diff --git a/generator/csharp.ml b/generator/csharp.ml index 6a280011a..0eab21f0d 100644 --- a/generator/csharp.ml +++ b/generator/csharp.ml @@ -20,7 +20,7 @@ open Printf -open Common_utils +open Std_utils open Types open Utils open Pr diff --git a/generator/customize.ml b/generator/customize.ml index b158eb5d9..381ed0627 100644 --- a/generator/customize.ml +++ b/generator/customize.ml @@ -20,7 +20,7 @@ open Printf -open Common_utils +open Std_utils open Docstrings open Pr @@ -623,6 +623,7 @@ and generate_customize_cmdline_ml () = open Printf +open Std_utils open Common_utils open Common_gettext.Gettext open Getopt.OptionName diff --git a/generator/daemon.ml b/generator/daemon.ml index 84686973c..0300dc54b 100644 --- a/generator/daemon.ml +++ b/generator/daemon.ml @@ -20,7 +20,7 @@ open Printf -open Common_utils +open Std_utils open Types open Utils open Pr diff --git a/generator/docstrings.ml b/generator/docstrings.ml index 2ce595dae..696f1c52a 100644 --- a/generator/docstrings.ml +++ b/generator/docstrings.ml @@ -21,7 +21,7 @@ open Unix open Printf -open Common_utils +open Std_utils open Types open Utils open Pr diff --git a/generator/erlang.ml b/generator/erlang.ml index 602380966..03cca3368 100644 --- a/generator/erlang.ml +++ b/generator/erlang.ml @@ -20,7 +20,7 @@ open Printf -open Common_utils +open Std_utils open Types open Utils open Pr diff --git a/generator/errnostring.ml b/generator/errnostring.ml index b3d718815..e5f4c69f8 100644 --- a/generator/errnostring.ml +++ b/generator/errnostring.ml @@ -20,7 +20,7 @@ open Printf -open Common_utils +open Std_utils open Types open Utils open Pr diff --git a/generator/events.ml b/generator/events.ml index 7188e1203..f3b682a5a 100644 --- a/generator/events.ml +++ b/generator/events.ml @@ -18,7 +18,7 @@ (* Please read generator/README first. *) -open Common_utils +open Std_utils open Utils (* NB: DO NOT REORDER THESE, as doing so will change the ABI. Only diff --git a/generator/fish.ml b/generator/fish.ml index 45289132f..3d99c9081 100644 --- a/generator/fish.ml +++ b/generator/fish.ml @@ -20,7 +20,7 @@ open Printf -open Common_utils +open Std_utils open Types open Utils open Pr diff --git a/generator/golang.ml b/generator/golang.ml index f32ccf2c1..67f360839 100644 --- a/generator/golang.ml +++ b/generator/golang.ml @@ -20,7 +20,7 @@ open Printf -open Common_utils +open Std_utils open Types open Utils open Pr diff --git a/generator/haskell.ml b/generator/haskell.ml index 592d817fa..ec3f311df 100644 --- a/generator/haskell.ml +++ b/generator/haskell.ml @@ -20,7 +20,7 @@ open Printf -open Common_utils +open Std_utils open Types open Utils open Pr diff --git a/generator/java.ml b/generator/java.ml index c44e669a0..7c3212a49 100644 --- a/generator/java.ml +++ b/generator/java.ml @@ -20,7 +20,7 @@ open Printf -open Common_utils +open Std_utils open Types open Utils open Pr diff --git a/generator/lua.ml b/generator/lua.ml index c4ab4cc47..b40c51753 100644 --- a/generator/lua.ml +++ b/generator/lua.ml @@ -20,7 +20,7 @@ open Printf -open Common_utils +open Std_utils open Types open Utils open Pr diff --git a/generator/main.ml b/generator/main.ml index d4316c085..0e1c01f74 100644 --- a/generator/main.ml +++ b/generator/main.ml @@ -21,7 +21,7 @@ open Unix open Printf -open Common_utils +open Std_utils open Pr open Actions open Structs diff --git a/generator/optgroups.ml b/generator/optgroups.ml index e9a37e19c..4b9b66f77 100644 --- a/generator/optgroups.ml +++ b/generator/optgroups.ml @@ -18,7 +18,7 @@ (* Please read generator/README first. *) -open Common_utils +open Std_utils open Types open Utils open Actions diff --git a/generator/perl.ml b/generator/perl.ml index bf2dc4a81..8e3dad75e 100644 --- a/generator/perl.ml +++ b/generator/perl.ml @@ -20,7 +20,7 @@ open Printf -open Common_utils +open Std_utils open Types open Utils open Pr diff --git a/generator/php.ml b/generator/php.ml index 48cd89fdc..0721e431a 100644 --- a/generator/php.ml +++ b/generator/php.ml @@ -20,7 +20,7 @@ open Printf -open Common_utils +open Std_utils open Types open Utils open Pr diff --git a/generator/pr.ml b/generator/pr.ml index e8b32b67d..0c56f3e67 100644 --- a/generator/pr.ml +++ b/generator/pr.ml @@ -21,7 +21,7 @@ open Unix open Printf -open Common_utils +open Std_utils open Utils (* Output channel, 'pr' prints to this. *) diff --git a/generator/python.ml b/generator/python.ml index 4cae24757..c6c237241 100644 --- a/generator/python.ml +++ b/generator/python.ml @@ -20,7 +20,7 @@ open Printf -open Common_utils +open Std_utils open Types open Utils open Pr diff --git a/generator/ruby.ml b/generator/ruby.ml index 4d2ebbf0d..825cab32a 100644 --- a/generator/ruby.ml +++ b/generator/ruby.ml @@ -20,7 +20,7 @@ open Printf -open Common_utils +open Std_utils open Types open Utils open Pr diff --git a/generator/structs.ml b/generator/structs.ml index 834fa9c54..57975b564 100644 --- a/generator/structs.ml +++ b/generator/structs.ml @@ -18,7 +18,7 @@ (* Please read generator/README first. *) -open Common_utils +open Std_utils open Types open Utils diff --git a/generator/tests_c_api.ml b/generator/tests_c_api.ml index f9f14f6dc..a680521f4 100644 --- a/generator/tests_c_api.ml +++ b/generator/tests_c_api.ml @@ -20,7 +20,7 @@ open Printf -open Common_utils +open Std_utils open Types open Utils open Pr diff --git a/generator/utils.ml b/generator/utils.ml index a745a02b7..b818a0b3c 100644 --- a/generator/utils.ml +++ b/generator/utils.ml @@ -23,7 +23,7 @@ * makes this a bit harder than it should be. *) -open Common_utils +open Std_utils open Unix open Printf diff --git a/get-kernel/Makefile.am b/get-kernel/Makefile.am index bda3a8db1..c6454d7a4 100644 --- a/get-kernel/Makefile.am +++ b/get-kernel/Makefile.am @@ -63,6 +63,7 @@ OCAMLPACKAGES = \ -I $(top_builddir)/lib/.libs \ -I $(top_builddir)/gnulib/lib/.libs \ -I $(top_builddir)/ocaml \ + -I $(top_builddir)/common/mlstdutils \ -I $(top_builddir)/mllib if HAVE_OCAML_PKG_GETTEXT OCAMLPACKAGES += -package gettext-stub @@ -83,10 +84,15 @@ else OBJECTS = $(XOBJECTS) endif -OCAMLLINKFLAGS = mlguestfs.$(MLARCHIVE) mllib.$(MLARCHIVE) $(LINK_CUSTOM_OCAMLC_ONLY) +OCAMLLINKFLAGS = \ + mlstdutils.$(MLARCHIVE) \ + mlguestfs.$(MLARCHIVE) \ + mllib.$(MLARCHIVE) \ + $(LINK_CUSTOM_OCAMLC_ONLY) virt_get_kernel_DEPENDENCIES = \ $(OBJECTS) \ + ../common/mlstdutils/mlstdutils.$(MLARCHIVE) \ ../mllib/mllib.$(MLARCHIVE) \ $(top_srcdir)/ocaml-link.sh virt_get_kernel_LINK = \ @@ -121,7 +127,7 @@ depend: .depend .depend: $(wildcard $(abs_srcdir)/*.mli) $(wildcard $(abs_srcdir)/*.ml) rm -f $@ $@-t - $(OCAMLFIND) ocamldep -I ../ocaml -I $(abs_srcdir) -I $(abs_top_builddir)/mllib $^ | \ + $(OCAMLFIND) ocamldep -I ../ocaml -I $(abs_srcdir) -I $(abs_top_builddir)/common/mlstdutils -I $(abs_top_builddir)/mllib $^ | \ $(SED) 's/ *$$//' | \ $(SED) -e :a -e '/ *\\$$/N; s/ *\\\n */ /; ta' | \ $(SED) -e 's,$(abs_srcdir)/,$(builddir)/,g' | \ diff --git a/get-kernel/get_kernel.ml b/get-kernel/get_kernel.ml index e45838811..1c9ece44b 100644 --- a/get-kernel/get_kernel.ml +++ b/get-kernel/get_kernel.ml @@ -16,8 +16,9 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Getopt.OptionName module G = Guestfs diff --git a/mllib/Makefile.am b/mllib/Makefile.am index c84f5f36d..5f6f7fa85 100644 --- a/mllib/Makefile.am +++ b/mllib/Makefile.am @@ -19,7 +19,7 @@ include $(top_srcdir)/subdir-rules.mk EXTRA_DIST = \ $(SOURCES_MLI) \ - $(filter-out guestfs_config.ml libdir.ml,$(SOURCES_ML)) \ + $(SOURCES_ML) \ $(SOURCES_C) \ common_utils_tests.ml \ getopt_tests.ml \ @@ -36,15 +36,11 @@ SOURCES_MLI = \ planner.mli \ regedit.mli \ registry.mli \ - stringMap.mli \ URI.mli \ xpath_helpers.mli SOURCES_ML = \ - guestfs_config.ml \ $(OCAML_BYTES_COMPAT_ML) \ - libdir.ml \ - stringMap.ml \ common_gettext.ml \ getopt.ml \ unix_utils.ml \ @@ -93,7 +89,8 @@ libmllib_a_CPPFLAGS = \ -I$(top_srcdir)/common/utils \ -I$(top_srcdir)/lib \ -I$(top_srcdir)/common/options \ - -I$(top_srcdir)/common/mlxml + -I$(top_srcdir)/common/mlxml \ + -I$(top_srcdir)/common/mlstdutils libmllib_a_CFLAGS = \ $(WARN_CFLAGS) $(WERROR_CFLAGS) \ $(LIBVIRT_CFLAGS) $(LIBXML2_CFLAGS) \ @@ -112,6 +109,7 @@ OCAMLPACKAGES = \ -I $(top_builddir)/gnulib/lib/.libs \ -I $(top_builddir)/ocaml \ -I $(top_builddir)/common/mlxml \ + -I $(top_builddir)/common/mlstdutils \ -I $(builddir) OCAMLPACKAGES_TESTS = $(MLLIB_CMA) if HAVE_OCAML_PKG_GETTEXT @@ -144,13 +142,6 @@ $(MLLIB_CMA): $(OBJECTS) libmllib.a $(OCAMLFIND) mklib $(OCAMLPACKAGES) \ $(OBJECTS) $(libmllib_a_OBJECTS) -o mllib -# This OCaml module has to be generated by make (configure will put -# unexpanded prefix macro in). - -libdir.ml: Makefile - echo 'let libdir = "$(libdir)"' > $@-t - mv $@-t $@ - # Tests. common_utils_tests_SOURCES = dummy.c @@ -196,10 +187,14 @@ JSON_tests_THEOBJECTS = $(JSON_tests_XOBJECTS) JSON_tests.cmx: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS) endif -OCAMLLINKFLAGS = mlguestfs.$(MLARCHIVE) $(LINK_CUSTOM_OCAMLC_ONLY) +OCAMLLINKFLAGS = \ + mlstdutils.$(MLARCHIVE) \ + mlguestfs.$(MLARCHIVE) \ + $(LINK_CUSTOM_OCAMLC_ONLY) common_utils_tests_DEPENDENCIES = \ $(common_utils_tests_THEOBJECTS) \ + ../common/mlstdutils/mlstdutils.$(MLARCHIVE) \ $(MLLIB_CMA) \ $(top_srcdir)/ocaml-link.sh common_utils_tests_LINK = \ @@ -210,6 +205,7 @@ common_utils_tests_LINK = \ getopt_tests_DEPENDENCIES = \ $(getopt_tests_THEOBJECTS) \ + ../common/mlstdutils/mlstdutils.$(MLARCHIVE) \ $(MLLIB_CMA) \ $(top_srcdir)/ocaml-link.sh getopt_tests_LINK = \ @@ -220,6 +216,7 @@ getopt_tests_LINK = \ JSON_tests_DEPENDENCIES = \ $(JSON_tests_THEOBJECTS) \ + ../common/mlstdutils/mlstdutils.$(MLARCHIVE) \ $(MLLIB_CMA) \ $(top_srcdir)/ocaml-link.sh JSON_tests_LINK = \ diff --git a/mllib/checksums.ml b/mllib/checksums.ml index 61deac2d1..f4c414f57 100644 --- a/mllib/checksums.ml +++ b/mllib/checksums.ml @@ -16,8 +16,9 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Printf diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml index 6a9b08973..1220de7a0 100644 --- a/mllib/common_utils.ml +++ b/mllib/common_utils.ml @@ -16,14 +16,9 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) -(* The parts between <stdlib>..</stdlib> are copied into the - * generator/common_utils.ml file. These parts must ONLY use - * functions from the OCaml stdlib. - *) -(*<stdlib>*) open Printf -(*</stdlib>*) +open Std_utils open Common_gettext.Gettext open Getopt.OptionName @@ -31,474 +26,6 @@ external c_inspect_decrypt : Guestfs.t -> int64 -> unit = "guestfs_int_mllib_ins external c_set_echo_keys : unit -> unit = "guestfs_int_mllib_set_echo_keys" "noalloc" external c_set_keys_from_stdin : unit -> unit = "guestfs_int_mllib_set_keys_from_stdin" "noalloc" -(*<stdlib>*) - -module Char = struct - include Char - - let lowercase_ascii c = - if (c >= 'A' && c <= 'Z') - then unsafe_chr (code c + 32) - else c - - let uppercase_ascii c = - if (c >= 'a' && c <= 'z') - then unsafe_chr (code c - 32) - else c - - let isspace c = - c = ' ' - (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *) - - let isdigit = function - | '0'..'9' -> true - | _ -> false - - let isxdigit = function - | '0'..'9' -> true - | 'a'..'f' -> true - | 'A'..'F' -> true - | _ -> false - - let isalpha = function - | 'a'..'z' -> true - | 'A'..'Z' -> true - | _ -> false - - let isalnum = function - | '0'..'9' -> true - | 'a'..'z' -> true - | 'A'..'Z' -> true - | _ -> false - - let hexdigit = function - | '0' -> 0 - | '1' -> 1 - | '2' -> 2 - | '3' -> 3 - | '4' -> 4 - | '5' -> 5 - | '6' -> 6 - | '7' -> 7 - | '8' -> 8 - | '9' -> 9 - | 'a' | 'A' -> 10 - | 'b' | 'B' -> 11 - | 'c' | 'C' -> 12 - | 'd' | 'D' -> 13 - | 'e' | 'E' -> 14 - | 'f' | 'F' -> 15 - | _ -> -1 -end - -module String = struct - include String - - let map f s = - let len = String.length s in - let b = Bytes.create len in - for i = 0 to len-1 do - Bytes.unsafe_set b i (f (unsafe_get s i)) - done; - Bytes.to_string b - - let lowercase_ascii s = map Char.lowercase_ascii s - let uppercase_ascii s = map Char.uppercase_ascii s - - let capitalize_ascii s = - let b = Bytes.of_string s in - Bytes.unsafe_set b 0 (Char.uppercase_ascii (Bytes.unsafe_get b 0)); - Bytes.to_string b - - let is_prefix str prefix = - let n = length prefix in - length str >= n && sub str 0 n = prefix - - let is_suffix str suffix = - let sufflen = length suffix - and len = length str in - len >= sufflen && sub str (len - sufflen) sufflen = suffix - - let rec find s sub = - let len = length s in - let sublen = length sub in - let rec loop i = - if i <= len-sublen then ( - let rec loop2 j = - if j < sublen then ( - if s.[i+j] = sub.[j] then loop2 (j+1) - else -1 - ) else - i (* found *) - in - let r = loop2 0 in - if r = -1 then loop (i+1) else r - ) else - -1 (* not found *) - in - loop 0 - - let rec replace s s1 s2 = - let len = length s in - let sublen = length s1 in - let i = find s s1 in - if i = -1 then s - else ( - let s' = sub s 0 i in - let s'' = sub s (i+sublen) (len-i-sublen) in - s' ^ s2 ^ replace s'' s1 s2 - ) - - let replace_char s c1 c2 = - let b2 = Bytes.of_string s in - let r = ref false in - 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 Bytes.to_string b2 - - let rec nsplit sep str = - let len = length str in - let seplen = length sep in - let i = find str sep in - if i = -1 then [str] - else ( - let s' = sub str 0 i in - let s'' = sub str (i+seplen) (len-i-seplen) in - s' :: nsplit sep s'' - ) - - let split sep str = - let len = length sep in - let seplen = length str in - let i = find str sep in - if i = -1 then str, "" - else ( - sub str 0 i, sub str (i + len) (seplen - i - len) - ) - - let rec lines_split str = - let buf = Buffer.create 16 in - let len = length str in - let rec loop start len = - try - let i = index_from str start '\n' in - if i > 0 && str.[i-1] = '\\' then ( - Buffer.add_substring buf str start (i-start-1); - Buffer.add_char buf '\n'; - loop (i+1) len - ) else ( - Buffer.add_substring buf str start (i-start); - i+1 - ) - with Not_found -> - if len > 0 && str.[len-1] = '\\' then ( - Buffer.add_substring buf str start (len-start-1); - Buffer.add_char buf '\n' - ) else - Buffer.add_substring buf str start (len-start); - len+1 - in - let endi = loop 0 len in - let line = Buffer.contents buf in - if endi > len then - [line] - else - line :: lines_split (sub str endi (len-endi)) - - let random8 = - let chars = "abcdefghijklmnopqrstuvwxyz0123456789" in - fun () -> - concat "" ( - List.map ( - fun _ -> - let c = Random.int 36 in - let c = chars.[c] in - make 1 c - ) [1;2;3;4;5;6;7;8] - ) - - let triml ?(test = Char.isspace) str = - let i = ref 0 in - let n = ref (String.length str) in - while !n > 0 && test str.[!i]; do - decr n; - incr i - done; - if !i = 0 then str - else String.sub str !i !n - - let trimr ?(test = Char.isspace) str = - let n = ref (String.length str) in - while !n > 0 && test str.[!n-1]; do - decr n - done; - if !n = String.length str then str - else String.sub str 0 !n - - let trim ?(test = Char.isspace) str = - trimr ~test (triml ~test str) - - let count_chars c str = - let count = ref 0 in - for i = 0 to String.length str - 1 do - if c = String.unsafe_get str i then incr count - done; - !count - - let explode str = - let r = ref [] in - for i = 0 to String.length str - 1 do - let c = String.unsafe_get str i in - r := c :: !r; - done; - List.rev !r - - let map_chars f str = - List.map f (explode str) - - let spaces n = String.make n ' ' -end - -let (//) = Filename.concat -let quote = Filename.quote - -let subdirectory parent path = - if path = parent then - "" - else if String.is_prefix path (parent // "") then ( - let len = String.length parent in - String.sub path (len+1) (String.length path - len-1) - ) else - invalid_arg (sprintf "%S is not a path prefix of %S" parent path) - -let ( +^ ) = Int64.add -let ( -^ ) = Int64.sub -let ( *^ ) = Int64.mul -let ( /^ ) = Int64.div -let ( &^ ) = Int64.logand -let ( ~^ ) = Int64.lognot - -external identity : 'a -> 'a = "%identity" - -let roundup64 i a = let a = a -^ 1L in (i +^ a) &^ (~^ a) -let div_roundup64 i a = (i +^ a -^ 1L) /^ a - -let int_of_le32 str = - assert (String.length str = 4); - let c0 = Char.code (String.unsafe_get str 0) in - let c1 = Char.code (String.unsafe_get str 1) in - let c2 = Char.code (String.unsafe_get str 2) in - let c3 = Char.code (String.unsafe_get str 3) in - Int64.of_int c0 +^ - (Int64.shift_left (Int64.of_int c1) 8) +^ - (Int64.shift_left (Int64.of_int c2) 16) +^ - (Int64.shift_left (Int64.of_int c3) 24) - -let le32_of_int i = - let c0 = i &^ 0xffL in - 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 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 - -type wrap_break_t = WrapEOS | WrapSpace | WrapNL - -let rec wrap ?(chan = stdout) ?(indent = 0) str = - let len = String.length str in - _wrap chan indent 0 0 len str - -and _wrap chan indent column i len str = - if i < len then ( - let (j, break) = _wrap_find_next_break i len str in - let next_column = - if column + (j-i) >= 76 then ( - output_char chan '\n'; - output_spaces chan indent; - indent + (j-i) + 1 - ) - else column + (j-i) + 1 in - output chan (Bytes.of_string str) i (j-i); - match break with - | WrapEOS -> () - | WrapSpace -> - output_char chan ' '; - _wrap chan indent next_column (j+1) len str - | WrapNL -> - output_char chan '\n'; - output_spaces chan indent; - _wrap chan indent indent (j+1) len str - ) - -and _wrap_find_next_break i len str = - if i >= len then (len, WrapEOS) - else if String.unsafe_get str i = ' ' then (i, WrapSpace) - else if String.unsafe_get str i = '\n' then (i, WrapNL) - else _wrap_find_next_break (i+1) len str - -and output_spaces chan n = for i = 0 to n-1 do output_char chan ' ' done - -let (|>) x f = f x - -(* Drop elements from a list while a predicate is true. *) -let rec dropwhile f = function - | [] -> [] - | x :: xs when f x -> dropwhile f xs - | xs -> xs - -(* Take elements from a list while a predicate is true. *) -let rec takewhile f = function - | x :: xs when f x -> x :: takewhile f xs - | _ -> [] - -let rec filter_map f = function - | [] -> [] - | x :: xs -> - match f x with - | Some y -> y :: filter_map f xs - | None -> filter_map f xs - -let rec find_map f = function - | [] -> raise Not_found - | x :: xs -> - match f x with - | Some y -> y - | None -> find_map f xs - -let iteri f xs = - let rec loop i = function - | [] -> () - | x :: xs -> f i x; loop (i+1) xs - in - loop 0 xs - -let rec mapi i f = - function - | [] -> [] - | a::l -> - let r = f i a in - r :: mapi (i + 1) f l -let mapi f l = mapi 0 f l - -let rec combine3 xs ys zs = - match xs, ys, zs with - | [], [], [] -> [] - | x::xs, y::ys, z::zs -> (x, y, z) :: combine3 xs ys zs - | _ -> invalid_arg "combine3" - -let rec assoc ?(cmp = compare) ~default x = function - | [] -> default - | (y, y') :: _ when cmp x y = 0 -> y' - | _ :: ys -> assoc ~cmp ~default x ys - -let uniq ?(cmp = Pervasives.compare) xs = - let rec loop acc = function - | [] -> acc - | [x] -> x :: acc - | x :: (y :: _ as xs) when cmp x y = 0 -> - loop acc xs - | x :: (y :: _ as xs) -> - loop (x :: acc) xs - in - List.rev (loop [] xs) - -let sort_uniq ?(cmp = Pervasives.compare) xs = - let xs = List.sort cmp xs in - let xs = uniq ~cmp xs in - xs - -let remove_duplicates xs = - let h = Hashtbl.create (List.length xs) in - let rec loop = function - | [] -> [] - | x :: xs when Hashtbl.mem h x -> xs - | x :: xs -> Hashtbl.add h x true; x :: loop xs - in - loop xs - -let push_back xsp x = xsp := !xsp @ [x] -let push_front x xsp = xsp := x :: !xsp -let pop_back xsp = - let x, xs = - match List.rev !xsp with - | x :: xs -> x, xs - | [] -> failwith "pop" in - xsp := List.rev xs; - x -let pop_front xsp = - let x, xs = - match !xsp with - | x :: xs -> x, xs - | [] -> failwith "shift" in - xsp := xs; - x - -let append xsp xs = xsp := !xsp @ xs -let prepend xs xsp = xsp := xs @ !xsp - -let unique = let i = ref 0 in fun () -> incr i; !i - -let may f = function - | None -> () - | Some x -> f x - -type ('a, 'b) maybe = Either of 'a | Or of 'b - -let protect ~f ~finally = - let r = - try Either (f ()) - with exn -> Or exn in - finally (); - match r with Either ret -> ret | Or exn -> raise exn - -let failwithf fs = ksprintf failwith fs - -exception Executable_not_found of string (* executable *) - -let which executable = - let paths = - try String.nsplit ":" (Sys.getenv "PATH") - with Not_found -> [] in - let paths = filter_map ( - fun p -> - let path = p // executable in - try Unix.access path [Unix.X_OK]; Some path - with Unix.Unix_error _ -> None - ) paths in - match paths with - | [] -> raise (Executable_not_found executable) - | x :: _ -> x - -(* Program name. *) -let prog = Filename.basename Sys.executable_name - -(* Stores the colours (--colours), quiet (--quiet), trace (-x) and - * verbose (-v) flags in a global variable. - *) -let colours = ref false -let set_colours () = colours := true -let colours () = !colours - -let quiet = ref false -let set_quiet () = quiet := true -let quiet () = !quiet - -let trace = ref false -let set_trace () = trace := true -let trace () = !trace - -let verbose = ref false -let set_verbose () = verbose := true -let verbose () = !verbose - (* ANSI terminal colours. *) let istty chan = Unix.isatty (Unix.descr_of_out_channel chan) @@ -514,8 +41,6 @@ let ansi_magenta ?(chan = stdout) () = let ansi_restore ?(chan = stdout) () = if colours () || istty chan then output_string chan "\x1b[0m" -(*</stdlib>*) - (* Timestamped progress messages, used for ordinary messages when not * --quiet. *) @@ -630,26 +155,6 @@ let virt_tools_data_dir = ) in fun () -> Lazy.force dir -(*<stdlib>*) - -let read_whole_file path = - let buf = Buffer.create 16384 in - let chan = open_in path in - let maxlen = 16384 in - let b = Bytes.create maxlen in - let rec loop () = - let r = input chan b 0 maxlen in - if r > 0 then ( - Buffer.add_substring buf (Bytes.to_string b) 0 r; - loop () - ) - in - loop (); - close_in chan; - Buffer.contents buf - -(*</stdlib>*) - (* Parse a size field, eg. "10G". *) let parse_size = let const_re = Str.regexp "^\\([.0-9]+\\)\\([bKMG]\\)$" in @@ -764,67 +269,6 @@ let create_standard_options argspec ?anon_fun ?(key_opts = false) usage_msg = else []) in Getopt.create argspec ?anon_fun usage_msg -(*<stdlib>*) - -(* Compare two version strings intelligently. *) -let rex_numbers = Str.regexp "^\\([0-9]+\\)\\(.*\\)$" -let rex_letters = Str.regexp_case_fold "^\\([a-z]+\\)\\(.*\\)$" - -let compare_version v1 v2 = - let rec split_version = function - | "" -> [] - | str -> - let first, rest = - if Str.string_match rex_numbers str 0 then ( - let n = Str.matched_group 1 str in - let rest = Str.matched_group 2 str in - let n = - try `Number (int_of_string n) - with Failure _ -> `String n in - n, rest - ) - else if Str.string_match rex_letters str 0 then - `String (Str.matched_group 1 str), Str.matched_group 2 str - else ( - let len = String.length str in - `Char str.[0], String.sub str 1 (len-1) - ) in - first :: split_version rest - in - compare (split_version v1) (split_version v2) - -(* Annoying LVM2 returns a differing UUID strings for different - * function calls (sometimes containing or not containing '-' - * characters), so we have to normalize each string before - * comparison. c.f. 'compare_pvuuids' in virt-filesystem. - *) -let compare_lvm2_uuids uuid1 uuid2 = - let n1 = String.length uuid1 and n2 = String.length uuid2 in - let rec loop i1 i2 = - if i1 = n1 && i2 = n2 then 0 (* matching *) - else if i1 >= n1 then 1 (* different lengths *) - else if i2 >= n2 then -1 - else if uuid1.[i1] = '-' then loop (i1+1) i2 (* ignore '-' characters *) - else if uuid2.[i2] = '-' then loop i1 (i2+1) - else ( - let c = compare uuid1.[i1] uuid2.[i2] in - if c <> 0 then c (* not matching *) - else loop (i1+1) (i2+1) - ) - in - loop 0 0 - -let stringify_args args = - let rec quote_args = function - | [] -> "" - | x :: xs -> " " ^ Filename.quote x ^ quote_args xs - in - match args with - | [] -> "" - | app :: xs -> app ^ quote_args xs - -(*</stdlib>*) - (* Run an external command, slurp up the output as a list of lines. *) let external_command ?(echo_cmd = true) cmd = if echo_cmd then @@ -889,31 +333,6 @@ let uuidgen () = if len < 10 then assert false; (* sanity check on uuidgen *) uuid -(*<stdlib>*) - -(* Unlink a temporary file on exit. *) -let unlink_on_exit = - let files = ref [] in - let registered_handlers = ref false in - - let rec unlink_files () = - List.iter ( - fun file -> try Unix.unlink file with _ -> () - ) !files - and register_handlers () = - (* Unlink on exit. *) - at_exit unlink_files - in - - fun file -> - files := file :: !files; - if not !registered_handlers then ( - register_handlers (); - registered_handlers := true - ) - -(*</stdlib>*) - (* Remove a temporary directory on exit. *) let rmdir_on_exit = let dirs = ref [] in @@ -1050,18 +469,6 @@ let detect_file_type filename = close_in chan; ret -(*<stdlib>*) - -let is_block_device file = - try (Unix.stat file).Unix.st_kind = Unix.S_BLK - with Unix.Unix_error _ -> false - -let is_char_device file = - try (Unix.stat file).Unix.st_kind = Unix.S_CHR - with Unix.Unix_error _ -> false - -(*</stdlib>*) - let is_partition dev = try if not (is_block_device dev) then false @@ -1075,87 +482,6 @@ let is_partition dev = ) with Unix.Unix_error _ -> false -(*<stdlib>*) - -(* Annoyingly Sys.is_directory throws an exception on failure - * (RHBZ#1022431). - *) -let is_directory path = - try Sys.is_directory path - with Sys_error _ -> false - -let absolute_path path = - if not (Filename.is_relative path) then path - else Sys.getcwd () // path - -let qemu_input_filename filename = - (* If the filename is something like "file:foo" then qemu-img will - * try to interpret that as "foo" in the file:/// protocol. To - * avoid that, if the path is relative prefix it with "./" since - * qemu-img won't try to interpret such a path. - *) - if String.length filename > 0 && filename.[0] <> '/' then - "./" ^ filename - else - filename - -let rec mkdir_p path permissions = - try Unix.mkdir path permissions - with - | Unix.Unix_error (Unix.EEXIST, _, _) -> () - | Unix.Unix_error (Unix.ENOENT, _, _) -> - (* A component in the path does not exist, so first try - * creating the parent directory, and then again the requested - * directory. *) - mkdir_p (Filename.dirname path) permissions; - Unix.mkdir path permissions - -let normalize_arch = function - | "i486" | "i586" | "i686" -> "i386" - | "amd64" -> "x86_64" - | "powerpc" -> "ppc" - | "powerpc64" -> "ppc64" - | "powerpc64le" -> "ppc64le" - | arch -> arch - -(* Are guest arch and host_cpu compatible, in terms of being able - * to run commands in the libguestfs appliance? - *) -let guest_arch_compatible guest_arch = - let own = normalize_arch Guestfs_config.host_cpu in - let guest_arch = normalize_arch guest_arch in - match own, guest_arch with - | x, y when x = y -> true - | "x86_64", "i386" -> true - | _ -> false - -(* Is the guest OS "Unix-like"? *) -let unix_like = function - | "hurd" - | "linux" - | "minix" -> true - | typ when String.is_suffix typ "bsd" -> true - | _ -> false - -(** Return the last part of a string, after the specified separator. *) -let last_part_of str sep = - try - let i = String.rindex str sep in - Some (String.sub str (i+1) (String.length str - (i+1))) - with Not_found -> None - -let read_first_line_from_file filename = - let chan = open_in filename in - let line = input_line chan in - close_in chan; - line - -let is_regular_file path = (* NB: follows symlinks. *) - try (Unix.stat path).Unix.st_kind = Unix.S_REG - with Unix.Unix_error _ -> false - -(*</stdlib>*) - let inspect_mount_root g ?mount_opts_fn root = let mps = g#inspect_get_mountpoints root in let cmp (a,_) (b,_) = diff --git a/mllib/common_utils.mli b/mllib/common_utils.mli index c088f8497..b72f7ee62 100644 --- a/mllib/common_utils.mli +++ b/mllib/common_utils.mli @@ -16,280 +16,6 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) -(* The parts between <stdlib>..</stdlib> are copied into the - * generator/common_utils.ml file. These parts must ONLY use - * functions from the OCaml stdlib. - *) -(*<stdlib>*) - -module Char : sig - type t = char - val chr : int -> char - val code : char -> int - val compare: t -> t -> int - val escaped : char -> string - val unsafe_chr : int -> char - - val lowercase_ascii : char -> char - val uppercase_ascii : char -> char - - val isspace : char -> bool - (** Return true if char is a whitespace character. *) - val isdigit : char -> bool - (** Return true if the character is a digit [[0-9]]. *) - val isxdigit : char -> bool - (** Return true if the character is a hex digit [[0-9a-fA-F]]. *) - val isalpha : char -> bool - (** Return true if the character is a US ASCII 7 bit alphabetic. *) - val isalnum : char -> bool - (** Return true if the character is a US ASCII 7 bit alphanumeric. *) - - val hexdigit : char -> int - (** Return the value of a hex digit. If the char is not in - the set [[0-9a-fA-F]] then this returns [-1]. *) -end -(** Override the Char module from stdlib. *) - -module String : sig - type t = string - 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 escaped : string -> string - val get : string -> int -> char - val index : string -> char -> int - val index_from : string -> int -> char -> int - val iter : (char -> unit) -> string -> unit - val length : string -> int - val make : int -> char -> string - val rcontains_from : string -> int -> char -> bool - val rindex : string -> char -> int - val rindex_from : string -> int -> char -> int - val sub : string -> int -> int -> string - val unsafe_get : string -> int -> char - - val map : (char -> char) -> string -> string - - val lowercase_ascii : string -> string - val uppercase_ascii : string -> string - val capitalize_ascii : string -> string - - val is_prefix : string -> string -> bool - (** [is_prefix str prefix] returns true if [prefix] is a prefix of [str]. *) - val is_suffix : string -> string -> bool - (** [is_suffix str suffix] returns true if [suffix] is a suffix of [str]. *) - val find : string -> string -> int - (** [find str sub] searches for [sub] as a substring of [str]. If - found it returns the index. If not found, it returns [-1]. *) - val replace : string -> string -> string -> string - (** [replace str s1 s2] replaces all instances of [s1] appearing in - [str] with [s2]. *) - val replace_char : string -> char -> char -> string - (** Replace character in string. *) - val nsplit : string -> string -> string list - (** [nsplit sep str] splits [str] into multiple strings at each - separator [sep]. *) - val split : string -> string -> string * string - (** [split sep str] splits [str] at the first occurrence of the - separator [sep], returning the part before and the part after. - If separator is not found, return the whole string and an - empty string. *) - val lines_split : string -> string list - (** [lines_split str] splits [str] into lines, keeping continuation - characters (i.e. [\] at the end of lines) into account. *) - val random8 : unit -> string - (** Return a string of 8 random printable characters. *) - val triml : ?test:(char -> bool) -> string -> string - (** Trim left. *) - val trimr : ?test:(char -> bool) -> string -> string - (** Trim right. *) - val trim : ?test:(char -> bool) -> string -> string - (** Trim left and right. *) - val count_chars : char -> string -> int - (** Count number of times the character occurs in string. *) - val explode : string -> char list - (** Explode a string into a list of characters. *) - val map_chars : (char -> 'a) -> string -> 'a list - (** Explode string, then map function over the characters. *) - val spaces : int -> string - (** [spaces n] creates a string of n spaces. *) -end -(** Override the String module from stdlib. *) - -val ( // ) : string -> string -> string -(** Concatenate directory and filename. *) - -val quote : string -> string -(** Shell-safe quoting of a string (alias for {!Filename.quote}). *) - -val subdirectory : string -> string -> string -(** [subdirectory parent path] returns subdirectory part of [path] relative - to the [parent]. If [path] and [parent] point to the same directory empty - string is returned. - - Note: path normalization on arguments is {b not} performed! - - If [parent] is not a path prefix of [path] the function raises - [Invalid_argument]. *) - -val ( +^ ) : int64 -> int64 -> int64 -val ( -^ ) : int64 -> int64 -> int64 -val ( *^ ) : int64 -> int64 -> int64 -val ( /^ ) : int64 -> int64 -> int64 -val ( &^ ) : int64 -> int64 -> int64 -val ( ~^ ) : int64 -> int64 -(** Various int64 operators. *) - -external identity : 'a -> 'a = "%identity" - -val roundup64 : int64 -> int64 -> int64 -(** [roundup64 i a] returns [i] rounded up to the next multiple of [a]. *) -val div_roundup64 : int64 -> int64 -> int64 -(** [div_roundup64 i a] returns [i] rounded up to the next multiple of [a], - with the result divided by [a]. *) -val int_of_le32 : string -> int64 -(** Unpack a 4 byte string as a little endian 32 bit integer. *) -val le32_of_int : int64 -> string -(** Pack a 32 bit integer a 4 byte string stored little endian. *) - -val wrap : ?chan:out_channel -> ?indent:int -> string -> unit -(** Wrap text. *) - -val output_spaces : out_channel -> int -> unit -(** Write [n] spaces to [out_channel]. *) - -val (|>) : 'a -> ('a -> 'b) -> 'b -(** Added in OCaml 4.01, we can remove our definition when we - can assume this minimum version of OCaml. *) - -val dropwhile : ('a -> bool) -> 'a list -> 'a list -(** [dropwhile f xs] drops leading elements from [xs] until - [f] returns false. *) -val takewhile : ('a -> bool) -> 'a list -> 'a list -(** [takewhile f xs] takes leading elements from [xs] until - [f] returns false. - - For any list [xs] and function [f], - [xs = takewhile f xs @ dropwhile f xs] *) -val filter_map : ('a -> 'b option) -> 'a list -> 'b list -(** [filter_map f xs] applies [f] to each element of [xs]. If - [f x] returns [Some y] then [y] is added to the returned list. *) -val find_map : ('a -> 'b option) -> 'a list -> 'b -(** [find_map f xs] applies [f] to each element of [xs] until - [f x] returns [Some y]. It returns [y]. If we exhaust the - list then this raises [Not_found]. *) -val iteri : (int -> 'a -> 'b) -> 'a list -> unit -(** [iteri f xs] calls [f i x] for each element, with [i] counting from [0]. *) -val mapi : (int -> 'a -> 'b) -> 'a list -> 'b list -(** [mapi f xs] calls [f i x] for each element, with [i] counting from [0], - forming the return values from [f] into another list. *) - -val combine3 : 'a list -> 'b list -> 'c list -> ('a * 'b * 'c) list -(** Like {!List.combine} but for triples. All lists must be the same length. *) - -val assoc : ?cmp:('a -> 'a -> int) -> default:'b -> 'a -> ('a * 'b) list -> 'b -(** Like {!List.assoc} but with a user-defined comparison function, and - instead of raising [Not_found], it returns the [~default] value. *) - -val uniq : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list -(** Uniquify a list (the list must be sorted first). *) - -val sort_uniq : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list -(** Sort and uniquify a list. *) - -val remove_duplicates : 'a list -> 'a list -(** Remove duplicates from an unsorted list; useful when the order - of the elements matter. - - Please use [sort_uniq] when the order does not matter. *) - -val push_back : 'a list ref -> 'a -> unit -val push_front : 'a -> 'a list ref -> unit -val pop_back : 'a list ref -> 'a -val pop_front : 'a list ref -> 'a -(** Imperative list manipulation functions, similar to C++ STL - functions with the same names. (Although the names are similar, - the computational complexity of the functions is quite different.) - - These operate on list references, and each function modifies the - list reference that is passed to it. - - [push_back xsp x] appends the element [x] to the end of the list - [xsp]. This function is not tail-recursive. - - [push_front x xsp] prepends the element [x] to the head of the - list [xsp]. (The arguments are reversed compared to the same Perl - function, but OCaml is type safe so that's OK.) - - [pop_back xsp] removes the last element of the list [xsp] and - returns it. The list is modified to become the list minus the - final element. If a zero-length list is passed in, this raises - [Failure "pop_back"]. This function is not tail-recursive. - - [pop_front xsp] removes the head element of the list [xsp] and - returns it. The list is modified to become the tail of the list. - If a zero-length list is passed in, this raises [Failure - "pop_front"]. *) - -val append : 'a list ref -> 'a list -> unit -val prepend : 'a list -> 'a list ref -> unit -(** More imperative list manipulation functions. - - [append] is like {!push_back} above, except it appends a list to - the list reference. This function is not tail-recursive. - - [prepend] is like {!push_front} above, except it prepends a list - to the list reference. *) - -val unique : unit -> int -(** Returns a unique number each time called. *) - -val may : ('a -> unit) -> 'a option -> unit -(** [may f (Some x)] runs [f x]. [may f None] does nothing. *) - -type ('a, 'b) maybe = Either of 'a | Or of 'b -(** Like the Haskell [Either] type. *) - -val protect : f:(unit -> 'a) -> finally:(unit -> unit) -> 'a -(** Execute [~f] and afterwards execute [~finally]. - - If [~f] throws an exception then [~finally] is run and the - original exception from [~f] is re-raised. - - If [~finally] throws an exception, then the original exception - is lost. (NB: Janestreet core {!Exn.protectx}, on which this - function is modelled, doesn't throw away the exception in this - case, but requires a lot more work by the caller. Perhaps we - will change this in future.) *) - -val failwithf : ('a, unit, string, 'b) format4 -> 'a -(** Like [failwith] but supports printf-like arguments. *) - -exception Executable_not_found of string (* executable *) -(** Exception thrown by [which] when the specified executable is not found - in [$PATH]. *) - -val which : string -> string -(** Return the full path of the specified executable from [$PATH]. - - Throw [Executable_not_found] if not available. *) - -val prog : string -(** The program name (derived from {!Sys.executable_name}). *) - -val set_quiet : unit -> unit -val quiet : unit -> bool -val set_trace : unit -> unit -val trace : unit -> bool -val set_verbose : unit -> unit -val verbose : unit -> bool -(** Stores the quiet ([--quiet]), trace ([-x]) and verbose ([-v]) flags - in global variables. *) - -(*</stdlib>*) - val message : ('a, unit, string, unit) format4 -> 'a (** Timestamped progress messages. Used for ordinary messages when not [--quiet]. *) @@ -328,13 +54,6 @@ val virt_tools_data_dir : unit -> string the environment variable is not set, a default value is calculated based on configure settings. *) -(*<stdlib>*) - -val read_whole_file : string -> string -(** Read in the whole file as a string. *) - -(*</stdlib>*) - val parse_size : string -> int64 (** Parse a size field, eg. [10G] *) @@ -354,20 +73,6 @@ val create_standard_options : Getopt.speclist -> ?anon_fun:Getopt.anon_fun -> ?k Returns a new [Getopt.t] handle. *) -(*<stdlib>*) - -val compare_version : string -> string -> int -(** Compare two version strings. *) - -val compare_lvm2_uuids : string -> string -> int -(** Compare two LVM2 UUIDs, ignoring '-' characters. *) - -val stringify_args : string list -> string -(** Create a "pretty-print" representation of a program invocation - (i.e. executable and its arguments). *) - -(*</stdlib>*) - val external_command : ?echo_cmd:bool -> string -> string list (** Run an external command, slurp up the output as a list of lines. @@ -389,13 +94,6 @@ val shell_command : ?echo_cmd:bool -> string -> int val uuidgen : unit -> string (** Run uuidgen to return a random UUID. *) -(*<stdlib>*) - -val unlink_on_exit : string -> unit -(** Unlink a temporary file on exit. *) - -(*</stdlib>*) - val rmdir_on_exit : string -> unit (** Remove a temporary directory on exit (using [rm -rf]). *) @@ -431,55 +129,10 @@ val debug_augeas_errors : Guestfs.guestfs -> unit val detect_file_type : string -> [`GZip | `Tar | `XZ | `Zip | `Unknown] (** Detect type of a file (for a very limited range of file types). *) -(*<stdlib>*) - -val is_block_device : string -> bool -val is_char_device : string -> bool -val is_directory : string -> bool -(** These don't throw exceptions, unlike the [Sys] functions. *) - -(*</stdlib>*) - val is_partition : string -> bool (** Return true if the host device [dev] is a partition. If it's anything else, or missing, returns false. *) -(*<stdlib>*) - -val absolute_path : string -> string -(** Convert any path to an absolute path. *) - -val qemu_input_filename : string -> string -(** Sanitizes a filename for passing it safely to qemu/qemu-img. *) - -val mkdir_p : string -> int -> unit -(** Creates a directory, and its parents if missing. *) - -val normalize_arch : string -> string -(** Normalize the architecture name, i.e. maps it into a defined - identifier for it -- e.g. i386, i486, i586, and i686 are - normalized as i386. *) - -val guest_arch_compatible : string -> bool -(** Are guest arch and host_cpu compatible, in terms of being able - to run commands in the libguestfs appliance? *) - -val unix_like : string -> bool -(** Is the guest OS "Unix-like"? Call this with the result of - {!Guestfs.inspect_get_type}. *) - -val last_part_of : string -> char -> string option -(** Return the last part of a string, after the specified separator. *) - -val read_first_line_from_file : string -> string -(** Read only the first line (i.e. until the first newline character) - of a file. *) - -val is_regular_file : string -> bool -(** Checks whether the file is a regular file. *) - -(*</stdlib>*) - val inspect_mount_root : Guestfs.guestfs -> ?mount_opts_fn:(string -> string) -> string -> unit (** Mounts all the mount points of the specified root, just like [guestfish -i] does. diff --git a/mllib/common_utils_tests.ml b/mllib/common_utils_tests.ml index aacc01e04..def5ea932 100644 --- a/mllib/common_utils_tests.ml +++ b/mllib/common_utils_tests.ml @@ -19,24 +19,13 @@ (* This file tests the Common_utils module. *) open OUnit2 + +open Std_utils open Common_utils (* Utils. *) let assert_equal_string = assert_equal ~printer:(fun x -> x) -let assert_equal_int = assert_equal ~printer:(fun x -> string_of_int x) let assert_equal_int64 = assert_equal ~printer:(fun x -> Int64.to_string x) -let assert_equal_stringlist = assert_equal ~printer:(fun x -> "(" ^ (String.escaped (String.concat "," x)) ^ ")") - -let test_subdirectory ctx = - assert_equal_string "" (subdirectory "/foo" "/foo"); - assert_equal_string "" (subdirectory "/foo" "/foo/"); - assert_equal_string "bar" (subdirectory "/foo" "/foo/bar"); - assert_equal_string "bar/baz" (subdirectory "/foo" "/foo/bar/baz") - -(* Test Common_utils.int_of_le32 and Common_utils.le32_of_int. *) -let test_le32 ctx = - assert_equal_int64 0x20406080L (int_of_le32 "\x80\x60\x40\x20"); - assert_equal_string "\x80\x60\x40\x20" (le32_of_int 0x20406080L) (* Test Common_utils.parse_size. *) let test_parse_resize ctx = @@ -90,59 +79,12 @@ let test_human_size ctx = assert_equal_string "3.4G" (human_size 3650722201_L); assert_equal_string "-3.4G" (human_size (-3650722201_L)) -(* Test Common_utils.String.is_prefix. *) -let test_string_is_prefix ctx = - assert_bool "String.is_prefix,," (String.is_prefix "" ""); - assert_bool "String.is_prefix,foo," (String.is_prefix "foo" ""); - assert_bool "String.is_prefix,foo,foo" (String.is_prefix "foo" "foo"); - assert_bool "String.is_prefix,foo123,foo" (String.is_prefix "foo123" "foo"); - assert_bool "not (String.is_prefix,,foo" (not (String.is_prefix "" "foo")) - -(* Test Common_utils.String.is_suffix. *) -let test_string_is_suffix ctx = - assert_bool "String.is_suffix,," (String.is_suffix "" ""); - assert_bool "String.is_suffix,foo," (String.is_suffix "foo" ""); - assert_bool "String.is_suffix,foo,foo" (String.is_suffix "foo" "foo"); - assert_bool "String.is_suffix,123foo,foo" (String.is_suffix "123foo" "foo"); - assert_bool "not String.is_suffix,,foo" (not (String.is_suffix "" "foo")) - -(* Test Common_utils.String.find. *) -let test_string_find ctx = - assert_equal_int 0 (String.find "" ""); - assert_equal_int 0 (String.find "foo" ""); - assert_equal_int 1 (String.find "foo" "o"); - assert_equal_int 3 (String.find "foobar" "bar"); - assert_equal_int (-1) (String.find "" "baz"); - assert_equal_int (-1) (String.find "foobar" "baz") - -(* Test Common_utils.String.lines_split. *) -let test_string_lines_split ctx = - assert_equal_stringlist [""] (String.lines_split ""); - assert_equal_stringlist ["A"] (String.lines_split "A"); - assert_equal_stringlist ["A"; ""] (String.lines_split "A\n"); - assert_equal_stringlist ["A"; "B"] (String.lines_split "A\nB"); - assert_equal_stringlist ["A"; "B"; "C"] (String.lines_split "A\nB\nC"); - assert_equal_stringlist ["A"; "B"; "C"; "D"] (String.lines_split "A\nB\nC\nD"); - assert_equal_stringlist ["A\n"] (String.lines_split "A\\"); - assert_equal_stringlist ["A\nB"] (String.lines_split "A\\\nB"); - assert_equal_stringlist ["A"; "B\nC"] (String.lines_split "A\nB\\\nC"); - assert_equal_stringlist ["A"; "B\nC"; "D"] (String.lines_split "A\nB\\\nC\nD"); - assert_equal_stringlist ["A"; "B\nC\nD"] (String.lines_split "A\nB\\\nC\\\nD"); - assert_equal_stringlist ["A\nB"; ""] (String.lines_split "A\\\nB\n"); - assert_equal_stringlist ["A\nB\n"] (String.lines_split "A\\\nB\\\n") - (* Suites declaration. *) let suite = "mllib Common_utils" >::: [ - "subdirectory" >:: test_subdirectory; - "numeric.le32" >:: test_le32; "sizes.parse_resize" >:: test_parse_resize; "sizes.human_size" >:: test_human_size; - "strings.is_prefix" >:: test_string_is_prefix; - "strings.is_suffix" >:: test_string_is_suffix; - "strings.find" >:: test_string_find; - "strings.lines_split" >:: test_string_lines_split; ] let () = diff --git a/mllib/curl.ml b/mllib/curl.ml index ed0b8960a..ccf98acef 100644 --- a/mllib/curl.ml +++ b/mllib/curl.ml @@ -18,6 +18,7 @@ open Printf +open Std_utils open Common_utils type t = { diff --git a/mllib/getopt_tests.ml b/mllib/getopt_tests.ml index 9d432e922..22e4282fa 100644 --- a/mllib/getopt_tests.ml +++ b/mllib/getopt_tests.ml @@ -22,6 +22,7 @@ open Printf +open Std_utils open Common_utils open Getopt.OptionName diff --git a/mllib/regedit.ml b/mllib/regedit.ml index dd03f5a23..e07700bb1 100644 --- a/mllib/regedit.ml +++ b/mllib/regedit.ml @@ -16,6 +16,7 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) +open Std_utils open Common_utils open Common_gettext.Gettext diff --git a/mllib/registry.ml b/mllib/registry.ml index 767092c6d..8d62e3bb5 100644 --- a/mllib/registry.ml +++ b/mllib/registry.ml @@ -18,8 +18,9 @@ open Printf -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext type node = int64 type value = int64 diff --git a/mllib/xpath_helpers.ml b/mllib/xpath_helpers.ml index d651fab23..e6185bf3d 100644 --- a/mllib/xpath_helpers.ml +++ b/mllib/xpath_helpers.ml @@ -18,8 +18,9 @@ open Printf -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext (* Parse an xpath expression and return a string/int. Returns * [Some v], or [None] if the expression doesn't match. diff --git a/resize/Makefile.am b/resize/Makefile.am index c35c3a78a..3707d73b4 100644 --- a/resize/Makefile.am +++ b/resize/Makefile.am @@ -61,6 +61,7 @@ OCAMLPACKAGES = \ -I $(top_builddir)/lib/.libs \ -I $(top_builddir)/gnulib/lib/.libs \ -I $(top_builddir)/ocaml \ + -I $(top_builddir)/common/mlstdutils \ -I $(top_builddir)/common/mlprogress \ -I $(top_builddir)/mllib if HAVE_OCAML_PKG_GETTEXT @@ -84,6 +85,7 @@ OBJECTS = $(XOBJECTS) endif OCAMLLINKFLAGS = \ + mlstdutils.$(MLARCHIVE) \ mlguestfs.$(MLARCHIVE) \ mlprogress.$(MLARCHIVE) \ mllib.$(MLARCHIVE) \ @@ -91,6 +93,7 @@ OCAMLLINKFLAGS = \ virt_resize_DEPENDENCIES = \ $(OBJECTS) \ + ../common/mlstdutils/mlstdutils.$(MLARCHIVE) \ ../mllib/mllib.$(MLARCHIVE) \ $(top_srcdir)/ocaml-link.sh virt_resize_LINK = \ @@ -135,7 +138,7 @@ depend: .depend .depend: $(wildcard $(abs_srcdir)/*.mli) $(wildcard $(abs_srcdir)/*.ml) rm -f $@ $@-t - $(OCAMLFIND) ocamldep -I ../ocaml -I $(abs_srcdir) -I $(abs_top_builddir)/mllib $^ | \ + $(OCAMLFIND) ocamldep -I ../ocaml -I $(abs_srcdir) -I $(abs_top_builddir)/mlstdutils -I $(abs_top_builddir)/mllib $^ | \ $(SED) 's/ *$$//' | \ $(SED) -e :a -e '/ *\\$$/N; s/ *\\\n */ /; ta' | \ $(SED) -e 's,$(abs_srcdir)/,$(builddir)/,g' | \ diff --git a/resize/resize.ml b/resize/resize.ml index f9b612e28..66ef9e11d 100644 --- a/resize/resize.ml +++ b/resize/resize.ml @@ -18,6 +18,7 @@ open Printf +open Std_utils open Common_utils open Common_gettext.Gettext open Unix_utils diff --git a/sparsify/Makefile.am b/sparsify/Makefile.am index 97236829e..a1395ccbd 100644 --- a/sparsify/Makefile.am +++ b/sparsify/Makefile.am @@ -66,6 +66,7 @@ OCAMLPACKAGES = \ -I $(top_builddir)/lib/.libs \ -I $(top_builddir)/gnulib/lib/.libs \ -I $(top_builddir)/ocaml \ + -I $(top_builddir)/common/mlstdutils \ -I $(top_builddir)/common/mlprogress \ -I $(top_builddir)/mllib if HAVE_OCAML_PKG_GETTEXT @@ -89,6 +90,7 @@ OBJECTS = $(XOBJECTS) endif OCAMLLINKFLAGS = \ + mlstdutils.$(MLARCHIVE) \ mlguestfs.$(MLARCHIVE) \ mlprogress.$(MLARCHIVE) \ mllib.$(MLARCHIVE) \ @@ -96,6 +98,7 @@ OCAMLLINKFLAGS = \ virt_sparsify_DEPENDENCIES = \ $(OBJECTS) \ + ../common/mlstdutils/mlstdutils.$(MLARCHIVE) \ ../mllib/mllib.$(MLARCHIVE) \ $(top_srcdir)/ocaml-link.sh virt_sparsify_LINK = \ @@ -142,7 +145,7 @@ depend: .depend .depend: $(wildcard $(abs_srcdir)/*.mli) $(wildcard $(abs_srcdir)/*.ml) rm -f $@ $@-t - $(OCAMLFIND) ocamldep -I ../ocaml -I $(abs_srcdir) -I $(abs_top_builddir)/mllib $^ | \ + $(OCAMLFIND) ocamldep -I ../ocaml -I $(abs_srcdir) -I $(abs_top_builddir)/common/mlstdutils -I $(abs_top_builddir)/mllib $^ | \ $(SED) 's/ *$$//' | \ $(SED) -e :a -e '/ *\\$$/N; s/ *\\\n */ /; ta' | \ $(SED) -e 's,$(abs_srcdir)/,$(builddir)/,g' | \ diff --git a/sparsify/cmdline.ml b/sparsify/cmdline.ml index 4629aa7a4..6e0594f12 100644 --- a/sparsify/cmdline.ml +++ b/sparsify/cmdline.ml @@ -20,8 +20,9 @@ open Printf -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Getopt.OptionName open Utils diff --git a/sparsify/copying.ml b/sparsify/copying.ml index 9042bd53d..02a53b9b4 100644 --- a/sparsify/copying.ml +++ b/sparsify/copying.ml @@ -23,6 +23,7 @@ open Unix open Printf +open Std_utils open Common_utils open Common_gettext.Gettext open Unix_utils diff --git a/sparsify/in_place.ml b/sparsify/in_place.ml index 88f30c0b3..1f3da2c70 100644 --- a/sparsify/in_place.ml +++ b/sparsify/in_place.ml @@ -21,6 +21,7 @@ open Unix open Printf +open Std_utils open Common_utils open Common_gettext.Gettext diff --git a/sparsify/utils.ml b/sparsify/utils.ml index 3bb64b737..27723c3a2 100644 --- a/sparsify/utils.ml +++ b/sparsify/utils.ml @@ -20,7 +20,7 @@ open Printf -open Common_utils +open Std_utils module G = Guestfs diff --git a/sysprep/Makefile.am b/sysprep/Makefile.am index 68cb1814a..c2adb1a6e 100644 --- a/sysprep/Makefile.am +++ b/sysprep/Makefile.am @@ -112,6 +112,7 @@ OCAMLPACKAGES = \ -I $(top_builddir)/gnulib/lib/.libs \ -I $(top_builddir)/ocaml \ -I $(top_builddir)/common/visit/.libs \ + -I $(top_builddir)/common/mlstdutils \ -I $(top_builddir)/common/mlvisit \ -I $(top_builddir)/mllib \ -I $(top_builddir)/customize @@ -137,6 +138,7 @@ OBJECTS = $(XOBJECTS) endif OCAMLLINKFLAGS = \ + mlstdutils.$(MLARCHIVE) \ mlguestfs.$(MLARCHIVE) \ mllib.$(MLARCHIVE) \ mlvisit.$(MLARCHIVE) \ @@ -145,6 +147,7 @@ OCAMLLINKFLAGS = \ virt_sysprep_DEPENDENCIES = \ $(OBJECTS) \ + ../common/mlstdutils/mlstdutils.$(MLARCHIVE) \ ../mllib/mllib.$(MLARCHIVE) \ ../customize/customize.$(MLARCHIVE) \ $(top_srcdir)/ocaml-link.sh @@ -213,7 +216,7 @@ depend: .depend .depend: $(wildcard $(abs_srcdir)/*.mli) $(wildcard $(abs_srcdir)/*.ml) rm -f $@ $@-t - $(OCAMLFIND) ocamldep -I ../ocaml -I $(abs_srcdir) -I $(abs_top_builddir)/mllib -I $(abs_top_builddir)/customize $^ | \ + $(OCAMLFIND) ocamldep -I ../ocaml -I $(abs_srcdir) -I $(abs_top_builddir)/mlstdutils -I $(abs_top_builddir)/mllib -I $(abs_top_builddir)/customize $^ | \ $(SED) 's/ *$$//' | \ $(SED) -e :a -e '/ *\\$$/N; s/ *\\\n */ /; ta' | \ $(SED) -e 's,$(abs_srcdir)/,$(builddir)/,g' | \ diff --git a/sysprep/main.ml b/sysprep/main.ml index 82164c62f..ab631c479 100644 --- a/sysprep/main.ml +++ b/sysprep/main.ml @@ -19,6 +19,7 @@ open Unix open Printf +open Std_utils open Common_utils open Common_gettext.Gettext open Getopt.OptionName diff --git a/sysprep/sysprep_operation.ml b/sysprep/sysprep_operation.ml index b2286f642..17d298fc1 100644 --- a/sysprep/sysprep_operation.ml +++ b/sysprep/sysprep_operation.ml @@ -16,10 +16,10 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) -open Common_utils - open Printf +open Std_utils +open Common_utils open Common_gettext.Gettext open Getopt.OptionName diff --git a/sysprep/sysprep_operation_backup_files.ml b/sysprep/sysprep_operation_backup_files.ml index 6b1a100e6..64df8d758 100644 --- a/sysprep/sysprep_operation_backup_files.ml +++ b/sysprep/sysprep_operation_backup_files.ml @@ -18,8 +18,9 @@ open Printf -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Visit open Unix_utils.Fnmatch open Sysprep_operation diff --git a/sysprep/sysprep_operation_cron_spool.ml b/sysprep/sysprep_operation_cron_spool.ml index 063f75a83..f48a5201a 100644 --- a/sysprep/sysprep_operation_cron_spool.ml +++ b/sysprep/sysprep_operation_cron_spool.ml @@ -16,9 +16,11 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) -open Sysprep_operation -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext + +open Sysprep_operation module G = Guestfs diff --git a/sysprep/sysprep_operation_net_hostname.ml b/sysprep/sysprep_operation_net_hostname.ml index 7284d630f..b455e5c93 100644 --- a/sysprep/sysprep_operation_net_hostname.ml +++ b/sysprep/sysprep_operation_net_hostname.ml @@ -16,10 +16,12 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) +open Std_utils open Common_utils -open Sysprep_operation open Common_gettext.Gettext +open Sysprep_operation + module G = Guestfs let net_hostname_perform (g : Guestfs.guestfs) root side_effects = diff --git a/sysprep/sysprep_operation_net_hwaddr.ml b/sysprep/sysprep_operation_net_hwaddr.ml index 439da6d81..21cae1be4 100644 --- a/sysprep/sysprep_operation_net_hwaddr.ml +++ b/sysprep/sysprep_operation_net_hwaddr.ml @@ -16,10 +16,12 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) +open Std_utils open Common_utils -open Sysprep_operation open Common_gettext.Gettext +open Sysprep_operation + module G = Guestfs let net_hwaddr_perform (g : Guestfs.guestfs) root side_effects = diff --git a/sysprep/sysprep_operation_script.ml b/sysprep/sysprep_operation_script.ml index aa656727e..cf911043a 100644 --- a/sysprep/sysprep_operation_script.ml +++ b/sysprep/sysprep_operation_script.ml @@ -19,9 +19,10 @@ open Printf open Unix -open Common_gettext.Gettext +open Std_utils open Common_utils open Unix_utils +open Common_gettext.Gettext open Getopt.OptionName open Sysprep_operation diff --git a/sysprep/sysprep_operation_user_account.ml b/sysprep/sysprep_operation_user_account.ml index 6f44b9dfd..2a633f5d8 100644 --- a/sysprep/sysprep_operation_user_account.ml +++ b/sysprep/sysprep_operation_user_account.ml @@ -19,6 +19,7 @@ open Printf +open Std_utils open Common_utils open Common_gettext.Gettext open Getopt.OptionName diff --git a/v2v/DOM.ml b/v2v/DOM.ml index 29ce64fa6..9986fc912 100644 --- a/v2v/DOM.ml +++ b/v2v/DOM.ml @@ -18,6 +18,7 @@ (* Poor man's XML DOM, mutable for ease of modification. *) +open Std_utils open Common_utils open Printf diff --git a/v2v/Makefile.am b/v2v/Makefile.am index 2de99ceb9..8a831a700 100644 --- a/v2v/Makefile.am +++ b/v2v/Makefile.am @@ -146,6 +146,7 @@ OCAMLPACKAGES = \ -I $(top_builddir)/lib/.libs \ -I $(top_builddir)/gnulib/lib/.libs \ -I $(top_builddir)/ocaml \ + -I $(top_builddir)/common/mlstdutils \ -I $(top_builddir)/common/mlxml \ -I $(top_builddir)/mllib \ -I $(top_builddir)/customize @@ -170,6 +171,7 @@ OBJECTS = $(XOBJECTS) endif OCAMLLINKFLAGS = \ + mlstdutils.$(MLARCHIVE) \ mlguestfs.$(MLARCHIVE) \ mlxml.$(MLARCHIVE) \ mllib.$(MLARCHIVE) \ @@ -210,6 +212,7 @@ endif virt_v2v_copy_to_local_DEPENDENCIES = \ $(COPY_TO_LOCAL_OBJECTS) \ + ../common/mlstdutils/mlstdutils.$(MLARCHIVE) \ ../common/mlxml/mlxml.$(MLARCHIVE) \ ../mllib/mllib.$(MLARCHIVE) \ $(top_srcdir)/ocaml-link.sh @@ -495,6 +498,7 @@ endif v2v_unit_tests_DEPENDENCIES = \ $(v2v_unit_tests_THEOBJECTS) \ + ../common/mlstdutils/mlstdutils.$(MLARCHIVE) \ ../common/mlxml/mlxml.$(MLARCHIVE) \ ../mllib/mllib.$(MLARCHIVE) \ $(top_srcdir)/ocaml-link.sh @@ -510,7 +514,7 @@ depend: .depend .depend: $(wildcard $(abs_srcdir)/*.mli) $(wildcard $(abs_srcdir)/*.ml) rm -f $@ $@-t - $(OCAMLFIND) ocamldep -I ../ocaml -I $(abs_srcdir) -I $(abs_top_builddir)/common/mlxml -I $(abs_top_builddir)/mllib -I $(abs_top_builddir)/customize $^ | \ + $(OCAMLFIND) ocamldep -I ../ocaml -I $(abs_srcdir) -I $(abs_top_builddir)/common/mlstdutils -I $(abs_top_builddir)/common/mlxml -I $(abs_top_builddir)/mllib -I $(abs_top_builddir)/customize $^ | \ $(SED) 's/ *$$//' | \ $(SED) -e :a -e '/ *\\$$/N; s/ *\\\n */ /; ta' | \ $(SED) -e 's,$(abs_srcdir)/,$(builddir)/,g' | \ diff --git a/v2v/changeuid.ml b/v2v/changeuid.ml index dbb05bc94..639fcfe12 100644 --- a/v2v/changeuid.ml +++ b/v2v/changeuid.ml @@ -21,9 +21,10 @@ open Unix open Printf +open Std_utils open Common_utils -open Common_gettext.Gettext open Unix_utils +open Common_gettext.Gettext open Utils diff --git a/v2v/cmdline.ml b/v2v/cmdline.ml index 70301ab40..a19510b3f 100644 --- a/v2v/cmdline.ml +++ b/v2v/cmdline.ml @@ -20,8 +20,9 @@ open Printf -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Getopt.OptionName open Types diff --git a/v2v/convert_linux.ml b/v2v/convert_linux.ml index 42a19947b..ffb43564f 100644 --- a/v2v/convert_linux.ml +++ b/v2v/convert_linux.ml @@ -28,8 +28,9 @@ open Printf -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Utils open Types diff --git a/v2v/convert_windows.ml b/v2v/convert_windows.ml index dfb90d079..2c8708878 100644 --- a/v2v/convert_windows.ml +++ b/v2v/convert_windows.ml @@ -18,8 +18,9 @@ open Printf -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Utils open Types diff --git a/v2v/copy_to_local.ml b/v2v/copy_to_local.ml index 88fd9abde..0a2b7ed75 100644 --- a/v2v/copy_to_local.ml +++ b/v2v/copy_to_local.ml @@ -20,8 +20,9 @@ open Printf -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Getopt.OptionName open Utils diff --git a/v2v/create_libvirt_xml.ml b/v2v/create_libvirt_xml.ml index 246cacd21..3f22f3764 100644 --- a/v2v/create_libvirt_xml.ml +++ b/v2v/create_libvirt_xml.ml @@ -18,8 +18,9 @@ open Printf -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Types open Utils diff --git a/v2v/create_ovf.ml b/v2v/create_ovf.ml index 6c7aba6d7..fd7ec5fe8 100644 --- a/v2v/create_ovf.ml +++ b/v2v/create_ovf.ml @@ -18,12 +18,13 @@ (* Create OVF and related files for RHV. *) -open Common_gettext.Gettext -open Common_utils - open Unix open Printf +open Std_utils +open Common_utils +open Common_gettext.Gettext + open Types open Utils open DOM diff --git a/v2v/input_disk.ml b/v2v/input_disk.ml index d28f45ece..a92f3a602 100644 --- a/v2v/input_disk.ml +++ b/v2v/input_disk.ml @@ -18,8 +18,9 @@ open Printf -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Types open Utils diff --git a/v2v/input_libvirtxml.ml b/v2v/input_libvirtxml.ml index d829ee523..570541d7d 100644 --- a/v2v/input_libvirtxml.ml +++ b/v2v/input_libvirtxml.ml @@ -18,8 +18,9 @@ open Printf -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Types open Parse_libvirt_xml diff --git a/v2v/input_ova.ml b/v2v/input_ova.ml index b509326dd..e8be68ed7 100644 --- a/v2v/input_ova.ml +++ b/v2v/input_ova.ml @@ -18,9 +18,10 @@ open Printf -open Common_gettext.Gettext +open Std_utils open Common_utils open Unix_utils +open Common_gettext.Gettext open Types open Utils diff --git a/v2v/input_vmx.ml b/v2v/input_vmx.ml index c48a0155a..bb1650ae9 100644 --- a/v2v/input_vmx.ml +++ b/v2v/input_vmx.ml @@ -19,8 +19,9 @@ open Printf open Scanf -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Types open Utils diff --git a/v2v/inspect_source.ml b/v2v/inspect_source.ml index 7476c3d85..e5d1fd3aa 100644 --- a/v2v/inspect_source.ml +++ b/v2v/inspect_source.ml @@ -18,6 +18,7 @@ open Printf +open Std_utils open Common_utils open Common_gettext.Gettext diff --git a/v2v/linux.ml b/v2v/linux.ml index 5f40c4196..799654511 100644 --- a/v2v/linux.ml +++ b/v2v/linux.ml @@ -18,8 +18,9 @@ open Printf -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Types open Utils diff --git a/v2v/linux_bootloaders.ml b/v2v/linux_bootloaders.ml index 33a6dc4e9..b5ad25508 100644 --- a/v2v/linux_bootloaders.ml +++ b/v2v/linux_bootloaders.ml @@ -18,8 +18,9 @@ open Printf -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Types open Utils diff --git a/v2v/linux_kernels.ml b/v2v/linux_kernels.ml index e8c3a93c6..6e1ca4bf1 100644 --- a/v2v/linux_kernels.ml +++ b/v2v/linux_kernels.ml @@ -20,8 +20,9 @@ open Printf -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Types diff --git a/v2v/modules_list.ml b/v2v/modules_list.ml index 3ee0bd7dc..e3c6d5934 100644 --- a/v2v/modules_list.ml +++ b/v2v/modules_list.ml @@ -16,7 +16,7 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) -open Common_utils +open Std_utils let input_modules = ref [] and output_modules = ref [] diff --git a/v2v/output_glance.ml b/v2v/output_glance.ml index 3feb2e493..e26bc0732 100644 --- a/v2v/output_glance.ml +++ b/v2v/output_glance.ml @@ -18,9 +18,10 @@ open Printf -open Common_gettext.Gettext +open Std_utils open Common_utils open Unix_utils +open Common_gettext.Gettext open Types open Utils diff --git a/v2v/output_libvirt.ml b/v2v/output_libvirt.ml index b3e695387..61e1efddb 100644 --- a/v2v/output_libvirt.ml +++ b/v2v/output_libvirt.ml @@ -18,8 +18,9 @@ open Printf -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Types open Utils diff --git a/v2v/output_local.ml b/v2v/output_local.ml index 9c105ef8d..3553150ff 100644 --- a/v2v/output_local.ml +++ b/v2v/output_local.ml @@ -18,8 +18,9 @@ open Printf -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Types open Utils diff --git a/v2v/output_null.ml b/v2v/output_null.ml index b0e99b4de..9b31c2d00 100644 --- a/v2v/output_null.ml +++ b/v2v/output_null.ml @@ -18,9 +18,10 @@ open Printf -open Common_gettext.Gettext +open Std_utils open Common_utils open Unix_utils +open Common_gettext.Gettext open Types open Utils diff --git a/v2v/output_qemu.ml b/v2v/output_qemu.ml index 031279cb3..00814e8f0 100644 --- a/v2v/output_qemu.ml +++ b/v2v/output_qemu.ml @@ -18,8 +18,9 @@ open Printf -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Types open Utils diff --git a/v2v/output_rhv.ml b/v2v/output_rhv.ml index 82e745a94..0c02df612 100644 --- a/v2v/output_rhv.ml +++ b/v2v/output_rhv.ml @@ -16,9 +16,10 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) -open Common_gettext.Gettext +open Std_utils open Common_utils open Unix_utils +open Common_gettext.Gettext open Unix open Printf diff --git a/v2v/output_vdsm.ml b/v2v/output_vdsm.ml index d8cd20156..361a8e555 100644 --- a/v2v/output_vdsm.ml +++ b/v2v/output_vdsm.ml @@ -16,8 +16,9 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Unix open Printf diff --git a/v2v/parse_libvirt_xml.ml b/v2v/parse_libvirt_xml.ml index 4ac9b51a5..56f9ea297 100644 --- a/v2v/parse_libvirt_xml.ml +++ b/v2v/parse_libvirt_xml.ml @@ -18,12 +18,13 @@ open Printf -open Common_gettext.Gettext +open Std_utils open Common_utils - -open Types +open Common_gettext.Gettext open Xpath_helpers +open Types + type parsed_disk = { p_source_disk : source_disk; p_source : parsed_source; diff --git a/v2v/parse_ovf_from_ova.ml b/v2v/parse_ovf_from_ova.ml index 2a3752776..6dc032407 100644 --- a/v2v/parse_ovf_from_ova.ml +++ b/v2v/parse_ovf_from_ova.ml @@ -18,9 +18,10 @@ (* Parse OVF from an externally produced OVA file. *) -open Common_gettext.Gettext +open Std_utils open Common_utils open Unix_utils +open Common_gettext.Gettext open Types open Utils diff --git a/v2v/parse_vmx.ml b/v2v/parse_vmx.ml index 33ec17d3d..770dc29d3 100644 --- a/v2v/parse_vmx.ml +++ b/v2v/parse_vmx.ml @@ -18,6 +18,7 @@ open Printf +open Std_utils open Common_utils open Common_gettext.Gettext diff --git a/v2v/target_bus_assignment.ml b/v2v/target_bus_assignment.ml index a9010c245..de6b0148d 100644 --- a/v2v/target_bus_assignment.ml +++ b/v2v/target_bus_assignment.ml @@ -16,6 +16,7 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) +open Std_utils open Common_utils open Common_gettext.Gettext diff --git a/v2v/test-harness/Makefile.am b/v2v/test-harness/Makefile.am index 9a548022a..bcfcdf21d 100644 --- a/v2v/test-harness/Makefile.am +++ b/v2v/test-harness/Makefile.am @@ -42,6 +42,7 @@ OCAMLPACKAGES = \ -I $(top_builddir)/lib/.libs \ -I $(top_builddir)/gnulib/lib/.libs \ -I $(top_builddir)/ocaml \ + -I $(top_builddir)/common/mlstdutils \ -I $(top_builddir)/common/mlxml \ -I $(top_builddir)/mllib \ -I $(top_builddir)/v2v @@ -129,7 +130,7 @@ depend: .depend .depend: $(wildcard $(abs_srcdir)/*.mli) $(wildcard $(abs_srcdir)/*.ml) rm -f $@ $@-t - $(OCAMLFIND) ocamldep -I ../../ocaml -I $(abs_srcdir) -I $(abs_top_builddir)/common/mlxml -I $(abs_top_builddir)/mllib -I $(abs_top_builddir)/customize -I $(abs_top_builddir)/v2v $^ | \ + $(OCAMLFIND) ocamldep -I ../../ocaml -I $(abs_srcdir) -I $(abs_top_builddir)/common/mlstdutils -I $(abs_top_builddir)/common/mlxml -I $(abs_top_builddir)/mllib -I $(abs_top_builddir)/customize -I $(abs_top_builddir)/v2v $^ | \ $(SED) 's/ *$$//' | \ $(SED) -e :a -e '/ *\\$$/N; s/ *\\\n */ /; ta' | \ $(SED) -e 's,$(abs_srcdir)/,$(builddir)/,g' | \ diff --git a/v2v/test-harness/v2v_test_harness.ml b/v2v/test-harness/v2v_test_harness.ml index 3c29a9430..ba8c5eeab 100644 --- a/v2v/test-harness/v2v_test_harness.ml +++ b/v2v/test-harness/v2v_test_harness.ml @@ -23,6 +23,7 @@ module D = Libvirt.Domain open Unix open Printf +open Std_utils open Common_utils type test_plan = { diff --git a/v2v/utils.ml b/v2v/utils.ml index e0275db53..0dab5816e 100644 --- a/v2v/utils.ml +++ b/v2v/utils.ml @@ -20,8 +20,9 @@ open Printf -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext external drive_name : int -> string = "v2v_utils_drive_name" external drive_index : string -> int = "v2v_utils_drive_index" diff --git a/v2v/v2v.ml b/v2v/v2v.ml index 59f5ef17e..f1ce9335a 100644 --- a/v2v/v2v.ml +++ b/v2v/v2v.ml @@ -19,9 +19,10 @@ open Unix open Printf -open Common_gettext.Gettext +open Std_utils open Common_utils open Unix_utils +open Common_gettext.Gettext open Types open Utils diff --git a/v2v/v2v_unit_tests.ml b/v2v/v2v_unit_tests.ml index 7f98e09d3..be0bf0172 100644 --- a/v2v/v2v_unit_tests.ml +++ b/v2v/v2v_unit_tests.ml @@ -18,13 +18,15 @@ (* This file tests individual virt-v2v functions. *) -open OUnit2 -open Types - open Printf +open OUnit2 + +open Std_utils open Common_utils +open Types + let inspect_defaults = { i_type = ""; i_distro = ""; i_arch = ""; i_major_version = 0; i_minor_version = 0; diff --git a/v2v/vCenter.ml b/v2v/vCenter.ml index 468261d3d..d84bf8b58 100644 --- a/v2v/vCenter.ml +++ b/v2v/vCenter.ml @@ -18,6 +18,7 @@ open Printf +open Std_utils open Common_utils open Common_gettext.Gettext diff --git a/v2v/windows_virtio.ml b/v2v/windows_virtio.ml index 9891a770c..76af7ab2f 100644 --- a/v2v/windows_virtio.ml +++ b/v2v/windows_virtio.ml @@ -18,8 +18,9 @@ open Printf -open Common_gettext.Gettext +open Std_utils open Common_utils +open Common_gettext.Gettext open Regedit -- 2.13.0