thr3ads.net - Libguestfs - Re: [Libguestfs] [PATCH v3 1/4] mltools: Rename Yajl module as JSON_parser and move to common/mltools. [Aug 2018]

If this information is useful, please help other people find it:
Share via:

Richard W.M. Jones

2018-Aug-17 15:16 UTC

[Libguestfs] [PATCH v3 4/4] v2v: Add --print-estimate option to print copy size

I rethought this again, as I think that it's a dangerous assumption to
bake qemu-img measure output into our API.

This patch series runs qemu-img measure behind the scenes, but then
parses the output and sums it to a single number which we print.

Doing that required a bit of reworking, moving the Jansson [JSON
parser] bindings from virt-builder into the common directory and
a couple of other minor changes, hence this has grown to 4 commits.

Rich.

Richard W.M. Jones

2018-Aug-17 15:16 UTC

head link

[Libguestfs] [PATCH v3 1/4] mltools: Rename Yajl module as JSON_parser and move to common/mltools.

Commit bd1c5c9f4dcf38458099db8a0bf4659a07ef055d changed all the code
to use Jansson instead of yajl.  However it didn't change the OCaml
API name (which was still Yajl).

This commit changes the module to a neutral name ("JSON_parser") and
moves it into common/mltools so it can be used by other tools.

This leaves us in a slightly awkward situation of having two JSON-ish
OCaml modules (JSON for creating trees and JSON_parser for parsing
them) with incompatible types.  That is left for future work to
resolve.  (It should be easier to do now that both modules live in the
same directory.)

This is just renaming and general refactoring.  There should be no
change in functionality.
---
 .gitignore                                    |  2 +-
 builder/Makefile.am                           | 57 ++++---------------
 builder/index_parser.ml                       |  2 +-
 builder/repository_main.ml                    |  2 +-
 builder/simplestreams_parser.ml               |  6 +-
 builder/utils.ml                              |  2 +-
 builder/utils.mli                             |  4 +-
 .../mltools/JSON_parser-c.c                   |  8 +--
 .../yajl.ml => common/mltools/JSON_parser.ml  | 38 ++++++-------
 .../mltools/JSON_parser.mli                   | 42 +++++++-------
 .../mltools/JSON_parser_tests.ml              | 56 +++++++++---------
 common/mltools/Makefile.am                    | 39 ++++++++++++-
 docs/C_SOURCE_FILES                           |  4 +-
 po/POTFILES                                   |  3 +-
 po/POTFILES-ml                                |  4 +-
 15 files changed, 135 insertions(+), 134 deletions(-)

diff --git a/.gitignore b/.gitignore
index 41219f4a1..b714b1a43 100644
--- a/.gitignore
+++ b/.gitignore
@@ -113,7 +113,6 @@ Makefile.in
 /builder/virt-index-validate
 /builder/virt-index-validate.1
 /builder/*.xz
-/builder/yajl_tests
 /cat/stamp-virt-*.pod
 /cat/virt-cat
 /cat/virt-cat.1
@@ -146,6 +145,7 @@ Makefile.in
 /common/mltools/.depend
 /common/mltools/getopt_tests
 /common/mltools/JSON_tests
+/common/mltools/JSON_parser_tests
 /common/mltools/tools_utils_tests
 /common/mltools/oUnit-*
 /common/mlutils/.depend
diff --git a/builder/Makefile.am b/builder/Makefile.am
index 7ede544b7..f64750c7f 100644
--- a/builder/Makefile.am
+++ b/builder/Makefile.am
@@ -45,8 +45,7 @@ EXTRA_DIST = \
 	test-virt-index-validate-good-4 \
 	virt-builder.pod \
 	virt-builder-repository.pod \
-	virt-index-validate.pod \
-	yajl_tests.ml
+	virt-index-validate.pod
 
 SOURCES_MLI = \
 	builder.mli \
@@ -67,11 +66,9 @@ SOURCES_MLI = \
 	sigchecker.mli \
 	simplestreams_parser.mli \
 	sources.mli \
-	utils.mli \
-	yajl.mli
+	utils.mli
 
 SOURCES_ML = \
-	yajl.ml \
 	utils.ml \
 	osinfo_config.ml \
 	osinfo.ml \
@@ -97,11 +94,9 @@ SOURCES_C = \
 	index-parse.c \
 	index-parser-c.c \
 	pxzcat-c.c \
-	setlocale-c.c \
-	yajl-c.c
+	setlocale-c.c
 
 REPOSITORY_SOURCES_ML = \
-	yajl.ml \
 	utils.ml \
 	index.ml \
 	cache.ml \
@@ -122,15 +117,13 @@ REPOSITORY_SOURCES_MLI = \
 	index_parser.mli \
 	ini_reader.mli \
 	sigchecker.mli \
-	sources.mli \
-	yajl.mli
+	sources.mli
 
 REPOSITORY_SOURCES_C = \
 	index-scan.c \
 	index-struct.c \
 	index-parse.c \
-	index-parser-c.c \
-	yajl-c.c
+	index-parser-c.c
 
 man_MANS  noinst_DATA @@ -156,8 +149,7 @@ virt_builder_CFLAGS = \
 	-Wno-unused-macros \
 	$(LIBLZMA_CFLAGS) \
 	$(LIBTINFO_CFLAGS) \
-	$(LIBXML2_CFLAGS) \
-	$(JANSSON_CFLAGS)
+	$(LIBXML2_CFLAGS)
 
 BOBJECTS = $(SOURCES_ML:.ml=.cmo)
 XOBJECTS = $(BOBJECTS:.cmo=.cmx)
@@ -175,8 +167,7 @@ virt_builder_repository_CFLAGS = \
 	$(WARN_CFLAGS) $(WERROR_CFLAGS) \
 	-Wno-unused-macros \
 	$(LIBTINFO_CFLAGS) \
-	$(LIBXML2_CFLAGS) \
-	$(YAJL_CFLAGS)
+	$(LIBXML2_CFLAGS)
 REPOSITORY_BOBJECTS = $(REPOSITORY_SOURCES_ML:.ml=.cmo)
 REPOSITORY_XOBJECTS = $(REPOSITORY_BOBJECTS:.cmo=.cmx)
 
@@ -323,22 +314,13 @@ fedora.qcow2.xz: fedora.qcow2
 	xz --best -c $< > $@-t
 	mv $@-t $@
 
-yajl_tests_SOURCES = yajl-c.c
-yajl_tests_CPPFLAGS = $(virt_builder_CPPFLAGS)
-yajl_tests_BOBJECTS = \
-	yajl.cmo \
-	yajl_tests.cmo
-yajl_tests_XOBJECTS = $(yajl_tests_BOBJECTS:.cmo=.cmx)
-
 index_parser_tests_SOURCES = \
 	index-scan.c \
 	index-struct.c \
 	index-parser-c.c \
-	index-parse.c \
-	yajl-c.c
+	index-parse.c
 index_parser_tests_CPPFLAGS = $(virt_builder_CPPFLAGS)
 index_parser_tests_BOBJECTS = \
-	yajl.cmo \
 	utils.cmo \
 	index.cmo \
 	cache.cmo \
@@ -351,32 +333,13 @@ index_parser_tests_XOBJECTS =
$(index_parser_tests_BOBJECTS:.cmo=.cmx)
 
 # Can't call the following as <test>_OBJECTS because automake gets
confused.
 if HAVE_OCAMLOPT
-yajl_tests_THEOBJECTS = $(yajl_tests_XOBJECTS)
-yajl_tests.cmx: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
-
 index_parser_tests_THEOBJECTS = $(index_parser_tests_XOBJECTS)
 index_parser_tests.cmx: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
 else
-yajl_tests_THEOBJECTS = $(yajl_tests_BOBJECTS)
-yajl_tests.cmo: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
-
 index_parser_tests_THEOBJECTS = $(index_parser_tests_BOBJECTS)
 index_parser_tests.cmo: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
 endif
 
-yajl_tests_DEPENDENCIES = \
-	$(yajl_tests_THEOBJECTS) \
-	../common/mlpcre/mlpcre.$(MLARCHIVE) \
-	../common/mlstdutils/mlstdutils.$(MLARCHIVE) \
-	../common/mlutils/mlcutils.$(MLARCHIVE) \
-	../common/mltools/mltools.$(MLARCHIVE) \
-	../customize/customize.$(MLARCHIVE) \
-	$(top_srcdir)/ocaml-link.sh
-yajl_tests_LINK = \
-	$(top_srcdir)/ocaml-link.sh -cclib '$(OCAMLCLIBS)' -- \
-	  $(OCAMLFIND) $(BEST) $(OCAMLFLAGS) $(OCAMLPACKAGES) $(OCAMLPACKAGES_TESTS)
$(OCAMLLINKFLAGS) \
-	  $(yajl_tests_THEOBJECTS) -o $@
-
 index_parser_tests_DEPENDENCIES = \
 	$(index_parser_tests_THEOBJECTS) \
 	../common/mltools/mltools.$(MLARCHIVE) \
@@ -400,8 +363,8 @@ if ENABLE_APPLIANCE
 TESTS += test-virt-builder.sh
 endif ENABLE_APPLIANCE
 if HAVE_OCAML_PKG_OUNIT
-check_PROGRAMS += yajl_tests index_parser_tests
-TESTS += yajl_tests index_parser_tests
+check_PROGRAMS += index_parser_tests
+TESTS += index_parser_tests
 endif
 
 check-valgrind:
diff --git a/builder/index_parser.ml b/builder/index_parser.ml
index 79653a91b..59fa5097d 100644
--- a/builder/index_parser.ml
+++ b/builder/index_parser.ml
@@ -140,7 +140,7 @@ let get_index ~downloader ~sigchecker ?(template = false) {
Sources.uri; proxy }
               match detect_file_type filepath with
               | `Unknown ->
                 let infos = Utils.get_image_infos filepath in
-                Yajl.object_get_number "virtual-size" infos
+                JSON_parser.object_get_number "virtual-size" infos
               | `XZ | `GZip | `Tar | ` Zip ->
                 eprintf (f_"%s: cannot determine the virtual size of %s
due to compression")
                         prog filepath;
diff --git a/builder/repository_main.ml b/builder/repository_main.ml
index 5dc4d57cd..43f749c5a 100644
--- a/builder/repository_main.ml
+++ b/builder/repository_main.ml
@@ -22,7 +22,7 @@ open Tools_utils
 open Unix_utils
 open Getopt.OptionName
 open Utils
-open Yajl
+open JSON_parser
 open Xpath_helpers
 
 open Printf
diff --git a/builder/simplestreams_parser.ml b/builder/simplestreams_parser.ml
index 18f45a6fd..fa5b887ac 100644
--- a/builder/simplestreams_parser.ml
+++ b/builder/simplestreams_parser.ml
@@ -20,7 +20,7 @@ open Std_utils
 open Tools_utils
 open Common_gettext.Gettext
 
-open Yajl
+open JSON_parser
 open Utils
 
 open Printf
@@ -44,7 +44,7 @@ let get_index ~downloader ~sigchecker { Sources.uri; proxy }  
| Some f -> f
       ) else
         tmpfile in
-    yajl_tree_parse (read_whole_file file) in
+    json_parser_tree_parse (read_whole_file file) in
 
   let downloads      let uri_index @@ -106,7 +106,7 @@ let get_index
~downloader ~sigchecker { Sources.uri; proxy }                     * the ones
related to checksums, explicitly filter
                    * the supported checksums.
                    *)
-                  | ("sha256"|"sha512" as t, Yajl_string c)
->
+                  | ("sha256"|"sha512" as t,
JSON_parser_string c) ->
                     Some (Checksums.of_string t c)
                   | _ -> None
                 ) disk_item in
diff --git a/builder/utils.ml b/builder/utils.ml
index 1446561b0..538a43be9 100644
--- a/builder/utils.ml
+++ b/builder/utils.ml
@@ -43,4 +43,4 @@ let get_image_infos filepath    let qemuimg_cmd =
"qemu-img info --output json " ^ quote filepath in
   let lines = external_command qemuimg_cmd in
   let line = String.concat "\n" lines in
-  Yajl.yajl_tree_parse line
+  JSON_parser.json_parser_tree_parse line
diff --git a/builder/utils.mli b/builder/utils.mli
index 4249fd956..5dde43a01 100644
--- a/builder/utils.mli
+++ b/builder/utils.mli
@@ -29,9 +29,9 @@ and revision  val string_of_revision : revision -> string
 (** Convert a {!revision} into a string. *)
 
-val get_image_infos : string -> Yajl.yajl_val
+val get_image_infos : string -> JSON_parser.json_parser_val
 (** [get_image_infos path] Run qemu-img info on the image pointed at
-    path as YAJL tree. *)
+    path as JSON tree. *)
 
 val increment_revision : revision -> revision
 (** Add one to the revision number *)
diff --git a/builder/yajl-c.c b/common/mltools/JSON_parser-c.c
similarity index 94%
rename from builder/yajl-c.c
rename to common/mltools/JSON_parser-c.c
index e53755f55..32432dc5b 100644
--- a/builder/yajl-c.c
+++ b/common/mltools/JSON_parser-c.c
@@ -1,5 +1,5 @@
-/* virt-builder
- * Copyright (C) 2015 Red Hat Inc.
+/* JSON parser
+ * Copyright (C) 2015-2018 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
@@ -30,7 +30,7 @@
 
 #define Val_none (Val_int (0))
 
-value virt_builder_yajl_tree_parse (value stringv);
+value virt_builder_json_parser_tree_parse (value stringv);
 
 static value
 convert_json_t (json_t *val, int level)
@@ -95,7 +95,7 @@ convert_json_t (json_t *val, int level)
 }
 
 value
-virt_builder_yajl_tree_parse (value stringv)
+virt_builder_json_parser_tree_parse (value stringv)
 {
   CAMLparam1 (stringv);
   CAMLlocal1 (rv);
diff --git a/builder/yajl.ml b/common/mltools/JSON_parser.ml
similarity index 75%
rename from builder/yajl.ml
rename to common/mltools/JSON_parser.ml
index d95f3932a..a82127454 100644
--- a/builder/yajl.ml
+++ b/common/mltools/JSON_parser.ml
@@ -1,5 +1,5 @@
-(* virt-builder
- * Copyright (C) 2015 Red Hat Inc.
+(* JSON parser
+ * Copyright (C) 2015-2018 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
@@ -20,19 +20,19 @@ open Std_utils
 open Tools_utils
 open Common_gettext.Gettext
 
-type yajl_val -| Yajl_null
-| Yajl_string of string
-| Yajl_number of int64
-| Yajl_double of float
-| Yajl_object of (string * yajl_val) array
-| Yajl_array of yajl_val array
-| Yajl_bool of bool
+type json_parser_val +| JSON_parser_null
+| JSON_parser_string of string
+| JSON_parser_number of int64
+| JSON_parser_double of float
+| JSON_parser_object of (string * json_parser_val) array
+| JSON_parser_array of json_parser_val array
+| JSON_parser_bool of bool
 
-external yajl_tree_parse : string -> yajl_val =
"virt_builder_yajl_tree_parse"
+external json_parser_tree_parse : string -> json_parser_val =
"virt_builder_json_parser_tree_parse"
 
 let object_find_optional key = function
-  | Yajl_object o ->
+  | JSON_parser_object o ->
     (match List.filter (fun (k, _) -> k = key) (Array.to_list o) with
     | [(k, v)] -> Some v
     | [] -> None
@@ -46,27 +46,27 @@ let object_find key yv  
 let object_get_string key yv    match object_find key yv with
-  | Yajl_string s -> s
+  | JSON_parser_string s -> s
   | _ -> error (f_"the value for the key ‘%s’ is not a string")
key
 
 let object_find_object key yv    match object_find key yv with
-  | Yajl_object _ as o -> o
+  | JSON_parser_object _ as o -> o
   | _ -> error (f_"the value for the key ‘%s’ is not an object")
key
 
 let object_find_objects fn = function
-  | Yajl_object o -> List.filter_map fn (Array.to_list o)
+  | JSON_parser_object o -> List.filter_map fn (Array.to_list o)
   | _ -> error (f_"the value is not an object")
 
 let object_get_object key yv    match object_find_object key yv with
-  | Yajl_object o -> o
+  | JSON_parser_object o -> o
   | _ -> assert false (* object_find_object already errors out. *)
 
 let object_get_number key yv    match object_find key yv with
-  | Yajl_number n -> n
-  | Yajl_double d -> Int64.of_float d
+  | JSON_parser_number n -> n
+  | JSON_parser_double d -> Int64.of_float d
   | _ -> error (f_"the value for the key ‘%s’ is not an integer")
key
 
 let objects_get_string key yvs @@ -74,7 +74,7 @@ let objects_get_string key yvs
| [] -> None
     | x :: xs ->
       (match object_find_optional key x with
-      | Some (Yajl_string s) -> Some s
+      | Some (JSON_parser_string s) -> Some s
       | Some _ -> error (f_"the value for key ‘%s’ is not a string as
expected") key
       | None -> loop xs
       )
diff --git a/builder/yajl.mli b/common/mltools/JSON_parser.mli
similarity index 60%
rename from builder/yajl.mli
rename to common/mltools/JSON_parser.mli
index ca0eb92f4..f505953f2 100644
--- a/builder/yajl.mli
+++ b/common/mltools/JSON_parser.mli
@@ -1,5 +1,5 @@
-(* virt-builder
- * Copyright (C) 2015 Red Hat Inc.
+(* JSON parser
+ * Copyright (C) 2015-2018 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
@@ -16,43 +16,43 @@
  * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  *)
 
-type yajl_val -| Yajl_null
-| Yajl_string of string
-| Yajl_number of int64
-| Yajl_double of float
-| Yajl_object of (string * yajl_val) array
-| Yajl_array of yajl_val array
-| Yajl_bool of bool
+type json_parser_val +| JSON_parser_null
+| JSON_parser_string of string
+| JSON_parser_number of int64
+| JSON_parser_double of float
+| JSON_parser_object of (string * json_parser_val) array
+| JSON_parser_array of json_parser_val array
+| JSON_parser_bool of bool
 
-val yajl_tree_parse : string -> yajl_val
+val json_parser_tree_parse : string -> json_parser_val
 (** Parse the JSON string. *)
 
-val object_get_string : string -> yajl_val -> string
+val object_get_string : string -> json_parser_val -> string
 (** [object_get_string key yv] gets the value of the [key] field as a string
     in the [yv] structure *)
 
-val object_find_object : string -> yajl_val -> yajl_val
-(** [object_get_object key yv] gets the value of the [key] field as a yajl
+val object_find_object : string -> json_parser_val -> json_parser_val
+(** [object_get_object key yv] gets the value of the [key] field as a JSON
     value in the [yv] structure.
 
     Mind the returned type is different from [object_get_object] *)
 
-val object_get_object : string -> yajl_val -> (string * yajl_val) array
-(** [object_get_object key yv] gets the value of the [key] field as a Yajl
+val object_get_object : string -> json_parser_val -> (string *
json_parser_val) array
+(** [object_get_object key yv] gets the value of the [key] field as a JSON
     object in the [yv] structure *)
 
-val object_get_number : string -> yajl_val -> int64
+val object_get_number : string -> json_parser_val -> int64
 (** [object_get_number key yv] gets the value of the [key] field as an
     integer in the [yv] structure *)
 
-val objects_get_string : string -> yajl_val list -> string
+val objects_get_string : string -> json_parser_val list -> string
 (** [objects_get_string key yvs] gets the value of the [key] field as a string
-    in an [yvs] list of yajl_val structure.
+    in an [yvs] list of json_parser_val structure.
 
     The key may not be found at all in the list, in which case an error
     is raised *)
 
-val object_find_objects : ((string * yajl_val) -> 'a option) ->
yajl_val -> 'a list
-(** [object_find_objects fn obj] returns all the Yajl objects matching the [fn]
+val object_find_objects : ((string * json_parser_val) -> 'a option)
-> json_parser_val -> 'a list
+(** [object_find_objects fn obj] returns all the JSON objects matching the [fn]
     function in [obj] list. *)
diff --git a/builder/yajl_tests.ml b/common/mltools/JSON_parser_tests.ml
similarity index 73%
rename from builder/yajl_tests.ml
rename to common/mltools/JSON_parser_tests.ml
index f5a44f2fa..42045122d 100644
--- a/builder/yajl_tests.ml
+++ b/common/mltools/JSON_parser_tests.ml
@@ -16,10 +16,10 @@
  * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  *)
 
-(* This file tests the Yajl module. *)
+(* This file tests the JSON_parser module. *)
 
 open OUnit2
-open Yajl
+open JSON_parser
 
 (* Utils. *)
 let assert_equal_string = assert_equal ~printer:(fun x -> x)
@@ -27,16 +27,16 @@ 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_bool = assert_equal ~printer:(fun x -> string_of_bool x)
 
-let string_of_yajl_val_type = function
-  | Yajl_null -> "null"
-  | Yajl_string _ -> "string"
-  | Yajl_number _ -> "number"
-  | Yajl_double _ -> "float"
-  | Yajl_object _ -> "object"
-  | Yajl_array _ -> "array"
-  | Yajl_bool _ -> "bool"
+let string_of_json_parser_val_type = function
+  | JSON_parser_null -> "null"
+  | JSON_parser_string _ -> "string"
+  | JSON_parser_number _ -> "number"
+  | JSON_parser_double _ -> "float"
+  | JSON_parser_object _ -> "object"
+  | JSON_parser_array _ -> "array"
+  | JSON_parser_bool _ -> "bool"
 let type_mismatch_string exp value -  Printf.sprintf "value is not %s but
%s" exp (string_of_yajl_val_type value)
+  Printf.sprintf "value is not %s but %s" exp
(string_of_json_parser_val_type value)
 
 let assert_raises_invalid_argument str    (* Replace the Invalid_argument
string with a fixed one, just to check
@@ -44,37 +44,37 @@ let assert_raises_invalid_argument str     *)
   let mock = "parse_error" in
   let wrapped_tree_parse str -    try yajl_tree_parse str
+    try json_parser_tree_parse str
     with Invalid_argument _ -> raise (Invalid_argument mock) in
   assert_raises (Invalid_argument mock) (fun () -> wrapped_tree_parse str)
 let assert_raises_nested str    let err = "too many levels of object/array
nesting" in
-  assert_raises (Invalid_argument err) (fun () -> yajl_tree_parse str)
+  assert_raises (Invalid_argument err) (fun () -> json_parser_tree_parse
str)
 
 let assert_is_object value    assert_bool
     (type_mismatch_string "object" value)
-    (match value with | Yajl_object _ -> true | _ -> false)
+    (match value with | JSON_parser_object _ -> true | _ -> false)
 let assert_is_string exp = function
-  | Yajl_string s -> assert_equal_string exp s
+  | JSON_parser_string s -> assert_equal_string exp s
   | _ as v -> assert_failure (type_mismatch_string "string" v)
 let assert_is_number exp = function
-  | Yajl_number n -> assert_equal_int64 exp n
-  | Yajl_double d -> assert_equal_int64 exp (Int64.of_float d)
+  | JSON_parser_number n -> assert_equal_int64 exp n
+  | JSON_parser_double d -> assert_equal_int64 exp (Int64.of_float d)
   | _ as v -> assert_failure (type_mismatch_string "number/double"
v)
 let assert_is_array value    assert_bool
     (type_mismatch_string "array" value)
-    (match value with | Yajl_array _ -> true | _ -> false)
+    (match value with | JSON_parser_array _ -> true | _ -> false)
 let assert_is_bool exp = function
-  | Yajl_bool b -> assert_equal_bool exp b
+  | JSON_parser_bool b -> assert_equal_bool exp b
   | _ as v -> assert_failure (type_mismatch_string "bool" v)
 
 let get_object_list = function
-  | Yajl_object x -> x
+  | JSON_parser_object x -> x
   | _ as v -> assert_failure (type_mismatch_string "object" v)
 let get_array = function
-  | Yajl_array x -> x
+  | JSON_parser_array x -> x
   | _ as v -> assert_failure (type_mismatch_string "array" v)
 
 
@@ -90,29 +90,29 @@ let test_tree_parse_invalid ctx    assert_raises_nested str
 
 let test_tree_parse_basic ctx -  let value = yajl_tree_parse "{}" in
+  let value = json_parser_tree_parse "{}" in
   assert_is_object value;
 
-  let value = yajl_tree_parse "\"foo\"" in
+  let value = json_parser_tree_parse "\"foo\"" in
   assert_is_string "foo" value;
 
-  let value = yajl_tree_parse "[]" in
+  let value = json_parser_tree_parse "[]" in
   assert_is_array value
 
 let test_tree_parse_inspect ctx -  let value = yajl_tree_parse
"{\"foo\":5}" in
+  let value = json_parser_tree_parse "{\"foo\":5}" in
   let l = get_object_list value in
   assert_equal_int 1 (Array.length l);
   assert_equal_string "foo" (fst (l.(0)));
   assert_is_number 5_L (snd (l.(0)));
 
-  let value = yajl_tree_parse "[\"foo\", true]" in
+  let value = json_parser_tree_parse "[\"foo\", true]" in
   let a = get_array value in
   assert_equal_int 2 (Array.length a);
   assert_is_string "foo" (a.(0));
   assert_is_bool true (a.(1));
 
-  let value = yajl_tree_parse "{\"foo\":[false, {}, 10],
\"second\":2}" in
+  let value = json_parser_tree_parse "{\"foo\":[false, {}, 10],
\"second\":2}" in
   let l = get_object_list value in
   assert_equal_int 2 (Array.length l);
   assert_equal_string "foo" (fst (l.(0)));
@@ -126,7 +126,7 @@ let test_tree_parse_inspect ctx  
 (* Suites declaration. *)
 let suite -  "builder Yajl" >:::
+  "mltools JSON_parser" >:::
     [
       "tree_parse.invalid" >:: test_tree_parse_invalid;
       "tree_parse.basic" >:: test_tree_parse_basic;
diff --git a/common/mltools/Makefile.am b/common/mltools/Makefile.am
index 66b18f5de..ac5f53651 100644
--- a/common/mltools/Makefile.am
+++ b/common/mltools/Makefile.am
@@ -23,6 +23,7 @@ EXTRA_DIST = \
 	$(SOURCES_C) \
 	getopt_tests.ml \
 	JSON_tests.ml \
+	JSON_parser_tests.ml \
 	test-getopt.sh \
 	tools_utils_tests.ml
 
@@ -31,6 +32,7 @@ SOURCES_MLI = \
 	curl.mli \
 	getopt.mli \
 	JSON.mli \
+	JSON_parser.mli \
 	planner.mli \
 	regedit.mli \
 	registry.mli \
@@ -47,6 +49,7 @@ SOURCES_ML = \
 	registry.ml \
 	regedit.ml \
 	JSON.ml \
+	JSON_parser.ml \
 	curl.ml \
 	checksums.ml \
 	xpath_helpers.ml \
@@ -57,6 +60,7 @@ SOURCES_C = \
 	../options/keys.c \
 	../options/uri.c \
 	getopt-c.c \
+	JSON_parser-c.c \
 	tools_utils-c.c \
 	uri-c.c
 
@@ -94,6 +98,7 @@ libmltools_a_CPPFLAGS = \
 libmltools_a_CFLAGS = \
 	$(WARN_CFLAGS) $(WERROR_CFLAGS) \
 	$(LIBVIRT_CFLAGS) $(LIBXML2_CFLAGS) \
+	$(JANSSON_CFLAGS) \
 	-fPIC
 
 BOBJECTS = $(SOURCES_ML:.ml=.cmo)
@@ -128,6 +133,7 @@ OCAMLCLIBS = \
 	$(LIBCRYPT_LIBS) \
 	$(LIBVIRT_LIBS) \
 	$(LIBXML2_LIBS) \
+	$(JANSSON_LIBS) \
 	$(LIBINTL) \
 	-lgnu
 
@@ -169,6 +175,16 @@ JSON_tests_SOURCES = dummy.c
 JSON_tests_BOBJECTS = JSON_tests.cmo
 JSON_tests_XOBJECTS = $(JSON_tests_BOBJECTS:.cmo=.cmx)
 
+JSON_parser_tests_SOURCES = dummy.c
+JSON_parser_tests_CPPFLAGS = \
+	-I . \
+	-I$(top_builddir) \
+	-I$(shell $(OCAMLC) -where) \
+	-I$(top_srcdir)/lib
+JSON_parser_tests_BOBJECTS = \
+	JSON_parser_tests.cmo
+JSON_parser_tests_XOBJECTS = $(JSON_parser_tests_BOBJECTS:.cmo=.cmx)
+
 # Can't call the following as <test>_OBJECTS because automake gets
confused.
 if !HAVE_OCAMLOPT
 tools_utils_tests_THEOBJECTS = $(tools_utils_tests_BOBJECTS)
@@ -179,6 +195,9 @@ getopt_tests.cmo: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
 
 JSON_tests_THEOBJECTS = $(JSON_tests_BOBJECTS)
 JSON_tests.cmo: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
+
+JSON_parser_tests_THEOBJECTS = $(JSON_parser_tests_BOBJECTS)
+JSON_parser_tests.cmo: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
 else
 tools_utils_tests_THEOBJECTS = $(tools_utils_tests_XOBJECTS)
 tools_utils_tests.cmx: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
@@ -188,6 +207,9 @@ getopt_tests.cmx: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
 
 JSON_tests_THEOBJECTS = $(JSON_tests_XOBJECTS)
 JSON_tests.cmx: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
+
+JSON_parser_tests_THEOBJECTS = $(JSON_parser_tests_XOBJECTS)
+JSON_parser_tests.cmx: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
 endif
 
 OCAMLLINKFLAGS = \
@@ -237,6 +259,19 @@ JSON_tests_LINK = \
 	  $(OCAMLPACKAGES) $(OCAMLPACKAGES_TESTS) \
 	  $(JSON_tests_THEOBJECTS) -o $@
 
+JSON_parser_tests_DEPENDENCIES = \
+	$(JSON_parser_tests_THEOBJECTS) \
+	../mlstdutils/mlstdutils.$(MLARCHIVE) \
+	../mlgettext/mlgettext.$(MLARCHIVE) \
+	../mlpcre/mlpcre.$(MLARCHIVE) \
+	$(MLTOOLS_CMA) \
+	$(top_srcdir)/ocaml-link.sh
+JSON_parser_tests_LINK = \
+	$(top_srcdir)/ocaml-link.sh -cclib '$(OCAMLCLIBS)' -- \
+	  $(OCAMLFIND) $(BEST) $(OCAMLFLAGS) $(OCAMLLINKFLAGS) \
+	  $(OCAMLPACKAGES) $(OCAMLPACKAGES_TESTS) \
+	  $(JSON_parser_tests_THEOBJECTS) -o $@
+
 TESTS_ENVIRONMENT = $(top_builddir)/run --test
 
 TESTS = \
@@ -245,8 +280,8 @@ check_PROGRAMS = \
 	getopt_tests
 
 if HAVE_OCAML_PKG_OUNIT
-check_PROGRAMS += JSON_tests tools_utils_tests
-TESTS += JSON_tests tools_utils_tests
+check_PROGRAMS += JSON_tests JSON_parser_tests tools_utils_tests
+TESTS += JSON_tests JSON_parser_tests tools_utils_tests
 endif
 
 check-valgrind:
diff --git a/docs/C_SOURCE_FILES b/docs/C_SOURCE_FILES
index f0d1f6c9d..b1db59cf5 100644
--- a/docs/C_SOURCE_FILES
+++ b/docs/C_SOURCE_FILES
@@ -5,7 +5,6 @@ builder/index-struct.h
 builder/index-validate.c
 builder/pxzcat-c.c
 builder/setlocale-c.c
-builder/yajl-c.c
 cat/cat.c
 cat/filesystems.c
 cat/log.c
@@ -21,6 +20,7 @@ common/mlpcre/dummy.c
 common/mlpcre/pcre-c.c
 common/mlprogress/progress-c.c
 common/mlstdutils/dummy.c
+common/mltools/JSON_parser-c.c
 common/mltools/dummy.c
 common/mltools/getopt-c.c
 common/mltools/tools_utils-c.c
@@ -62,6 +62,8 @@ common/utils/cleanups.h
 common/utils/gnulib-cleanups.c
 common/utils/guestfs-utils.h
 common/utils/libxml2-cleanups.c
+common/utils/libxml2-utils.c
+common/utils/libxml2-utils.h
 common/utils/utils.c
 common/visit/visit.c
 common/visit/visit.h
diff --git a/po/POTFILES b/po/POTFILES
index 55d7e6894..4e53b694f 100644
--- a/po/POTFILES
+++ b/po/POTFILES
@@ -6,7 +6,6 @@ builder/index-struct.c
 builder/index-validate.c
 builder/pxzcat-c.c
 builder/setlocale-c.c
-builder/yajl-c.c
 cat/cat.c
 cat/filesystems.c
 cat/log.c
@@ -22,6 +21,7 @@ common/mlpcre/dummy.c
 common/mlpcre/pcre-c.c
 common/mlprogress/progress-c.c
 common/mlstdutils/dummy.c
+common/mltools/JSON_parser-c.c
 common/mltools/dummy.c
 common/mltools/getopt-c.c
 common/mltools/tools_utils-c.c
@@ -51,6 +51,7 @@ common/structs/structs-print.c
 common/utils/cleanups.c
 common/utils/gnulib-cleanups.c
 common/utils/libxml2-cleanups.c
+common/utils/libxml2-utils.c
 common/utils/utils.c
 common/visit/visit.c
 common/windows/windows.c
diff --git a/po/POTFILES-ml b/po/POTFILES-ml
index b18ff7410..de07e37d4 100644
--- a/po/POTFILES-ml
+++ b/po/POTFILES-ml
@@ -18,8 +18,6 @@ builder/sigchecker.ml
 builder/simplestreams_parser.ml
 builder/sources.ml
 builder/utils.ml
-builder/yajl.ml
-builder/yajl_tests.ml
 common/mlaugeas/augeas.ml
 common/mlgettext/common_gettext.ml
 common/mlpcre/PCRE.ml
@@ -31,6 +29,8 @@ common/mlstdutils/std_utils_tests.ml
 common/mlstdutils/stringMap.ml
 common/mlstdutils/stringSet.ml
 common/mltools/JSON.ml
+common/mltools/JSON_parser.ml
+common/mltools/JSON_parser_tests.ml
 common/mltools/JSON_tests.ml
 common/mltools/URI.ml
 common/mltools/checksums.ml
-- 
2.18.0

Richard W.M. Jones

2018-Aug-17 15:16 UTC

head link

[Libguestfs] [PATCH v3 2/4] mltools: Document that run_command closes stdout_chan/stderr_chan.

This behaviour is documented for run_commands, but not documented for
run_command, so document it.
---
 common/mltools/tools_utils.mli | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/common/mltools/tools_utils.mli b/common/mltools/tools_utils.mli
index dac6b4120..c9350d0f9 100644
--- a/common/mltools/tools_utils.mli
+++ b/common/mltools/tools_utils.mli
@@ -101,6 +101,9 @@ val run_commands : ?echo_cmd:bool -> (string list *
Unix.file_descr option * Uni
 val run_command : ?echo_cmd:bool -> ?stdout_chan:Unix.file_descr ->
?stderr_chan:Unix.file_descr -> string list -> int
 (** Run an external command without using a shell, and return its exit code.
 
+    If [stdout_chan] or [stderr_chan] is specified, the file descriptor
+    is automatically closed after executing the command.
+
     [echo_cmd] specifies whether output the full command on verbose
     mode, and it's on by default. *)
 
-- 
2.18.0

Richard W.M. Jones

2018-Aug-17 15:16 UTC

head link

[Libguestfs] [PATCH v3 3/4] mltools: Rename run_command std_chan -> std_fd.

These are file descriptors, not the high level OCaml in_channel/
out_channel type, so we would normally not refer to them as *_chan.

Just renaming, no functional change.
---
 builder/repository_main.ml          |  2 +-
 common/mltools/tools_utils.ml       | 16 ++++++++--------
 common/mltools/tools_utils.mli      |  4 ++--
 common/mltools/tools_utils_tests.ml |  4 ++--
 v2v/python_script.ml                |  4 ++--
 v2v/python_script.mli               |  2 +-
 6 files changed, 16 insertions(+), 16 deletions(-)

diff --git a/builder/repository_main.ml b/builder/repository_main.ml
index 43f749c5a..4ec434e57 100644
--- a/builder/repository_main.ml
+++ b/builder/repository_main.ml
@@ -152,7 +152,7 @@ let compress_to file outdir    let cmd = [ "xz";
"-f"; "--best"; "--block-size=16777216";
"-c"; file ] in
   let file_flags = [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC; ] in
   let outfd = Unix.openfile outimg file_flags 0o666 in
-  let res = run_command cmd ~stdout_chan:outfd in
+  let res = run_command cmd ~stdout_fd:outfd in
   if res <> 0 then
     error (f_"‘xz’ command failed");
   outimg
diff --git a/common/mltools/tools_utils.ml b/common/mltools/tools_utils.ml
index 09f1bb544..cccc424fb 100644
--- a/common/mltools/tools_utils.ml
+++ b/common/mltools/tools_utils.ml
@@ -277,8 +277,8 @@ let rec run_commands ?(echo_cmd = true) cmds    let res =
Array.make (List.length cmds) 0 in
   let pids      List.mapi (
-      fun i (args, stdout_chan, stderr_chan) ->
-        let run_res = do_run args ?stdout_chan ?stderr_chan in
+      fun i (args, stdout_fd, stderr_fd) ->
+        let run_res = do_run args ?stdout_fd ?stderr_fd in
         match run_res with
         | Either (pid, app, outfd, errfd) ->
           Some (i, pid, app, outfd, errfd)
@@ -304,8 +304,8 @@ let rec run_commands ?(echo_cmd = true) cmds    done;
   Array.to_list res
 
-and run_command ?(echo_cmd = true) ?stdout_chan ?stderr_chan args -  let
run_res = do_run args ~echo_cmd ?stdout_chan ?stderr_chan in
+and run_command ?(echo_cmd = true) ?stdout_fd ?stderr_fd args +  let run_res =
do_run args ~echo_cmd ?stdout_fd ?stderr_fd in
   match run_res with
   | Either (pid, app, outfd, errfd) ->
     let _, stat = Unix.waitpid [] pid in
@@ -313,7 +313,7 @@ and run_command ?(echo_cmd = true) ?stdout_chan ?stderr_chan
args    | Or code ->
     code
 
-and do_run ?(echo_cmd = true) ?stdout_chan ?stderr_chan args +and do_run
?(echo_cmd = true) ?stdout_fd ?stderr_fd args    let app = List.hd args in
   let get_fd default = function
     | None ->
@@ -326,13 +326,13 @@ and do_run ?(echo_cmd = true) ?stdout_chan ?stderr_chan
args      let app        if Filename.is_relative app then which app
       else (Unix.access app [Unix.X_OK]; app) in
-    let outfd = get_fd Unix.stdout stdout_chan in
-    let errfd = get_fd Unix.stderr stderr_chan in
+    let outfd = get_fd Unix.stdout stdout_fd in
+    let errfd = get_fd Unix.stderr stderr_fd in
     if echo_cmd then
       debug "%s" (stringify_args args);
     let pid = Unix.create_process app (Array.of_list args) Unix.stdin
                 outfd errfd in
-    Either (pid, app, stdout_chan, stderr_chan)
+    Either (pid, app, stdout_fd, stderr_fd)
   with
   | Executable_not_found _ ->
     Or 127
diff --git a/common/mltools/tools_utils.mli b/common/mltools/tools_utils.mli
index c9350d0f9..97cc4de08 100644
--- a/common/mltools/tools_utils.mli
+++ b/common/mltools/tools_utils.mli
@@ -98,10 +98,10 @@ val run_commands : ?echo_cmd:bool -> (string list *
Unix.file_descr option * Uni
     [echo_cmd] specifies whether output the full command on verbose
     mode, and it's on by default. *)
 
-val run_command : ?echo_cmd:bool -> ?stdout_chan:Unix.file_descr ->
?stderr_chan:Unix.file_descr -> string list -> int
+val run_command : ?echo_cmd:bool -> ?stdout_fd:Unix.file_descr ->
?stderr_fd:Unix.file_descr -> string list -> int
 (** Run an external command without using a shell, and return its exit code.
 
-    If [stdout_chan] or [stderr_chan] is specified, the file descriptor
+    If [stdout_fd] or [stderr_fd] is specified, the file descriptor
     is automatically closed after executing the command.
 
     [echo_cmd] specifies whether output the full command on verbose
diff --git a/common/mltools/tools_utils_tests.ml
b/common/mltools/tools_utils_tests.ml
index c1d65084a..490942310 100644
--- a/common/mltools/tools_utils_tests.ml
+++ b/common/mltools/tools_utils_tests.ml
@@ -94,14 +94,14 @@ let test_run_command ctx    assert_equal_int 0 (run_command
["true"]);
   begin
     let tmpfile, chan = bracket_tmpfile ctx in
-    let res = run_command ["echo"; "this is a test"]
~stdout_chan:(Unix.descr_of_out_channel chan) in
+    let res = run_command ["echo"; "this is a test"]
~stdout_fd:(Unix.descr_of_out_channel chan) in
     assert_equal_int 0 res;
     let content = read_whole_file tmpfile in
     assert_equal_string "this is a test\n" content
   end;
   begin
     let tmpfile, chan = bracket_tmpfile ctx in
-    let res = run_command ["ls";
"/this-directory-is-unlikely-to-exist"]
~stderr_chan:(Unix.descr_of_out_channel chan) in
+    let res = run_command ["ls";
"/this-directory-is-unlikely-to-exist"]
~stderr_fd:(Unix.descr_of_out_channel chan) in
     assert_equal_int 2 res;
     let content = read_whole_file tmpfile in
     assert_bool "test_run_commands/not-existing/content"
(String.length content > 0)
diff --git a/v2v/python_script.ml b/v2v/python_script.ml
index 1c0f9660c..3c00c28f6 100644
--- a/v2v/python_script.ml
+++ b/v2v/python_script.ml
@@ -41,13 +41,13 @@ let create ?(name = "script.py") code   
with_open_out path (fun chan -> output_string chan code);
   { tmpdir; path }
 
-let run_command ?echo_cmd ?stdout_chan ?stderr_chan
+let run_command ?echo_cmd ?stdout_fd ?stderr_fd
                 { tmpdir; path } params args    let param_file = tmpdir //
sprintf "params%d.json" (unique ()) in
   with_open_out
     param_file
     (fun chan -> output_string chan (JSON.string_of_doc params));
-  Tools_utils.run_command ?echo_cmd ?stdout_chan ?stderr_chan
+  Tools_utils.run_command ?echo_cmd ?stdout_fd ?stderr_fd
                           (python :: path :: param_file :: args)
 
 let path { path } = path
diff --git a/v2v/python_script.mli b/v2v/python_script.mli
index cf137b142..fd20208bf 100644
--- a/v2v/python_script.mli
+++ b/v2v/python_script.mli
@@ -29,7 +29,7 @@ val create : ?name:string -> string -> script
     [Some_source.code] where [some_source.ml] is generated from
     the Python file by [v2v/embed.sh] (see also [v2v/Makefile.am]). *)
 
-val run_command : ?echo_cmd:bool -> ?stdout_chan:Unix.file_descr ->
?stderr_chan:Unix.file_descr -> script -> JSON.doc -> string list ->
int
+val run_command : ?echo_cmd:bool -> ?stdout_fd:Unix.file_descr ->
?stderr_fd:Unix.file_descr -> script -> JSON.doc -> string list ->
int
 (** [run_command script params args] is a wrapper around
     {!Tools_utils.run_command} which runs the Python script with the
     supplied list of JSON parameters and the list of extra arguments.
-- 
2.18.0

Richard W.M. Jones

2018-Aug-17 15:16 UTC

head link

[Libguestfs] [PATCH v3 4/4] v2v: Add --print-estimate option to print copy size estimate.

This option prints the estimated size of the data that will be copied
from the source disk.

Currently this overestimates by the size of the qcow2 header, but for
real disk images that doesn't matter much.

For example:

$ virt-builder fedora-27
$ virt-v2v -i disk fedora-27.img -o null --print-estimate
[...]
virt-v2v: This guest has virtio drivers installed.
[  44.0] Mapping filesystem data to avoid copying unused and blank areas
[  44.5] Closing the overlay
1047920640
---
 v2v/Makefile.am                |  5 +++
 v2v/cmdline.ml                 | 13 +++++-
 v2v/cmdline.mli                |  1 +
 v2v/measure_disk.ml            | 75 ++++++++++++++++++++++++++++++++++
 v2v/measure_disk.mli           | 21 ++++++++++
 v2v/test-v2v-print-estimate.sh | 44 ++++++++++++++++++++
 v2v/v2v.ml                     | 15 ++++++-
 v2v/virt-v2v.pod               | 11 +++++
 8 files changed, 182 insertions(+), 3 deletions(-)

diff --git a/v2v/Makefile.am b/v2v/Makefile.am
index 97dd44ec9..e1fee77b0 100644
--- a/v2v/Makefile.am
+++ b/v2v/Makefile.am
@@ -63,6 +63,7 @@ SOURCES_MLI = \
 	linux.mli \
 	linux_bootloaders.mli \
 	linux_kernels.mli \
+	measure_disk.mli \
 	modules_list.mli \
 	name_from_disk.mli \
 	networks.mli \
@@ -139,6 +140,7 @@ SOURCES_ML = \
 	output_vdsm.ml \
 	inspect_source.ml \
 	target_bus_assignment.ml \
+	measure_disk.ml \
 	networks.ml \
 	cmdline.ml \
 	v2v.ml
@@ -203,6 +205,7 @@ OCAMLCLIBS = \
 	-lqemuopts \
 	$(LIBVIRT_LIBS) \
 	$(LIBXML2_LIBS) \
+	$(JANSSON_LIBS) \
 	$(LIBINTL) \
 	-lgnu
 
@@ -378,6 +381,7 @@ TESTS += \
 	test-v2v-oa-option.sh \
 	test-v2v-of-option.sh \
 	test-v2v-on-option.sh \
+	test-v2v-print-estimate.sh \
 	test-v2v-print-source.sh \
 	test-v2v-sound.sh \
 	$(SLOW_TESTS) \
@@ -533,6 +537,7 @@ EXTRA_DIST += \
 	test-v2v-oa-option.sh \
 	test-v2v-of-option.sh \
 	test-v2v-on-option.sh \
+	test-v2v-print-estimate.sh \
 	test-v2v-print-source.expected \
 	test-v2v-print-source.sh \
 	test-v2v-print-source.xml \
diff --git a/v2v/cmdline.ml b/v2v/cmdline.ml
index 5b2df3555..005a58ad5 100644
--- a/v2v/cmdline.ml
+++ b/v2v/cmdline.ml
@@ -37,6 +37,7 @@ type cmdline = {
   output_alloc : output_allocation;
   output_format : string option;
   output_name : string option;
+  print_estimate : bool;
   print_source : bool;
   root_choice : root_choice;
 }
@@ -49,6 +50,7 @@ let parse_cmdline ()    let debug_overlays = ref false in
   let do_copy = ref true in
   let machine_readable = ref false in
+  let print_estimate = ref false in
   let print_source = ref false in
   let qemu_boot = ref false in
 
@@ -235,6 +237,8 @@ let parse_cmdline ()                                     
s_"Set output storage location";
     [ L"password-file" ], Getopt.String ("filename",
set_string_option_once "--password-file" input_password),
                                     s_"Same as ‘-ip filename’";
+    [ L"print-estimate" ], Getopt.Set print_estimate,
+                                    s_"Estimate size of source and
stop";
     [ L"print-source" ], Getopt.Set print_source,
                                     s_"Print source and stop";
     [ L"qemu-boot" ], Getopt.Set qemu_boot, s_"Boot in qemu (-o
qemu only)";
@@ -330,6 +334,7 @@ read the man page virt-v2v(1).
   let output_options = List.rev !output_options in
   let output_password = !output_password in
   let output_storage = !output_storage in
+  let print_estimate = !print_estimate in
   let print_source = !print_source in
   let qemu_boot = !qemu_boot in
   let root_choice = !root_choice in
@@ -355,6 +360,12 @@ read the man page virt-v2v(1).
     exit 0
   );
 
+  (* Some options cannot be used with --in-place. *)
+  if in_place then (
+    if print_estimate then
+      error (f_"--in-place and --print-estimate cannot be used
together")
+  );
+
   (* Input transport affects whether some input options should or
    * should not be used.
    *)
@@ -622,6 +633,6 @@ read the man page virt-v2v(1).
   {
     compressed; debug_overlays; do_copy; in_place; network_map;
     output_alloc; output_format; output_name;
-    print_source; root_choice;
+    print_estimate; print_source; root_choice;
   },
   input, output
diff --git a/v2v/cmdline.mli b/v2v/cmdline.mli
index 25beb1c95..de6281bab 100644
--- a/v2v/cmdline.mli
+++ b/v2v/cmdline.mli
@@ -27,6 +27,7 @@ type cmdline = {
   output_alloc : Types.output_allocation;
   output_format : string option;
   output_name : string option;
+  print_estimate : bool;
   print_source : bool;
   root_choice : Types.root_choice;
 }
diff --git a/v2v/measure_disk.ml b/v2v/measure_disk.ml
new file mode 100644
index 000000000..100ab3d55
--- /dev/null
+++ b/v2v/measure_disk.ml
@@ -0,0 +1,75 @@
+(* virt-v2v
+ * Copyright (C) 2018 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 Std_utils
+open Tools_utils
+open JSON_parser
+open Common_gettext.Gettext
+
+(* Run qemu-img measure on a disk. *)
+
+let error_unexpected_output what json +  error (f_"qemu-img measure:
unexpected output: %s\n\nqemu-img command printed:\n\n%s")
+        what json
+
+let measure ?format filename +  let cmd = ref [] in
+  List.push_back_list cmd [Guestfs_config.qemu_img; "measure"];
+  (match format with
+   | None -> ()
+   | Some format ->
+      List.push_back_list cmd ["-f"; format]
+  );
+  (* For use of -O qcow2 here, see this thread:
+   * https://www.redhat.com/archives/libguestfs/2018-August/thread.html#00142
+   *)
+  List.push_back_list cmd ["-O"; "qcow2"];
+  List.push_back cmd "--output=json";
+  List.push_back cmd filename;
+
+  let json = Filename.temp_file "v2vmeasure" ".json" in
+  unlink_on_exit json;
+
+  let fd = Unix.openfile json [O_WRONLY; O_CREAT; O_TRUNC] 0o600 in
+  if run_command ~stdout_fd:fd !cmd <> 0 then
+    error (f_"qemu-img measure failed, see earlier errors");
+  (* Note that run_command closes fd. *)
+
+  let json = read_whole_file json in
+  let tree = json_parser_tree_parse json in
+
+  (* We're expecting the tree to contain nodes:
+   * object [| "required", number; "fully-allocated",
number |]
+   * Of course the array could appear in any order.
+   *)
+  match tree with
+  | JSON_parser_object fields ->
+     let fields = Array.to_list fields in
+     let rq +       try List.assoc "required" fields
+       with Not_found ->
+            error_unexpected_output (s_"expecting \"required\"
field") json in
+     (match rq with
+      | JSON_parser_number i64 ->
+         i64
+      | _ ->
+         error_unexpected_output (s_"expecting \"required\" to
be an integer")
+                                 json
+     )
+  | _ ->
+     error_unexpected_output (s_"expecting object at top level") json
diff --git a/v2v/measure_disk.mli b/v2v/measure_disk.mli
new file mode 100644
index 000000000..efaa76105
--- /dev/null
+++ b/v2v/measure_disk.mli
@@ -0,0 +1,21 @@
+(* virt-v2v
+ * Copyright (C) 2018 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.
+ *)
+
+(** Run qemu-img measure on a disk. *)
+
+val measure : ?format:string -> string -> int64
diff --git a/v2v/test-v2v-print-estimate.sh b/v2v/test-v2v-print-estimate.sh
new file mode 100755
index 000000000..10388f896
--- /dev/null
+++ b/v2v/test-v2v-print-estimate.sh
@@ -0,0 +1,44 @@
+#!/bin/bash -
+# libguestfs virt-v2v test script
+# Copyright (C) 2018 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.
+
+# Test --print-estimate option.
+
+set -e
+
+$TEST_FUNCTIONS
+skip_if_skipped
+skip_unless_phony_guest windows.img
+
+f=test-v2v-print-estimate.out
+rm -f $f
+
+echo "Actual:"
+du -s -B 1 ../test-data/phony-guests/windows.img
+
+$VG virt-v2v --debug-gc \
+    -i libvirtxml test-v2v-print-source.xml \
+    -o local -os $(pwd) \
+    --print-estimate --quiet > $f
+
+echo -n "Estimate: "
+cat $f
+
+# Check the output looks reasonable.
+grep -E '^[[:digit:]]+$' $f
+
+rm -f $f
diff --git a/v2v/v2v.ml b/v2v/v2v.ml
index 1775200d3..af04a265a 100644
--- a/v2v/v2v.ml
+++ b/v2v/v2v.ml
@@ -48,6 +48,8 @@ type mpstat = {
 
 let () = Random.self_init ()
 
+let sum = List.fold_left (+^) 0L
+
 let rec main ()    (* Handle the command line. *)
   let cmdline, input, output = parse_cmdline () in
@@ -156,6 +158,17 @@ let rec main ()    (match conversion_mode with
    | In_place -> ()
    | Copying overlays ->
+      (* Print copy size estimate and stop. *)
+      if cmdline.print_estimate then (
+        let estimated_size +          sum (List.map
+                 (fun { ov_overlay_file } ->
+                   Measure_disk.measure ~format:"qcow2"
ov_overlay_file)
+                 overlays) in
+        printf "%Ld\n" estimated_size;
+        exit 0
+      );
+
       message (f_"Assigning disks to buses");
       let target_buses          Target_bus_assignment.target_bus_assignment
source guestcaps in
@@ -487,8 +500,6 @@ and do_fstrim g inspect   *     sdb final estimate size = 3
- (3*1.35/4) = 1.9875 GB
  *)
 and estimate_target_size mpstats overlays -  let sum = List.fold_left (+^) 0L
in
-
   (* (1) *)
   let fs_total_size      sum (
diff --git a/v2v/virt-v2v.pod b/v2v/virt-v2v.pod
index 303fe425c..af3f4d6b1 100644
--- a/v2v/virt-v2v.pod
+++ b/v2v/virt-v2v.pod
@@ -794,6 +794,17 @@ C<root>.
 You will get an error if virt-v2v is unable to mount/write to the
 Export Storage Domain.
 
+=item B<--print-estimate>
+
+Print the estimated size of the data which will be copied from the
+source disk(s) and stop.  The output is a single number, which is the
+number of bytes (estimated) that virt-v2v would copy.
+
+When using this option you must specify an output mode.  This is
+because virt-v2v has to perform the conversion in order to print the
+estimate, and the conversion depends on the output mode.  Using
+I<-o null> should be safe for most purposes.
+
 =item B<--print-source>
 
 Print information about the source guest and stop.  This option is
-- 
2.18.0

Eric Blake

2018-Aug-17 15:30 UTC

head link

Re: [Libguestfs] [PATCH v3 1/4] mltools: Rename Yajl module as JSON_parser and move to common/mltools.

On 08/17/2018 10:16 AM, Richard W.M. Jones wrote:> Commit bd1c5c9f4dcf38458099db8a0bf4659a07ef055d changed all the code
> to use Jansson instead of yajl.  However it didn't change the OCaml
> API name (which was still Yajl).
> 
Are you aware that Jansson can't parse all JSON generated by qemu, and 
that the developers of Jansson did not seem sympathetic to patches that 
would make it possible?  Libvirt recently reverted their use of Jansson 
because of its inability to deal with unsigned 64-bit numbers (and 
sadly, RFC7159 does not define bounds for what forms valid JSON numbers, 
but merely leaves it up to implementations to decide for themselves).

-- 
Eric Blake, Principal Software Engineer
Red Hat, Inc.           +1-919-301-3266
Virtualization:  qemu.org | libvirt.org

Pino Toscano

2018-Aug-20 13:22 UTC

head link

Re: [Libguestfs] [PATCH v3 1/4] mltools: Rename Yajl module as JSON_parser and move to common/mltools.

On Friday, 17 August 2018 17:16:10 CEST Richard W.M. Jones
wrote:> Commit bd1c5c9f4dcf38458099db8a0bf4659a07ef055d changed all the code
> to use Jansson instead of yajl.  However it didn't change the OCaml
> API name (which was still Yajl).
This was done initially to avoid much larger patch/series for the
yajl -> jansson conversion.  And then... I forgot :-)
> -type yajl_val > -| Yajl_null
> -| Yajl_string of string
> -| Yajl_number of int64
> -| Yajl_double of float
> -| Yajl_object of (string * yajl_val) array
> -| Yajl_array of yajl_val array
> -| Yajl_bool of bool
> +type json_parser_val > +| JSON_parser_null
> +| JSON_parser_string of string
> +| JSON_parser_number of int64
> +| JSON_parser_double of float
> +| JSON_parser_object of (string * json_parser_val) array
> +| JSON_parser_array of json_parser_val array
> +| JSON_parser_bool of bool
I'd drop the _parser_ from the name, as seems redundant (and makes
both type name, and all its values long enough...).

The rest of it LGTM.

-- 
Pino Toscano

Pino Toscano

2018-Aug-20 14:15 UTC

head link

Re: [Libguestfs] [PATCH v3 4/4] v2v: Add --print-estimate option to print copy size estimate.

On Friday, 17 August 2018 17:16:13 CEST Richard W.M. Jones
wrote:> This option prints the estimated size of the data that will be copied
> from the source disk.
> 
> Currently this overestimates by the size of the qcow2 header, but for
> real disk images that doesn't matter much.
> 
> For example:
> 
> $ virt-builder fedora-27
> $ virt-v2v -i disk fedora-27.img -o null --print-estimate
> [...]
> virt-v2v: This guest has virtio drivers installed.
> [  44.0] Mapping filesystem data to avoid copying unused and blank areas
> [  44.5] Closing the overlay
> 1047920640
This is not easy to parse, because this output contains every output,
from the info messages to this value.  IMHO a better idea is to make
use of the machine-parseable to print this in some better format
(JSON?), and possibly to a separate output than the normal stdout.

I had already an idea for this, i.e. improve the output of
--machine-readable.  Let me shape it in form of patches.

Regardless, a couple of notes follow.
> +  let fd = Unix.openfile json [O_WRONLY; O_CREAT; O_TRUNC] 0o600 in
> +  if run_command ~stdout_fd:fd !cmd <> 0 then
> +    error (f_"qemu-img measure failed, see earlier errors");
> +  (* Note that run_command closes fd. *)
> +
> +  let json = read_whole_file json in
I'd print 'json' here when debugging is enabled.
> +  (* We're expecting the tree to contain nodes:
> +   * object [| "required", number; "fully-allocated",
number |]
> +   * Of course the array could appear in any order.
> +   *)
> +  match tree with
> +  | JSON_parser_object fields ->
> +     let fields = Array.to_list fields in
> +     let rq > +       try List.assoc "required" fields
> +       with Not_found ->
> +            error_unexpected_output (s_"expecting
\"required\" field") json in
> +     (match rq with
> +      | JSON_parser_number i64 ->
> +         i64
> +      | _ ->
> +         error_unexpected_output (s_"expecting \"required\"
to be an integer")
> +                                 json
> +     )
> +  | _ ->
> +     error_unexpected_output (s_"expecting object at top level")
json
You can replace this whole using the helper object_get_number:

  let v = object_get_number "required" tree in

-- 
Pino Toscano

Pino Toscano

2018-Aug-20 14:16 UTC

head link

Re: [Libguestfs] [PATCH v3 4/4] v2v: Add --print-estimate option to print copy size

Hi,

patches #2, and #3 LGTM; I left notes for patches #1, and #4.

Thanks,
-- 
Pino Toscano

Maybe Matching Threads

Search for more seemingly similar threads

Libguestfs - Aug 2018 - Re: [PATCH v3 1/4] mltools: Rename Yajl module as JSON_parser and move to common/mltools.

[Libguestfs] [PATCH v3 4/4] v2v: Add --print-estimate option to print copy size

[Libguestfs] [PATCH v3 1/4] mltools: Rename Yajl module as JSON_parser and move to common/mltools.

[Libguestfs] [PATCH v3 2/4] mltools: Document that run_command closes stdout_chan/stderr_chan.

[Libguestfs] [PATCH v3 3/4] mltools: Rename run_command std*_chan -> std*_fd.

[Libguestfs] [PATCH v3 4/4] v2v: Add --print-estimate option to print copy size estimate.

Re: [Libguestfs] [PATCH v3 1/4] mltools: Rename Yajl module as JSON_parser and move to common/mltools.

Re: [Libguestfs] [PATCH v3 1/4] mltools: Rename Yajl module as JSON_parser and move to common/mltools.

Re: [Libguestfs] [PATCH v3 4/4] v2v: Add --print-estimate option to print copy size estimate.

Re: [Libguestfs] [PATCH v3 4/4] v2v: Add --print-estimate option to print copy size

Maybe Matching Threads

[Libguestfs] [PATCH v3 3/4] mltools: Rename run_command std_chan -> std_fd.