thr3ads.net - Libguestfs - [Libguestfs] [PATCH v8 6/7] mllib: add XPath helper xpath_get

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

Cédric Bosdonnat

2017-Sep-12 07:03 UTC

[Libguestfs] [PATCH v8 0/7] virt-builder-repository tool

Hi all,

Here is the latest iteration on the virt-builder-repository
series. Diffs to previous version are: fixing things mentioned
by Pino, integrate Pino's osinfo ocaml iterator and adding a
check of the mime type to filter potential image files.

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

Pino Toscano (1):
  ocaml osinfo database iterator

 .gitignore                                         |   5 +
 builder/Makefile.am                                | 133 ++++-
 builder/builder.ml                                 |   2 +-
 builder/index.mli                                  |   3 +
 builder/index_parser.ml                            |  80 ++-
 builder/index_parser.mli                           |   8 +-
 builder/index_parser_tests.ml                      | 129 +++++
 builder/osinfo.ml                                  |  80 +++
 builder/osinfo.mli                                 |  22 +
 builder/repository_main.ml                         | 590 +++++++++++++++++++++
 .../{test-virt-builder-docs.sh => test-docs.sh}    |   2 +
 builder/virt-builder-repository.pod                | 213 ++++++++
 mllib/common_utils.ml                              |   6 +
 mllib/common_utils.mli                             |   3 +
 mllib/xpath_helpers.ml                             |   9 +
 mllib/xpath_helpers.mli                            |   4 +
 16 files changed, 1272 insertions(+), 17 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

Cédric Bosdonnat

2017-Sep-12 07:03 UTC

head link

[Libguestfs] [PATCH v8 1/7] ocaml osinfo database iterator

From: Pino Toscano <ptoscano@redhat.com>

The C osinfo database parser has been deprecated, reimplement the base
of it in ocaml for virt-builder-repository to use. This provides an
Osinfo.iterate_db() function traversing the files of the osinfo database
and calling a function on each of them.
---
 .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 4d738d10f..2eb7a8099 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 e1c7bd016..cb3e0a055 100644
--- a/builder/Makefile.am
+++ b/builder/Makefile.am
@@ -208,6 +208,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..6c0361100
--- /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 Common_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

Cédric Bosdonnat

2017-Sep-12 07:03 UTC

head link

[Libguestfs] [PATCH v8 2/7] builder: rename docs test script

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 cb3e0a055..cd653dcd3 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 \
@@ -257,7 +257,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

Cédric Bosdonnat

2017-Sep-12 07:03 UTC

head link

[Libguestfs] [PATCH v8 3/7] builder: add a template parameter to get_index

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 |  4 +++-
 3 files changed, 22 insertions(+), 10 deletions(-)

diff --git a/builder/builder.ml b/builder/builder.ml
index 3c1f04c77..0bb145466 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 fb546831f..02c124df3 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
+let get_index ~downloader ~sigchecker ~template
   { Sources.uri = uri; proxy = 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
@@ -100,8 +100,10 @@ let get_index ~downloader ~sigchecker
           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
@@ -113,7 +115,7 @@ let get_index ~downloader ~sigchecker
           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
@@ -123,11 +125,19 @@ let get_index ~downloader ~sigchecker
             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..aa5f84730 100644
--- a/builder/index_parser.mli
+++ b/builder/index_parser.mli
@@ -16,4 +16,6 @@
  * 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 source] will parse the source index file
+     into an index entry list. *)
-- 
2.13.2

Cédric Bosdonnat

2017-Sep-12 07:03 UTC

head link

[Libguestfs] [PATCH v8 4/7] builder: add Index.write_entry function

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 2eb7a8099..c6de3e80e 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 cd653dcd3..59de42a57 100644
--- a/builder/Makefile.am
+++ b/builder/Makefile.am
@@ -234,13 +234,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 = \
@@ -256,6 +279,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 \
@@ -269,8 +301,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 02c124df3..3987cc385 100644
--- a/builder/index_parser.ml
+++ b/builder/index_parser.ml
@@ -237,3 +237,57 @@ let get_index ~downloader ~sigchecker ~template
   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 aa5f84730..ae757ad6f 100644
--- a/builder/index_parser.mli
+++ b/builder/index_parser.mli
@@ -19,3 +19,7 @@
 val get_index : downloader:Downloader.t -> sigchecker:Sigchecker.t ->
template:bool -> Sources.source -> Index.index
 (** [get_index download sigchecker source] will parse the source index file
      into an index entry list. *)
+
+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

Cédric Bosdonnat

2017-Sep-12 07:03 UTC

head link

[Libguestfs] [PATCH v8 5/7] mllib: add do_mv helper function to Common_utils

---
 mllib/common_utils.ml  | 6 ++++++
 mllib/common_utils.mli | 3 +++
 2 files changed, 9 insertions(+)

diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml
index 597128967..1126f233b 100644
--- a/mllib/common_utils.ml
+++ b/mllib/common_utils.ml
@@ -561,3 +561,9 @@ let inspect_decrypt g     * function.
    *)
   c_inspect_decrypt g#ocaml_handle (Guestfs.c_pointer g#ocaml_handle)
+
+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
diff --git a/mllib/common_utils.mli b/mllib/common_utils.mli
index fa4d15054..2c9d30a99 100644
--- a/mllib/common_utils.mli
+++ b/mllib/common_utils.mli
@@ -170,3 +170,6 @@ val inspect_decrypt : Guestfs.guestfs -> unit
 (** Simple implementation of decryption: look for any [crypto_LUKS]
     partitions and decrypt them, then rescan for VGs.  This only works
     for Fedora whole-disk encryption. *)
+
+val do_mv : string -> string -> unit
+(** Run the mv command, and exit with an error if it failed *)
-- 
2.13.2

Cédric Bosdonnat

2017-Sep-12 07:03 UTC

head link

[Libguestfs] [PATCH v8 6/7] mllib: add XPath helper xpath_get_nodes()

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

diff --git a/mllib/xpath_helpers.ml b/mllib/xpath_helpers.ml
index e6185bf3d..eb655e1fe 100644
--- a/mllib/xpath_helpers.ml
+++ b/mllib/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/mllib/xpath_helpers.mli b/mllib/xpath_helpers.mli
index 7434ba645..83c770281 100644
--- a/mllib/xpath_helpers.mli
+++ b/mllib/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

Cédric Bosdonnat

2017-Sep-12 07:03 UTC

head link

[Libguestfs] [PATCH v8 7/7] Add a virt-builder-repository tool

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

diff --git a/.gitignore b/.gitignore
index c6de3e80e..079e78273 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 59de42a57..5647ebce1 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,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 = \
@@ -101,8 +137,7 @@ virt_builder_CPPFLAGS = \
 	-I$(shell $(OCAMLC) -where) \
 	-I$(top_srcdir)/gnulib/lib \
 	-I$(top_srcdir)/common/utils \
-	-I$(top_srcdir)/lib \
-	-I$(top_srcdir)/fish
+	-I$(top_srcdir)/lib
 virt_builder_CFLAGS = \
 	-pthread \
 	$(WARN_CFLAGS) $(WERROR_CFLAGS) \
@@ -115,12 +150,33 @@ 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 \
+	-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)
+
 # -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 \
@@ -152,12 +208,15 @@ OCAMLFLAGS = $(OCAML_FLAGS) $(OCAML_WARN_ERROR)
 
 if !HAVE_OCAMLOPT
 OBJECTS = $(BOBJECTS)
+REPOSITORY_OBJECTS = $(REPOSITORY_BOBJECTS)
 else
 OBJECTS = $(XOBJECTS)
+REPOSITORY_OBJECTS = $(REPOSITORY_XOBJECTS)
 endif
 
 OCAMLLINKFLAGS = \
 	mlpcre.$(MLARCHIVE) \
+	mlxml.$(MLARCHIVE) \
 	mlstdutils.$(MLARCHIVE) \
 	mlguestfs.$(MLARCHIVE) \
 	mlcutils.$(MLARCHIVE) \
@@ -178,6 +237,16 @@ virt_builder_LINK = \
 	  $(OCAMLFIND) $(BEST) $(OCAMLFLAGS) $(OCAMLPACKAGES) $(OCAMLLINKFLAGS) \
 	  $(OBJECTS) -o $@
 
+virt_builder_repository_DEPENDENCIES = \
+	$(REPOSITORY_OBJECTS) \
+	../mllib/mllib.$(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
@@ -196,6 +265,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
diff --git a/builder/repository_main.ml b/builder/repository_main.ml
new file mode 100644
index 000000000..ee2c795a8
--- /dev/null
+++ b/builder/repository_main.ml
@@ -0,0 +1,590 @@
+(* 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 Common_utils
+open Unix_utils
+open Getopt.OptionName
+open Utils
+open Yajl
+open Xpath_helpers
+
+open Printf
+
+module StringSet = Set.Make(String)
+
+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 ->
+    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 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 " ^
(quote filepath) in
+  let output = List.hd (external_command file_cmd) in
+  let _, mime = String.split ":" output in
+  String.trim mime
+
+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.UnsetProxy } 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.UnsetProxy })
+  )
+
+let main () +  let cmdline = parse_cmdline () in
+
+  (* If debugging, echo the command line arguments. *)
+  debug "command line: %s\n" (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 ...\n";
+
+  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 -> (get_mime_type file) = "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 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 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..585d39437
--- /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 ".xz"
+suffix if the C<--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
+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@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
+C<--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

Pino Toscano

2017-Sep-14 15:00 UTC

head link

Re: [Libguestfs] [PATCH v8 1/7] ocaml osinfo database iterator

On Tuesday, 12 September 2017 09:03:08 CEST Cédric Bosdonnat
wrote:> From: Pino Toscano <ptoscano@redhat.com>
> 
> The C osinfo database parser has been deprecated, reimplement the base
> of it in ocaml for virt-builder-repository to use. This provides an
> Osinfo.iterate_db() function traversing the files of the osinfo database
> and calling a function on each of them.
> ---
Since I contributed this bit, I guess I can provide also a commit
message:

  builder: add simple OCaml osinfo-db reader

  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 suppors the old libosinfo db.
> --- /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 Common_utils
> +open Osinfo_config
We can add some comment here:

  (*
   * This module deals with the osinfo-db, so we can get information on
   * e.g. the distributions provided by the database.
   *
   * Try to use the shared osinfo database layout (and location) first:
   * https://gitlab.com/libosinfo/libosinfo/blob/master/docs/database-layout.txt
   *)
> +
> +let rec iterate_db fn > +  let locations = ref [] in
> [...]
The rest LGTM.

-- 
Pino Toscano

Pino Toscano

2017-Sep-14 15:01 UTC

head link

Re: [Libguestfs] [PATCH v8 5/7] mllib: add do_mv helper function to Common_utils

On Tuesday, 12 September 2017 09:03:12 CEST Cédric Bosdonnat
wrote:> ---
>  mllib/common_utils.ml  | 6 ++++++
>  mllib/common_utils.mli | 3 +++
>  2 files changed, 9 insertions(+)
Since it is used only in virt-builder-repository ATM, I'd put it there
(it can be always easily moved to Std_utils / Common_utils).
> +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
Since this patch was done, Rich introduced Unicode quotes, so:

  error (f_"moving file ‘%s’ to ‘%s’ failed") src dest
> +val do_mv : string -> string -> unit
> +(** Run the mv command, and exit with an error if it failed *)
Nitpick: missing period at the end of the sentence.

-- 
Pino Toscano

Pino Toscano

2017-Sep-15 14:24 UTC

head link

Re: [Libguestfs] [PATCH v8 7/7] Add a virt-builder-repository tool

On Tuesday, 12 September 2017 09:03:14 CEST 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.
> ---
Since this patch was done, Rich introduced Unicode quotes, so
- '%s'/'...' -> ‘%s’/‘...’
- don't/etc'etera -> don’t/etc’etera
and so on -- mostly in error/etc messages, and documentation

This looks almost like the last version I reviewed; will give a test
run on Monday.

A minor note on the commit message: I'd use
  New tool: virt-builder-repository
which is what was used in the past for other tools (so it makes it
sligtly easier to search for that).
> @@ -101,8 +137,7 @@ virt_builder_CPPFLAGS = \
>  	-I$(shell $(OCAMLC) -where) \
>  	-I$(top_srcdir)/gnulib/lib \
>  	-I$(top_srcdir)/common/utils \
> -	-I$(top_srcdir)/lib \
> -	-I$(top_srcdir)/fish
> +	-I$(top_srcdir)/lib
Extra change, can go in directly if split as own commit.
> +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 \
> +	-I$(top_srcdir)/fish
guestfish is needed here?
> +module StringSet = Set.Make(String)
This is now provided by mlstdutils.
> +let increment_revision = function
> +  | Utils.Rev_int n -> Utils.Rev_int (n + 1)
> +  | Utils.Rev_string s ->
> +    if Str.string_match (Str.regexp
"^\\(.*[-._]\\)\\([0-9]+\\)$") s 0 then
There's a PCRE OCaml module now, so maybe it could be a better choice
here (and make the regexp less ugly).
> +let get_mime_type filepath > +  let file_cmd = "file --mime-type
" ^ (quote filepath) in
> +  let output = List.hd (external_command file_cmd) in
> +  let _, mime = String.split ":" output in
> +  String.trim mime
- passing --brief removes the filename from the output, and thus the
  need to strip it (which will not work in case the file has a colon in
  the name)
- List.hd will raise an exception if the list is empty (so the command
  produced no output for some reason) -- you might need to check it,
  for example like I did in dib/utils.ml:var_from_lines
> +    printf "%s%s%s" message default_str list_str;
I think it might be a good idea to flush stdout before reading the
answer from the user -- just append "%!" at the end of the format
string.
> +      if x == "" then
You just need '=', as '==' is stronger than that (compares also
object equality).
> +    (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.UnsetProxy })
Most probably it won't change (although I remember a chat on IRC about
different proxy values leading to failures in the unit test added in
patch #4), but better use one (e.g. Curl.SystemProxy) thoroughly.
> +  (* If debugging, echo the command line arguments. *)
> +  debug "command line: %s\n" (String.concat " "
(Array.to_list Sys.argv));
debug already prints the newline at the end of the message. (Also in
other occurrences.)
> +  (* Remove the processed image files *)
> +  if not cmdline.no_compression then
> +      List.iter (
> +        fun filename -> Sys.remove (cmdline.repo // filename)
> +      ) images
Indented twice?
> +The file value needs to match the image name extended with the
".xz"
C<.xz>.
> +suffix if the C<--no-compression> parameter is not provided or the
Options with I<>.
> +To remove an image from the repository, just remove the corresponding
> +compressed image file before running virt-builder-repository.
I'd remove "compressed" here, since both options (compressed, and
not)
are supported.

Thanks,
-- 
Pino Toscano

Possibly Parallel Threads

Search for more apparently analagous threads

Libguestfs - Sep 2017 - [PATCH v8 6/7] mllib: add XPath helper xpath_get_nodes()

[Libguestfs] [PATCH v8 0/7] virt-builder-repository tool

[Libguestfs] [PATCH v8 1/7] ocaml osinfo database iterator

[Libguestfs] [PATCH v8 2/7] builder: rename docs test script

[Libguestfs] [PATCH v8 3/7] builder: add a template parameter to get_index

[Libguestfs] [PATCH v8 4/7] builder: add Index.write_entry function

[Libguestfs] [PATCH v8 5/7] mllib: add do_mv helper function to Common_utils

[Libguestfs] [PATCH v8 6/7] mllib: add XPath helper xpath_get_nodes()

[Libguestfs] [PATCH v8 7/7] Add a virt-builder-repository tool

Re: [Libguestfs] [PATCH v8 1/7] ocaml osinfo database iterator

Re: [Libguestfs] [PATCH v8 5/7] mllib: add do_mv helper function to Common_utils

Re: [Libguestfs] [PATCH v8 7/7] Add a virt-builder-repository tool

Possibly Parallel Threads