Cédric Bosdonnat
2017-Sep-20 14:07 UTC
[Libguestfs] [PATCH v10 0/6] virt-builder-repository
Hi all,
Diff to v9 includes the changes requested by Pino.
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 ++++++++
mllib/xpath_helpers.ml | 9 +
mllib/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
Cédric Bosdonnat
2017-Sep-20 14:07 UTC
[Libguestfs] [PATCH v10 1/6] builder: add simple OCaml osinfo-db reader
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 302aa2d81..faf6068fa 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 64cb20ade..76e6d4f3a 100644 --- a/builder/Makefile.am +++ b/builder/Makefile.am @@ -207,6 +207,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-20 14:07 UTC
[Libguestfs] [PATCH v10 2/6] 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 76e6d4f3a..38f4c6968 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 \
@@ -256,7 +256,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-20 14:07 UTC
[Libguestfs] [PATCH v10 3/6] 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 | 5 ++++-
3 files changed, 23 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..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
Cédric Bosdonnat
2017-Sep-20 14:07 UTC
[Libguestfs] [PATCH v10 4/6] 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 faf6068fa..9ee28181e 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 38f4c6968..2af44ecd3 100644
--- a/builder/Makefile.am
+++ b/builder/Makefile.am
@@ -233,13 +233,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 = \
@@ -255,6 +278,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 \
@@ -268,8 +300,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 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
Cédric Bosdonnat
2017-Sep-20 14:07 UTC
[Libguestfs] [PATCH v10 5/6] 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-20 14:07 UTC
[Libguestfs] [PATCH v10 6/6] New tool: virt-builder-repository
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 | 84 ++++-
builder/repository_main.ml | 597 ++++++++++++++++++++++++++++++++++++
builder/test-docs.sh | 2 +
builder/virt-builder-repository.pod | 213 +++++++++++++
5 files changed, 898 insertions(+), 1 deletion(-)
create mode 100644 builder/repository_main.ml
create mode 100644 builder/virt-builder-repository.pod
diff --git a/.gitignore b/.gitignore
index 9ee28181e..24b95944a 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 2af44ecd3..c9a5e8088 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 = \
@@ -114,12 +150,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 \
@@ -151,12 +206,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) \
@@ -177,6 +235,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
@@ -195,6 +263,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..96abf9853
--- /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 Common_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