Libguestfs - Oct 2017 - [PATCH v11 1/6] builder: add simple OCaml osinfo-db reader

Hi there,

This is an update of the series. Just to rebase it on top of
Rich's latest changes.

Cédric Bosdonnat (5):
  builder: rename docs test script
  builder: add a template parameter to get_index
  builder: add Index.write_entry function
  mllib: add XPath helper xpath_get_nodes()
  New tool: virt-builder-repository

Pino Toscano (1):
  builder: add simple OCaml osinfo-db reader

 .gitignore                                         |   5 +
 builder/Makefile.am                                | 128 ++++-
 builder/builder.ml                                 |   2 +-
 builder/index.mli                                  |   3 +
 builder/index_parser.ml                            |  80 ++-
 builder/index_parser.mli                           |   9 +-
 builder/index_parser_tests.ml                      | 129 +++++
 builder/osinfo.ml                                  |  80 +++
 builder/osinfo.mli                                 |  22 +
 builder/repository_main.ml                         | 597 +++++++++++++++++++++
 .../{test-virt-builder-docs.sh => test-docs.sh}    |   2 +
 builder/virt-builder-repository.pod                | 213 ++++++++
 common/mltools/xpath_helpers.ml                    |   9 +
 common/mltools/xpath_helpers.mli                   |   4 +
 14 files changed, 1268 insertions(+), 15 deletions(-)
 create mode 100644 builder/index_parser_tests.ml
 create mode 100644 builder/osinfo.ml
 create mode 100644 builder/osinfo.mli
 create mode 100644 builder/repository_main.ml
 rename builder/{test-virt-builder-docs.sh => test-docs.sh} (93%)
 create mode 100644 builder/virt-builder-repository.pod

-- 
2.13.2

From: Pino Toscano <ptoscano@redhat.com>

Add a simple OCaml-based implementation of reader of the osinfo-db:
the only interface is an iterator that invokes an user-supplied
function with each XML file found.

This implementation behaves like the current C implementation, and
still supports the old libosinfo db.
---
 .gitignore          |  1 +
 builder/Makefile.am |  4 +++
 builder/osinfo.ml   | 80 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 builder/osinfo.mli  | 22 +++++++++++++++
 4 files changed, 107 insertions(+)
 create mode 100644 builder/osinfo.ml
 create mode 100644 builder/osinfo.mli

diff --git a/.gitignore b/.gitignore
index 36a193054..75e69edbd 100644
--- a/.gitignore
+++ b/.gitignore
@@ -92,6 +92,7 @@ Makefile.in
 /builder/index-scan.c
 /builder/libguestfs.conf
 /builder/opensuse.conf
+/builder/osinfo_config.ml
 /builder/oUnit-*
 /builder/*.qcow2
 /builder/stamp-virt-builder.pod
diff --git a/builder/Makefile.am b/builder/Makefile.am
index f3becd51d..e315bc785 100644
--- a/builder/Makefile.am
+++ b/builder/Makefile.am
@@ -213,6 +213,10 @@ CLEANFILES += *.qcow2 *.xz
 
 check_DATA = $(disk_images)
 
+osinfo_config.ml: Makefile
+	echo 'let libosinfo_db_path = "$(datadir)/libosinfo/db"'
> $@-t
+	mv $@-t $@
+
 fedora.qcow2: ../test-data/phony-guests/fedora.img
 	rm -f $@ $@-t
 	qemu-img convert -f raw -O qcow2 $< $@-t
diff --git a/builder/osinfo.ml b/builder/osinfo.ml
new file mode 100644
index 000000000..bfafdbde9
--- /dev/null
+++ b/builder/osinfo.ml
@@ -0,0 +1,80 @@
+(* virt-builder
+ * Copyright (C) 2017 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+open Std_utils
+open Tools_utils
+open Osinfo_config
+
+let rec iterate_db fn +  let locations = ref [] in
+
+  (* (1) Try the shared osinfo directory, using either the
+   * $OSINFO_SYSTEM_DIR envvar or its default value.
+   *)
+  let () +    let dir +      try Sys.getenv "OSINFO_SYSTEM_DIR"
+      with Not_found -> "/usr/share/osinfo" in
+    push_back locations ((dir // "os"), read_osinfo_db_three_levels)
+  in
+
+  (* (2) Try the libosinfo directory, using the newer three-directory
+   * layout ($LIBOSINFO_DB_PATH / "os" / $group-ID / [file.xml]).
+   *)
+  let () +    let path = Osinfo_config.libosinfo_db_path // "os" in
+    push_back locations (path, read_osinfo_db_three_levels)
+  in
+
+  (* (3) Try the libosinfo directory, using the old flat directory
+   * layout ($LIBOSINFO_DB_PATH / "oses" / [file.xml]).
+   *)
+  let () +    let path = Osinfo_config.libosinfo_db_path // "oses" in
+    push_back locations (path, read_osinfo_db_flat)
+  in
+
+  let rec loop = function
+    | (path, f) :: paths ->
+      if is_directory path then f fn path
+      (* This is not an error: RHBZ#948324. *)
+      else loop paths
+    | [] -> ()
+  in
+
+  loop !locations
+
+and read_osinfo_db_three_levels fn path +  debug "osinfo: loading
3-level-directories database from %s" path;
+  let entries = Array.to_list (Sys.readdir path) in
+  let entries = List.map ((//) path) entries in
+  (* Iterate only on directories. *)
+  let entries = List.filter is_directory entries in
+  List.iter (read_osinfo_db_directory fn) entries
+
+and read_osinfo_db_flat fn path +  debug "osinfo: loading flat database
from %s" path;
+  read_osinfo_db_directory fn path
+
+and read_osinfo_db_directory fn path +  let entries = Array.to_list
(Sys.readdir path) in
+  let entries = List.filter (fun x -> Filename.check_suffix x
".xml") entries in
+  let entries = List.map ((//) path) entries in
+  let entries = List.filter is_regular_file entries in
+  List.iter fn entries
+
diff --git a/builder/osinfo.mli b/builder/osinfo.mli
new file mode 100644
index 000000000..949d776a9
--- /dev/null
+++ b/builder/osinfo.mli
@@ -0,0 +1,22 @@
+(* virt-builder
+ * Copyright (C) 2017 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+val iterate_db : (string -> unit) -> unit
+(** [iterate_db fun] iterates over the osinfo-db/libosinfo database
+    of OS definitions, invoking the specified [fun] on each XML file.
+ *)
-- 
2.13.2

Rename test-virt-builder-docs.sh into test-docs.sh to include test
for another tool's documentation.
---
 builder/Makefile.am                                 | 4 ++--
 builder/{test-virt-builder-docs.sh => test-docs.sh} | 0
 2 files changed, 2 insertions(+), 2 deletions(-)
 rename builder/{test-virt-builder-docs.sh => test-docs.sh} (100%)

diff --git a/builder/Makefile.am b/builder/Makefile.am
index e315bc785..4a2f639c3 100644
--- a/builder/Makefile.am
+++ b/builder/Makefile.am
@@ -28,7 +28,7 @@ EXTRA_DIST = \
 	test-simplestreams/streams/v1/index.json \
 	test-simplestreams/streams/v1/net.cirros-cloud_released_download.json \
 	test-virt-builder.sh \
-	test-virt-builder-docs.sh \
+	test-docs.sh \
 	test-virt-builder-list.sh \
 	test-virt-builder-list-simplestreams.sh \
 	test-virt-builder-planner.sh \
@@ -262,7 +262,7 @@ yajl_tests_LINK = \
 	  $(yajl_tests_THEOBJECTS) -o $@
 
 TESTS = \
-	test-virt-builder-docs.sh \
+	test-docs.sh \
 	test-virt-builder-list.sh \
 	test-virt-index-validate.sh \
 	$(SLOW_TESTS)
diff --git a/builder/test-virt-builder-docs.sh b/builder/test-docs.sh
similarity index 100%
rename from builder/test-virt-builder-docs.sh
rename to builder/test-docs.sh
-- 
2.13.2

get_index now gets a new template parameter. Setting it to true will
make the index parsing less picky about missing important data. This
can be used to parse a partial index file.
---
 builder/builder.ml       |  2 +-
 builder/index_parser.ml  | 26 ++++++++++++++++++--------
 builder/index_parser.mli |  5 ++++-
 3 files changed, 23 insertions(+), 10 deletions(-)

diff --git a/builder/builder.ml b/builder/builder.ml
index 3d0dbe7a8..a19eb2d7b 100644
--- a/builder/builder.ml
+++ b/builder/builder.ml
@@ -208,7 +208,7 @@ let main ()                                ~tmpdir in
           match source.Sources.format with
           | Sources.FormatNative ->
-            Index_parser.get_index ~downloader ~sigchecker source
+            Index_parser.get_index ~downloader ~sigchecker ~template:false
source
           | Sources.FormatSimpleStreams ->
             Simplestreams_parser.get_index ~downloader ~sigchecker source
       ) sources
diff --git a/builder/index_parser.ml b/builder/index_parser.ml
index d6a4e2e86..6f611a7f5 100644
--- a/builder/index_parser.ml
+++ b/builder/index_parser.ml
@@ -25,7 +25,7 @@ open Utils
 open Printf
 open Unix
 
-let get_index ~downloader ~sigchecker { Sources.uri; proxy } +let get_index
~downloader ~sigchecker ~template { Sources.uri; proxy }    let corrupt_file () 
error (f_"The index file downloaded from ‘%s’ is corrupt.\nYou need to ask
the supplier of this file to fix it and upload a fixed version.") uri
   in
@@ -99,8 +99,10 @@ let get_index ~downloader ~sigchecker { Sources.uri; proxy } 
let arch              try List.assoc ("arch", None) fields
             with Not_found ->
-              eprintf (f_"%s: no ‘arch’ entry for ‘%s’\n") prog n;
-            corrupt_file () in
+              if template then "" else (
+                eprintf (f_"%s: no ‘arch’ entry for ‘%s’\n") prog n;
+                corrupt_file ()
+              ) in
           let signature_uri              try Some (make_absolute_uri
(List.assoc ("sig", None) fields))
             with Not_found -> None in
@@ -112,7 +114,7 @@ let get_index ~downloader ~sigchecker { Sources.uri; proxy }
let revision              try Rev_int (int_of_string (List.assoc
("revision", None) fields))
             with
-            | Not_found -> Rev_int 1
+            | Not_found -> if template then Rev_int 0 else Rev_int 1
             | Failure _ ->
               eprintf (f_"%s: cannot parse ‘revision’ field for
‘%s’\n") prog n;
               corrupt_file () in
@@ -122,11 +124,19 @@ let get_index ~downloader ~sigchecker { Sources.uri; proxy
}              try Int64.of_string (List.assoc ("size", None) fields)
             with
             | Not_found ->
-              eprintf (f_"%s: no ‘size’ field for ‘%s’\n") prog n;
-              corrupt_file ()
+              if template then
+                Int64.zero
+              else (
+                eprintf (f_"%s: no ‘size’ field for ‘%s’\n") prog n;
+                corrupt_file ()
+              )
             | Failure _ ->
-              eprintf (f_"%s: cannot parse ‘size’ field for ‘%s’\n")
prog n;
-              corrupt_file () in
+              if template then
+                Int64.zero
+              else (
+                eprintf (f_"%s: cannot parse ‘size’ field for
‘%s’\n") prog n;
+                corrupt_file ()
+              ) in
           let compressed_size              try Some (Int64.of_string
(List.assoc ("compressed_size", None) fields))
             with
diff --git a/builder/index_parser.mli b/builder/index_parser.mli
index b8d8ddf3d..a93e20825 100644
--- a/builder/index_parser.mli
+++ b/builder/index_parser.mli
@@ -16,4 +16,7 @@
  * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  *)
 
-val get_index : downloader:Downloader.t -> sigchecker:Sigchecker.t ->
Sources.source -> Index.index
+val get_index : downloader:Downloader.t -> sigchecker:Sigchecker.t ->
template:bool -> Sources.source -> Index.index
+(** [get_index download sigchecker template source] will parse the source
+    index file into an index entry list. If the template flag is set to
+    true, the parser will be less picky about missing values. *)
-- 
2.13.2

Add a function to properly write virt-builder source index entries.
Note that this function is very similar to Index.print_entry that is
meant for debugging purposes.
---
 .gitignore                    |   1 +
 builder/Makefile.am           |  36 +++++++++++-
 builder/index.mli             |   3 +
 builder/index_parser.ml       |  54 ++++++++++++++++++
 builder/index_parser.mli      |   4 ++
 builder/index_parser_tests.ml | 129 ++++++++++++++++++++++++++++++++++++++++++
 6 files changed, 225 insertions(+), 2 deletions(-)
 create mode 100644 builder/index_parser_tests.ml

diff --git a/.gitignore b/.gitignore
index 75e69edbd..c68bc9088 100644
--- a/.gitignore
+++ b/.gitignore
@@ -106,6 +106,7 @@ Makefile.in
 /builder/virt-index-validate
 /builder/virt-index-validate.1
 /builder/*.xz
+/builder/index_parser_tests
 /builder/yajl_tests
 /cat/stamp-virt-*.pod
 /cat/virt-cat
diff --git a/builder/Makefile.am b/builder/Makefile.am
index 4a2f639c3..fa049be4d 100644
--- a/builder/Makefile.am
+++ b/builder/Makefile.am
@@ -239,13 +239,36 @@ yajl_tests_BOBJECTS = \
 	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
+index_parser_tests_CPPFLAGS = $(virt_builder_CPPFLAGS)
+index_parser_tests_BOBJECTS = \
+	utils.cmo \
+	cache.cmo \
+	downloader.cmo \
+	sigchecker.cmo \
+	index.cmo \
+	ini_reader.cmo \
+	index_parser.cmo \
+	index_parser_tests.cmo
+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 = \
@@ -261,6 +284,15 @@ yajl_tests_LINK = \
 	  $(OCAMLFIND) $(BEST) $(OCAMLFLAGS) $(OCAMLPACKAGES) $(OCAMLPACKAGES_TESTS)
$(OCAMLLINKFLAGS) \
 	  $(yajl_tests_THEOBJECTS) -o $@
 
+index_parser_tests_DEPENDENCIES = \
+	$(index_parser_tests_THEOBJECTS) \
+	../mllib/mllib.$(MLARCHIVE) \
+	$(top_srcdir)/ocaml-link.sh
+index_parser_tests_LINK = \
+	$(top_srcdir)/ocaml-link.sh -cclib '$(OCAMLCLIBS)' -- \
+	  $(OCAMLFIND) $(BEST) $(OCAMLFLAGS) $(OCAMLPACKAGES) $(OCAMLPACKAGES_TESTS)
$(OCAMLLINKFLAGS) \
+	  $(index_parser_tests_THEOBJECTS) -o $@
+
 TESTS = \
 	test-docs.sh \
 	test-virt-builder-list.sh \
@@ -274,8 +306,8 @@ if ENABLE_APPLIANCE
 TESTS += test-virt-builder.sh
 endif ENABLE_APPLIANCE
 if HAVE_OCAML_PKG_OUNIT
-check_PROGRAMS += yajl_tests
-TESTS += yajl_tests
+check_PROGRAMS += yajl_tests index_parser_tests
+TESTS += yajl_tests index_parser_tests
 endif
 
 check-valgrind:
diff --git a/builder/index.mli b/builder/index.mli
index ff5ec4a35..6202d636e 100644
--- a/builder/index.mli
+++ b/builder/index.mli
@@ -39,3 +39,6 @@ and entry = {
 }
 
 val print_entry : out_channel -> (string * entry) -> unit
+(** Debugging helper function dumping an index entry to a stream.
+    To write entries for non-debugging purpose, use the
+    [Index_parser.write_entry] function. *)
diff --git a/builder/index_parser.ml b/builder/index_parser.ml
index 6f611a7f5..4405eca12 100644
--- a/builder/index_parser.ml
+++ b/builder/index_parser.ml
@@ -236,3 +236,57 @@ let get_index ~downloader ~sigchecker ~template {
Sources.uri; proxy }    in
 
   get_index ()
+
+let write_entry chan (name, { Index.printable_name = printable_name;
+                              file_uri = file_uri;
+                              arch = arch;
+                              osinfo = osinfo;
+                              signature_uri = signature_uri;
+                              checksums = checksums;
+                              revision = revision;
+                              format = format;
+                              size = size;
+                              compressed_size = compressed_size;
+                              expand = expand;
+                              lvexpand = lvexpand;
+                              notes = notes;
+                              aliases = aliases;
+                              hidden = hidden }) +  let fp fs = fprintf chan fs
in
+  fp "[%s]\n" name;
+  may (fp "name=%s\n") printable_name;
+  may (fp "osinfo=%s\n") osinfo;
+  fp "file=%s\n" file_uri;
+  fp "arch=%s\n" arch;
+  may (fp "sig=%s\n") signature_uri;
+  (match checksums with
+  | None -> ()
+  | Some checksums ->
+    List.iter (
+      fun c ->
+        fp "checksum[%s]=%s\n"
+          (Checksums.string_of_csum_t c) (Checksums.string_of_csum c)
+    ) checksums
+  );
+  fp "revision=%s\n" (string_of_revision revision);
+  may (fp "format=%s\n") format;
+  fp "size=%Ld\n" size;
+  may (fp "compressed_size=%Ld\n") compressed_size;
+  may (fp "expand=%s\n") expand;
+  may (fp "lvexpand=%s\n") lvexpand;
+
+  let format_notes notes +    String.concat "\n " (String.nsplit
"\n" notes) in
+
+  List.iter (
+    fun (lang, notes) ->
+      match lang with
+      | "" -> fp "notes=%s\n" (format_notes notes)
+      | lang -> fp "notes[%s]=%s\n" lang (format_notes notes)
+  ) notes;
+  (match aliases with
+  | None -> ()
+  | Some l -> fp "aliases=%s\n" (String.concat " " l)
+  );
+  if hidden then fp "hidden=true\n";
+  fp "\n"
diff --git a/builder/index_parser.mli b/builder/index_parser.mli
index a93e20825..a7079b9ac 100644
--- a/builder/index_parser.mli
+++ b/builder/index_parser.mli
@@ -20,3 +20,7 @@ val get_index : downloader:Downloader.t ->
sigchecker:Sigchecker.t -> template:b
 (** [get_index download sigchecker template source] will parse the source
     index file into an index entry list. If the template flag is set to
     true, the parser will be less picky about missing values. *)
+
+val write_entry : out_channel -> (string * Index.entry) -> unit
+(** [write_entry chan entry] writes the index entry to the chan output
+    stream.*)
diff --git a/builder/index_parser_tests.ml b/builder/index_parser_tests.ml
new file mode 100644
index 000000000..c4352d752
--- /dev/null
+++ b/builder/index_parser_tests.ml
@@ -0,0 +1,129 @@
+(* builder
+ * Copyright (C) 2017 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.
+ *)
+
+(* This file tests the Index_parser module. *)
+
+open OUnit2
+open Printf
+open Unix_utils
+open Common_utils
+
+let tmpdir = Mkdtemp.temp_dir "guestfs-tests." "";;
+rmdir_on_exit tmpdir
+
+let dummy_sigchecker = Sigchecker.create ~gpg:"gpg"
+                                         ~check_signature:false
+                                         ~gpgkey:Utils.No_Key
+                                         ~tmpdir
+
+let dummy_downloader = Downloader.create ~curl:"do-not-use-curl"
+                                         ~cache:None ~tmpdir
+
+(* Utils. *)
+let write_entries file entries +  let chan = open_out (tmpdir // file) in
+  List.iter (
+    fun (entry) ->
+      Index_parser.write_entry chan entry;
+  ) entries;
+  close_out chan
+
+let read_file file +  read_whole_file (tmpdir // "out")
+
+let parse_file file +  let source = { Sources.name = "input";
+                 uri = tmpdir // file;
+                 gpgkey = Utils.No_Key;
+                 proxy = Curl.SystemProxy;
+                 format = Sources.FormatNative } in
+  let entries = Index_parser.get_index ~downloader:dummy_downloader
+                                       ~sigchecker:dummy_sigchecker
+                                       ~template:false
+                                       source in
+  List.map (
+    fun (id, e) -> (id, { e with Index.file_uri = Filename.basename
e.Index.file_uri })
+  ) entries
+
+let format_entries entries +  let format_entry entry +    write_entries
"out" [entry];
+    read_file "out" in
+  List.map format_entry entries
+
+let assert_equal_string = assert_equal ~printer:(fun x -> sprintf
"\"%s\"" x)
+let assert_equal_list formatter +  let printer = (
+    fun x -> "(" ^ (String.escaped (String.concat ","
(formatter x))) ^ ")"
+  ) in
+  assert_equal ~printer
+
+let test_write_complete ctx +  let entry +    ("test-id", {
Index.printable_name = Some "test_name";
+           osinfo = Some "osinfo_data";
+           file_uri = "image_path";
+           arch = "test_arch";
+           signature_uri = None;
+           checksums = Some [Checksums.SHA512 "512checksum"];
+           revision = Utils.Rev_int 42;
+           format = Some "qcow2";
+           size = Int64.of_int 123456;
+           compressed_size = Some (Int64.of_int 12345);
+           expand = Some "/dev/sda1";
+           lvexpand = Some "/some/lv";
+           notes = [ ("", "Notes split\non several lines\n\n
with starting space ") ];
+           hidden = false;
+           aliases = Some ["alias1"; "alias2"];
+           sigchecker = dummy_sigchecker;
+           proxy = Curl.SystemProxy }) in
+
+  write_entries "out" [entry];
+  let actual = read_file "out" in
+  let expected = "[test-id]
+name=test_name
+osinfo=osinfo_data
+file=image_path
+arch=test_arch
+checksum[sha512]=512checksum
+revision=42
+format=qcow2
+size=123456
+compressed_size=12345
+expand=/dev/sda1
+lvexpand=/some/lv
+notes=Notes split
+ on several lines
+ 
+  with starting space 
+aliases=alias1 alias2
+
+" in
+  assert_equal_string expected actual;
+
+  let parsed_entries = parse_file "out" in
+  assert_equal_list format_entries [entry] parsed_entries
+
+let suite +  "builder Index_parser" >:::
+    [
+      "write.complete" >:: test_write_complete;
+    ]
+
+let () +  run_test_tt_main suite
-- 
2.13.2

This function will allow more OCaml-ish processing of XPath queries
with multiple results.
---
 common/mltools/xpath_helpers.ml  | 9 +++++++++
 common/mltools/xpath_helpers.mli | 4 ++++
 2 files changed, 13 insertions(+)

diff --git a/common/mltools/xpath_helpers.ml b/common/mltools/xpath_helpers.ml
index 05fad89a4..a79733486 100644
--- a/common/mltools/xpath_helpers.ml
+++ b/common/mltools/xpath_helpers.ml
@@ -52,3 +52,12 @@ let xpath_eval_default parsefn xpath expr default  let
xpath_string_default = xpath_eval_default identity
 let xpath_int_default = xpath_eval_default int_of_string
 let xpath_int64_default = xpath_eval_default Int64.of_string
+
+let xpath_get_nodes xpathctx expr +  let obj = Xml.xpath_eval_expression
xpathctx expr in
+  let nodes = ref [] in
+  for i = 0 to Xml.xpathobj_nr_nodes obj - 1 do
+    let node = Xml.xpathobj_node obj i in
+    push_back nodes node
+  done;
+  !nodes
diff --git a/common/mltools/xpath_helpers.mli b/common/mltools/xpath_helpers.mli
index 7434ba645..83c770281 100644
--- a/common/mltools/xpath_helpers.mli
+++ b/common/mltools/xpath_helpers.mli
@@ -31,3 +31,7 @@ val xpath_int_default : Xml.xpathctx -> string -> int
-> int
 val xpath_int64_default : Xml.xpathctx -> string -> int64 -> int64
 (** Parse an xpath expression and return a string/int; if the expression
     doesn't match, return the default. *)
+
+val xpath_get_nodes : Xml.xpathctx -> string -> Xml.node list
+(** Parse an XPath expression and return a list with the matching
+    XML nodes. *)
-- 
2.13.2

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                 |  86 +++++-
 builder/repository_main.ml          | 597 ++++++++++++++++++++++++++++++++++++
 builder/test-docs.sh                |   2 +
 builder/virt-builder-repository.pod | 213 +++++++++++++
 5 files changed, 899 insertions(+), 2 deletions(-)
 create mode 100644 builder/repository_main.ml
 create mode 100644 builder/virt-builder-repository.pod

diff --git a/.gitignore b/.gitignore
index c68bc9088..9b318c360 100644
--- a/.gitignore
+++ b/.gitignore
@@ -96,13 +96,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 fa049be4d..67e95c3c4 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
 
@@ -88,13 +91,46 @@ 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 \
+	osinfo_config.ml \
+	osinfo.ml \
+	repository_main.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 = \
@@ -117,12 +153,31 @@ virt_builder_CFLAGS = \
 BOBJECTS = $(SOURCES_ML:.ml=.cmo)
 XOBJECTS = $(BOBJECTS:.cmo=.cmx)
 
+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)/lib
+virt_builder_repository_CFLAGS = \
+	-pthread \
+	$(WARN_CFLAGS) $(WERROR_CFLAGS) \
+	-Wno-unused-macros \
+	$(LIBTINFO_CFLAGS) \
+	$(LIBXML2_CFLAGS) \
+	$(YAJL_CFLAGS)
+REPOSITORY_BOBJECTS = $(REPOSITORY_SOURCES_ML:.ml=.cmo)
+REPOSITORY_XOBJECTS = $(REPOSITORY_BOBJECTS:.cmo=.cmx)
+
 # -I $(top_builddir)/lib/.libs is a hack which forces corresponding -L
 # option to be passed to gcc, so we don't try linking against an
 # installed copy of libguestfs.
 OCAMLPACKAGES = \
 	-package str,unix \
 	-I $(top_builddir)/common/utils/.libs \
+	-I $(top_builddir)/common/mlxml \
 	-I $(top_builddir)/lib/.libs \
 	-I $(top_builddir)/gnulib/lib/.libs \
 	-I $(top_builddir)/ocaml \
@@ -155,13 +210,16 @@ OCAMLFLAGS = $(OCAML_FLAGS) $(OCAML_WARN_ERROR)
 
 if !HAVE_OCAMLOPT
 OBJECTS = $(BOBJECTS)
+REPOSITORY_OBJECTS = $(REPOSITORY_BOBJECTS)
 else
 OBJECTS = $(XOBJECTS)
+REPOSITORY_OBJECTS = $(REPOSITORY_XOBJECTS)
 endif
 
 OCAMLLINKFLAGS = \
 	mlgettext.$(MLARCHIVE) \
 	mlpcre.$(MLARCHIVE) \
+	mlxml.$(MLARCHIVE) \
 	mlstdutils.$(MLARCHIVE) \
 	mlguestfs.$(MLARCHIVE) \
 	mlcutils.$(MLARCHIVE) \
@@ -183,6 +241,16 @@ virt_builder_LINK = \
 	  $(OCAMLFIND) $(BEST) $(OCAMLFLAGS) $(OCAMLPACKAGES) $(OCAMLLINKFLAGS) \
 	  $(OBJECTS) -o $@
 
+virt_builder_repository_DEPENDENCIES = \
+	$(REPOSITORY_OBJECTS) \
+	../common/mltools/mltools.$(MLARCHIVE) \
+	../common/mlxml/mlxml.$(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 $@
+
 # Manual pages and HTML files for the website.
 
 man_MANS += virt-builder.1
@@ -201,6 +269,20 @@ stamp-virt-builder.pod: virt-builder.pod
$(top_srcdir)/customize/customize-synop
 	  $<
 	touch $@
 
+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 $@
+
 # Tests.
 
 TESTS_ENVIRONMENT = $(top_builddir)/run --test
@@ -286,7 +368,7 @@ yajl_tests_LINK = \
 
 index_parser_tests_DEPENDENCIES = \
 	$(index_parser_tests_THEOBJECTS) \
-	../mllib/mllib.$(MLARCHIVE) \
+	../common/mltools/mltools.$(MLARCHIVE) \
 	$(top_srcdir)/ocaml-link.sh
 index_parser_tests_LINK = \
 	$(top_srcdir)/ocaml-link.sh -cclib '$(OCAMLCLIBS)' -- \
diff --git a/builder/repository_main.ml b/builder/repository_main.ml
new file mode 100644
index 000000000..674dc4eca
--- /dev/null
+++ b/builder/repository_main.ml
@@ -0,0 +1,597 @@
+(* virt-builder
+ * Copyright (C) 2016-2017 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 Std_utils
+open Common_gettext.Gettext
+open Tools_utils
+open Unix_utils
+open Getopt.OptionName
+open Utils
+open Yajl
+open Xpath_helpers
+open StringSet
+
+open Printf
+
+type cmdline = {
+  gpg : string;
+  gpgkey : string option;
+  interactive : bool;
+  keep_unsigned : bool;
+  no_compression : bool;
+  repo : string;
+}
+
+type disk_image_info = {
+  format : string;
+  size : int64;
+}
+
+let parse_cmdline () +  let gpg = ref "gpg" in
+  let gpgkey = ref "" in
+  let interactive = ref false in
+  let keep_unsigned = ref false in
+  let no_compression = ref false in
+  let machine_readable = ref false in
+
+  let argspec = [
+    [ L"gpg" ], Getopt.Set_string ("gpg", gpg), s_"Set
GPG binary/command";
+    [ S 'K'; 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";
+    [ L"keep-index" ], Getopt.Set keep_unsigned, s_"Keep
unsigned index";
+    [ L"no-compression" ], Getopt.Set no_compression, s_"Don’t
compress the new images in the index";
+    [ L"machine-readable" ], Getopt.Set machine_readable,
s_"Make output machine readable";
+  ] 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;
+
+  (* Machine-readable mode?  Print out some facts about what
+   * this binary supports.
+   *)
+  if !machine_readable then (
+    printf "virt-builder-repository\n";
+    exit 0
+  );
+
+  (* Dereference options. *)
+  let args = List.rev !args in
+  let gpg = !gpg in
+  let gpgkey = match !gpgkey with "" -> None | s -> Some s in
+  let interactive = !interactive in
+  let keep_unsigned = !keep_unsigned in
+  let no_compression = !no_compression 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, only one path to repository is
allowed") in
+
+  {
+    gpg = gpg;
+    gpgkey = gpgkey;
+    interactive = interactive;
+    keep_unsigned = keep_unsigned;
+    no_compression = no_compression;
+    repo = repo;
+  }
+
+let increment_revision = function
+  | Utils.Rev_int n -> Utils.Rev_int (n + 1)
+  | Utils.Rev_string s -> Utils.Rev_int ((int_of_string s) + 1)
+
+let do_mv src dest +  let cmd = [ "mv"; src; dest ] in
+  let r = run_command cmd in
+  if r <> 0 then
+    error (f_"moving file ‘%s’ to ‘%s’ failed") src dest
+
+let checksums_get_sha512 = function
+  | None -> Checksums.SHA512 ""
+  | Some csums ->
+      try
+        List.find (
+          function
+          | Checksums.SHA512 _ -> true
+          | _ -> false
+        ) csums
+      with Not_found -> Checksums.SHA512 ""
+
+let osinfo_ids = ref None
+
+let osinfo_get_short_ids () +  match !osinfo_ids with
+  | Some ids -> ids
+  | None -> (
+    let set = ref StringSet.empty in
+    Osinfo.iterate_db (
+      fun filepath ->
+        let doc = Xml.parse_file filepath in
+        let xpathctx = Xml.xpath_new_context doc in
+        let nodes = xpath_get_nodes xpathctx "/libosinfo/os/short-id"
in
+        List.iter (
+          fun node ->
+            let id = Xml.node_as_string node in
+            set := StringSet.add id !set
+        ) nodes
+    );
+    osinfo_ids := Some (!set);
+    !set
+  )
+
+let compress_to file outdir +  let outimg = outdir // (Filename.basename file)
^ ".xz" in
+
+  info "Compressing ...%!";
+  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
+  if res <> 0 then
+    error (f_"‘xz’ command failed");
+  outimg
+
+let get_mime_type filepath +  let file_cmd = "file --mime-type --brief
" ^ (quote filepath) in
+  match external_command file_cmd with
+  | [] -> None
+  | line :: _ -> Some line
+
+let get_disk_image_info 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
+  let infos = yajl_tree_parse line in
+  {
+    format = object_get_string "format" infos;
+    size = object_get_number "virtual-size" infos
+  }
+
+let compute_short_id distro major minor +  match distro with
+  | "centos" when major >= 7 ->
+    sprintf "%s%d.0" distro major
+  | "debian" when major >= 4 ->
+    sprintf "%s%d" distro major
+  | ("fedora"|"mageia") ->
+    sprintf "%s%d" distro major
+  | "sles" when major = 0 ->
+    sprintf "%s%d" distro major
+  | "sles" ->
+    sprintf "%s%dsp%d" distro major minor
+  | "ubuntu" ->
+    sprintf "%s%d.%02d" distro major minor
+  | _ (* Any other combination. *) ->
+    sprintf "%s%d.%d" distro major minor
+
+let has_entry id arch index +  List.exists (
+    fun (item_id, { Index.arch = item_arch }) ->
+      item_id = id && item_arch = arch
+  ) index
+
+let process_image acc_entries filename repo tmprepo index interactive
+                  no_compression sigchecker +  message (f_"Preparing
%s") filename;
+
+  let filepath = repo // filename in
+  let { format = format; size = size } = get_disk_image_info filepath in
+  let out_path +    if no_compression then filepath
+    else compress_to filepath tmprepo in
+  let out_filename = Filename.basename out_path in
+  let checksum = Checksums.compute_checksum "sha512" out_path in
+  let compressed_size = (Unix.LargeFile.stat out_path).Unix.LargeFile.st_size
in
+
+  let ask ?default ?values message +    let default_str = match default with
+    | None -> ""
+    | Some x -> sprintf " [%s] " x in
+
+    let list_str = match values with
+    | None -> ""
+    | Some x ->
+      sprintf (f_"Choose one from the list below:\n %s\n")
+              (String.concat "\n " x) in
+
+    printf "%s%s%s%!" message default_str list_str;
+
+    let value = read_line () in
+    match value with
+    | "" -> default
+    | "-" -> None
+    | s -> Some s
+  in
+
+  let rec ask_id default +    match ask (s_"Identifier: ") ~default
with
+    | None -> default
+    | Some id ->
+      if not (Str.string_match (Str.regexp "[a-zA-Z0-9-_.]+") id 0)
then (
+        warning (f_"Allowed characters are letters, digits, - _ and
.");
+        ask_id default
+      ) else
+        id in
+
+  let rec ask_arch guess +    let arches = [ "x86_64";
"aarch64"; "armv7l"; "i686"; "ppc64";
"ppc64le"; "s390x" ] in
+    match (ask (s_"Architecture: ") ~default:guess ~values:arches)
with
+    | None -> ask_arch guess
+    | Some x ->
+      if x = "" then
+        ask_arch guess
+      else
+        x
+  in
+
+  let ask_osinfo default +    match ask (s_ "osinfo short ID: ")
+              ~default with
+    | None -> None
+    | Some osinfo ->
+      let osinfo_ids = osinfo_get_short_ids () in
+      if not (StringSet.mem osinfo osinfo_ids) then
+        warning (f_"‘%s’ is not a recognized osinfo OS id; using it
anyway") osinfo;
+      Some osinfo in
+
+  (* Do we have an entry for that file already? *)
+  let file_entry +    try
+      List.hd (
+        List.filter (
+          fun (_, { Index.file_uri = file_uri }) ->
+            let basename = Filename.basename file_uri in
+            basename = out_filename || basename = filename
+        ) index
+      )
+    with
+    | Failure _ ->
+      let entry = { 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 compressed_size;
+                    expand = None;
+                    lvexpand = None;
+                    notes = [];
+                    hidden = false;
+                    aliases = None;
+                    sigchecker = sigchecker;
+                    proxy = Curl.SystemProxy } in
+      ("", entry) 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 = checksums_get_sha512 checksums in
+
+  if old_checksum = checksum then
+    let id, entry = file_entry in
+    (id, { entry with Index.file_uri = out_filename })
+  else (
+    message (f_"Extracting data from the image...");
+    let g = new Guestfs.guestfs () in
+    g#add_drive_ro filepath;
+    g#launch ();
+
+    let roots = g#inspect_os () in
+    let nroots = Array.length roots in
+    if nroots <> 1 then
+      error (f_"virt-builder template images must have one and only one
root file system, found %d")
+            nroots;
+
+    let root = Array.get roots 0 in
+    let product = g#inspect_get_product_name root in
+    let inspected_arch = g#inspect_get_arch root in
+    let distro = g#inspect_get_distro root in
+    let version_major = g#inspect_get_major_version root in
+    let version_minor = g#inspect_get_minor_version root in
+    let lvs = g#lvs () in
+    let filesystems = g#inspect_get_filesystems root in
+
+    let shortid = compute_short_id distro version_major version_minor in
+
+    g#close ();
+
+    let id +      if id = "" then (
+        if interactive then ask_id shortid
+        else error (f_"missing image identifier");
+      ) else id in
+
+    let arch +      if arch = "" then (
+        if interactive then ask_arch inspected_arch
+        else inspected_arch;
+      ) else arch in
+
+    if arch = "" then
+      error (f_"missing architecture for %s") id;
+
+    if has_entry id arch acc_entries then
+      error (f_"Already existing image with id %s and architecture
%s") id arch;
+
+    let printable_name +      if printable_name = None then
+        if interactive then ask (s_"Display name: ") ~default:product
+        else Some product
+      else
+        printable_name in
+
+    let osinfo +      if osinfo = None then
+        if interactive then ask_osinfo shortid else Some shortid
+      else
+        osinfo in
+
+    let expand +      if expand = None then
+        if interactive then ask (s_"Expandable partition: ")
~default:root
+                                ~values:(Array.to_list filesystems)
+        else Some root
+      else
+        expand in
+
+    let lvexpand +      if lvexpand = None && lvs <> [||] then
+        if interactive then
+          ask (s_"Expandable volume: ") ~values:(Array.to_list lvs)
+        else Some (Array.get lvs 0)
+      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 out_path;
+           arch = arch;
+           signature_uri = None;
+           checksums = Some [checksum];
+           revision = revision;
+           format = Some format;
+           size = size;
+           compressed_size = Some compressed_size;
+           expand = expand;
+           lvexpand = lvexpand;
+           notes = notes;
+           hidden = hidden;
+           aliases = aliases;
+           sigchecker = sigchecker;
+           proxy = Curl.SystemProxy })
+  )
+
+let main () +  let cmdline = parse_cmdline () in
+
+  (* If debugging, echo the command line arguments. *)
+  debug "command line: %s" (String.concat " "
(Array.to_list Sys.argv));
+
+  (* 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
+  mkdir_p tmprepo 0o700;
+
+  let sigchecker = Sigchecker.create ~gpg:cmdline.gpg
+                                     ~check_signature:false
+                                     ~gpgkey:No_Key
+                                     ~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:"do-not-use-curl"
+                                         ~cache:None ~tmpdir in
+
+      let source = { Sources.name = index_filename;
+                     uri = cmdline.repo // index_filename;
+                     gpgkey = No_Key;
+                     proxy = Curl.SystemProxy;
+                     format = Sources.FormatNative } in
+
+      Index_parser.get_index ~downloader ~sigchecker ~template:true source
+    with Not_found -> [] in
+
+  (* Check for index/interactive consistency *)
+  if not cmdline.interactive && index = [] then
+    error (f_"the repository must contain an index file when running in
automated mode");
+
+  debug "Searching for images ...";
+
+  let images +    let is_supported_format file +      let extension =
last_part_of file '.' in
+      match extension with
+      | Some ext -> List.mem ext [ "qcow2"; "raw";
"img" ]
+      | None -> 
+        match (get_mime_type file) with
+        | None -> false
+        | Some mime -> mime = "application/octet-stream" in
+    let is_new file +      try
+        let _, { Index.checksums = checksums } +          List.find (
+            fun (_, { Index.file_uri = file_uri }) ->
+              Filename.basename file_uri = file
+          ) index in
+        let checksum = checksums_get_sha512 checksums in
+        let path = cmdline.repo // file in
+        let file_checksum = Checksums.compute_checksum "sha512" path
in
+        checksum <> file_checksum
+      with Not_found -> true in
+    let files = Array.to_list (Sys.readdir cmdline.repo) in
+    let files = List.filter (
+      fun file -> is_regular_file (cmdline.repo // file)
+    ) files in
+    List.filter (
+      fun file ->
+        if is_supported_format (cmdline.repo // file) then
+          is_new file
+        else
+          false
+    ) files in
+
+  if images = [] then (
+    info (f_ "No new image found");
+    exit 0
+  );
+
+  info (f_ "Found new images: %s") (String.concat " "
images);
+
+  let outindex_path = tmprepo // "index" in
+  let index_channel = open_out outindex_path in
+
+  (* Generate entries for uncompressed images *)
+  let images_entries = List.fold_right (
+    fun filename acc ->
+      let image_entry = process_image acc
+                                      filename
+                                      cmdline.repo
+                                      tmprepo
+                                      index
+                                      cmdline.interactive
+                                      cmdline.no_compression
+                                      sigchecker in
+      image_entry :: acc
+  ) images [] in
+
+  (* Filter out entries for newly found images and entries
+     without a corresponding image file or with empty arch *)
+  let index = List.filter (
+    fun (id, { Index.arch = arch;
+               Index.file_uri = file_uri }) ->
+      arch <> "" && not (has_entry id arch
images_entries) &&
+      Sys.file_exists file_uri
+  ) index in
+
+  (* Convert all URIs back to relative ones *)
+  let index = List.map (
+    fun (id, entry) ->
+      let { Index.file_uri = file_uri } = entry in
+      let rel_path +        try
+          subdirectory cmdline.repo file_uri
+        with
+        | Invalid_argument _ ->
+          file_uri in
+      let rel_entry = { entry with Index.file_uri = rel_path } in
+      (id, rel_entry)
+  ) index in
+
+  (* Write all the entries *)
+  List.iter (
+    fun entry ->
+      Index_parser.write_entry index_channel entry;
+  ) (index @ images_entries);
+
+  close_out index_channel;
+
+  (* GPG sign the generated index *)
+  (match cmdline.gpgkey with
+  | None ->
+    debug "Skip index signing"
+  | Some gpgkey ->
+    message (f_"Signing index with the GPG key %s") gpgkey;
+    let cmd = sprintf "%s --armor --output %s --export %s"
+                      (quote (cmdline.gpg // "index.gpg"))
+                      (quote tmprepo) (quote gpgkey) in
+    if shell_command cmd <> 0 then
+      error (f_"failed to export the GPG key %s") gpgkey;
+
+    let cmd = sprintf "%s --armor --default-key %s --clearsign %s"
+                       (quote cmdline.gpg) (quote gpgkey)
+                       (quote (tmprepo // "index" )) in
+    if shell_command cmd <> 0 then
+      error (f_"failed to sign index");
+
+    (* Remove the index file since we have the signed version of it *)
+    if not cmdline.keep_unsigned then
+      Sys.remove (tmprepo // "index")
+  );
+
+  message (f_"Creating index backup copy");
+
+  List.iter (
+    fun filename ->
+      let filepath = cmdline.repo // filename in
+      if Sys.file_exists filepath then
+        do_mv filepath (filepath ^ ".bak")
+  ) ["index"; "index.asc"];
+
+  message (f_"Moving files to final destination");
+
+  Array.iter (
+    fun filename ->
+      do_mv (tmprepo // filename) cmdline.repo
+  ) (Sys.readdir tmprepo);
+
+  debug "Cleanup";
+
+  (* Remove the processed image files *)
+  if not cmdline.no_compression then
+    List.iter (
+      fun filename -> Sys.remove (cmdline.repo // filename)
+    ) images
+
+let () = run_main_and_handle_errors main
diff --git a/builder/test-docs.sh b/builder/test-docs.sh
index 884135de6..6f39b906d 100755
--- a/builder/test-docs.sh
+++ b/builder/test-docs.sh
@@ -25,3 +25,5 @@ $top_srcdir/podcheck.pl virt-builder.pod virt-builder \
   --insert $top_srcdir/customize/customize-synopsis.pod:__CUSTOMIZE_SYNOPSIS__
\
   --insert $top_srcdir/customize/customize-options.pod:__CUSTOMIZE_OPTIONS__ \
   --ignore=--check-signatures,--no-check-signatures
+
+$srcdir/../podcheck.pl virt-builder-repository.pod virt-builder-repository
diff --git a/builder/virt-builder-repository.pod
b/builder/virt-builder-repository.pod
new file mode 100644
index 000000000..11fec8f07
--- /dev/null
+++ b/builder/virt-builder-repository.pod
@@ -0,0 +1,213 @@
+=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 directory specified
+as argument, compresses the files with a name ending by C<qcow2>,
C<raw>,
+C<img> or without extension, 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@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]
+ file=template_filename.qcow.xz
+
+The file value needs to match the image name extended with the C<.xz>
+suffix if the I<--no-compression> parameter is not provided or the
+image name if no compression is involved. Other optional data can be
+prefilled. Default values are computed by inspecting the disk image.
+For more informations, see
+L<virt-builder(1)/Creating and signing the index file>.
+
+=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 signed again by the tool.
+
+To remove an image from the repository, just remove the corresponding
+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@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<-K> KEYID
+
+=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
+I<--default-key> option and 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 keyring.
+
+=item B<-i>
+
+=item B<--interactive>
+
+Prompt for missing data. Default values are computed from the disk
+image.
+
+When prompted for data, inputting C<-> corresponds to leaving the
+value empty. This can be used to avoid setting the default computed value.
+
+=item B<--keep-index>
+
+When using a GPG key, don’t remove the unsigned index.
+
+=item B<--no-compression>
+
+Don’t compress the template images.
+
+=item B<--machine-readable>
+
+This option is used to make the output more machine friendly
+when being parsed by other programs.  See
+L</MACHINE READABLE OUTPUT> below.
+
+
+=item B<--colors>
+
+=item B<--colours>
+
+Use ANSI colour sequences to colourize messages.  This is the default
+when the output is a tty.  If the output of the program is redirected
+to a file, ANSI colour sequences are disabled unless you use this
+option.
+
+=item B<-q>
+
+=item B<--quiet>
+
+Don’t print ordinary progress messages.
+
+=item B<-v>
+
+=item B<--verbose>
+
+Enable debug messages and/or produce verbose output.
+
+When reporting bugs, use this option and attach the complete output to
+your bug report.
+
+=item B<-V>
+
+=item B<--version>
+
+Display version number and exit.
+
+=item B<-x>
+
+Enable tracing of libguestfs API calls.
+
+
+=back
+
+=head1 MACHINE READABLE OUTPUT
+
+The I<--machine-readable> option can be used to make the output more
+machine friendly, which is useful when calling virt-builder-repository from
+other programs, GUIs etc.
+
+Use the option on its own to query the capabilities of the
+virt-builder-repository binary.  Typical output looks like this:
+
+ $ virt-builder-repository --machine-readable
+ virt-builder-repository
+
+A list of features is printed, one per line, and the program exits
+with status 0.
+
+=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@suse.com>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2016-2017 SUSE Inc.
-- 
2.13.2

On Thu, Oct 05, 2017 at 04:58:28PM +0200, Cédric Bosdonnat
wrote:
> +open Common_utils
I just noticed while I was building and testing this that
you need to replace the above with ‘open Std_utils’.

Rich.

-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
libguestfs lets you edit virtual machines.  Supports shell scripting,
bindings from many languages.  http://libguestfs.org

The subject says ‘xpath_get_nodes()‘, but this function doesn't
actually take a unit parameter, so it's better to drop ‘()’.

On Thu, Oct 05, 2017 at 04:58:29PM +0200, Cédric Bosdonnat
wrote:
> +
> +let xpath_get_nodes xpathctx expr > +  let obj =
Xml.xpath_eval_expression xpathctx expr in
> +  let nodes = ref [] in
> +  for i = 0 to Xml.xpathobj_nr_nodes obj - 1 do
> +    let node = Xml.xpathobj_node obj i in
> +    push_back nodes node
> +  done;
> +  !nodes
‘push_back’ is unfortunately O(n) and no tail recursive, and so the
whole loop is O(n²).  It's going to be much more efficient therefore
to build the list up in reverse and reverse it at the end:

  for ...
    ...
    push_front node nodes
  done;
  List.rev !nodes

Despite that problem this seems like quite a useful function, it would
be nice to extend this commit so it changes existing code to use the
function.  Grepping the code for ‘Xml.xpathobj_nr_nodes.*- 1’ shows
some candidates.  In v2v/output_libvirt.ml we presently have:

    (* Get guest/features/* nodes. *)
    let obj = Xml.xpath_eval_expression xpathctx "features/*" in

    let features = ref [] in
    for i = 0 to Xml.xpathobj_nr_nodes obj - 1 do
      let feature_node = Xml.xpathobj_node obj i in
      let feature_name = Xml.node_name feature_node in
      push_front feature_name features
    done;
    !features

I think this can be rewritten as:

    (* Get guest/features/* nodes. *)
    let features = xpath_get_nodes xpathctx "features/*" in
    let features = List.map Xml.node_name features in

Rich.

-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
libguestfs lets you edit virtual machines.  Supports shell scripting,
bindings from many languages.  http://libguestfs.org

On Thu, Oct 05, 2017 at 04:58:28PM +0200, Cédric Bosdonnat
wrote:
> +open OUnit2
> +open Printf
> +open Unix_utils
> +open Common_utils
We normally separate out the headers according to whether they are
part of the OCaml stdlib, an external library, or our own library.
Therefore I'd write this as:

open Printf

open OUnit2

open Std_utils
open Tools_utils
open Unix_utils
> +let tmpdir = Mkdtemp.temp_dir "guestfs-tests." "";;
> +rmdir_on_exit tmpdir
This is OK, but perhaps more stylish to avoid ‘;;’ by writing:

let tmpdir   let tmpdir = Mkdtemp.temp_dir "guestfs-tests."
"" in
  rmdir_on_exit tmpdir;
  tmpdir
> +(* Utils. *)
> +let write_entries file entries > +  let chan = open_out (tmpdir //
file) in
> +  List.iter (
> +    fun (entry) ->
> +      Index_parser.write_entry chan entry;
> +  ) entries;
You don't need parentheses around ‘(entry)’.  In any case these 4
lines can be written much more briefly using currying:

  List.iter (Index_parser.write_entry chan) entries;

(https://ocaml.org/learn/tutorials/functional_programming.html#Partial-function-applications-and-currying)

Rich.

-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
Fedora Windows cross-compiler. Compile Windows programs, test, and
build Windows installers. Over 100 libraries supported.
http://fedoraproject.org/wiki/MinGW

On Thu, Oct 05, 2017 at 04:58:28PM +0200, Cédric Bosdonnat
wrote:
> +let write_entry chan (name, { Index.printable_name = printable_name;
> +                              file_uri = file_uri;
> +                              arch = arch;
> +                              osinfo = osinfo;
> +                              signature_uri = signature_uri;
> +                              checksums = checksums;
> +                              revision = revision;
> +                              format = format;
> +                              size = size;
> +                              compressed_size = compressed_size;
> +                              expand = expand;
> +                              lvexpand = lvexpand;
> +                              notes = notes;
> +                              aliases = aliases;
> +                              hidden = hidden }) 
Since commit c7651744da455a00a7abeb930621c50bfb23c40c we've moved the
base OCaml compiler version forwards, allowing this to be written much
more concisely as:

let write_entry chan (name, { Index.printable_name; file_uri; arch; osinfo;
                              signature_uri; checksums; revision; format;
                              size; compressed_size; expand; lvexpand;
                              notes; aliases; hidden }) 

Rich.

-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
libguestfs lets you edit virtual machines.  Supports shell scripting,
bindings from many languages.  http://libguestfs.org

On Thu, Oct 05, 2017 at 04:58:25PM +0200, Cédric Bosdonnat
wrote:
> +let rec iterate_db fn > +  let locations = ref [] in
> +
> +  (* (1) Try the shared osinfo directory, using either the
> +   * $OSINFO_SYSTEM_DIR envvar or its default value.
> +   *)
> +  let () > +    let dir > +      try Sys.getenv
"OSINFO_SYSTEM_DIR"
> +      with Not_found -> "/usr/share/osinfo" in
> +    push_back locations ((dir // "os"),
read_osinfo_db_three_levels)
> +  in
> +
> +  (* (2) Try the libosinfo directory, using the newer three-directory
> +   * layout ($LIBOSINFO_DB_PATH / "os" / $group-ID /
[file.xml]).
> +   *)
> +  let () > +    let path = Osinfo_config.libosinfo_db_path //
"os" in
> +    push_back locations (path, read_osinfo_db_three_levels)
> +  in
> +
> +  (* (3) Try the libosinfo directory, using the old flat directory
> +   * layout ($LIBOSINFO_DB_PATH / "oses" / [file.xml]).
> +   *)
> +  let () > +    let path = Osinfo_config.libosinfo_db_path //
"oses" in
> +    push_back locations (path, read_osinfo_db_flat)
> +  in
> +
> +  let rec loop = function
> +    | (path, f) :: paths ->
> +      if is_directory path then f fn path
> +      (* This is not an error: RHBZ#948324. *)
> +      else loop paths
> +    | [] -> ()
> +  in
> +
> +  loop !locations
This is just a stylistic thing but it seems as if this could be
written more simply as something like:

  let locations     let dir       try Sys.getenv "OSINFO_SYSTEM_DIR"
      with Not_found -> "/usr/share/osinfo" in
    ((dir // "os"), read_osinfo_db_three_levels) @
    ... same for the other two cases ...

You might or might not need parens around the (let dir = ...) @

The rest of the commit seems fine.

Rich.
> +and read_osinfo_db_three_levels fn path > +  debug "osinfo:
loading 3-level-directories database from %s" path;
> +  let entries = Array.to_list (Sys.readdir path) in
> +  let entries = List.map ((//) path) entries in
> +  (* Iterate only on directories. *)
> +  let entries = List.filter is_directory entries in
> +  List.iter (read_osinfo_db_directory fn) entries
> +
> +and read_osinfo_db_flat fn path > +  debug "osinfo: loading flat
database from %s" path;
> +  read_osinfo_db_directory fn path
> +
> +and read_osinfo_db_directory fn path > +  let entries = Array.to_list
(Sys.readdir path) in
> +  let entries = List.filter (fun x -> Filename.check_suffix x
".xml") entries in
> +  let entries = List.map ((//) path) entries in
> +  let entries = List.filter is_regular_file entries in
> +  List.iter fn entries
> +
> diff --git a/builder/osinfo.mli b/builder/osinfo.mli
> new file mode 100644
> index 000000000..949d776a9
> --- /dev/null
> +++ b/builder/osinfo.mli
> @@ -0,0 +1,22 @@
> +(* virt-builder
> + * Copyright (C) 2017 Red Hat Inc.
> + *
> + * This program is free software; you can redistribute it and/or modify
> + * it under the terms of the GNU General Public License as published by
> + * the Free Software Foundation; either version 2 of the License, or
> + * (at your option) any later version.
> + *
> + * This program is distributed in the hope that it will be useful,
> + * but WITHOUT ANY WARRANTY; without even the implied warranty of
> + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
> + * GNU General Public License for more details.
> + *
> + * You should have received a copy of the GNU General Public License along
> + * with this program; if not, write to the Free Software Foundation, Inc.,
> + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
> + *)
> +
> +val iterate_db : (string -> unit) -> unit
> +(** [iterate_db fun] iterates over the osinfo-db/libosinfo database
> +    of OS definitions, invoking the specified [fun] on each XML file.
> + *)
> -- 
> 2.13.2
> 
> _______________________________________________
> Libguestfs mailing list
> Libguestfs@redhat.com
> https://www.redhat.com/mailman/listinfo/libguestfs
-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
virt-p2v converts physical machines to virtual machines.  Boot with a
live CD or over the network (PXE) and turn machines into KVM guests.
http://libguestfs.org/virt-v2v

On Thu, Oct 05, 2017 at 04:58:26PM +0200, Cédric Bosdonnat
wrote:
> Rename test-virt-builder-docs.sh into test-docs.sh to include test
> for another tool's documentation.
> ---
>  builder/Makefile.am                                 | 4 ++--
>  builder/{test-virt-builder-docs.sh => test-docs.sh} | 0
>  2 files changed, 2 insertions(+), 2 deletions(-)
>  rename builder/{test-virt-builder-docs.sh => test-docs.sh} (100%)
> 
> diff --git a/builder/Makefile.am b/builder/Makefile.am
> index e315bc785..4a2f639c3 100644
> --- a/builder/Makefile.am
> +++ b/builder/Makefile.am
> @@ -28,7 +28,7 @@ EXTRA_DIST = \
>  	test-simplestreams/streams/v1/index.json \
>  	test-simplestreams/streams/v1/net.cirros-cloud_released_download.json \
>  	test-virt-builder.sh \
> -	test-virt-builder-docs.sh \
> +	test-docs.sh \
>  	test-virt-builder-list.sh \
>  	test-virt-builder-list-simplestreams.sh \
>  	test-virt-builder-planner.sh \
> @@ -262,7 +262,7 @@ yajl_tests_LINK = \
>  	  $(yajl_tests_THEOBJECTS) -o $@
>  
>  TESTS = \
> -	test-virt-builder-docs.sh \
> +	test-docs.sh \
>  	test-virt-builder-list.sh \
>  	test-virt-index-validate.sh \
>  	$(SLOW_TESTS)
> diff --git a/builder/test-virt-builder-docs.sh b/builder/test-docs.sh
> similarity index 100%
> rename from builder/test-virt-builder-docs.sh
> rename to builder/test-docs.sh
> -- 
I pushed this change.

Rich.

-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
virt-top is 'top' for virtual machines.  Tiny program with many
powerful monitoring features, net stats, disk stats, logging, etc.
http://people.redhat.com/~rjones/virt-top

On Thu, Oct 05, 2017 at 04:58:27PM +0200, Cédric Bosdonnat
wrote:
> get_index now gets a new template parameter. Setting it to true will
> make the index parsing less picky about missing important data. This
> can be used to parse a partial index file.
> ---
>  builder/builder.ml       |  2 +-
>  builder/index_parser.ml  | 26 ++++++++++++++++++--------
>  builder/index_parser.mli |  5 ++++-
>  3 files changed, 23 insertions(+), 10 deletions(-)
> 
> diff --git a/builder/builder.ml b/builder/builder.ml
> index 3d0dbe7a8..a19eb2d7b 100644
> --- a/builder/builder.ml
> +++ b/builder/builder.ml
> @@ -208,7 +208,7 @@ let main () >                                ~tmpdir
in
>            match source.Sources.format with
>            | Sources.FormatNative ->
> -            Index_parser.get_index ~downloader ~sigchecker source
> +            Index_parser.get_index ~downloader ~sigchecker ~template:false
source
>            | Sources.FormatSimpleStreams ->
>              Simplestreams_parser.get_index ~downloader ~sigchecker source
>        ) sources
> diff --git a/builder/index_parser.ml b/builder/index_parser.ml
> index d6a4e2e86..6f611a7f5 100644
> --- a/builder/index_parser.ml
> +++ b/builder/index_parser.ml
> @@ -25,7 +25,7 @@ open Utils
>  open Printf
>  open Unix
>  
> -let get_index ~downloader ~sigchecker { Sources.uri; proxy } > +let
get_index ~downloader ~sigchecker ~template { Sources.uri; proxy }
I don't think this patch is the right approach for reasons given
below.  Notwithstanding that, I would make template into an optional
argument, defaulting to false:

  let get_index ~downloader ~sigchecker ?(template = false)
                { Sources.uri; proxy } 
Then you can remove any place where you've added ‘~template:false’.
>    let corrupt_file () >      error (f_"The index file downloaded
from ‘%s’ is corrupt.\nYou need to ask the supplier of this file to fix it and
upload a fixed version.") uri
>    in
> @@ -99,8 +99,10 @@ let get_index ~downloader ~sigchecker { Sources.uri;
proxy } >            let arch >              try List.assoc
("arch", None) fields
>              with Not_found ->
> -              eprintf (f_"%s: no ‘arch’ entry for ‘%s’\n") prog
n;
> -            corrupt_file () in
> +              if template then "" else (
> +                eprintf (f_"%s: no ‘arch’ entry for ‘%s’\n")
prog n;
> +                corrupt_file ()
> +              ) in
This leaves arch = "", which subverts strong typing.

I think what is really needed is for the Index.index type to be
modified (or even split into two) so that you can express templates vs
full index entries safely.

Can you explain a bit more about why the arch field would not be
present in a template?
>            let signature_uri >              try Some (make_absolute_uri
(List.assoc ("sig", None) fields))
>              with Not_found -> None in
> @@ -112,7 +114,7 @@ let get_index ~downloader ~sigchecker { Sources.uri;
proxy } >            let revision >              try Rev_int
(int_of_string (List.assoc ("revision", None) fields))
>              with
> -            | Not_found -> Rev_int 1
> +            | Not_found -> if template then Rev_int 0 else Rev_int 1
Do you really mean that the revision should default to 0 for templates?
>              | Failure _ ->
>                eprintf (f_"%s: cannot parse ‘revision’ field for
‘%s’\n") prog n;
>                corrupt_file () in
> @@ -122,11 +124,19 @@ let get_index ~downloader ~sigchecker { Sources.uri;
proxy } >              try Int64.of_string (List.assoc ("size",
None) fields)
>              with
>              | Not_found ->
> -              eprintf (f_"%s: no ‘size’ field for ‘%s’\n") prog
n;
> -              corrupt_file ()
> +              if template then
> +                Int64.zero
> +              else (
> +                eprintf (f_"%s: no ‘size’ field for ‘%s’\n")
prog n;
> +                corrupt_file ()
> +              )
>              | Failure _ ->
> -              eprintf (f_"%s: cannot parse ‘size’ field for
‘%s’\n") prog n;
> -              corrupt_file () in
> +              if template then
> +                Int64.zero
> +              else (
> +                eprintf (f_"%s: cannot parse ‘size’ field for
‘%s’\n") prog n;
> +                corrupt_file ()
> +              ) in
Same comment as above - abusing type safety for dubious reasons.

Rich.
>            let compressed_size >              try Some (Int64.of_string
(List.assoc ("compressed_size", None) fields))
>              with
> diff --git a/builder/index_parser.mli b/builder/index_parser.mli
> index b8d8ddf3d..a93e20825 100644
> --- a/builder/index_parser.mli
> +++ b/builder/index_parser.mli
> @@ -16,4 +16,7 @@
>   * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
>   *)
>  
> -val get_index : downloader:Downloader.t -> sigchecker:Sigchecker.t
-> Sources.source -> Index.index
> +val get_index : downloader:Downloader.t -> sigchecker:Sigchecker.t
-> template:bool -> Sources.source -> Index.index
> +(** [get_index download sigchecker template source] will parse the source
> +    index file into an index entry list. If the template flag is set to
> +    true, the parser will be less picky about missing values. *)
> -- 
> 2.13.2
> 
> _______________________________________________
> Libguestfs mailing list
> Libguestfs@redhat.com
> https://www.redhat.com/mailman/listinfo/libguestfs
-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
libguestfs lets you edit virtual machines.  Supports shell scripting,
bindings from many languages.  http://libguestfs.org

On Thu, Oct 05, 2017 at 04:58:30PM +0200, 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.
> ---
>  .gitignore                          |   3 +
>  builder/Makefile.am                 |  86 +++++-
>  builder/repository_main.ml          | 597
++++++++++++++++++++++++++++++++++++
>  builder/test-docs.sh                |   2 +
>  builder/virt-builder-repository.pod | 213 +++++++++++++
You will also need to add references to virt-builder-repository
(man page, tools) in at least:

* docs/guestfs-building.pod in the F<builder> section

* builder/virt-builder.pod man page, in the SEE ALSO section and
  anywhere else in that page that may be appropriate

* lib/guestfs.pod & fish/guestfish.pod

* installcheck.sh.in

Does run.in need to be modified to set the new environment
variables?

Also this new tool lacks any kind of test.

[...]
> +REPOSITORY_SOURCES_C = \
> +	index-scan.c \
> +	index-struct.c \
> +	index-parse.c \
> +	index-parser-c.c \
> +	yajl-c.c
> +
> +
^ Two blank lines here.
>  TESTS_ENVIRONMENT = $(top_builddir)/run --test
> @@ -286,7 +368,7 @@ yajl_tests_LINK = \
>  
>  index_parser_tests_DEPENDENCIES = \
>  	$(index_parser_tests_THEOBJECTS) \
> -	../mllib/mllib.$(MLARCHIVE) \
> +	../common/mltools/mltools.$(MLARCHIVE) \
This looks like a general fix?  Should this go into a separate patch?
> +open StringSet
I'm 99% certain that you shouldn't be opening StringSet.  What
did you need that for?
> +  let gpgkey = match !gpgkey with "" -> None | s -> Some s
in
Using my proposed, not upstream, Option module, you will be able to
write this as:

  let gpgkey = Option.default "" !gpgkey in
> +  let no_compression = !no_compression in
Double negatives!  Can this be called ‘compression’ instead?
> +  (* 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.")
OCaml lets you use multiline strings directly:

  | [] ->
     error (f_"Usage: virt-builder-repository /path/to/repo

Use ‘/path/to/repo’ to point to the repository folder.")
> +let increment_revision = function
> +  | Utils.Rev_int n -> Utils.Rev_int (n + 1)
> +  | Utils.Rev_string s -> Utils.Rev_int ((int_of_string s) + 1)
You could probably put this little utility function into builder/utils.ml.
> +let checksums_get_sha512 = function
> +  | None -> Checksums.SHA512 ""
> +  | Some csums ->
> +      try
> +        List.find (
> +          function
> +          | Checksums.SHA512 _ -> true
> +          | _ -> false
> +        ) csums
> +      with Not_found -> Checksums.SHA512 ""
This looks like you're subverting type safety.  There shouldn't be any
case where SHA512 is an empty string.  If you meant "I want to return
nothing from this function", then make the function return an option
type.
> +let osinfo_ids = ref None
> +
> +let osinfo_get_short_ids () > +  match !osinfo_ids with
> +  | Some ids -> ids
> +  | None -> (
> +    let set = ref StringSet.empty in
> +    Osinfo.iterate_db (
> +      fun filepath ->
> +        let doc = Xml.parse_file filepath in
> +        let xpathctx = Xml.xpath_new_context doc in
> +        let nodes = xpath_get_nodes xpathctx
"/libosinfo/os/short-id" in
> +        List.iter (
> +          fun node ->
> +            let id = Xml.node_as_string node in
> +            set := StringSet.add id !set
> +        ) nodes
> +    );
> +    osinfo_ids := Some (!set);
> +    !set
> +  )
If the Osinfo module implemented a ‘fold’ function (instead of iter)
then you could write this much more conveniently.  It would be
something like:

  let set = Osinfo.fold (fun set filepath -> ...) StringSet.empty in

where the ‘...’ bit non-imperatively updates ‘set’.
> +let compress_to file outdir 
I reviewed up to this function.  Will come back to this later.

Rich.

-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
libguestfs lets you edit virtual machines.  Supports shell scripting,
bindings from many languages.  http://libguestfs.org