Libguestfs - Jan 2017 - [PATCH 1/5] builder: extract Yajl helper functions to yajl.ml

Hi all,

I wanted to provide an easy way to create or update a virt-builder
repository out of a folder of template disk image files. This is what
virt-builder-repository aims at. Some of the data are computed from
the image file, others are asked the user or extracted from an existing
index file.

So far, virt-builder-repository doesn't run libguestfs on each image
to extract the architecture, the list of available partitions and the
list of volumes. May be this should be done, but I have several concerns
with it: it will add extra running time to load the appliance in each
detected new/updated image. And the question of how to handle cases where
multiple OSes are installed on the template would need to be solved:
raise an error or ask the user which one to use?

In order to share more code, I have extracted the Yajl helpers with the
yajl OCAML wrapper code, moved the libxml2 wrapper into mllib and written
some OCAML osinfo db reading code in mllib.

C?dric Bosdonnat (5):
  builder: extract Yajl helper functions to yajl.ml
  mllib: factorize code to add Checksum.get_checksum function
  Move xml and xpath_helpers OCAML code to mllib
  mllib: add libosinfo DB reading helpers
  Add a virt-builder-repository tool

 .gitignore                          |   3 +
 builder/Makefile.am                 |  91 ++++++-
 builder/builder_repository.ml       | 493 ++++++++++++++++++++++++++++++++++++
 builder/simplestreams_parser.ml     |  52 ----
 builder/virt-builder-repository.pod | 144 +++++++++++
 builder/yajl.ml                     |  55 ++++
 builder/yajl.mli                    |  29 +++
 docs/C_SOURCE_FILES                 |   2 +-
 mllib/Makefile.am                   |  19 +-
 mllib/checksums.ml                  |  20 +-
 mllib/checksums.mli                 |   3 +
 mllib/osinfo.ml                     |  64 +++++
 mllib/osinfo.mli                    |  21 ++
 mllib/osinfopath.ml                 |   1 +
 {v2v => mllib}/xml-c.c              |   0
 {v2v => mllib}/xml.ml               |   0
 {v2v => mllib}/xml.mli              |   0
 {v2v => mllib}/xpath_helpers.ml     |   0
 {v2v => mllib}/xpath_helpers.mli    |   0
 v2v/Makefile.am                     |  17 +-
 20 files changed, 932 insertions(+), 82 deletions(-)
 create mode 100644 builder/builder_repository.ml
 create mode 100644 builder/virt-builder-repository.pod
 create mode 100644 mllib/osinfo.ml
 create mode 100644 mllib/osinfo.mli
 create mode 100644 mllib/osinfopath.ml
 rename {v2v => mllib}/xml-c.c (100%)
 rename {v2v => mllib}/xml.ml (100%)
 rename {v2v => mllib}/xml.mli (100%)
 rename {v2v => mllib}/xpath_helpers.ml (100%)
 rename {v2v => mllib}/xpath_helpers.mli (100%)

-- 
2.11.0

Extract the yajl object_get_* helpers in the Yajl module since this
could be useful for any Yajl user code.
---
 builder/simplestreams_parser.ml | 52 --------------------------------------
 builder/yajl.ml                 | 55 +++++++++++++++++++++++++++++++++++++++++
 builder/yajl.mli                | 29 ++++++++++++++++++++++
 3 files changed, 84 insertions(+), 52 deletions(-)

diff --git a/builder/simplestreams_parser.ml b/builder/simplestreams_parser.ml
index 81e70189a..8844d476b 100644
--- a/builder/simplestreams_parser.ml
+++ b/builder/simplestreams_parser.ml
@@ -28,58 +28,6 @@ let ensure_trailing_slash str    if String.length str > 0
&& str.[String.length str - 1] <> '/' then str ^
"/"
   else str
 
-let object_find_optional key = function
-  | Yajl_object o ->
-    (match List.filter (fun (k, _) -> k = key) (Array.to_list o) with
-    | [(k, v)] -> Some v
-    | [] -> None
-    | _ -> error (f_"more than value for the key '%s'")
key)
-  | _ -> error (f_"the value of the key '%s' is not an
object") key
-
-let object_find key yv -  match object_find_optional key yv with
-  | None -> error (f_"missing value for the key '%s'") key
-  | Some v -> v
-
-let object_get_string key yv -  match object_find key yv with
-  | Yajl_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
-  | _ -> error (f_"the value for the key '%s' is not an
object") key
-
-let object_find_objects fn = function
-  | Yajl_object o -> 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
-  | _ -> 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
-  | _ -> error (f_"the value for the key '%s' is not an
integer") key
-
-let objects_get_string key yvs -  let rec loop = function
-    | [] -> None
-    | x :: xs ->
-      (match object_find_optional key x with
-      | Some (Yajl_string s) -> Some s
-      | Some _ -> error (f_"the value for key '%s' is not a
string as expected") key
-      | None -> loop xs
-      )
-  in
-  match loop yvs with
-  | Some s -> s
-  | None -> error (f_"the key '%s' was not found in a list of
objects") key
-
 let get_index ~downloader ~sigchecker
   { Sources.uri = uri; proxy = proxy }  
diff --git a/builder/yajl.ml b/builder/yajl.ml
index 00e4dac4b..e53706abc 100644
--- a/builder/yajl.ml
+++ b/builder/yajl.ml
@@ -16,6 +16,9 @@
  * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  *)
 
+open Common_gettext.Gettext
+open Common_utils
+
 type yajl_val  | Yajl_null
 | Yajl_string of string
@@ -26,3 +29,55 @@ type yajl_val  | Yajl_bool of bool
 
 external yajl_tree_parse : string -> yajl_val =
"virt_builder_yajl_tree_parse"
+
+let object_find_optional key = function
+  | Yajl_object o ->
+    (match List.filter (fun (k, _) -> k = key) (Array.to_list o) with
+    | [(k, v)] -> Some v
+    | [] -> None
+    | _ -> error (f_"more than value for the key '%s'")
key)
+  | _ -> error (f_"the value of the key '%s' is not an
object") key
+
+let object_find key yv +  match object_find_optional key yv with
+  | None -> error (f_"missing value for the key '%s'") key
+  | Some v -> v
+
+let object_get_string key yv +  match object_find key yv with
+  | Yajl_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
+  | _ -> error (f_"the value for the key '%s' is not an
object") key
+
+let object_find_objects fn = function
+  | Yajl_object o -> 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
+  | _ -> 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
+  | _ -> error (f_"the value for the key '%s' is not an
integer") key
+
+let objects_get_string key yvs +  let rec loop = function
+    | [] -> None
+    | x :: xs ->
+      (match object_find_optional key x with
+      | Some (Yajl_string s) -> Some s
+      | Some _ -> error (f_"the value for key '%s' is not a
string as expected") key
+      | None -> loop xs
+      )
+  in
+  match loop yvs with
+  | Some s -> s
+  | None -> error (f_"the key '%s' was not found in a list of
objects") key
diff --git a/builder/yajl.mli b/builder/yajl.mli
index 9771e5399..ca0eb92f4 100644
--- a/builder/yajl.mli
+++ b/builder/yajl.mli
@@ -27,3 +27,32 @@ type yajl_val  
 val yajl_tree_parse : string -> yajl_val
 (** Parse the JSON string. *)
+
+val object_get_string : string -> yajl_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
+    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
+    object in the [yv] structure *)
+
+val object_get_number : string -> yajl_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
+(** [objects_get_string key yvs] gets the value of the [key] field as a string
+    in an [yvs] list of yajl_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]
+    function in [obj] list. *)
-- 
2.11.0

Getting checksum involves the same code than verifying them. Create
a get_checksum function and use it in verify_checksum.
---
 mllib/checksums.ml  | 20 +++++++++-----------
 mllib/checksums.mli |  3 +++
 2 files changed, 12 insertions(+), 11 deletions(-)

diff --git a/mllib/checksums.ml b/mllib/checksums.ml
index dfa8c3ae7..3efc764b9 100644
--- a/mllib/checksums.ml
+++ b/mllib/checksums.ml
@@ -45,23 +45,21 @@ let of_string csum_type csum_value    | "sha512"
-> SHA512 csum_value
   | _ -> invalid_arg csum_type
 
-let verify_checksum csum filename -  let prog, csum_ref -    match csum with
-    | SHA1 c -> "sha1sum", c
-    | SHA256 c -> "sha256sum", c
-    | SHA512 c -> "sha512sum", c
-  in
-
+let get_checksum csum filename +  let prog = (string_of_csum_t csum) ^
"sum" in
   let cmd = sprintf "%s %s" prog (Filename.quote filename) in
   let lines = external_command cmd in
   match lines with
   | [] ->
     error (f_"%s did not return any output") prog
   | line :: _ ->
-    let csum_actual = fst (String.split " " line) in
-    if csum_ref <> csum_actual then
-      raise (Mismatched_checksum (csum, csum_actual))
+    fst (String.split " " line)
+
+let verify_checksum csum filename +  let csum_ref = string_of_csum csum in
+  let csum_actual = get_checksum csum filename in
+  if csum_ref <> csum_actual then
+    raise (Mismatched_checksum (csum, csum_actual))
 
 let verify_checksums checksums filename    List.iter (fun c ->
verify_checksum c filename) checksums
diff --git a/mllib/checksums.mli b/mllib/checksums.mli
index 0074837b3..e09d61890 100644
--- a/mllib/checksums.mli
+++ b/mllib/checksums.mli
@@ -40,3 +40,6 @@ val string_of_csum_t : csum_t -> string
 
 val string_of_csum : csum_t -> string
 (** Return a string representation of the checksum value. *)
+
+val get_checksum : csum_t -> string -> string
+(** Computes the checksum of the file. *)
-- 
2.11.0

To allow other pieces of code to process XML files easily, move the
xml.ml* and xpath_helpers.ml* from v2v to mllib.
---
 docs/C_SOURCE_FILES              |  2 +-
 mllib/Makefile.am                |  9 +++++++--
 {v2v => mllib}/xml-c.c           |  0
 {v2v => mllib}/xml.ml            |  0
 {v2v => mllib}/xml.mli           |  0
 {v2v => mllib}/xpath_helpers.ml  |  0
 {v2v => mllib}/xpath_helpers.mli |  0
 v2v/Makefile.am                  | 17 +++--------------
 8 files changed, 11 insertions(+), 17 deletions(-)
 rename {v2v => mllib}/xml-c.c (100%)
 rename {v2v => mllib}/xml.ml (100%)
 rename {v2v => mllib}/xml.mli (100%)
 rename {v2v => mllib}/xpath_helpers.ml (100%)
 rename {v2v => mllib}/xpath_helpers.mli (100%)

diff --git a/docs/C_SOURCE_FILES b/docs/C_SOURCE_FILES
index 7fa7d0a67..7e4dbdb25 100644
--- a/docs/C_SOURCE_FILES
+++ b/docs/C_SOURCE_FILES
@@ -390,4 +390,4 @@ utils/qemu-boot/qemu-boot.c
 utils/qemu-speed-test/qemu-speed-test.c
 v2v/domainxml-c.c
 v2v/utils-c.c
-v2v/xml-c.c
+mllib/xml-c.c
diff --git a/mllib/Makefile.am b/mllib/Makefile.am
index 4cf495555..1a21f825f 100644
--- a/mllib/Makefile.am
+++ b/mllib/Makefile.am
@@ -28,6 +28,8 @@ EXTRA_DIST = \
 	test-getopt.sh
 
 SOURCES_MLI = \
+	xml.mli \
+	xpath_helpers.mli \
 	checksums.mli \
 	common_utils.mli \
 	curl.mli \
@@ -67,7 +69,9 @@ SOURCES_ML = \
 	JSON.ml \
 	curl.ml \
 	exit.ml \
-	checksums.ml
+	checksums.ml \
+	xml.ml \
+	xpath_helpers.ml
 
 SOURCES_C = \
 	../cat/visit.c \
@@ -85,7 +89,8 @@ SOURCES_C = \
 	progress-c.c \
 	statvfs-c.c \
 	uri-c.c \
-	visit-c.c
+	visit-c.c \
+	xml-c.c
 
 if HAVE_OCAML
 
diff --git a/v2v/xml-c.c b/mllib/xml-c.c
similarity index 100%
rename from v2v/xml-c.c
rename to mllib/xml-c.c
diff --git a/v2v/xml.ml b/mllib/xml.ml
similarity index 100%
rename from v2v/xml.ml
rename to mllib/xml.ml
diff --git a/v2v/xml.mli b/mllib/xml.mli
similarity index 100%
rename from v2v/xml.mli
rename to mllib/xml.mli
diff --git a/v2v/xpath_helpers.ml b/mllib/xpath_helpers.ml
similarity index 100%
rename from v2v/xpath_helpers.ml
rename to mllib/xpath_helpers.ml
diff --git a/v2v/xpath_helpers.mli b/mllib/xpath_helpers.mli
similarity index 100%
rename from v2v/xpath_helpers.mli
rename to mllib/xpath_helpers.mli
diff --git a/v2v/Makefile.am b/v2v/Makefile.am
index cbb974fe4..feb47695a 100644
--- a/v2v/Makefile.am
+++ b/v2v/Makefile.am
@@ -58,14 +58,10 @@ SOURCES_MLI = \
 	utils.mli \
 	vCenter.mli \
 	windows.mli \
-	windows_virtio.mli \
-	xml.mli \
-	xpath_helpers.mli
+	windows_virtio.mli
 
 SOURCES_ML = \
 	types.ml \
-	xml.ml \
-	xpath_helpers.ml \
 	uefi.ml \
 	utils.ml \
 	name_from_disk.ml \
@@ -103,8 +99,7 @@ SOURCES_ML = \
 
 SOURCES_C = \
 	domainxml-c.c \
-	utils-c.c \
-	xml-c.c
+	utils-c.c
 
 if HAVE_OCAML
 
@@ -118,7 +113,6 @@ virt_v2v_CPPFLAGS = \
 	-I$(top_srcdir)/src
 virt_v2v_CFLAGS = \
 	$(WARN_CFLAGS) $(WERROR_CFLAGS) \
-	$(LIBXML2_CFLAGS) \
 	$(LIBVIRT_CFLAGS)
 
 BOBJECTS = \
@@ -166,8 +160,7 @@ virt_v2v_LINK = \
 
 virt_v2v_copy_to_local_SOURCES = \
 	domainxml-c.c \
-	utils-c.c \
-	xml-c.c
+	utils-c.c
 virt_v2v_copy_to_local_CPPFLAGS = \
 	-I. \
 	-I$(top_builddir) \
@@ -175,12 +168,9 @@ virt_v2v_copy_to_local_CPPFLAGS = \
 	-I$(top_srcdir)/src
 virt_v2v_copy_to_local_CFLAGS = \
 	$(WARN_CFLAGS) $(WERROR_CFLAGS) \
-	$(LIBXML2_CFLAGS) \
 	$(LIBVIRT_CFLAGS)
 
 COPY_TO_LOCAL_BOBJECTS = \
-	xml.cmo \
-	xpath_helpers.cmo \
 	uefi.cmo \
 	utils.cmo \
 	vCenter.cmo \
@@ -393,7 +383,6 @@ endif
 
 v2v_unit_tests_BOBJECTS = \
 	types.cmo \
-	xml.cmo \
 	uefi.cmo \
 	utils.cmo \
 	DOM.cmo \
-- 
2.11.0

There is already a libosinfo reading function located in src folder to
get the iso informations. Provide a similar but more generic function
to be used in ocaml tools.
---
 mllib/Makefile.am   | 12 ++++++++--
 mllib/osinfo.ml     | 64 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 mllib/osinfo.mli    | 21 ++++++++++++++++++
 mllib/osinfopath.ml |  1 +
 4 files changed, 96 insertions(+), 2 deletions(-)
 create mode 100644 mllib/osinfo.ml
 create mode 100644 mllib/osinfo.mli
 create mode 100644 mllib/osinfopath.ml

diff --git a/mllib/Makefile.am b/mllib/Makefile.am
index 1a21f825f..eb9753e45 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)) \
+	$(filter-out guestfs_config.ml libdir.ml osinfopath.ml,$(SOURCES_ML)) \
 	$(SOURCES_C) \
 	common_utils_tests.ml \
 	getopt_tests.ml \
@@ -40,6 +40,7 @@ SOURCES_MLI = \
 	getopt.mli \
 	JSON.mli \
 	mkdtemp.mli \
+	osinfo.mli \
 	planner.mli \
 	progress.mli \
 	regedit.mli \
@@ -71,7 +72,9 @@ SOURCES_ML = \
 	exit.ml \
 	checksums.ml \
 	xml.ml \
-	xpath_helpers.ml
+	xpath_helpers.ml \
+	osinfopath.ml \
+	osinfo.ml
 
 SOURCES_C = \
 	../cat/visit.c \
@@ -173,6 +176,11 @@ libdir.ml: Makefile
 	echo 'let libdir = "$(libdir)"' > $@-t
 	mv $@-t $@
 
+osinfopath.ml: Makefile
+	echo 'let osinfopath = "$(datadir)/libosinfo/db"' > $@-t
+	mv $@-t $@
+
+
 # Tests.
 
 common_utils_tests_SOURCES = dummy.c
diff --git a/mllib/osinfo.ml b/mllib/osinfo.ml
new file mode 100644
index 000000000..7630c4f9c
--- /dev/null
+++ b/mllib/osinfo.ml
@@ -0,0 +1,64 @@
+(* virt-builder
+ * Copyright (C) 2016 - SUSE 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 Common_utils
+open Osinfopath
+
+let osinfo_db_read_three_levels os_path filter +  let distros = Array.to_list
(Sys.readdir os_path) in
+  remove_duplicates (
+    List.concat (
+      List.map (
+        fun distro ->
+          let distro_path = os_path // distro in
+          let os_files = Array.to_list (Sys.readdir distro_path) in
+          List.map (
+            fun os_file ->
+              let file_path = distro_path // os_file in
+              let xml = read_whole_file file_path in
+              let doc = Xml.parse_memory xml in
+              let xpathctx = Xml.xpath_new_context doc in
+              filter xpathctx
+          ) os_files
+      ) distros
+    )
+  )
+
+let osinfo_db_read_flat os_path filter +  let os_files = Array.to_list
(Sys.readdir os_path) in
+  remove_duplicates (
+    List.map (
+      fun os_file ->
+        let file_path = os_path // os_file in
+        let xml = read_whole_file file_path in
+        let doc = Xml.parse_memory xml in
+        let xpathctx = Xml.xpath_new_context doc in
+        filter xpathctx
+    ) os_files
+  )
+
+let osinfo_read_db filter +  let path = try
+    Sys.getenv "OSINFO_SYSTEM_DIR"
+  with Not_found -> "/usr/share/osinfo" in
+
+  try osinfo_db_read_three_levels (path // "os") filter with
+  | _ ->
+    try osinfo_db_read_three_levels (osinfopath // "os") filter with
+    | _ ->
+      try osinfo_db_read_flat (osinfopath // "oses") filter with
+      | _ -> []
diff --git a/mllib/osinfo.mli b/mllib/osinfo.mli
new file mode 100644
index 000000000..4b881408e
--- /dev/null
+++ b/mllib/osinfo.mli
@@ -0,0 +1,21 @@
+(* virt-builder
+ * Copyright (C) 2016 - SUSE 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.
+ *)
+
+val osinfo_read_db : (Xml.xpathctx -> 'a) -> 'a list
+(** [osinfo_read_db filter] runs the [filter] function on the
+    XPath context of every osinfo os description XML file. *)
diff --git a/mllib/osinfopath.ml b/mllib/osinfopath.ml
new file mode 100644
index 000000000..a58b8d60f
--- /dev/null
+++ b/mllib/osinfopath.ml
@@ -0,0 +1 @@
+let osinfopath = "/usr/local/share/libosinfo/db"
-- 
2.11.0

virt-builder-repository allows users to easily create or update
a virt-builder source repository out of disk images. The tool can
be run in either interactive or automated mode.
---
 .gitignore                          |   3 +
 builder/Makefile.am                 |  91 ++++++-
 builder/builder_repository.ml       | 493 ++++++++++++++++++++++++++++++++++++
 builder/virt-builder-repository.pod | 144 +++++++++++
 4 files changed, 730 insertions(+), 1 deletion(-)
 create mode 100644 builder/builder_repository.ml
 create mode 100644 builder/virt-builder-repository.pod

diff --git a/.gitignore b/.gitignore
index 76a16c565..d9a3137fe 100644
--- a/.gitignore
+++ b/.gitignore
@@ -93,13 +93,16 @@ Makefile.in
 /builder/oUnit-*
 /builder/*.qcow2
 /builder/stamp-virt-builder.pod
+/builder/stamp-virt-builder-repository.pod
 /builder/stamp-virt-index-validate.pod
 /builder/test-config/virt-builder/repos.d/test-index.conf
 /builder/test-console-*.sh
 /builder/test-simplestreams/virt-builder/repos.d/cirros.conf
 /builder/test-website/virt-builder/repos.d/libguestfs.conf
 /builder/virt-builder
+/builder/virt-builder-repository
 /builder/virt-builder.1
+/builder/virt-builder-repository.1
 /builder/virt-index-validate
 /builder/virt-index-validate.1
 /builder/*.xz
diff --git a/builder/Makefile.am b/builder/Makefile.am
index b1ccd49f3..d9f203381 100644
--- a/builder/Makefile.am
+++ b/builder/Makefile.am
@@ -21,6 +21,8 @@ AM_YFLAGS = -d
 
 EXTRA_DIST = \
 	$(SOURCES_MLI) $(SOURCES_ML) $(SOURCES_C) \
+	$(REPOSITORY_SOURCES_ML) \
+	$(REPOSITORY_SOURCES_MLI) \
 	libguestfs.gpg \
 	opensuse.gpg \
 	test-console.sh \
@@ -38,6 +40,7 @@ EXTRA_DIST = \
 	test-virt-index-validate-good-2 \
 	test-virt-index-validate-good-3 \
 	virt-builder.pod \
+	virt-builder-repository.pod \
 	virt-index-validate.pod \
 	yajl_tests.ml
 
@@ -85,13 +88,44 @@ SOURCES_C = \
 	setlocale-c.c \
 	yajl-c.c
 
+REPOSITORY_SOURCES_ML = \
+	utils.ml \
+	index.ml \
+	cache.ml \
+	downloader.ml \
+	sigchecker.ml \
+	ini_reader.ml \
+	index_parser.ml \
+	yajl.ml \
+	paths.ml \
+	sources.ml \
+	builder_repository.ml
+
+REPOSITORY_SOURCES_MLI = \
+	cache.mli \
+	downloader.mli \
+	index.mli \
+	index_parser.mli \
+	ini_reader.mli \
+	sigchecker.mli \
+	sources.mli \
+	yajl.mli
+
+REPOSITORY_SOURCES_C = \
+	index-scan.c \
+	index-struct.c \
+	index-parse.c \
+	index-parser-c.c \
+	yajl-c.c
+
+
 man_MANS  noinst_DATA  bin_PROGRAMS  
 if HAVE_OCAML
 
-bin_PROGRAMS += virt-builder
+bin_PROGRAMS += virt-builder virt-builder-repository
 
 virt_builder_SOURCES = $(SOURCES_C)
 virt_builder_CPPFLAGS = \
@@ -306,6 +340,61 @@ depend: .depend
 
 -include .depend
 
+# virt-builder repository creation tool
+
+bin_PROGRAMS += virt-builder-repository
+
+virt_builder_repository_SOURCES = $(REPOSITORY_SOURCES_C)
+virt_builder_repository_CPPFLAGS = \
+	-I. \
+	-I$(top_builddir) \
+	-I$(top_srcdir)/gnulib/lib -I$(top_builddir)/gnulib/lib \
+	-I$(shell $(OCAMLC) -where) \
+	-I$(top_srcdir)/gnulib/lib \
+	-I$(top_srcdir)/src \
+	-I$(top_srcdir)/fish
+virt_builder_repository_CFLAGS = \
+	-pthread \
+	$(WARN_CFLAGS) $(WERROR_CFLAGS) \
+	-Wno-unused-macros \
+	$(LIBLZMA_CFLAGS) \
+	$(LIBTINFO_CFLAGS) \
+	$(LIBXML2_CFLAGS) \
+	$(YAJL_CFLAGS)
+REPOSITORY_BOBJECTS = $(REPOSITORY_SOURCES_ML:.ml=.cmo)
+REPOSITORY_XOBJECTS = $(REPOSITORY_BOBJECTS:.cmo=.cmx)
+
+
+if !HAVE_OCAMLOPT
+REPOSITORY_OBJECTS = $(REPOSITORY_BOBJECTS)
+else
+REPOSITORY_OBJECTS = $(REPOSITORY_XOBJECTS)
+endif
+
+virt_builder_repository_DEPENDENCIES = \
+	$(REPOSITORY_OBJECTS) \
+	../mllib/mllib.$(MLARCHIVE) \
+	../customize/customize.$(MLARCHIVE) \
+	$(top_srcdir)/ocaml-link.sh
+virt_builder_repository_LINK = \
+	$(top_srcdir)/ocaml-link.sh -cclib '$(OCAMLCLIBS)' -- \
+	  $(OCAMLFIND) $(BEST) $(OCAMLFLAGS) $(OCAMLPACKAGES) $(OCAMLLINKFLAGS) \
+	  $(REPOSITORY_OBJECTS) -o $@
+
+man_MANS += virt-builder-repository.1
+noinst_DATA += $(top_builddir)/website/virt-builder-repository.1.html
+
+virt-builder-repository.1
$(top_builddir)/website/virt-builder-repository.1.html:
stamp-virt-builder-repository.pod
+
+stamp-virt-builder-repository.pod: virt-builder-repository.pod
+	$(PODWRAPPER) \
+	  --man virt-builder-repository.1 \
+	  --html $(top_builddir)/website/virt-builder-repository.1.html \
+	  --license GPLv2+ \
+	  --warning safe \
+	  $<
+	touch $@
+
 endif
 
 .PHONY: depend docs
diff --git a/builder/builder_repository.ml b/builder/builder_repository.ml
new file mode 100644
index 000000000..682bc9405
--- /dev/null
+++ b/builder/builder_repository.ml
@@ -0,0 +1,493 @@
+(* virt-builder
+ * Copyright (C) 2016 SUSE 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 Common_gettext.Gettext
+open Common_utils
+open Getopt.OptionName
+open Utils
+open Yajl
+open Xpath_helpers
+
+open Printf
+
+let () = Random.self_init ()
+
+type cmdline = {
+  gpg : string;
+  gpgkey : string;
+  interactive : bool;
+  repo : string;
+}
+
+let parse_cmdline () +  let gpg = ref "gpg" in
+  let gpgkey = ref "" in
+  let interactive = ref false in
+
+  let argspec = [
+    [ L"gpg" ],       Getopt.Set_string ("gpg", gpg),      
s_"Set GPG binary/command";
+    [ L"gpg-key" ],   Getopt.Set_string ("gpgkey", gpgkey),
s_"ID of the GPG key to sign the repo with";
+    [ S 'i'; L"interactive" ],  Getopt.Set interactive,      
s_"Ask the user about missing data";
+  ] in
+
+  let args = ref [] in
+  let anon_fun s = push_front s args in
+  let usage_msg +    sprintf (f_"\
+%s: create a repository for virt-builder
+
+  virt-builder-repository REPOSITORY_PATH
+
+A short summary of the options is given below.  For detailed help please
+read the man page virt-builder-repository(1).
+")
+      prog in
+  let opthandle = create_standard_options argspec ~anon_fun usage_msg in
+  Getopt.parse opthandle;
+
+  (* Dereference options. *)
+  let args = List.rev !args in
+  let gpg = !gpg in
+  let gpgkey = !gpgkey in
+  let interactive = !interactive in
+
+  (* Check options *)
+  let repo +    (match args with
+    | [repo] -> repo
+    | [] ->
+      error (f_"virt-builder-repository /path/to/repo\nUse
'/path/to/repo' to point to the repository folder.")
+    | _ ->
+      error (f_"too many parameters, at most one '/path/to/repo'
is allowed")
+    ) in
+
+  {
+      gpg = gpg;
+      gpgkey = gpgkey;
+      interactive = interactive;
+      repo = repo;
+  }
+
+let make_relative_path base absolute +  if Filename.is_relative absolute then
+    absolute
+  else
+    let expr = sprintf "^%s/\\(.+\\)$" (Str.quote base) in
+    if Str.string_match (Str.regexp expr) absolute 0 then
+      Str.matched_group 1 absolute
+    else
+      absolute
+
+let increment_revision revision +  match revision with
+  | Utils.Rev_int n -> Utils.Rev_int (n + 1)
+  | Utils.Rev_string s ->
+    if Str.string_match (Str.regexp "^\\(.*[-._]\\)\\([0-9]+\\)$") s
0 then
+      let prefix = Str.matched_group 1 s in
+      let suffix = int_of_string (Str.matched_group 2 s) in
+      Utils.Rev_string (prefix ^ (string_of_int (suffix + 1)))
+    else
+      Utils.Rev_string (s ^ ".1")
+
+let osinfo_get_short_ids () +  let get_ids xpathctx +    xpath_string_default
xpathctx "/libosinfo/os/short-id" "" in
+
+  let ids = Osinfo.osinfo_read_db get_ids in
+  List.filter (fun id -> id <> "") ids
+
+let main () +  let cmdline = parse_cmdline () in
+
+  (* If debugging, echo the command line arguments. *)
+  if verbose () then (
+    printf "command line:";
+    List.iter (printf " %s") (Array.to_list Sys.argv);
+    printf "\n";
+  );
+
+  (* Check that the paths are existing *)
+  if not (Sys.file_exists (cmdline.repo)) then
+    error (f_"Repository folder '%s' doesn't exist")
cmdline.repo;
+
+  (* Create a temporary folder to work in *)
+  let tmpdir = Mkdtemp.temp_dir ~base_dir:cmdline.repo
"virt-builder-repository." "" in
+  rmdir_on_exit tmpdir;
+
+  let tmprepo = tmpdir // "repo" in
+  Unix.mkdir tmprepo 0o700;
+
+  let sigchecker = Sigchecker.create ~gpg:cmdline.gpg
+                                     ~check_signature:false
+                                     ~gpgkey:No_Key
+                                     ~tmpdir:tmpdir in
+
+  let index +    try
+      let index_filename +        List.find (
+          fun filename -> Sys.file_exists (cmdline.repo // filename)
+        ) [ "index.asc"; "index" ] in
+
+      let downloader = Downloader.create ~curl:"curl" ~cache:None
~tmpdir:tmpdir in
+
+      let source = { Sources.name = "input";
+                     uri = (cmdline.repo // index_filename);
+                     gpgkey = No_Key;
+                     proxy = Curl.SystemProxy;
+                     format = Sources.FormatNative } in
+
+      Index_parser.get_index ~downloader:downloader
+                             ~sigchecker:sigchecker
+                             source
+    with Not_found -> [] in
+
+  (* Check for index/interactive consistency *)
+  if not cmdline.interactive && index == [] then
+    error (f_"The repository needs to contain an index file when running
in automated mode");
+
+  if verbose () then
+    printf "Searching for images ...\n";
+
+  let is_supported_format file +    String.is_suffix file "qcow2" ||
+    String.is_suffix file "raw" ||
+    String.is_suffix file "img" in
+
+  let images +    let files = Array.to_list (Sys.readdir cmdline.repo) in
+    List.filter (fun f -> is_supported_format f) files in
+
+  if verbose () then
+    List.iter (
+      fun filename -> printf " + %s\n" filename;
+    ) images;
+
+  let compress_to file outdir = (
+    printf "Copying image to temporary folder ...\n%!";
+    let outimg = tmprepo // (Filename.basename file) in
+    let cmd = [ "cp" ] @
+      (if verbose () then [ "-v" ] else []) @
+      [ file; outimg ] in
+    let r = run_command cmd in
+    if r <> 0 then
+      error (f_"cp command failed copying '%s'") file;
+
+    printf "Compressing ...\n%!";
+    let cmd = [ "xz"; "-f"; "--best";
+                "--block-size=16777216"; outimg ] in
+    if run_command cmd <> 0 then
+      exit 1;
+    outimg ^ ".xz"
+  ) in
+
+  let outindex_path = tmprepo // "index" in
+  let index_channel = open_out outindex_path in
+
+  let process_image filename repo index interactive = (
+    printf "Preparing %s...\n" filename;
+
+    let filepath = repo // filename in
+    let qemuimg_cmd = "qemu-img info --output json " ^ (quote
filepath) in
+    let lines = external_command qemuimg_cmd in
+    let line = String.concat "" lines in
+    let infos = yajl_tree_parse line in
+    let format = object_get_string "format" infos in
+    let size = object_get_number "virtual-size" infos in
+
+    let xz_path = compress_to filepath cmdline.repo in
+    let checksum = Checksums.get_checksum (Checksums.SHA512 "")
xz_path in
+    let compressed_size = (Unix.stat xz_path).Unix.st_size in
+
+    let ask message = (
+      printf (f_ message);
+      let value = read_line () in
+      match value with
+      | "" -> None
+      | s -> Some s
+    ) in
+
+    let rec ask_id () = (
+      printf (f_"Identifier: ");
+      let id = read_line () in
+      if not (Str.string_match (Str.regexp "[a-zA-Z0-9-_.]+") id 0)
then (
+        printf (f_"Allowed characters are letters, digits, - _ and
.\n");
+        ask_id ();
+      ) else
+        id;
+    ) in
+
+    let ask_arch () = (
+      printf (f_"Architecture. Choose one from the list below:\n");
+      let arches = ["x86_64"; "aarch64";
"armv7l"; "i686"; "ppc64"; "ppc64le";
"s390x" ] in
+      iteri (
+        fun i arch -> printf " [%d] %s\n" (i + 1) arch
+      ) arches;
+
+      let i = ref 0 in
+      let n = List.length arches in
+      while !i < 1 || !i > n do
+        let input = read_line () in
+        if input = "exit" || input = "q" || input =
"quit" then
+          exit 0
+        else
+          try i := int_of_string input
+          with Failure _ -> ()
+      done;
+      List.nth arches (!i - 1)
+    ) in
+
+    let ask_osinfo () +      printf (f_ "osinfo short ID (can be found
with osinfo-query os command): ");
+      let value = read_line () in
+      match value with
+      | "" -> None
+      | osinfo ->
+        let ids = osinfo_get_short_ids () in
+        let osinfo_exists = List.exists (fun id -> osinfo = id) ids in
+        if not osinfo_exists then
+          warning (f_"'%s' is not a libosinfo OS id") osinfo;
+        Some osinfo in
+
+    (* Do we have an entry for that file already? *)
+    let file_entry +      try
+        List.hd (
+          List.filter (
+            fun (id, {Index.file_uri=file_uri}) ->
+              (Filename.basename file_uri) = ((Filename.basename filename) ^
".xz")
+          ) index
+        )
+      with
+      | Failure _ -> ("", {Index.printable_name = None;
+                           osinfo = None;
+                           file_uri = "";
+                           arch = "";
+                           signature_uri = None;
+                           checksums = None;
+                           revision = Utils.Rev_int 0;
+                           format = Some format;
+                           size = size;
+                           compressed_size = Some (Int64.of_int
compressed_size);
+                           expand = None;
+                           lvexpand = None;
+                           notes = [];
+                           hidden = false;
+                           aliases = None;
+                           sigchecker = sigchecker;
+                           proxy = Curl.UnsetProxy}) in
+
+      let id, {Index.printable_name = printable_name;
+               osinfo = osinfo;
+               arch = arch;
+               checksums = checksums;
+               revision = revision;
+               expand = expand;
+               lvexpand = lvexpand;
+               notes = notes;
+               hidden = hidden;
+               aliases = aliases} = file_entry in
+
+      let old_checksum +        match checksums with
+        | Some csums -> (
+            try
+              let csum = List.find (
+                fun c ->
+                  match c with
+                  | Checksums.SHA512 _ -> true
+                  | _ -> false
+              ) csums in
+              Checksums.string_of_csum csum
+            with
+            | _ -> ""
+          )
+        | None -> "" in
+
+      let id +        if id = "" && interactive then
+          ask_id ()
+        else (
+          if id = "" then
+            error (f_"Missing image identifier");
+          id
+        ) in
+
+      let printable_name +        if printable_name = None &&
interactive then
+          ask "Display name: "
+        else
+          printable_name in
+
+      let arch +        if arch = "" && interactive then
+          ask_arch ()
+        else (
+          if arch = "" then
+            error (f_"Missing architecture");
+          arch
+        ) in
+
+      let osinfo +        if osinfo = None && interactive then
+          ask_osinfo ()
+        else
+          osinfo in
+
+      let expand +        if expand = None && interactive then
+          ask "Expandable partition: "
+        else
+          expand in
+
+      let lvexpand +        if lvexpand = None && interactive then
+          ask "Expandable volume: "
+        else
+          lvexpand in
+
+      let revision +        if old_checksum <> checksum then
+          increment_revision revision
+        else
+          revision in
+
+      (id, {Index.printable_name = printable_name;
+            osinfo = osinfo;
+            file_uri = Filename.basename xz_path;
+            arch = arch;
+            signature_uri = None;
+            checksums = Some [(Checksums.SHA512 checksum)];
+            revision = revision;
+            format = Some format;
+            size = size;
+            compressed_size = Some (Int64.of_int compressed_size);
+            expand = expand;
+            lvexpand = lvexpand;
+            notes = notes;
+            hidden = hidden;
+            aliases = aliases;
+            sigchecker = sigchecker;
+            proxy = Curl.UnsetProxy})
+  ) in
+
+  (* Generate entries for uncompressed images *)
+  let written_ids +  List.map (
+    fun filename ->
+      let (id, new_entry) = process_image filename cmdline.repo
+                                          index cmdline.interactive in
+
+      Index.print_entry index_channel (id, new_entry);
+      output_string index_channel "\n";
+      id
+  ) images in
+
+  (* Write the unchanged entries *)
+  List.iter (
+    fun (id, {Index.printable_name = printable_name;
+              osinfo = osinfo;
+              file_uri = file_uri;
+              arch = arch;
+              signature_uri = signature_uri;
+              checksums = checksums;
+              revision = revision;
+              format = format;
+              size = size;
+              compressed_size = compressed_size;
+              expand = expand;
+              lvexpand = lvexpand;
+              notes = notes;
+              hidden = hidden;
+              aliases = aliases;
+              sigchecker = sigchecker;
+              proxy = proxy}) ->
+      let written = List.exists (fun written_id -> written_id = id)
written_ids in
+      if not written then
+        if Sys.file_exists file_uri then (
+          let rel_path = make_relative_path cmdline.repo file_uri in
+          let entry = {Index.printable_name = printable_name;
+                       osinfo = osinfo;
+                       file_uri = rel_path;
+                       arch = arch;
+                       signature_uri = signature_uri;
+                       checksums = checksums;
+                       revision = revision;
+                       format = format;
+                       size = size;
+                       compressed_size = compressed_size;
+                       expand = expand;
+                       lvexpand = lvexpand;
+                       notes = notes;
+                       hidden = hidden;
+                       aliases = aliases;
+                       sigchecker = sigchecker;
+                       proxy = proxy} in
+          Index.print_entry index_channel (id, entry);
+          output_string index_channel "\n"
+        );
+  ) index;
+
+  close_out index_channel;
+
+  (* GPG sign the generated index *)
+  if cmdline.gpgkey <> "" then (
+    let cmd = [ cmdline.gpg; "--armor";
+                "--output"; (tmprepo // "pubkey");
+                "--export"; cmdline.gpgkey ] in
+    if run_command cmd <> 0 then
+      error (f_"Failed to export GPG key %s") cmdline.gpgkey;
+
+    let cmd = [ cmdline.gpg; "--armor";
+                "--default-key"; cmdline.gpgkey;
+                "--clearsign"; (tmprepo // "index") ] in
+    if run_command cmd <> 0 then
+      error (f_"Failed to sign index");
+
+    (* Remove the index file since we have the signed version of it *)
+    Sys.remove (tmprepo // "index")
+  );
+
+  (* Move files in tmprepo into the repository *)
+
+  List.iter (
+    fun filename ->
+      let filepath = cmdline.repo // filename in
+      if Sys.file_exists filepath then (
+        let cmd = [ "mv"; filepath;
+                          (filepath ^ ".bak") ] in
+        if run_command cmd <> 0 then
+          error (f_"Failed to create %s backup copy") filename
+      )
+  ) ["index"; "index.asc"];
+
+
+  List.iter (
+    fun filename ->
+      let cmd = [ "mv"; tmprepo // filename;
+                        cmdline.repo ] in
+      if run_command cmd <> 0 then
+        error (f_"Failed to move %s in repository") (tmprepo //
filename)
+  ) (Array.to_list (Sys.readdir tmprepo));
+
+  (* Remove the processed image files *)
+  List.iter (
+    fun filename -> Sys.remove (cmdline.repo // filename)
+  ) images
+
+let () = run_main_and_handle_errors main
diff --git a/builder/virt-builder-repository.pod
b/builder/virt-builder-repository.pod
new file mode 100644
index 000000000..29d86b4ac
--- /dev/null
+++ b/builder/virt-builder-repository.pod
@@ -0,0 +1,144 @@
+=begin html
+
+<img src="virt-builder.svg" width="250"
+  style="float: right; clear: right;" />
+
+=end html
+
+=head1 NAME
+
+virt-builder-repository - Build virt-builder source repository easily
+
+=head1 SYNOPSIS
+
+ virt-builder-repository /path/to/repository
+    [-i|--interactive] [--gpg-key KEYID]
+
+=head1 DESCRIPTION
+
+Virt-builder is a tool for quickly building new virtual machines. It can
+be configured to use template repositories. However creating and
+maintaining a repository involves many tasks which can be automated.
+virt-builder-repository is a tool helping to manage these repositories.
+
+Virt-builder-repository loops over the files in the
C</path/to/repository>
+folder, compresses the files with a name ending by C<qcow2>, C<raw>
or
+C<img>, extracts data from them and creates or updates the C<index>
file.
+
+Some of the image-related data needed for the index file can't be
+computed from the image file. virt-builder-repository first tries to
+find them in the existing index file. If data are still missing after
+this, they are prompted in interactive mode, otherwise an error will
+be triggered.
+
+If a C<KEYID> is provided, the generated index file will be signed
+with this GPG key.
+
+=head1 EXAMPLES
+
+=head2 Create the initial repository
+
+Create a folder and copy the disk image template files in it. Then
+run a command like the following one:
+
+ virt-builder-repository --gpg-key "joe at hacker.org" -i
/path/to/folder
+
+Note that this example command runs in interactive mode. To run in
+automated mode, a minimal index file needs to be created before running
+the command containing sections like this one:
+
+ [template_id]
+ name=template display name
+ file=template_filename.qcow.xz
+ arch=x86_64
+ revision=0
+ size=0
+ expand=/dev/sda3
+
+The file value needs to match the image name extended with the ".xz"
+suffix. Other optional data can be prefilled, for more informations,
+see the I<Creating and signing the index file> section in
+L<virt-builder(1)> man page.
+
+=head2 Update images in an existing repository
+
+In this use case, an new image or a new revision of an existing image
+needs to be added to the repository. Place the corresponding image
+template files in the repository folder.
+
+To update the revision of an image, the file needs to have the same
+name than the existing one (without the C<xz> extension).
+
+As in the repository creation use case, a minimal fragment can be
+added to the index file for the automated mode. This can be done
+on the signed index even if it may sound a strange idea: the index
+will be resigned by the tool.
+
+To remove an image from the repository, just remove the corresponding
+compressed image file before running virt-builder-repository.
+
+Then running the following command will complete and update the index
+file:
+
+ virt-builder-repository --gpg-key "joe at hacker.org" -i
/path/to/folder
+
+virt-builder-repository works in a temporary folder inside the repository
+one. If anything wrong happens when running the tool, the repository is
+left untouched.
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<--help>
+
+Display help.
+
+=item B<--gpg> GPG
+
+Specify an alternate L<gpg(1)> (GNU Privacy Guard) binary.  You can
+also use this to add gpg parameters, for example to specify an
+alternate home directory:
+
+ virt-builder-repository --gpg "gpg --homedir /tmp" [...]
+
+This can also be used to avoid gpg asking for the key passphrase:
+
+ virt-builder-repository --gpg "gpg --passphrase-file /tmp/pass
--batch" [...]
+
+=item B<--gpg-key> KEYID
+
+Specify the GPG key to be used to sign the repository index file.
+If not provided, the index will left unsigned. C<KEYID> is used to
+identify the GPG key to use. This value is passed to gpg's
+C<--default-key> option and can can thus be an email address or a
+fingerprint.
+
+B<NOTE>: by default, virt-builder-repository searches for the key
+in the user's GPG key ring.
+
+=item B<-i>
+
+=item B<--interactive>
+
+Prompt for missing data.
+
+=back
+
+=head1 EXIT STATUS
+
+This program returns 0 if successful, or non-zero if there was an
+error.
+
+=head1 SEE ALSO
+
+L<virt-builder(1)>
+L<http://libguestfs.org/>.
+
+=head1 AUTHOR
+
+C?dric Bosdonnat L<mailto:cbosdonnat at suse.com>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2016 SUSE Inc.
-- 
2.11.0

Hi, talking from user perspective here, I think this is a great addition!
At the Lago project[1] we basically have a set of scripts that does
something similar, but we need to maintain our own format which
differs from the index file format in order to store few more metadata
parameters. It would be great to have similar capability built in.
> with it: it will add extra running time to load the appliance in each
detected new/updated image

I think having this optional would be great, usually when we need to
generate the repository we don't really care how long it takes(doesn't
happen that frequently). What I have in mind is a similar experience
to 'createrepo' command - just pass it a root path and the repository
is generated. Also I think interactive mode is nice, but the more
automated it can be the better(by pre-defining the template), maybe it
will be possible to 'register' commands that will populate parameters?

My second wonder, would it be possible to add 'metadata' parameters to
the the template used to generate the images? I know this might
require changes to the index.asc format. Currently it has 'notes' but
this just feels unnatural to use. For instance one use case I have in
mind is to add a 'backing_file_hash' parameter which will indicate the
hash of the backing_file . That way I can resolve multiple layered
qcow images and download them just by parsing the index file.

Thanks,

Nadav.

[1] https://github.com/lago-project/lago



On Tue, Jan 3, 2017 at 12:18 PM, Cédric Bosdonnat <cbosdonnat@suse.com>
wrote:
> Hi all,
>
> I wanted to provide an easy way to create or update a virt-builder
> repository out of a folder of template disk image files. This is what
> virt-builder-repository aims at. Some of the data are computed from
> the image file, others are asked the user or extracted from an existing
> index file.
>
> So far, virt-builder-repository doesn't run libguestfs on each image
> to extract the architecture, the list of available partitions and the
> list of volumes. May be this should be done, but I have several concerns
> with it: it will add extra running time to load the appliance in each
> detected new/updated image. And the question of how to handle cases where
> multiple OSes are installed on the template would need to be solved:
> raise an error or ask the user which one to use?
>
> In order to share more code, I have extracted the Yajl helpers with the
> yajl OCAML wrapper code, moved the libxml2 wrapper into mllib and written
> some OCAML osinfo db reading code in mllib.
>
> Cédric Bosdonnat (5):
>   builder: extract Yajl helper functions to yajl.ml
>   mllib: factorize code to add Checksum.get_checksum function
>   Move xml and xpath_helpers OCAML code to mllib
>   mllib: add libosinfo DB reading helpers
>   Add a virt-builder-repository tool
>
>  .gitignore                          |   3 +
>  builder/Makefile.am                 |  91 ++++++-
>  builder/builder_repository.ml       | 493
++++++++++++++++++++++++++++++++++++
>  builder/simplestreams_parser.ml     |  52 ----
>  builder/virt-builder-repository.pod | 144 +++++++++++
>  builder/yajl.ml                     |  55 ++++
>  builder/yajl.mli                    |  29 +++
>  docs/C_SOURCE_FILES                 |   2 +-
>  mllib/Makefile.am                   |  19 +-
>  mllib/checksums.ml                  |  20 +-
>  mllib/checksums.mli                 |   3 +
>  mllib/osinfo.ml                     |  64 +++++
>  mllib/osinfo.mli                    |  21 ++
>  mllib/osinfopath.ml                 |   1 +
>  {v2v => mllib}/xml-c.c              |   0
>  {v2v => mllib}/xml.ml               |   0
>  {v2v => mllib}/xml.mli              |   0
>  {v2v => mllib}/xpath_helpers.ml     |   0
>  {v2v => mllib}/xpath_helpers.mli    |   0
>  v2v/Makefile.am                     |  17 +-
>  20 files changed, 932 insertions(+), 82 deletions(-)
>  create mode 100644 builder/builder_repository.ml
>  create mode 100644 builder/virt-builder-repository.pod
>  create mode 100644 mllib/osinfo.ml
>  create mode 100644 mllib/osinfo.mli
>  create mode 100644 mllib/osinfopath.ml
>  rename {v2v => mllib}/xml-c.c (100%)
>  rename {v2v => mllib}/xml.ml (100%)
>  rename {v2v => mllib}/xml.mli (100%)
>  rename {v2v => mllib}/xpath_helpers.ml (100%)
>  rename {v2v => mllib}/xpath_helpers.mli (100%)
>
> --
> 2.11.0
>
> _______________________________________________
> Libguestfs mailing list
> Libguestfs@redhat.com
> https://www.redhat.com/mailman/listinfo/libguestfs

On Tue, 2017-01-03 at 14:38 +0200, Nadav Goldin wrote:
> Hi, talking from user perspective here, I think this is a great addition!
> At the Lago project[1] we basically have a set of scripts that does
> something similar, but we need to maintain our own format which
> differs from the index file format in order to store few more metadata
> parameters. It would be great to have similar capability built in.
Good to read that this is a feature that would interest users ;)
> > with it: it will add extra running time to load the appliance in each
> 
> detected new/updated image
> 
> I think having this optional would be great, usually when we need to
> generate the repository we don't really care how long it
takes(doesn't
> happen that frequently). What I have in mind is a similar experience
> to 'createrepo' command - just pass it a root path and the
repository
> is generated. Also I think interactive mode is nice, but the more
> automated it can be the better(by pre-defining the template), maybe it
> will be possible to 'register' commands that will populate
parameters?
What you mention with the automated mode is what virt-builder-repository
currently does by default. Just that is gets the missing data by parsing
a small (incomplete) index file.

As for the time it takes, I'm sure we shouldn't forget the case of
automatically built images containing updates... and this would require
virt-builder-repository to run quite often.
> My second wonder, would it be possible to add 'metadata' parameters
to
> the the template used to generate the images? I know this might
> require changes to the index.asc format. Currently it has 'notes'
but
> this just feels unnatural to use. For instance one use case I have in
> mind is to add a 'backing_file_hash' parameter which will indicate
the
> hash of the backing_file . That way I can resolve multiple layered
> qcow images and download them just by parsing the index file.
If adding metadata is not a problem in virt-builder's index, then I'ld
happily add that support in virt-builder-repository. However I'ld rather
keep that feature away from the initial commit and have a series for the
feature implementing it in both tools at a time.

--
Cedric
> Thanks,
> 
> Nadav.
> 
> [1] https://github.com/lago-project/lago
> 
> 
> 
> On Tue, Jan 3, 2017 at 12:18 PM, Cédric Bosdonnat
<cbosdonnat@suse.com> wrote:
> > Hi all,
> > 
> > I wanted to provide an easy way to create or update a virt-builder
> > repository out of a folder of template disk image files. This is what
> > virt-builder-repository aims at. Some of the data are computed from
> > the image file, others are asked the user or extracted from an
existing
> > index file.
> > 
> > So far, virt-builder-repository doesn't run libguestfs on each
image
> > to extract the architecture, the list of available partitions and the
> > list of volumes. May be this should be done, but I have several
concerns
> > with it: it will add extra running time to load the appliance in each
> > detected new/updated image. And the question of how to handle cases
where
> > multiple OSes are installed on the template would need to be solved:
> > raise an error or ask the user which one to use?
> > 
> > In order to share more code, I have extracted the Yajl helpers with
the
> > yajl OCAML wrapper code, moved the libxml2 wrapper into mllib and
written
> > some OCAML osinfo db reading code in mllib.
> > 
> > Cédric Bosdonnat (5):
> >   builder: extract Yajl helper functions to yajl.ml
> >   mllib: factorize code to add Checksum.get_checksum function
> >   Move xml and xpath_helpers OCAML code to mllib
> >   mllib: add libosinfo DB reading helpers
> >   Add a virt-builder-repository tool
> > 
> >  .gitignore                          |   3 +
> >  builder/Makefile.am                 |  91 ++++++-
> >  builder/builder_repository.ml       | 493
++++++++++++++++++++++++++++++++++++
> >  builder/simplestreams_parser.ml     |  52 ----
> >  builder/virt-builder-repository.pod | 144 +++++++++++
> >  builder/yajl.ml                     |  55 ++++
> >  builder/yajl.mli                    |  29 +++
> >  docs/C_SOURCE_FILES                 |   2 +-
> >  mllib/Makefile.am                   |  19 +-
> >  mllib/checksums.ml                  |  20 +-
> >  mllib/checksums.mli                 |   3 +
> >  mllib/osinfo.ml                     |  64 +++++
> >  mllib/osinfo.mli                    |  21 ++
> >  mllib/osinfopath.ml                 |   1 +
> >  {v2v => mllib}/xml-c.c              |   0
> >  {v2v => mllib}/xml.ml               |   0
> >  {v2v => mllib}/xml.mli              |   0
> >  {v2v => mllib}/xpath_helpers.ml     |   0
> >  {v2v => mllib}/xpath_helpers.mli    |   0
> >  v2v/Makefile.am                     |  17 +-
> >  20 files changed, 932 insertions(+), 82 deletions(-)
> >  create mode 100644 builder/builder_repository.ml
> >  create mode 100644 builder/virt-builder-repository.pod
> >  create mode 100644 mllib/osinfo.ml
> >  create mode 100644 mllib/osinfo.mli
> >  create mode 100644 mllib/osinfopath.ml
> >  rename {v2v => mllib}/xml-c.c (100%)
> >  rename {v2v => mllib}/xml.ml (100%)
> >  rename {v2v => mllib}/xml.mli (100%)
> >  rename {v2v => mllib}/xpath_helpers.ml (100%)
> >  rename {v2v => mllib}/xpath_helpers.mli (100%)
> > 
> > --
> > 2.11.0
> > 
> > _______________________________________________
> > Libguestfs mailing list
> > Libguestfs@redhat.com
> > https://www.redhat.com/mailman/listinfo/libguestfs
> 
>

On Tuesday, 3 January 2017 11:18:55 CET Cédric Bosdonnat
wrote:
> There is already a libosinfo reading function located in src folder to
> get the iso informations. Provide a similar but more generic function
> to be used in ocaml tools.
> ---
I'd rather avoid duplicating the logic used for reading the osinfo-db,
especially that
a) it was touched recently to support the newer osinfo-db, the newer
   internal libosinfo-db, and the old internal libosinfo-db
b) we might support more from the osinfo-db spec in the future (e.g.
   OSINFO_LOCAL_DIR and OSINFO_USER_DIR), especially since they are
   declared "MUST"

A way to do this could be the following (at least IMHO):
1) adapt the current C code (src/osinfo.c) to use a callback (with
   void *opaque) to parse each XML file -- in short, adding a new
   parameter to read_osinfo_db_xml
2) separate osinfo.c in two parts:
  2.a) what reads the osinfo-db and invokes a callback
  2.b) the libguestfs DB (osinfo_db, osinfo_db_size) with
       read_osinfo_db_xml as callback to fill it
3) expose (2.a) to OCaml, with an implementation similar to what Rich
   did recently for the visit API -- see cat/visit.c, mllib/visit-c.c,
   and mllib/visit.ml
4) build & use (2.b) + (3) in virt-builder

This way we would have just the OCaml callback to read the XML file,
and just collecting the list of short-id's.
> +            fun os_file ->
> +              let file_path = distro_path // os_file in
> +              let xml = read_whole_file file_path in
> +              let doc = Xml.parse_memory xml in
Hmm I've seen this pattern already, and IMHO it's time to change it:
the Xml module needs also a parse_file method to parse an existing
file, instead of keeping it all in memory.  Other users of this new
parse_file are in v2v/input_ova.ml, and
v2v/test-harness/v2v_test_harness.ml.
> +let osinfo_read_db filter > +  let path = try
> +    Sys.getenv "OSINFO_SYSTEM_DIR"
> +  with Not_found -> "/usr/share/osinfo" in
> +
> +  try osinfo_db_read_three_levels (path // "os") filter with
> +  | _ ->
> +    try osinfo_db_read_three_levels (osinfopath // "os") filter
with
> +    | _ ->
> +      try osinfo_db_read_flat (osinfopath // "oses") filter with
> +      | _ -> []
Note that this chain of try..with is too "coarse", and swallows also
errors which needs to be considered fatal (I/O errors, XML issues).
> diff --git a/mllib/osinfo.mli b/mllib/osinfo.mli
> new file mode 100644
> index 000000000..4b881408e
> --- /dev/null
> +++ b/mllib/osinfo.mli
> @@ -0,0 +1,21 @@
> +(* virt-builder
> + * Copyright (C) 2016 - SUSE 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.
> + *)
> +
> +val osinfo_read_db : (Xml.xpathctx -> 'a) -> 'a list
> +(** [osinfo_read_db filter] runs the [filter] function on the
> +    XPath context of every osinfo os description XML file. *)
> diff --git a/mllib/osinfopath.ml b/mllib/osinfopath.ml
> new file mode 100644
> index 000000000..a58b8d60f
> --- /dev/null
> +++ b/mllib/osinfopath.ml
> @@ -0,0 +1 @@
> +let osinfopath = "/usr/local/share/libosinfo/db"
Note that a generated file should not be in the patch, and needs to be
added to the top level .gitignore.

Thanks,
-- 
Pino Toscano

On Tuesday, 3 January 2017 11:18:56 CET Cédric Bosdonnat
wrote:
> virt-builder-repository allows users to easily create or update
> a virt-builder source repository out of disk images. The tool can
> be run in either interactive or automated mode.
> ---
Lots of code to review, so this is not an exhaustive review, neither
in the style nor in what is actually done; for some coding style issues,
I'm usually noting only one occurrence, so please check them in all the
sources.
>  builder/builder_repository.ml       | 493
++++++++++++++++++++++++++++++++++++
I'd call this source as repository_main.ml, similar to what was done
for virt-customize (although the reason was different), so there's a
pattern when the main source for an OCaml tool is not called "main.ml"
or "$tool.ml".
> diff --git a/builder/Makefile.am b/builder/Makefile.am
> index b1ccd49f3..d9f203381 100644
> --- a/builder/Makefile.am
> +++ b/builder/Makefile.am
>  
> -bin_PROGRAMS += virt-builder
> +bin_PROGRAMS += virt-builder virt-builder-repository
You should add virt-builder-repository once, either here or below.
> +# virt-builder repository creation tool
> +
> +bin_PROGRAMS += virt-builder-repository
> +
> +virt_builder_repository_SOURCES = $(REPOSITORY_SOURCES_C)
> +virt_builder_repository_CPPFLAGS = \
> +	-I. \
> +	-I$(top_builddir) \
> +	-I$(top_srcdir)/gnulib/lib -I$(top_builddir)/gnulib/lib \
> +	-I$(shell $(OCAMLC) -where) \
> +	-I$(top_srcdir)/gnulib/lib \
> +	-I$(top_srcdir)/src \
> +	-I$(top_srcdir)/fish
> +virt_builder_repository_CFLAGS = \
> +	-pthread \
> +	$(WARN_CFLAGS) $(WERROR_CFLAGS) \
> +	-Wno-unused-macros \
> +	$(LIBLZMA_CFLAGS) \
> +	$(LIBTINFO_CFLAGS) \
> +	$(LIBXML2_CFLAGS) \
> +	$(YAJL_CFLAGS)
> +REPOSITORY_BOBJECTS = $(REPOSITORY_SOURCES_ML:.ml=.cmo)
> +REPOSITORY_XOBJECTS = $(REPOSITORY_BOBJECTS:.cmo=.cmx)
> +
> +
> +if !HAVE_OCAMLOPT
> +REPOSITORY_OBJECTS = $(REPOSITORY_BOBJECTS)
> +else
> +REPOSITORY_OBJECTS = $(REPOSITORY_XOBJECTS)
> +endif
> +
> +virt_builder_repository_DEPENDENCIES = \
> +	$(REPOSITORY_OBJECTS) \
> +	../mllib/mllib.$(MLARCHIVE) \
> +	../customize/customize.$(MLARCHIVE) \
> +	$(top_srcdir)/ocaml-link.sh
> +virt_builder_repository_LINK = \
> +	$(top_srcdir)/ocaml-link.sh -cclib '$(OCAMLCLIBS)' -- \
> +	  $(OCAMLFIND) $(BEST) $(OCAMLFLAGS) $(OCAMLPACKAGES) $(OCAMLLINKFLAGS) \
> +	  $(REPOSITORY_OBJECTS) -o $@
I'd move the whole block quoted above after the same of
virt-builder, ...
> +man_MANS += virt-builder-repository.1
> +noinst_DATA += $(top_builddir)/website/virt-builder-repository.1.html
> +
> +virt-builder-repository.1
$(top_builddir)/website/virt-builder-repository.1.html:
stamp-virt-builder-repository.pod
> +
> +stamp-virt-builder-repository.pod: virt-builder-repository.pod
> +	$(PODWRAPPER) \
> +	  --man virt-builder-repository.1 \
> +	  --html $(top_builddir)/website/virt-builder-repository.1.html \
> +	  --license GPLv2+ \
> +	  --warning safe \
> +	  $<
> +	touch $@
... and the same for this one, after the block of the documentation of
virt-builder.
> diff --git a/builder/builder_repository.ml b/builder/builder_repository.ml
> new file mode 100644
> index 000000000..682bc9405
> --- /dev/null
> +++ b/builder/builder_repository.ml
> @@ -0,0 +1,493 @@
> +let () = Random.self_init ()
Most probably this is not needed, since this tool will not need to get
random bytes.
> +type cmdline = {
> +  gpg : string;
> +  gpgkey : string;
Make this a string option ref, so it's clearer to distinguish whether
a key was actually specified.
> +    [ L"gpg-key" ],   Getopt.Set_string ("gpgkey",
gpgkey),    s_"ID of the GPG key to sign the repo with";
I'd add a short alias, -K.
> +    | _ ->
> +      error (f_"too many parameters, at most one
'/path/to/repo' is allowed")
  "too many parameters, only one path to repository is allowed"
> +let make_relative_path base absolute > +  if Filename.is_relative
absolute then
> +    absolute
> +  else
> +    let expr = sprintf "^%s/\\(.+\\)$" (Str.quote base) in
> +    if Str.string_match (Str.regexp expr) absolute 0 then
> +      Str.matched_group 1 absolute
> +    else
> +      absolute
Hm the path in the "else" branch seems overkill; also, in one of the
patches by Tomáš [1] there's one small function, subfolder, which seems
to do the same job, so you could polish and add it to Common_utils first
(with unit tests, of course ;) ).

[1] https://www.redhat.com/archives/libguestfs/2016-December/msg00156.html
> +let osinfo_get_short_ids () > +  let get_ids xpathctx > +   
xpath_string_default xpathctx "/libosinfo/os/short-id" "" in
> +
> +  let ids = Osinfo.osinfo_read_db get_ids in
> +  List.filter (fun id -> id <> "") ids
The last line can be simplified:
  List.filter ((<>) "") ids

Also, the function is ok (modulo changes proposed in patch #4), but
it is called every time an osinfo short-id is requested... meaning
re-reading fully the whole osinfo-db. Please add a cache for this,
reading the osinfo-db only once at the first access.

Furthermore, since it's just a collection of strings, I'd use a
StringSet for the cache, so the lookup is fast.
> +  (* Check that the paths are existing *)
> +  if not (Sys.file_exists (cmdline.repo)) then
No need for round brackets around cmdline.repo.
> +  (* Create a temporary folder to work in *)
> +  let tmpdir = Mkdtemp.temp_dir ~base_dir:cmdline.repo
"virt-builder-repository." "" in
Too long line, please wrap it.
> +  let sigchecker = Sigchecker.create ~gpg:cmdline.gpg
> +                                     ~check_signature:false
> +                                     ~gpgkey:No_Key
> +                                     ~tmpdir:tmpdir in
When the variable for a labelled argument is named exactly like the
labelled argument, it can be simplified: ~foo:foo -> ~foo.
> +  let index > +    try
> +      let index_filename > +        List.find (
> +          fun filename -> Sys.file_exists (cmdline.repo // filename)
Since it is done every iteration (and also below),
cmdline.repo // filename could be saved in a variable at the beginning
in this try block.
> +      let downloader = Downloader.create ~curl:"curl"
~cache:None ~tmpdir:tmpdir in
Maybe the path to curl could be made configurable like in virt-builder.
> +      let source = { Sources.name = "input";
> +                     uri = (cmdline.repo // index_filename);
Extra round brackets.
> +  (* Check for index/interactive consistency *)
> +  if not cmdline.interactive && index == [] then
> +    error (f_"The repository needs to contain an index file when
running in automated mode");
Messages for error should not start as capitalized sentence.
> +  let is_supported_format file > +    String.is_suffix file
"qcow2" ||
> +    String.is_suffix file "raw" ||
> +    String.is_suffix file "img" in
This function could be in the same block of 'let images' below, as
it is not useful outside. Also, Filename.check_suffix could fit better
here.

Another note is that I've seen filenames for disk images with no
extension, e.g. "SomeDisk" or "instance-hda". Maybe we could
pick
also those files, or try to detect files with unknown extension: the
problem is that there is no simple way IIRC to detect RAW images as
such.
> +  let images > +    let files = Array.to_list (Sys.readdir
cmdline.repo) in
> +    List.filter (fun f -> is_supported_format f) files in
The last line can be simplified:
  List.filter is_supported files
> +    if r <> 0 then
> +      error (f_"cp command failed copying '%s'") file;
I guess "copying" can be left out from the error message, since
mentioning cp implies that already, sort of :)
> +  let process_image filename repo index interactive = (
No need for round brackets around whole functions, there is the "in"
at the end already.

Also, I'd move this big function as top-level in the file, making the
"main" easier to read.
> +    printf "Preparing %s...\n" filename;
> +
> +    let filepath = repo // filename in
> +    let qemuimg_cmd = "qemu-img info --output json " ^ (quote
filepath) in
> +    let lines = external_command qemuimg_cmd in
> +    let line = String.concat "" lines in
I'd concat the lines with \n, because IIRC the error messages of the
yajl library include the line number information.
> +    let infos = yajl_tree_parse line in
> +    let format = object_get_string "format" infos in
> +    let size = object_get_number "virtual-size" infos in
The code for getting size and format of a disk image fits as separate
helper function IMHO.
> +    let xz_path = compress_to filepath cmdline.repo in
> +    let checksum = Checksums.get_checksum (Checksums.SHA512 "")
xz_path in
> +    let compressed_size = (Unix.stat xz_path).Unix.st_size in
> +
> +    let ask message = (
> +      printf (f_ message);
> +      let value = read_line () in
> +      match value with
> +      | "" -> None
> +      | s -> Some s
> +    ) in
> +
> +    let rec ask_id () = (
> +      printf (f_"Identifier: ");
Small hint: when ask details about an image, either put the basename of
the file (i.e. "Identifier (foo.qcow2): ") or use the "info"
functions
to print the progress (like the other tools do).
> +      if not (Str.string_match (Str.regexp "[a-zA-Z0-9-_.]+") id
0) then (
> +        printf (f_"Allowed characters are letters, digits, - _ and
.\n");
Such messages should use 'warning' IMHO.
> +    let ask_arch () = (
> +      printf (f_"Architecture. Choose one from the list
below:\n");
> +      let arches = ["x86_64"; "aarch64";
"armv7l"; "i686"; "ppc64"; "ppc64le";
"s390x" ] in
> +      iteri (
> +        fun i arch -> printf " [%d] %s\n" (i + 1) arch
> +      ) arches;
> +
> +      let i = ref 0 in
> +      let n = List.length arches in
> +      while !i < 1 || !i > n do
> +        let input = read_line () in
> +        if input = "exit" || input = "q" || input =
"quit" then
> +          exit 0
> +        else
> +          try i := int_of_string input
> +          with Failure _ -> ()
> +      done;
> +      List.nth arches (!i - 1)
> +    ) in
While giving a choice of the common options is a good thing, I'd still
accept arbitrary architectures, as there is no limitation in other
parts of libguestfs. If the input cannot parsed as integer, use the
input string as-in.
> +        let osinfo_exists = List.exists (fun id -> osinfo = id) ids in
  List.exists ((=) osinfo) ids
> +      with
> +      | Failure _ -> ("", {Index.printable_name = None;
Hm weird indentation, I'd indent it like:

   with
   | Failure ->
      let entry = { Index.foo = ...;
                    ...
      } in
      ( "", entry }
> +      let printable_name > +        if printable_name = None &&
interactive then
> +          ask "Display name: "
Missing translation for this string.
> +      let arch > +        if arch = "" && interactive
then
> +          ask_arch ()
> +        else (
> +          if arch = "" then
> +            error (f_"Missing architecture");
> +          arch
> +        ) in
Hmm convoluted conditions, I'd make it simplier:

  let arch     if arch = "" then (
      if interactive then ask_arch ()
      else error (f_"missing architecture for %s") short_id
    ) else arch in
> +      (id, {Index.printable_name = printable_name;
Space between '{' and Index.etc.
> +            osinfo = osinfo;
> +            file_uri = Filename.basename xz_path;
> +            arch = arch;
> +            signature_uri = None;
> +            checksums = Some [(Checksums.SHA512 checksum)];
> +            revision = revision;
> +            format = Some format;
> +            size = size;
> +            compressed_size = Some (Int64.of_int compressed_size);
> +            expand = expand;
> +            lvexpand = lvexpand;
> +            notes = notes;
> +            hidden = hidden;
> +            aliases = aliases;
> +            sigchecker = sigchecker;
> +            proxy = Curl.UnsetProxy})
Ditto.
> +  (* Generate entries for uncompressed images *)
> +  let written_ids > +  List.map (
> +    fun filename ->
> +      let (id, new_entry) = process_image filename cmdline.repo
> +                                          index cmdline.interactive in
No need for round brackets, as the return value is automatically
unwrapped.
> +
> +      Index.print_entry index_channel (id, new_entry);
Note print_entry is designed mostly as debugging helper, not as way to
recreate the native index again -- for example, text lines in notes are
not indented. I'd add a new function in Index_parser to do this
specifically (we can always rename the module to something more
fitting later on).
> +      output_string index_channel "\n";
> +      id
> +  ) images in
> +
> +  (* Write the unchanged entries *)
> +  List.iter (
> +    fun (id, {Index.printable_name = printable_name;
> +              osinfo = osinfo;
> +              file_uri = file_uri;
> +              arch = arch;
> +              signature_uri = signature_uri;
> +              checksums = checksums;
> +              revision = revision;
> +              format = format;
> +              size = size;
> +              compressed_size = compressed_size;
> +              expand = expand;
> +              lvexpand = lvexpand;
> +              notes = notes;
> +              hidden = hidden;
> +              aliases = aliases;
> +              sigchecker = sigchecker;
> +              proxy = proxy}) ->
No need to extract all the struct values to create a new struct just
for changing one or more values -- use the "with" keyword:

  let entry = { ... } in
  let new = { entry with size = 10; ... } in
> +    (* Remove the index file since we have the signed version of it *)
> +    Sys.remove (tmprepo // "index")
Small TODO item: command line option to not remove the unsigned index
when signing -- useful to keep the unsigned index in VCS/etc, while
publishing only the signed one.
> +        let cmd = [ "mv"; filepath;
> +                          (filepath ^ ".bak") ] in
> +        if run_command cmd <> 0 then
> +          error (f_"Failed to create %s backup copy") filename
I'd use a simple helper function, do_mv, for this and the mv below,
similar to do_cp in dib/utils.ml.
> +  List.iter (
> +    fun filename ->
> +      let cmd = [ "mv"; tmprepo // filename;
> +                        cmdline.repo ] in
> +      if run_command cmd <> 0 then
> +        error (f_"Failed to move %s in repository") (tmprepo //
filename)
> +  ) (Array.to_list (Sys.readdir tmprepo));
No need to convert the Array returned by Sys.readdir to List to iterate
it, you can iterate just fine on an Array.
> diff --git a/builder/virt-builder-repository.pod
b/builder/virt-builder-repository.pod
> new file mode 100644
> index 000000000..29d86b4ac
> --- /dev/null
> +++ b/builder/virt-builder-repository.pod
> + [template_id]
> + name=template display name
> + file=template_filename.qcow.xz
> + arch=x86_64
> + revision=0
> + size=0
Hm, this makes me think Index_parser.get_index could have a "template"
parameter and not abort for fields missing that are considered mandatory
when parsing a real index.
> +The file value needs to match the image name extended with the
".xz"
> +suffix. Other optional data can be prefilled, for more informations,
> +see the I<Creating and signing the index file> section in
> +L<virt-builder(1)> man page.
Use L<virt-builder(1)/Creating and signing the index file>, so it
creates the proper linking in HTML.

Thanks,
-- 
Pino Toscano

On Tuesday, 3 January 2017 11:18:53 CET Cédric Bosdonnat
wrote:
> Getting checksum involves the same code than verifying them. Create
> a get_checksum function and use it in verify_checksum.
> ---
The idea is good, although there are few issues:

- you need to rebase the patch on master, since the code changed and
  this patch will not apply

- I'd call the function as 'calculate_checksum', as fits more what
it
  does

- I don't like much the usage of csum_t as parameter, since it's a bit
  misleading to pass a checksum string which will be ignored; one idea
  to avoid duplicating code with no need to refactor much could be
  still use your approach internally of using a csum_t, constructing
  that from the string of a checksum type -- something like:

  let rec calculate_checksum csum_type filename     do_calculate_checksum
(of_string csum_type "")

  and do_calculate_checksum csum filename     (* rest of your code *)

calculate_checksum would be the public API (exported), while
do_calculate_checksum the private implementation used by
calculate_checksum and verify_checksum.  Also, of_string already has
the string -> csum_t mapping, including raising an error on unknown
type.
> diff --git a/mllib/checksums.ml b/mllib/checksums.ml
> index dfa8c3ae7..3efc764b9 100644
> --- a/mllib/checksums.ml
> +++ b/mllib/checksums.ml
> @@ -45,23 +45,21 @@ let of_string csum_type csum_value >    |
"sha512" -> SHA512 csum_value
>    | _ -> invalid_arg csum_type
>  
> -let verify_checksum csum filename > -  let prog, csum_ref > -   
match csum with
> -    | SHA1 c -> "sha1sum", c
> -    | SHA256 c -> "sha256sum", c
> -    | SHA512 c -> "sha512sum", c
> -  in
> -
> +let get_checksum csum filename > +  let prog = (string_of_csum_t csum)
^ "sum" in
I'd leave the way prog is set as it is, as it is more explicit,
and will be easier to adapt in the future when I get to make this code
work on non-GNU platforms (e.g. FreeBSD).

Thanks,
-- 
Pino Toscano

On Tuesday, 3 January 2017 11:18:54 CET Cédric Bosdonnat
wrote:
> To allow other pieces of code to process XML files easily, move the
> xml.ml* and xpath_helpers.ml* from v2v to mllib.
> ---
This seems mostly fine, with just code motion indeed.
> diff --git a/docs/C_SOURCE_FILES b/docs/C_SOURCE_FILES
> index 7fa7d0a67..7e4dbdb25 100644
> --- a/docs/C_SOURCE_FILES
> +++ b/docs/C_SOURCE_FILES
> @@ -390,4 +390,4 @@ utils/qemu-boot/qemu-boot.c
>  utils/qemu-speed-test/qemu-speed-test.c
>  v2v/domainxml-c.c
>  v2v/utils-c.c
> -v2v/xml-c.c
> +mllib/xml-c.c
This file should be sorted, and it can be updated automatically:
  $ rm docs/C_SOURCE_FILES
  $ make docs/C_SOURCE_FILES

Thanks,
-- 
Pino Toscano

On Tuesday, 3 January 2017 11:18:56 CET Cédric Bosdonnat
wrote:
> virt-builder-repository allows users to easily create or update
> a virt-builder source repository out of disk images. The tool can
> be run in either interactive or automated mode.
> ---
Ah, another thing missing in this commit: since it adds a new
documentation, it needs to add a test for it (see the various
test-docs.sh and test-*-docs.sh).  Since there is a single test-docs.sh
for a directory containing more than one tool, then please add first a
simple commit renaming test-virt-builder-docs.sh to test-docs.sh, and
then adding the virt-builder-repository bits to it to this commit.

Thanks,
-- 
Pino Toscano

On Tuesday, 3 January 2017 11:18:52 CET Cédric Bosdonnat
wrote:
> Extract the yajl object_get_* helpers in the Yajl module since this
> could be useful for any Yajl user code.
> ---
Indeed code motion only, LGTM -- pushed too.

Thanks,
-- 
Pino Toscano