Cédric Bosdonnat
2017-Oct-27 14:08 UTC
[Libguestfs] [PATCH v11 0/8] virt-builder-repository
Hi all,
Here is the latest version of the series.
Diffs to v10:
* Make Index.arch a (string, string option) maybe and use it
to guess arch at parse time
* Compute the image size at parse time when the template flag
is set and the value is missing.
* Add virt-repository_main slow test
* Other fixes from Richard's comments
Cédric Bosdonnat (7):
Ignore builder/*.out and *.img files
builder: change arch type to (string, string option) maybe.
builder: add Utils.get_image_infos function
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 | 8 +
builder/Makefile.am | 129 ++++++-
builder/builder.ml | 9 +-
builder/cache.ml | 10 +
builder/cache.mli | 6 +-
builder/downloader.mli | 2 +-
builder/index.ml | 13 +-
builder/index.mli | 10 +-
builder/index_parser.ml | 94 ++++-
builder/index_parser.mli | 9 +-
builder/index_parser_tests.ml | 130 +++++++
builder/list_entries.ml | 16 +-
builder/osinfo.ml | 76 ++++
builder/osinfo.mli | 22 ++
builder/repository_main.ml | 607 ++++++++++++++++++++++++++++++++
builder/simplestreams_parser.ml | 2 +-
builder/test-docs.sh | 2 +
builder/test-virt-builder-repository.sh | 98 ++++++
builder/utils.ml | 10 +
builder/utils.mli | 7 +
builder/virt-builder-repository.pod | 213 +++++++++++
builder/virt-builder.pod | 4 +
common/mltools/xpath_helpers.ml | 9 +
common/mltools/xpath_helpers.mli | 4 +
fish/guestfish.pod | 1 +
installcheck.sh.in | 1 +
lib/guestfs.pod | 1 +
v2v/output_libvirt.ml | 11 +-
v2v/test-harness/v2v_test_harness.ml | 51 +--
29 files changed, 1481 insertions(+), 74 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
create mode 100755 builder/test-virt-builder-repository.sh
create mode 100644 builder/virt-builder-repository.pod
--
2.13.2
Cédric Bosdonnat
2017-Oct-27 14:08 UTC
[Libguestfs] [PATCH v11 1/8] Ignore builder/*.out and *.img files
These ignores are covering test-console-ubuntu-12.04 test data. --- .gitignore | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.gitignore b/.gitignore index 36a193054..54dd5c6d0 100644 --- a/.gitignore +++ b/.gitignore @@ -87,12 +87,14 @@ Makefile.in /build-aux/test-driver /build-aux/ylwrap /builder/.depend +/builder/*.img /builder/index-parse.c /builder/index-parse.h /builder/index-scan.c /builder/libguestfs.conf /builder/opensuse.conf /builder/oUnit-* +/builder/*.out /builder/*.qcow2 /builder/stamp-virt-builder.pod /builder/stamp-virt-index-validate.pod -- 2.13.2
Cédric Bosdonnat
2017-Oct-27 14:08 UTC
[Libguestfs] [PATCH v11 2/8] 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 | 76 +++++++++++++++++++++++++++++++++++++++++++++++++++++
builder/osinfo.mli | 22 ++++++++++++++++
4 files changed, 103 insertions(+)
create mode 100644 builder/osinfo.ml
create mode 100644 builder/osinfo.mli
diff --git a/.gitignore b/.gitignore
index 54dd5c6d0..59bf52f2b 100644
--- a/.gitignore
+++ b/.gitignore
@@ -93,6 +93,7 @@ Makefile.in
/builder/index-scan.c
/builder/libguestfs.conf
/builder/opensuse.conf
+/builder/osinfo_config.ml
/builder/oUnit-*
/builder/*.out
/builder/*.qcow2
diff --git a/builder/Makefile.am b/builder/Makefile.am
index 7aa97e31d..4a2f639c3 100644
--- a/builder/Makefile.am
+++ b/builder/Makefile.am
@@ -213,6 +213,10 @@ CLEANFILES += *.qcow2 *.xz
check_DATA = $(disk_images)
+osinfo_config.ml: Makefile
+ echo 'let libosinfo_db_path = "$(datadir)/libosinfo/db"'
> $@-t
+ mv $@-t $@
+
fedora.qcow2: ../test-data/phony-guests/fedora.img
rm -f $@ $@-t
qemu-img convert -f raw -O qcow2 $< $@-t
diff --git a/builder/osinfo.ml b/builder/osinfo.ml
new file mode 100644
index 000000000..9d1b0169e
--- /dev/null
+++ b/builder/osinfo.ml
@@ -0,0 +1,76 @@
+(* virt-builder
+ * Copyright (C) 2017 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+open Std_utils
+open Tools_utils
+open Osinfo_config
+
+let rec fold fn base + let locations + (* (1) Try the shared osinfo
directory, using either the
+ * $OSINFO_SYSTEM_DIR envvar or its default value.
+ *)
+ let dir + try Sys.getenv "OSINFO_SYSTEM_DIR"
+ with Not_found -> "/usr/share/osinfo" in
+ ((dir // "os"), read_osinfo_db_three_levels) ::
+
+ (* (2) Try the libosinfo directory, using the newer three-directory
+ * layout ($LIBOSINFO_DB_PATH / "os" / $group-ID / [file.xml]).
+ *)
+ let path = Osinfo_config.libosinfo_db_path // "os" in
+ (path, read_osinfo_db_three_levels) ::
+
+ (* (3) Try the libosinfo directory, using the old flat directory
+ * layout ($LIBOSINFO_DB_PATH / "oses" / [file.xml]).
+ *)
+ let path = Osinfo_config.libosinfo_db_path // "oses" in
+ (path, read_osinfo_db_flat) :: [] in
+
+
+ let files + List.flatten (
+ filter_map (
+ fun (path, f) ->
+ if is_directory path then Some (f path)
+ (* This is not an error: RHBZ#948324. *)
+ else None
+ ) locations
+ ) in
+
+ List.fold_left fn base files
+
+and read_osinfo_db_three_levels 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.flatten (List.map read_osinfo_db_directory entries)
+
+and read_osinfo_db_flat path + debug "osinfo: loading flat database from
%s" path;
+ read_osinfo_db_directory path
+
+and read_osinfo_db_directory path + let entries = Sys.readdir path in
+ let entries = Array.to_list entries 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
+ entries
diff --git a/builder/osinfo.mli b/builder/osinfo.mli
new file mode 100644
index 000000000..fa179509d
--- /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 fold : ('a -> string -> 'a) -> 'a -> 'a
+(** [fold f base] folds function [f] over every file in the
+ osinfo-db/libosinfo database of OS definitions.
+ *)
--
2.13.2
Cédric Bosdonnat
2017-Oct-27 14:08 UTC
[Libguestfs] [PATCH v11 3/8] builder: change arch type to (string, string option) maybe.
In a future commit, the index parser will allow arch not to be set
for some cases. In such cases, it will be guessed by inspecting the
image, but we need to distinguish between a set value and a guessed
one. Using the '(string, string option) maybe' type will help it:
match arch with
| Either s -> (* This is a set value *)
| Or Some s -> (* This is a guessed value *)
| Or None -> (* No value and no guess *)
---
builder/builder.ml | 9 ++++++---
builder/cache.ml | 10 ++++++++++
builder/cache.mli | 6 +++---
builder/downloader.mli | 2 +-
builder/index.ml | 13 +++++++++++--
builder/index.mli | 7 ++++++-
builder/index_parser.ml | 2 +-
builder/list_entries.ml | 16 +++++++++++++---
builder/simplestreams_parser.ml | 2 +-
9 files changed, 52 insertions(+), 15 deletions(-)
diff --git a/builder/builder.ml b/builder/builder.ml
index 3f7c79bc9..519cdbc79 100644
--- a/builder/builder.ml
+++ b/builder/builder.ml
@@ -94,7 +94,10 @@ let selected_cli_item cmdline index let item try
List.find (
fun (name, { Index.arch = a }) ->
- name = arg && cmdline.arch = normalize_arch a
+ match a with
+ | Either a
+ | Or Some a -> name = arg && cmdline.arch = normalize_arch a
+ | Or None -> false
) index
with Not_found ->
error (f_"cannot find os-version ‘%s’ with architecture ‘%s’.\nUse
--list to list available guest types.")
@@ -252,7 +255,7 @@ let main () List.iter (
fun (name,
{ Index.revision; file_uri; proxy }) ->
- let template = name, cmdline.arch, revision in
+ let template = name, (Either cmdline.arch), revision in
message (f_"Downloading: %s") file_uri;
let progress_bar = not (quiet ()) in
ignore (Downloader.download downloader ~template ~progress_bar
@@ -300,7 +303,7 @@ let main () let template let template,
delete_on_exit let { Index.revision; file_uri; proxy } = entry in
- let template = arg, cmdline.arch, revision in
+ let template = arg, (Either cmdline.arch), revision in
message (f_"Downloading: %s") file_uri;
let progress_bar = not (quiet ()) in
Downloader.download downloader ~template ~progress_bar ~proxy
diff --git a/builder/cache.ml b/builder/cache.ml
index dbd222fda..c4a6b0578 100644
--- a/builder/cache.ml
+++ b/builder/cache.ml
@@ -41,6 +41,11 @@ let create ~directory }
let cache_of_name t name arch revision + let arch + match arch with
+ | Either arch
+ | Or Some arch -> arch
+ | Or None -> "" in
t.directory // sprintf "%s.%s.%s" name arch (string_of_revision
revision)
let is_cached t name arch revision @@ -54,6 +59,11 @@ let print_item_status t
~header l List.iter (
fun (name, arch, revision) ->
let cached = is_cached t name arch revision in
+ let arch + match arch with
+ | Either arch
+ | Or Some arch -> arch
+ | Or None -> "" in
printf "%-24s %-10s %s\n" name arch
(if cached then s_"cached" else (*s_*)"no")
) l
diff --git a/builder/cache.mli b/builder/cache.mli
index f27fc235b..f88cbdf2f 100644
--- a/builder/cache.mli
+++ b/builder/cache.mli
@@ -27,16 +27,16 @@ type t
val create : directory:string -> t
(** Create the abstract type. *)
-val cache_of_name : t -> string -> string -> Utils.revision ->
string
+val cache_of_name : t -> string -> Index.arch -> Utils.revision ->
string
(** [cache_of_name t name arch revision] return the filename
of the cached file. (Note: It doesn't check if the filename
exists, this is just a simple string transformation). *)
-val is_cached : t -> string -> string -> Utils.revision -> bool
+val is_cached : t -> string -> Index.arch -> Utils.revision -> bool
(** [is_cached t name arch revision] return whether the file with
specified name, architecture and revision is cached. *)
-val print_item_status : t -> header:bool -> (string * string *
Utils.revision) list -> unit
+val print_item_status : t -> header:bool -> (string * Index.arch *
Utils.revision) list -> unit
(** [print_item_status t header items] print the status in the cache
of the specified items (which are tuples of name, architecture,
and revision).
diff --git a/builder/downloader.mli b/builder/downloader.mli
index 7f39f7e36..e2dd49f27 100644
--- a/builder/downloader.mli
+++ b/builder/downloader.mli
@@ -27,7 +27,7 @@ type t
val create : curl:string -> tmpdir:string -> cache:Cache.t option -> t
(** Create the abstract type. *)
-val download : t -> ?template:(string*string*Utils.revision) ->
?progress_bar:bool -> ?proxy:Curl.proxy -> uri -> (filename * bool)
+val download : t -> ?template:(string*Index.arch*Utils.revision) ->
?progress_bar:bool -> ?proxy:Curl.proxy -> uri -> (filename * bool)
(** Download the URI, returning the downloaded filename and a
temporary file flag. The temporary file flag is [true] iff
the downloaded file is temporary and should be deleted by the
diff --git a/builder/index.ml b/builder/index.ml
index 84f66c265..18e653534 100644
--- a/builder/index.ml
+++ b/builder/index.ml
@@ -25,12 +25,18 @@ open Utils
open Printf
open Unix
+
+(* Either string -> value set
+ Or Some string -> value guessed
+ Or None -> value neither set nor guessed
+ *)
+type arch = (string, string option) Std_utils.maybe
type index = (string * entry) list (* string = "os-version" *)
and entry = {
printable_name : string option; (* the name= field *)
osinfo : string option;
file_uri : string;
- arch : string;
+ arch : arch;
signature_uri : string option; (* deprecated, will be removed in 1.26
*)
checksums : Checksums.csum_t list option;
revision : Utils.revision;
@@ -56,7 +62,10 @@ let print_entry chan (name, { printable_name; file_uri; arch;
osinfo;
Option.may (fp "name=%s\n") printable_name;
Option.may (fp "osinfo=%s\n") osinfo;
fp "file=%s\n" file_uri;
- fp "arch=%s\n" arch;
+ match arch with
+ | Either arch
+ | Or Some arch -> fp "arch=%s\n" arch;
+ | Or None -> ();
Option.may (fp "sig=%s\n") signature_uri;
Option.may (
List.iter (
diff --git a/builder/index.mli b/builder/index.mli
index ff5ec4a35..43d5485fb 100644
--- a/builder/index.mli
+++ b/builder/index.mli
@@ -16,12 +16,17 @@
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
*)
+(* Either string -> value set
+ Or Some string -> value guessed
+ Or None -> value neither set nor guessed
+ *)
+type arch = (string, string option) Std_utils.maybe
type index = (string * entry) list (* string = "os-version" *)
and entry = {
printable_name : string option; (* the name= field *)
osinfo : string option;
file_uri : string;
- arch : string;
+ arch : arch;
signature_uri : string option; (* deprecated, will be removed in 1.26
*)
checksums : Checksums.csum_t list option;
revision : Utils.revision;
diff --git a/builder/index_parser.ml b/builder/index_parser.ml
index d6a4e2e86..c715ccac7 100644
--- a/builder/index_parser.ml
+++ b/builder/index_parser.ml
@@ -97,7 +97,7 @@ let get_index ~downloader ~sigchecker { Sources.uri; proxy }
eprintf (f_"%s: no ‘file’ (URI) entry for ‘%s’\n") prog n;
corrupt_file () in
let arch - try List.assoc ("arch", None) fields
+ try Either (List.assoc ("arch", None) fields)
with Not_found ->
eprintf (f_"%s: no ‘arch’ entry for ‘%s’\n") prog n;
corrupt_file () in
diff --git a/builder/list_entries.ml b/builder/list_entries.ml
index af1d2419b..54983df8d 100644
--- a/builder/list_entries.ml
+++ b/builder/list_entries.ml
@@ -46,7 +46,10 @@ and list_entries_short index fun (name, {
Index.printable_name; arch; hidden }) ->
if not hidden then (
printf "%-24s" name;
- printf " %-10s" arch;
+ match arch with
+ | Either arch
+ | Or Some arch -> printf " %-10s" arch
+ | Or None -> ();
Option.may (printf " %s") printable_name;
printf "\n"
)
@@ -74,7 +77,10 @@ and list_entries_long ~sources index if not hidden
then (
printf "%-24s %s\n" "os-version:" name;
Option.may (printf "%-24s %s\n" (s_"Full name:"))
printable_name;
- printf "%-24s %s\n" (s_"Architecture:") arch;
+ match arch with
+ | Either arch
+ | Or Some arch -> printf "%-24s %s\n"
(s_"Architecture:") arch
+ | Or None -> ();
printf "%-24s %s\n" (s_"Minimum/default size:")
(human_size size);
Option.may (fun size ->
printf "%-24s %s\n" (s_"Download size:")
(human_size size)
@@ -116,7 +122,11 @@ and list_entries_json ~sources index match
printable_name with
| None -> item
| Some str -> ("full-name", JSON.String str) :: item in
- let item = ("arch", JSON.String arch) :: item in
+ let item + match arch with
+ | Either arch
+ | Or Some arch -> ("arch", JSON.String arch) :: item
+ | Or None -> item in
let item = ("size", JSON.Int64 size) :: item in
let item match compressed_size with
diff --git a/builder/simplestreams_parser.ml b/builder/simplestreams_parser.ml
index 75592e377..10721e49c 100644
--- a/builder/simplestreams_parser.ml
+++ b/builder/simplestreams_parser.ml
@@ -83,7 +83,7 @@ let get_index ~downloader ~sigchecker { Sources.uri; proxy }
let products = Array.to_list products_node in
filter_map (
fun (prod, prod_desc) ->
- let arch = object_get_string "arch" prod_desc in
+ let arch = Either (object_get_string "arch" prod_desc) in
let prods = Array.to_list (object_get_object "versions"
prod_desc) in
let prods = filter_map (
fun (rel, rel_desc) ->
--
2.13.2
Cédric Bosdonnat
2017-Oct-27 14:08 UTC
[Libguestfs] [PATCH v11 4/8] builder: add Utils.get_image_infos function
This helper function calls qemu-img info on an image file and
returns the output as a JSON Yajl tree.
This function will be used in future commits.
---
builder/Makefile.am | 2 +-
builder/utils.ml | 6 ++++++
builder/utils.mli | 4 ++++
3 files changed, 11 insertions(+), 1 deletion(-)
diff --git a/builder/Makefile.am b/builder/Makefile.am
index 4a2f639c3..88392d327 100644
--- a/builder/Makefile.am
+++ b/builder/Makefile.am
@@ -61,12 +61,12 @@ SOURCES_MLI = \
yajl.mli
SOURCES_ML = \
+ yajl.ml \
utils.ml \
pxzcat.ml \
setlocale.ml \
index.ml \
ini_reader.ml \
- yajl.ml \
paths.ml \
languages.ml \
cache.ml \
diff --git a/builder/utils.ml b/builder/utils.ml
index acb6c2f4b..9fceee282 100644
--- a/builder/utils.ml
+++ b/builder/utils.ml
@@ -33,3 +33,9 @@ and revision let string_of_revision = function
| Rev_int n -> string_of_int n
| Rev_string s -> s
+
+let get_image_infos filepath + let qemuimg_cmd = "qemu-img info --output
json " ^ (Std_utils.quote filepath) in
+ let lines = external_command qemuimg_cmd in
+ let line = String.concat "\n" lines in
+ Yajl.yajl_tree_parse line
diff --git a/builder/utils.mli b/builder/utils.mli
index 45385f713..4acde9f36 100644
--- a/builder/utils.mli
+++ b/builder/utils.mli
@@ -28,3 +28,7 @@ and revision
val string_of_revision : revision -> string
(** Convert a {!revision} into a string. *)
+
+val get_image_infos : string -> Yajl.yajl_val
+(** [get_image_infos path] Run qemu-img info on the image pointed at
+ path as YAJL tree. *)
--
2.13.2
Cédric Bosdonnat
2017-Oct-27 14:08 UTC
[Libguestfs] [PATCH v11 5/8] 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/index_parser.ml | 46 ++++++++++++++++++++++++++++++++++++++--------
builder/index_parser.mli | 5 ++++-
2 files changed, 42 insertions(+), 9 deletions(-)
diff --git a/builder/index_parser.ml b/builder/index_parser.ml
index c715ccac7..7f64d0d98 100644
--- a/builder/index_parser.ml
+++ b/builder/index_parser.ml
@@ -25,7 +25,7 @@ open Utils
open Printf
open Unix
-let get_index ~downloader ~sigchecker { Sources.uri; proxy } +let get_index
~downloader ~sigchecker ?(template = false) { Sources.uri; proxy } let
corrupt_file () error (f_"The index file downloaded from ‘%s’ is
corrupt.\nYou need to ask the supplier of this file to fix it and upload a fixed
version.") uri
in
@@ -99,8 +99,25 @@ let get_index ~downloader ~sigchecker { Sources.uri; proxy }
let arch try Either (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
+ try
+ let g = new Guestfs.guestfs () in
+ g#add_drive_ro file_uri;
+ g#launch ();
+ let roots = g#inspect_os () in
+ let nroots = Array.length roots in
+ if nroots <> 1 then (
+ eprintf (f_"%s: no ‘arch’ entry for %s and failed to
guess it\n") prog n;
+ corrupt_file ()
+ );
+ let inspected_arch = g#inspect_get_arch (Array.get roots 0)
in
+ g#close();
+ Or (Some inspected_arch)
+ with exn -> Or None
+ else (
+ eprintf (f_"%s: no ‘arch’ entry for ‘%s’\n") prog n;
+ corrupt_file ()
+ ) in
let signature_uri try Some (make_absolute_uri
(List.assoc ("sig", None) fields))
with Not_found -> None in
@@ -112,21 +129,34 @@ let get_index ~downloader ~sigchecker { Sources.uri; proxy
} let revision try Rev_int (int_of_string (List.assoc
("revision", None) fields))
with
- | Not_found -> Rev_int 1
+ | Not_found -> if template then Rev_int 0 else Rev_int 1
| Failure _ ->
eprintf (f_"%s: cannot parse ‘revision’ field for
‘%s’\n") prog n;
corrupt_file () in
let format try Some (List.assoc ("format",
None) fields) with Not_found -> None in
let size + let get_image_size filepath + (*
If a compressed image manages to reach this code, qemu-img just
+ returns a virtual-size equal to actual-size *)
+ let infos = Utils.get_image_infos filepath in
+ Yajl.object_get_number "virtual-size" infos in
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
+ get_image_size file_uri
+ 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
+ get_image_size file_uri
+ 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..324f4fc5a 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-Oct-27 14:08 UTC
[Libguestfs] [PATCH v11 6/8] 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 | 46 +++++++++++++++
builder/index_parser.mli | 4 ++
builder/index_parser_tests.ml | 130 ++++++++++++++++++++++++++++++++++++++++++
6 files changed, 218 insertions(+), 2 deletions(-)
create mode 100644 builder/index_parser_tests.ml
diff --git a/.gitignore b/.gitignore
index 59bf52f2b..30165d59e 100644
--- a/.gitignore
+++ b/.gitignore
@@ -108,6 +108,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 88392d327..e4a347a09 100644
--- a/builder/Makefile.am
+++ b/builder/Makefile.am
@@ -239,13 +239,36 @@ yajl_tests_BOBJECTS = \
yajl_tests.cmo
yajl_tests_XOBJECTS = $(yajl_tests_BOBJECTS:.cmo=.cmx)
+index_parser_tests_SOURCES = \
+ index-scan.c \
+ index-struct.c \
+ index-parser-c.c \
+ index-parse.c
+index_parser_tests_CPPFLAGS = $(virt_builder_CPPFLAGS)
+index_parser_tests_BOBJECTS = \
+ utils.cmo \
+ cache.cmo \
+ downloader.cmo \
+ sigchecker.cmo \
+ index.cmo \
+ ini_reader.cmo \
+ index_parser.cmo \
+ index_parser_tests.cmo
+index_parser_tests_XOBJECTS = $(index_parser_tests_BOBJECTS:.cmo=.cmx)
+
# Can't call the following as <test>_OBJECTS because automake gets
confused.
if HAVE_OCAMLOPT
yajl_tests_THEOBJECTS = $(yajl_tests_XOBJECTS)
yajl_tests.cmx: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
+
+index_parser_tests_THEOBJECTS = $(index_parser_tests_XOBJECTS)
+index_parser_tests.cmx: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
else
yajl_tests_THEOBJECTS = $(yajl_tests_BOBJECTS)
yajl_tests.cmo: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
+
+index_parser_tests_THEOBJECTS = $(index_parser_tests_BOBJECTS)
+index_parser_tests.cmo: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
endif
yajl_tests_DEPENDENCIES = \
@@ -261,6 +284,15 @@ yajl_tests_LINK = \
$(OCAMLFIND) $(BEST) $(OCAMLFLAGS) $(OCAMLPACKAGES) $(OCAMLPACKAGES_TESTS)
$(OCAMLLINKFLAGS) \
$(yajl_tests_THEOBJECTS) -o $@
+index_parser_tests_DEPENDENCIES = \
+ $(index_parser_tests_THEOBJECTS) \
+ ../common/mltools/mltools.$(MLARCHIVE) \
+ $(top_srcdir)/ocaml-link.sh
+index_parser_tests_LINK = \
+ $(top_srcdir)/ocaml-link.sh -cclib '$(OCAMLCLIBS)' -- \
+ $(OCAMLFIND) $(BEST) $(OCAMLFLAGS) $(OCAMLPACKAGES) $(OCAMLPACKAGES_TESTS)
$(OCAMLLINKFLAGS) \
+ $(index_parser_tests_THEOBJECTS) -o $@
+
TESTS = \
test-docs.sh \
test-virt-builder-list.sh \
@@ -274,8 +306,8 @@ if ENABLE_APPLIANCE
TESTS += test-virt-builder.sh
endif ENABLE_APPLIANCE
if HAVE_OCAML_PKG_OUNIT
-check_PROGRAMS += yajl_tests
-TESTS += yajl_tests
+check_PROGRAMS += yajl_tests index_parser_tests
+TESTS += yajl_tests index_parser_tests
endif
check-valgrind:
diff --git a/builder/index.mli b/builder/index.mli
index 43d5485fb..3ed633ddc 100644
--- a/builder/index.mli
+++ b/builder/index.mli
@@ -44,3 +44,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 7f64d0d98..0fc3ecc06 100644
--- a/builder/index_parser.ml
+++ b/builder/index_parser.ml
@@ -256,3 +256,49 @@ let get_index ~downloader ~sigchecker ?(template = false) {
Sources.uri; proxy }
in
get_index ()
+
+let write_entry chan (name, { Index.printable_name; file_uri; arch; osinfo;
+ signature_uri; checksums; revision; format; size;
+ compressed_size; expand; lvexpand; notes;
+ aliases; hidden}) + let fp fs = fprintf chan fs
in
+ fp "[%s]\n" name;
+ Option.may (fp "name=%s\n") printable_name;
+ Option.may (fp "osinfo=%s\n") osinfo;
+ fp "file=%s\n" file_uri;
+ match arch with
+ | Either arch
+ | Or Some arch -> fp "arch=%s\n" arch
+ | Or None -> ();
+ Option.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);
+ Option.may (fp "format=%s\n") format;
+ fp "size=%Ld\n" size;
+ Option.may (fp "compressed_size=%Ld\n") compressed_size;
+ Option.may (fp "expand=%s\n") expand;
+ Option.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 324f4fc5a..dc6b0b407 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:
(** [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..2315ebe27
--- /dev/null
+++ b/builder/index_parser_tests.ml
@@ -0,0 +1,130 @@
+(* 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 Printf
+
+open OUnit2
+
+open Std_utils
+open Unix_utils
+open Tools_utils
+
+let tmpdir =
+ let tmpdir = Mkdtemp.temp_dir "guestfs-tests." in
+ rmdir_on_exit tmpdir;
+ 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 (Index_parser.write_entry chan) 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
+ 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-Oct-27 14:08 UTC
[Libguestfs] [PATCH v11 7/8] mllib: add XPath helper xpath_get_nodes
This function will allow more OCaml-ish processing of XPath queries
with multiple results.
---
common/mltools/xpath_helpers.ml | 9 +++++++
common/mltools/xpath_helpers.mli | 4 +++
v2v/output_libvirt.ml | 11 ++------
v2v/test-harness/v2v_test_harness.ml | 51 +++++++++++-------------------------
4 files changed, 30 insertions(+), 45 deletions(-)
diff --git a/common/mltools/xpath_helpers.ml b/common/mltools/xpath_helpers.ml
index 3afee8b21..d2bfd3fb9 100644
--- a/common/mltools/xpath_helpers.ml
+++ b/common/mltools/xpath_helpers.ml
@@ -40,3 +40,12 @@ let xpath_eval parsefn xpathctx expr let xpath_string =
xpath_eval identity
let xpath_int = xpath_eval int_of_string
let xpath_int64 = xpath_eval 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_front node nodes
+ done;
+ List.rev !nodes
diff --git a/common/mltools/xpath_helpers.mli b/common/mltools/xpath_helpers.mli
index 3a8190b05..3a2607aeb 100644
--- a/common/mltools/xpath_helpers.mli
+++ b/common/mltools/xpath_helpers.mli
@@ -25,3 +25,7 @@ val xpath_int : Xml.xpathctx -> string -> int option
val xpath_int64 : Xml.xpathctx -> string -> int64 option
(** Parse an xpath expression and return a string/int. Returns
[Some v], or [None] if the expression doesn't match. *)
+
+val xpath_get_nodes : Xml.xpathctx -> string -> Xml.node list
+(** Parse an XPath expression and return a list with the matching
+ XML nodes. *)
diff --git a/v2v/output_libvirt.ml b/v2v/output_libvirt.ml
index 02b4d54ff..729f8b67a 100644
--- a/v2v/output_libvirt.ml
+++ b/v2v/output_libvirt.ml
@@ -55,15 +55,8 @@ let target_features_of_capabilities_doc doc arch
Xml.xpathctx_set_current_context xpathctx node;
(* Get guest/features/* nodes. *)
- let obj = Xml.xpath_eval_expression xpathctx "features/*" in
-
- let features = ref [] in
- for i = 0 to Xml.xpathobj_nr_nodes obj - 1 do
- let feature_node = Xml.xpathobj_node obj i in
- let feature_name = Xml.node_name feature_node in
- push_front feature_name features
- done;
- !features
+ let features = xpath_get_nodes xpathctx "features/*" in
+ List.map Xml.node_name features
)
class output_libvirt oc output_pool = object
diff --git a/v2v/test-harness/v2v_test_harness.ml
b/v2v/test-harness/v2v_test_harness.ml
index ae0033dde..79e97a4b2 100644
--- a/v2v/test-harness/v2v_test_harness.ml
+++ b/v2v/test-harness/v2v_test_harness.ml
@@ -25,6 +25,7 @@ open Printf
open Std_utils
open Tools_utils
+open Xpath_helpers
type test_plan = {
guest_clock : float option;
@@ -90,29 +91,18 @@ let run ~test ?input_disk ?input_xml ?(test_plan =
default_plan) () g, root
in
- let nodes_of_xpathobj doc xpathobj - let nodes = ref [] in
- for i = 0 to Xml.xpathobj_nr_nodes xpathobj - 1 do
- push_front (Xml.xpathobj_node xpathobj i) nodes
- done;
- List.rev !nodes
- in
-
let test_boot boot_disk boot_xml_doc (* Modify boot XML (in memory). *)
let xpathctx = Xml.xpath_new_context boot_xml_doc in
(* Change <name> to something unique. *)
let domname = "tmpv2v-" ^ test in
- let xpath = Xml.xpath_eval_expression xpathctx "/domain/name" in
- let nodes = nodes_of_xpathobj boot_xml_doc xpath in
+ let nodes = xpath_get_nodes xpathctx "/domain/name" in
List.iter (fun node -> Xml.node_set_content node domname) nodes;
(* Limit the RAM used by the guest to 2GB. *)
- let xpath = Xml.xpath_eval_expression xpathctx "/domain/memory"
in
- let nodes = nodes_of_xpathobj boot_xml_doc xpath in
- let xpath = Xml.xpath_eval_expression xpathctx
"/domain/currentMemory" in
- let nodes = nodes @ nodes_of_xpathobj boot_xml_doc xpath in
+ let nodes = xpath_get_nodes xpathctx "/domain/memory" in
+ let nodes = nodes @ xpath_get_nodes xpathctx
"/domain/currentMemory" in
List.iter (
fun node ->
let i = int_of_string (Xml.node_as_string node) in
@@ -127,8 +117,7 @@ let run ~test ?input_disk ?input_xml ?(test_plan =
default_plan) () let adjustment = t -. time () in
assert (adjustment <= 0.);
let adjustment = int_of_float adjustment in
- let xpath = Xml.xpath_eval_expression xpathctx
"/domain/clock" in
- let nodes = nodes_of_xpathobj boot_xml_doc xpath in
+ let nodes = xpath_get_nodes xpathctx "/domain/clock" in
let clock_node match nodes with
| [] ->
@@ -147,8 +136,7 @@ let run ~test ?input_disk ?input_xml ?(test_plan =
default_plan) () );
(* Remove all devices except for a whitelist. *)
- let xpath = Xml.xpath_eval_expression xpathctx
"/domain/devices/*" in
- let nodes = nodes_of_xpathobj boot_xml_doc xpath in
+ let nodes = xpath_get_nodes xpathctx "/domain/devices/*" in
List.iter (
fun node ->
match Xml.node_name node with
@@ -157,33 +145,26 @@ let run ~test ?input_disk ?input_xml ?(test_plan =
default_plan) () ) nodes;
(* Remove CDROMs. *)
- let xpath - Xml.xpath_eval_expression xpathctx
- "/domain/devices/disk[@device=\"cdrom\"]" in
- let nodes = nodes_of_xpathobj boot_xml_doc xpath in
+ let nodes = xpath_get_nodes xpathctx
+ "/domain/devices/disk[@device=\"cdrom\"]" in
List.iter Xml.unlink_node nodes;
(* Change <on_*> settings to destroy ... *)
- let xpath = Xml.xpath_eval_expression xpathctx
"/domain/on_poweroff" in
- let nodes = nodes_of_xpathobj boot_xml_doc xpath in
- let xpath = Xml.xpath_eval_expression xpathctx "/domain/on_crash"
in
- let nodes = nodes @ nodes_of_xpathobj boot_xml_doc xpath in
+ let nodes = xpath_get_nodes xpathctx "/domain/on_poweroff" in
+ let nodes = nodes @ xpath_get_nodes xpathctx "/domain/on_crash"
in
List.iter (fun node -> Xml.node_set_content node "destroy")
nodes;
(* ... except for <on_reboot> which is permitted (for SELinux
* relabelling)
*)
- let xpath = Xml.xpath_eval_expression xpathctx
"/domain/on_reboot" in
- let nodes = nodes_of_xpathobj boot_xml_doc xpath in
+ let nodes = xpath_get_nodes xpathctx "/domain/on_reboot" in
List.iter (fun node -> Xml.node_set_content node "restart")
nodes;
(* Get the name of the disk device (eg. "sda"), which is used
* for getting disk stats.
*)
- let xpath - Xml.xpath_eval_expression xpathctx
-
"/domain/devices/disk[@device=\"disk\"]/target/@dev" in
let dev - match nodes_of_xpathobj boot_xml_doc xpath with
+ match xpath_get_nodes xpathctx
+
"/domain/devices/disk[@device=\"disk\"]/target/@dev" with
| [node] -> Xml.node_as_string node
| _ -> assert false in
@@ -523,10 +504,8 @@ let run ~test ?input_disk ?input_xml ?(test_plan =
default_plan) () (* We need to remember to change the XML to point to the
boot overlay. *)
let () let xpathctx = Xml.xpath_new_context boot_xml_doc in
- let xpath - Xml.xpath_eval_expression xpathctx
- "/domain/devices/disk[@device=\"disk\"]/source"
in
- match nodes_of_xpathobj boot_xml_doc xpath with
+ match xpath_get_nodes xpathctx
+ "/domain/devices/disk[@device=\"disk\"]/source"
with
| [node] ->
(* Libvirt requires that the path is absolute. *)
let abs_boot_disk = Sys.getcwd () // boot_disk in
--
2.13.2
Cédric Bosdonnat
2017-Oct-27 14:08 UTC
[Libguestfs] [PATCH v11 8/8] 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 | 4 +
builder/Makefile.am | 87 ++++-
builder/repository_main.ml | 607 ++++++++++++++++++++++++++++++++
builder/test-docs.sh | 2 +
builder/test-virt-builder-repository.sh | 98 ++++++
builder/utils.ml | 4 +
builder/utils.mli | 3 +
builder/virt-builder-repository.pod | 213 +++++++++++
builder/virt-builder.pod | 4 +
fish/guestfish.pod | 1 +
installcheck.sh.in | 1 +
lib/guestfs.pod | 1 +
12 files changed, 1023 insertions(+), 2 deletions(-)
create mode 100644 builder/repository_main.ml
create mode 100755 builder/test-virt-builder-repository.sh
create mode 100644 builder/virt-builder-repository.pod
diff --git a/.gitignore b/.gitignore
index 30165d59e..e43baec65 100644
--- a/.gitignore
+++ b/.gitignore
@@ -97,14 +97,18 @@ Makefile.in
/builder/oUnit-*
/builder/*.out
/builder/*.qcow2
+/builder/repository-testdata
/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 e4a347a09..975f5e08c 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 \
@@ -32,12 +34,14 @@ EXTRA_DIST = \
test-virt-builder-list.sh \
test-virt-builder-list-simplestreams.sh \
test-virt-builder-planner.sh \
+ test-virt-builder-repository.sh \
test-virt-index-validate.sh \
test-virt-index-validate-bad-1 \
test-virt-index-validate-good-1 \
test-virt-index-validate-good-2 \
test-virt-index-validate-good-3 \
virt-builder.pod \
+ virt-builder-repository.pod \
virt-index-validate.pod \
yajl_tests.ml
@@ -88,13 +92,45 @@ SOURCES_C = \
setlocale-c.c \
yajl-c.c
+REPOSITORY_SOURCES_ML = \
+ yajl.ml \
+ utils.ml \
+ index.ml \
+ cache.ml \
+ downloader.ml \
+ sigchecker.ml \
+ ini_reader.ml \
+ index_parser.ml \
+ paths.ml \
+ sources.ml \
+ osinfo_config.ml \
+ osinfo.ml \
+ repository_main.ml
+
+REPOSITORY_SOURCES_MLI = \
+ cache.mli \
+ downloader.mli \
+ index.mli \
+ index_parser.mli \
+ ini_reader.mli \
+ sigchecker.mli \
+ sources.mli \
+ yajl.mli
+
+REPOSITORY_SOURCES_C = \
+ index-scan.c \
+ index-struct.c \
+ index-parse.c \
+ index-parser-c.c \
+ yajl-c.c
+
man_MANS noinst_DATA bin_PROGRAMS
if HAVE_OCAML
-bin_PROGRAMS += virt-builder
+bin_PROGRAMS += virt-builder virt-builder-repository
virt_builder_SOURCES = $(SOURCES_C)
virt_builder_CPPFLAGS = \
@@ -117,12 +153,31 @@ virt_builder_CFLAGS = \
BOBJECTS = $(SOURCES_ML:.ml=.cmo)
XOBJECTS = $(BOBJECTS:.cmo=.cmx)
+virt_builder_repository_SOURCES = $(REPOSITORY_SOURCES_C)
+virt_builder_repository_CPPFLAGS = \
+ -I. \
+ -I$(top_builddir) \
+ -I$(top_srcdir)/gnulib/lib -I$(top_builddir)/gnulib/lib \
+ -I$(shell $(OCAMLC) -where) \
+ -I$(top_srcdir)/gnulib/lib \
+ -I$(top_srcdir)/lib
+virt_builder_repository_CFLAGS = \
+ -pthread \
+ $(WARN_CFLAGS) $(WERROR_CFLAGS) \
+ -Wno-unused-macros \
+ $(LIBTINFO_CFLAGS) \
+ $(LIBXML2_CFLAGS) \
+ $(YAJL_CFLAGS)
+REPOSITORY_BOBJECTS = $(REPOSITORY_SOURCES_ML:.ml=.cmo)
+REPOSITORY_XOBJECTS = $(REPOSITORY_BOBJECTS:.cmo=.cmx)
+
# -I $(top_builddir)/lib/.libs is a hack which forces corresponding -L
# option to be passed to gcc, so we don't try linking against an
# installed copy of libguestfs.
OCAMLPACKAGES = \
-package str,unix \
-I $(top_builddir)/common/utils/.libs \
+ -I $(top_builddir)/common/mlxml \
-I $(top_builddir)/lib/.libs \
-I $(top_builddir)/gnulib/lib/.libs \
-I $(top_builddir)/ocaml \
@@ -155,13 +210,16 @@ OCAMLFLAGS = $(OCAML_FLAGS) $(OCAML_WARN_ERROR)
if !HAVE_OCAMLOPT
OBJECTS = $(BOBJECTS)
+REPOSITORY_OBJECTS = $(REPOSITORY_BOBJECTS)
else
OBJECTS = $(XOBJECTS)
+REPOSITORY_OBJECTS = $(REPOSITORY_XOBJECTS)
endif
OCAMLLINKFLAGS = \
mlgettext.$(MLARCHIVE) \
mlpcre.$(MLARCHIVE) \
+ mlxml.$(MLARCHIVE) \
mlstdutils.$(MLARCHIVE) \
mlguestfs.$(MLARCHIVE) \
mlcutils.$(MLARCHIVE) \
@@ -183,6 +241,16 @@ virt_builder_LINK = \
$(OCAMLFIND) $(BEST) $(OCAMLFLAGS) $(OCAMLPACKAGES) $(OCAMLLINKFLAGS) \
$(OBJECTS) -o $@
+virt_builder_repository_DEPENDENCIES = \
+ $(REPOSITORY_OBJECTS) \
+ ../common/mltools/mltools.$(MLARCHIVE) \
+ ../common/mlxml/mlxml.$(MLARCHIVE) \
+ $(top_srcdir)/ocaml-link.sh
+virt_builder_repository_LINK = \
+ $(top_srcdir)/ocaml-link.sh -cclib '$(OCAMLCLIBS)' -- \
+ $(OCAMLFIND) $(BEST) $(OCAMLFLAGS) $(OCAMLPACKAGES) $(OCAMLLINKFLAGS) \
+ $(REPOSITORY_OBJECTS) -o $@
+
# Manual pages and HTML files for the website.
man_MANS += virt-builder.1
@@ -201,6 +269,20 @@ stamp-virt-builder.pod: virt-builder.pod
$(top_srcdir)/customize/customize-synop
$<
touch $@
+man_MANS += virt-builder-repository.1
+noinst_DATA += $(top_builddir)/website/virt-builder-repository.1.html
+
+virt-builder-repository.1
$(top_builddir)/website/virt-builder-repository.1.html:
stamp-virt-builder-repository.pod
+
+stamp-virt-builder-repository.pod: virt-builder-repository.pod
+ $(PODWRAPPER) \
+ --man virt-builder-repository.1 \
+ --html $(top_builddir)/website/virt-builder-repository.1.html \
+ --license GPLv2+ \
+ --warning safe \
+ $<
+ touch $@
+
# Tests.
TESTS_ENVIRONMENT = $(top_builddir)/run --test
@@ -317,7 +399,8 @@ check-valgrind:
SLOW_TESTS = \
$(console_test_scripts) \
- test-virt-builder-planner.sh
+ test-virt-builder-planner.sh \
+ test-virt-builder-repository.sh
check-slow:
$(MAKE) check TESTS="$(SLOW_TESTS)" SLOW=1
diff --git a/builder/repository_main.ml b/builder/repository_main.ml
new file mode 100644
index 000000000..b66cfba13
--- /dev/null
+++ b/builder/repository_main.ml
@@ -0,0 +1,607 @@
+(* virt-builder
+ * Copyright (C) 2016-2017 SUSE Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+open Std_utils
+open Common_gettext.Gettext
+open Tools_utils
+open Unix_utils
+open Getopt.OptionName
+open Utils
+open Yajl
+open Xpath_helpers
+
+open Printf
+
+type cmdline = {
+ gpg : string;
+ gpgkey : string option;
+ interactive : bool;
+ keep_unsigned : bool;
+ compression : bool;
+ repo : string;
+}
+
+type disk_image_info = {
+ format : string;
+ size : int64;
+}
+
+let parse_cmdline () + let gpg = ref "gpg" in
+ let gpgkey = ref None in
+ let set_gpgkey arg = gpgkey := Some arg in
+
+ let interactive = ref false in
+ let keep_unsigned = ref false in
+ let compression = ref true 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.String ("gpgkey",
set_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.Clear 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 = !gpgkey in
+ let interactive = !interactive in
+ let keep_unsigned = !keep_unsigned in
+ let compression = !compression in
+
+ (* Check options *)
+ let repo + match args with
+ | [repo] -> repo
+ | [] ->
+ error (f_"virt-builder-repository /path/to/repo
+
+Use ‘/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;
+ compression = compression;
+ repo = repo;
+ }
+
+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 -> None
+ | Some csums ->
+ try
+ Some (List.find (
+ function
+ | Checksums.SHA512 _ -> true
+ | _ -> false
+ ) csums)
+ with Not_found -> None
+
+let osinfo_ids = ref None
+
+let rec osinfo_get_short_ids () + match !osinfo_ids with
+ | Some ids -> ids
+ | None ->
+ osinfo_ids :+ Some (
+ Osinfo.fold (
+ fun set 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.fold_left (
+ fun set node ->
+ let id = Xml.node_as_string node in
+ StringSet.add id set
+ ) set nodes
+ ) StringSet.empty
+ );
+ osinfo_get_short_ids ()
+
+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 infos = get_image_infos filepath 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
+ 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 not 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
+ Either 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 = Or None;
+ 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
+
+ let extract_entry_data () + 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 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 + match arch with
+ | Either arch -> Either arch
+ | Or Some arch ->
+ if interactive then ask_arch arch
+ else Either arch
+ | Or None ->
+ if interactive then ask_arch ""
+ else error (f_"missing architecture for %s") id in
+
+ if has_entry id arch acc_entries then (
+ let msg + match arch with
+ | Either arch
+ | Or Some arch -> sprintf (f_"and architure %s") arch
+ | Or None -> "" in
+ error (f_"Already existing image with id %s%s") id msg
+ );
+
+ 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 = Utils.increment_revision 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 })
+ in
+
+ match old_checksum with
+ | Some old_sum ->
+ if old_sum = checksum then
+ let id, entry = file_entry in
+ (id, { entry with Index.file_uri = out_filename })
+ else
+ extract_entry_data ()
+ | None -> extract_entry_data ()
+
+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
+ match checksum with
+ | None -> true
+ | Some sum -> sum <> 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.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 }) ->
+ let has_arch + match arch with
+ | Either arch
+ | Or Some arch -> true
+ | Or None -> false in
+ has_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 cmdline.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/test-virt-builder-repository.sh
b/builder/test-virt-builder-repository.sh
new file mode 100755
index 000000000..609891022
--- /dev/null
+++ b/builder/test-virt-builder-repository.sh
@@ -0,0 +1,98 @@
+#!/bin/bash -
+# libguestfs
+# 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.
+
+set -e
+
+$TEST_FUNCTIONS
+slow_test
+skip_if_skipped "$script"
+
+test_data=repository-testdata
+rm -rf $test_data
+mkdir $test_data
+
+# Make a copy of the Fedora image
+cp ../test-data/phony-guests/fedora.img $test_data
+
+# Create minimal index file
+cat > $test_data/index << EOF
+[fedora]
+file=fedora.img
+EOF
+
+# Run virt-builder-repository (no compression, interactive)
+echo 'x86_64
+Fedora Test Image
+fedora14
+/dev/sda1
+/dev/VG/Root
+' | virt-builder-repository --no-compression -i $test_data
+
+assert_config () {
+ item=$1
+ regex=$2
+
+ sed -n -e "/\[$item]/,/^$/p" $test_data/index | grep
"$regex"
+}
+
+# Check the generated index file
+assert_config 'fedora' 'revision=1'
+assert_config 'fedora' 'arch=x86_64'
+assert_config 'fedora' 'name=Fedora Test Image'
+assert_config 'fedora' 'osinfo=fedora14'
+assert_config 'fedora' 'checksum'
+assert_config 'fedora' 'format=raw'
+assert_config 'fedora' '^size='
+assert_config 'fedora' 'compressed_size='
+assert_config 'fedora' 'expand=/dev/'
+
+
+# Copy the debian image and add the minimal piece to index
+cp ../test-data/phony-guests/debian.img $test_data
+
+cat >> $test_data/index << EOF
+
+[debian]
+file=debian.img
+EOF
+
+# Run virt-builder-repository again
+echo 'x86_64
+Debian Test Image
+debian9
+
+' | virt-builder-repository --no-compression -i $test_data
+
+# Check that the new image is complete and the first one hasn't changed
+assert_config 'fedora' 'revision=1'
+
+assert_config 'debian' 'revision=1'
+assert_config 'debian' 'checksum'
+
+# Modify the fedora image
+export EDITOR='echo newline >>'
+virt-edit -a $test_data/fedora.img /etc/test3
+
+# Rerun the tool (with compression)
+virt-builder-repository -i $test_data
+
+# Check that the revision, file and size have been updated
+assert_config 'fedora' 'revision=2'
+assert_config 'fedora' 'file=fedora.img.xz'
+test -e $test_data/fedora.img.xz
+! test -e $test_data/fedora.img
diff --git a/builder/utils.ml b/builder/utils.ml
index 9fceee282..8477218e9 100644
--- a/builder/utils.ml
+++ b/builder/utils.ml
@@ -34,6 +34,10 @@ let string_of_revision = function
| Rev_int n -> string_of_int n
| Rev_string s -> s
+let increment_revision = function
+ | Rev_int n -> Rev_int (n + 1)
+ | Rev_string s -> Rev_int ((int_of_string s) + 1)
+
let get_image_infos filepath let qemuimg_cmd = "qemu-img info --output
json " ^ (Std_utils.quote filepath) in
let lines = external_command qemuimg_cmd in
diff --git a/builder/utils.mli b/builder/utils.mli
index 4acde9f36..b829cf831 100644
--- a/builder/utils.mli
+++ b/builder/utils.mli
@@ -29,6 +29,9 @@ and revision val string_of_revision : revision -> string
(** Convert a {!revision} into a string. *)
+val increment_revision : revision -> revision
+(** Add one to the version number *)
+
val get_image_infos : string -> Yajl.yajl_val
(** [get_image_infos path] Run qemu-img info on the image pointed at
path as YAJL tree. *)
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.
diff --git a/builder/virt-builder.pod b/builder/virt-builder.pod
index 74bf7bb11..1ed18a7c7 100644
--- a/builder/virt-builder.pod
+++ b/builder/virt-builder.pod
@@ -1319,6 +1319,9 @@ digital signature):
The part in square brackets is the C<os-version>, which is the same
string that is used on the virt-builder command line to build that OS.
+The index file creation and signature can be eased with the
+L<virt-builder-repository(1)> tool.
+
After preparing the C<index> file in the correct format, clearsign it
using the following command:
@@ -1875,6 +1878,7 @@ error.
L<guestfs(3)>,
L<guestfish(1)>,
L<guestmount(1)>,
+L<virt-builder-repository(1)>,
L<virt-copy-out(1)>,
L<virt-customize(1)>,
L<virt-get-kernel(1)>,
diff --git a/fish/guestfish.pod b/fish/guestfish.pod
index 11f2bbeb5..c37189bd8 100644
--- a/fish/guestfish.pod
+++ b/fish/guestfish.pod
@@ -1617,6 +1617,7 @@ L<guestfs(3)>,
L<http://libguestfs.org/>,
L<virt-alignment-scan(1)>,
L<virt-builder(1)>,
+L<virt-builder-repository(1)>,
L<virt-cat(1)>,
L<virt-copy-in(1)>,
L<virt-copy-out(1)>,
diff --git a/installcheck.sh.in b/installcheck.sh.in
index 6b05ab812..a4829cda6 100644
--- a/installcheck.sh.in
+++ b/installcheck.sh.in
@@ -46,6 +46,7 @@ cp @bindir@/guestfish fish/
cp @bindir@/guestmount fuse/
cp @bindir@/virt-alignment-scan align/
cp @bindir@/virt-builder builder/
+cp @bindir@/virt-builder-repository builder/
cp @bindir@/virt-cat cat/
cp @bindir@/virt-copy-in fish/
cp @bindir@/virt-copy-out fish/
diff --git a/lib/guestfs.pod b/lib/guestfs.pod
index 8d31f3200..55467e92e 100644
--- a/lib/guestfs.pod
+++ b/lib/guestfs.pod
@@ -3417,6 +3417,7 @@ L<guestfish(1)>,
L<guestmount(1)>,
L<virt-alignment-scan(1)>,
L<virt-builder(1)>,
+L<virt-builder-repository(1)>,
L<virt-cat(1)>,
L<virt-copy-in(1)>,
L<virt-copy-out(1)>,
--
2.13.2
Richard W.M. Jones
2017-Nov-07 12:22 UTC
Re: [Libguestfs] [PATCH v11 7/8] mllib: add XPath helper xpath_get_nodes
On Fri, Oct 27, 2017 at 04:08:21PM +0200, Cédric Bosdonnat wrote:> This function will allow more OCaml-ish processing of XPath queries > with multiple results. > --- > common/mltools/xpath_helpers.ml | 9 +++++++ > common/mltools/xpath_helpers.mli | 4 +++ > v2v/output_libvirt.ml | 11 ++------ > v2v/test-harness/v2v_test_harness.ml | 51 +++++++++++------------------------- > 4 files changed, 30 insertions(+), 45 deletions(-) > > diff --git a/common/mltools/xpath_helpers.ml b/common/mltools/xpath_helpers.ml > index 3afee8b21..d2bfd3fb9 100644 > --- a/common/mltools/xpath_helpers.ml > +++ b/common/mltools/xpath_helpers.ml > @@ -40,3 +40,12 @@ let xpath_eval parsefn xpathctx expr > let xpath_string = xpath_eval identity > let xpath_int = xpath_eval int_of_string > let xpath_int64 = xpath_eval 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_front node nodes > + done; > + List.rev !nodes > diff --git a/common/mltools/xpath_helpers.mli b/common/mltools/xpath_helpers.mli > index 3a8190b05..3a2607aeb 100644 > --- a/common/mltools/xpath_helpers.mli > +++ b/common/mltools/xpath_helpers.mli > @@ -25,3 +25,7 @@ val xpath_int : Xml.xpathctx -> string -> int option > val xpath_int64 : Xml.xpathctx -> string -> int64 option > (** Parse an xpath expression and return a string/int. Returns > [Some v], or [None] if the expression doesn't match. *) > + > +val xpath_get_nodes : Xml.xpathctx -> string -> Xml.node list > +(** Parse an XPath expression and return a list with the matching > + XML nodes. *) > diff --git a/v2v/output_libvirt.ml b/v2v/output_libvirt.ml > index 02b4d54ff..729f8b67a 100644 > --- a/v2v/output_libvirt.ml > +++ b/v2v/output_libvirt.ml > @@ -55,15 +55,8 @@ let target_features_of_capabilities_doc doc arch > Xml.xpathctx_set_current_context xpathctx node; > > (* Get guest/features/* nodes. *) > - let obj = Xml.xpath_eval_expression xpathctx "features/*" in > - > - let features = ref [] in > - for i = 0 to Xml.xpathobj_nr_nodes obj - 1 do > - let feature_node = Xml.xpathobj_node obj i in > - let feature_name = Xml.node_name feature_node in > - push_front feature_name features > - done; > - !features > + let features = xpath_get_nodes xpathctx "features/*" in > + List.map Xml.node_name features > ) > > class output_libvirt oc output_pool = object > diff --git a/v2v/test-harness/v2v_test_harness.ml b/v2v/test-harness/v2v_test_harness.ml > index ae0033dde..79e97a4b2 100644 > --- a/v2v/test-harness/v2v_test_harness.ml > +++ b/v2v/test-harness/v2v_test_harness.ml > @@ -25,6 +25,7 @@ open Printf > > open Std_utils > open Tools_utils > +open Xpath_helpers > > type test_plan = { > guest_clock : float option; > @@ -90,29 +91,18 @@ let run ~test ?input_disk ?input_xml ?(test_plan = default_plan) () > g, root > in > > - let nodes_of_xpathobj doc xpathobj > - let nodes = ref [] in > - for i = 0 to Xml.xpathobj_nr_nodes xpathobj - 1 do > - push_front (Xml.xpathobj_node xpathobj i) nodes > - done; > - List.rev !nodes > - in > - > let test_boot boot_disk boot_xml_doc > (* Modify boot XML (in memory). *) > let xpathctx = Xml.xpath_new_context boot_xml_doc in > > (* Change <name> to something unique. *) > let domname = "tmpv2v-" ^ test in > - let xpath = Xml.xpath_eval_expression xpathctx "/domain/name" in > - let nodes = nodes_of_xpathobj boot_xml_doc xpath in > + let nodes = xpath_get_nodes xpathctx "/domain/name" in > List.iter (fun node -> Xml.node_set_content node domname) nodes; > > (* Limit the RAM used by the guest to 2GB. *) > - let xpath = Xml.xpath_eval_expression xpathctx "/domain/memory" in > - let nodes = nodes_of_xpathobj boot_xml_doc xpath in > - let xpath = Xml.xpath_eval_expression xpathctx "/domain/currentMemory" in > - let nodes = nodes @ nodes_of_xpathobj boot_xml_doc xpath in > + let nodes = xpath_get_nodes xpathctx "/domain/memory" in > + let nodes = nodes @ xpath_get_nodes xpathctx "/domain/currentMemory" in > List.iter ( > fun node -> > let i = int_of_string (Xml.node_as_string node) in > @@ -127,8 +117,7 @@ let run ~test ?input_disk ?input_xml ?(test_plan = default_plan) () > let adjustment = t -. time () in > assert (adjustment <= 0.); > let adjustment = int_of_float adjustment in > - let xpath = Xml.xpath_eval_expression xpathctx "/domain/clock" in > - let nodes = nodes_of_xpathobj boot_xml_doc xpath in > + let nodes = xpath_get_nodes xpathctx "/domain/clock" in > let clock_node > match nodes with > | [] -> > @@ -147,8 +136,7 @@ let run ~test ?input_disk ?input_xml ?(test_plan = default_plan) () > ); > > (* Remove all devices except for a whitelist. *) > - let xpath = Xml.xpath_eval_expression xpathctx "/domain/devices/*" in > - let nodes = nodes_of_xpathobj boot_xml_doc xpath in > + let nodes = xpath_get_nodes xpathctx "/domain/devices/*" in > List.iter ( > fun node -> > match Xml.node_name node with > @@ -157,33 +145,26 @@ let run ~test ?input_disk ?input_xml ?(test_plan = default_plan) () > ) nodes; > > (* Remove CDROMs. *) > - let xpath > - Xml.xpath_eval_expression xpathctx > - "/domain/devices/disk[@device=\"cdrom\"]" in > - let nodes = nodes_of_xpathobj boot_xml_doc xpath in > + let nodes = xpath_get_nodes xpathctx > + "/domain/devices/disk[@device=\"cdrom\"]" in > List.iter Xml.unlink_node nodes; > > (* Change <on_*> settings to destroy ... *) > - let xpath = Xml.xpath_eval_expression xpathctx "/domain/on_poweroff" in > - let nodes = nodes_of_xpathobj boot_xml_doc xpath in > - let xpath = Xml.xpath_eval_expression xpathctx "/domain/on_crash" in > - let nodes = nodes @ nodes_of_xpathobj boot_xml_doc xpath in > + let nodes = xpath_get_nodes xpathctx "/domain/on_poweroff" in > + let nodes = nodes @ xpath_get_nodes xpathctx "/domain/on_crash" in > List.iter (fun node -> Xml.node_set_content node "destroy") nodes; > (* ... except for <on_reboot> which is permitted (for SELinux > * relabelling) > *) > - let xpath = Xml.xpath_eval_expression xpathctx "/domain/on_reboot" in > - let nodes = nodes_of_xpathobj boot_xml_doc xpath in > + let nodes = xpath_get_nodes xpathctx "/domain/on_reboot" in > List.iter (fun node -> Xml.node_set_content node "restart") nodes; > > (* Get the name of the disk device (eg. "sda"), which is used > * for getting disk stats. > *) > - let xpath > - Xml.xpath_eval_expression xpathctx > - "/domain/devices/disk[@device=\"disk\"]/target/@dev" in > let dev > - match nodes_of_xpathobj boot_xml_doc xpath with > + match xpath_get_nodes xpathctx > + "/domain/devices/disk[@device=\"disk\"]/target/@dev" with > | [node] -> Xml.node_as_string node > | _ -> assert false in > > @@ -523,10 +504,8 @@ let run ~test ?input_disk ?input_xml ?(test_plan = default_plan) () > (* We need to remember to change the XML to point to the boot overlay. *) > let () > let xpathctx = Xml.xpath_new_context boot_xml_doc in > - let xpath > - Xml.xpath_eval_expression xpathctx > - "/domain/devices/disk[@device=\"disk\"]/source" in > - match nodes_of_xpathobj boot_xml_doc xpath with > + match xpath_get_nodes xpathctx > + "/domain/devices/disk[@device=\"disk\"]/source" with > | [node] -> > (* Libvirt requires that the path is absolute. *) > let abs_boot_disk = Sys.getcwd () // boot_disk inACK Rich. -- Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones Read my programming and virtualization blog: http://rwmj.wordpress.com Fedora Windows cross-compiler. Compile Windows programs, test, and build Windows installers. Over 100 libraries supported. http://fedoraproject.org/wiki/MinGW
Richard W.M. Jones
2017-Nov-07 12:25 UTC
Re: [Libguestfs] [PATCH v11 2/8] builder: add simple OCaml osinfo-db reader
On Fri, Oct 27, 2017 at 04:08:16PM +0200, Cédric Bosdonnat wrote:> 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.ACK. There was a trailing whitespace problem on one line but I fixed that before pushing it. Rich. -- Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones Read my programming and virtualization blog: http://rwmj.wordpress.com virt-p2v converts physical machines to virtual machines. Boot with a live CD or over the network (PXE) and turn machines into KVM guests. http://libguestfs.org/virt-v2v
Richard W.M. Jones
2017-Nov-07 12:32 UTC
Re: [Libguestfs] [PATCH v11 5/8] builder: add a template parameter to get_index
On Fri, Oct 27, 2017 at 04:08:19PM +0200, Cédric Bosdonnat wrote:> get_index now gets a new template parameter. Setting it to true will > make the index parsing less picky about missing important data. This > can be used to parse a partial index file. > --- > builder/index_parser.ml | 46 ++++++++++++++++++++++++++++++++++++++-------- > builder/index_parser.mli | 5 ++++- > 2 files changed, 42 insertions(+), 9 deletions(-) > > diff --git a/builder/index_parser.ml b/builder/index_parser.ml > index c715ccac7..7f64d0d98 100644 > --- a/builder/index_parser.ml > +++ b/builder/index_parser.ml > @@ -25,7 +25,7 @@ open Utils > open Printf > open Unix > > -let get_index ~downloader ~sigchecker { Sources.uri; proxy } > +let get_index ~downloader ~sigchecker ?(template = false) { Sources.uri; proxy } > let corrupt_file () > error (f_"The index file downloaded from ‘%s’ is corrupt.\nYou need to ask the supplier of this file to fix it and upload a fixed version.") uri > in > @@ -99,8 +99,25 @@ let get_index ~downloader ~sigchecker { Sources.uri; proxy } > let arch > try Either (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 > + try > + let g = new Guestfs.guestfs () in > + g#add_drive_ro file_uri; > + g#launch (); > + let roots = g#inspect_os () in > + let nroots = Array.length roots in > + if nroots <> 1 then ( > + eprintf (f_"%s: no ‘arch’ entry for %s and failed to guess it\n") prog n; > + corrupt_file () > + ); > + let inspected_arch = g#inspect_get_arch (Array.get roots 0) in > + g#close(); > + Or (Some inspected_arch) > + with exn -> Or NoneSo we're throwing away the exception here ... Are we expecting an exception to be thrown? I'm guessing not, in which case don't catch the exception and you don't need the "Or None" case at all. (See also another comment which I'm about to send ...) Rich. -- Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones Read my programming and virtualization blog: http://rwmj.wordpress.com virt-p2v converts physical machines to virtual machines. Boot with a live CD or over the network (PXE) and turn machines into KVM guests. http://libguestfs.org/virt-v2v
Richard W.M. Jones
2017-Nov-07 12:35 UTC
Re: [Libguestfs] [PATCH v11 3/8] builder: change arch type to (string, string option) maybe.
On Fri, Oct 27, 2017 at 04:08:17PM +0200, Cédric Bosdonnat wrote:> In a future commit, the index parser will allow arch not to be set > for some cases. In such cases, it will be guessed by inspecting the > image, but we need to distinguish between a set value and a guessed > one. Using the '(string, string option) maybe' type will help it: > > match arch with > | Either s -> (* This is a set value *) > | Or Some s -> (* This is a guessed value *) > | Or None -> (* No value and no guess *)I know I suggested something like this on IRC, but in retrospect that wasn't a good idea. First of all I don't think you need the "Or None" case at all. Secondly it would be better to use descriptive cases instead of the Either/Or type. Here's a better idea (on top of your patch). I didn't change the rest of the code but it should be obvious how to change it. Rich. ---------------------------------------------------------------------- diff --git a/builder/index.ml b/builder/index.ml index 18e653534..566f3e22a 100644 --- a/builder/index.ml +++ b/builder/index.ml @@ -26,11 +26,6 @@ open Printf open Unix -(* Either string -> value set - Or Some string -> value guessed - Or None -> value neither set nor guessed - *) -type arch = (string, string option) Std_utils.maybe type index = (string * entry) list (* string = "os-version" *) and entry = { printable_name : string option; (* the name= field *) @@ -52,6 +47,9 @@ and entry = { sigchecker : Sigchecker.t; proxy : Curl.proxy; } +and arch + | Arch of string + | ArchGuessed of string let print_entry chan (name, { printable_name; file_uri; arch; osinfo; signature_uri; checksums; revision; format; diff --git a/builder/index.mli b/builder/index.mli index 43d5485fb..eb83a469c 100644 --- a/builder/index.mli +++ b/builder/index.mli @@ -16,11 +16,6 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) -(* Either string -> value set - Or Some string -> value guessed - Or None -> value neither set nor guessed - *) -type arch = (string, string option) Std_utils.maybe type index = (string * entry) list (* string = "os-version" *) and entry = { printable_name : string option; (* the name= field *) @@ -42,5 +37,9 @@ and entry = { sigchecker : Sigchecker.t; proxy : Curl.proxy; } +and arch + | Arch of string (** value chosen by user or config file *) + | ArchGuessed of string (** architecture was guessed from + inspection data *) val print_entry : out_channel -> (string * entry) -> unit -- Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones Read my programming and virtualization blog: http://rwmj.wordpress.com virt-builder quickly builds VMs from scratch http://libguestfs.org/virt-builder.1.html
Richard W.M. Jones
2017-Nov-07 12:41 UTC
Re: [Libguestfs] [PATCH v11 4/8] builder: add Utils.get_image_infos function
On Fri, Oct 27, 2017 at 04:08:18PM +0200, Cédric Bosdonnat wrote:> This helper function calls qemu-img info on an image file and > returns the output as a JSON Yajl tree. > > This function will be used in future commits. > --- > builder/Makefile.am | 2 +- > builder/utils.ml | 6 ++++++ > builder/utils.mli | 4 ++++ > 3 files changed, 11 insertions(+), 1 deletion(-) > > diff --git a/builder/Makefile.am b/builder/Makefile.am > index 4a2f639c3..88392d327 100644 > --- a/builder/Makefile.am > +++ b/builder/Makefile.am > @@ -61,12 +61,12 @@ SOURCES_MLI = \ > yajl.mli > > SOURCES_ML = \ > + yajl.ml \ > utils.ml \ > pxzcat.ml \ > setlocale.ml \ > index.ml \ > ini_reader.ml \ > - yajl.ml \ > paths.ml \ > languages.ml \ > cache.ml \ > diff --git a/builder/utils.ml b/builder/utils.ml > index acb6c2f4b..9fceee282 100644 > --- a/builder/utils.ml > +++ b/builder/utils.ml > @@ -33,3 +33,9 @@ and revision > let string_of_revision = function > | Rev_int n -> string_of_int n > | Rev_string s -> s > + > +let get_image_infos filepath > + let qemuimg_cmd = "qemu-img info --output json " ^ (Std_utils.quote filepath) inIf you open Std_utils then you can write this more concisely. Parentheses are not needed too because function application binds tightly: let qemuimg_cmd = "qemu-img info --output json " ^ quote filepath in> + let lines = external_command qemuimg_cmd in > + let line = String.concat "\n" lines in > + Yajl.yajl_tree_parse line > diff --git a/builder/utils.mli b/builder/utils.mli > index 45385f713..4acde9f36 100644 > --- a/builder/utils.mli > +++ b/builder/utils.mli > @@ -28,3 +28,7 @@ and revision > > val string_of_revision : revision -> string > (** Convert a {!revision} into a string. *) > + > +val get_image_infos : string -> Yajl.yajl_valThere is some trailing whitespace here. I pushed this with the changes mentioned above. Thanks, Rich. -- Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones Read my programming and virtualization blog: http://rwmj.wordpress.com virt-builder quickly builds VMs from scratch http://libguestfs.org/virt-builder.1.html
Richard W.M. Jones
2017-Nov-07 12:52 UTC
Re: [Libguestfs] [PATCH v11 6/8] builder: add Index.write_entry function
On Fri, Oct 27, 2017 at 04:08:20PM +0200, Cédric Bosdonnat wrote:> 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.I pushed this with only minor changes required to get it to compile (as the patches have gone upstream out of order). Thanks, Rich. -- Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones Read my programming and virtualization blog: http://rwmj.wordpress.com virt-df lists disk usage of guests without needing to install any software inside the virtual machine. Supports Linux and Windows. http://people.redhat.com/~rjones/virt-df/
Richard W.M. Jones
2017-Nov-07 12:54 UTC
Re: [Libguestfs] [PATCH v11 0/8] virt-builder-repository
I have pushed:> Ignore builder/*.out and *.img files > builder: add simple OCaml osinfo-db reader > builder: add Utils.get_image_infos function > builder: add Index.write_entry function > mllib: add XPath helper xpath_get_nodesI suggested a change to the ‘arch’ type which affects these two patches:> builder: change arch type to (string, string option) maybe. > builder: add a template parameter to get_indexI didn't review:> New tool: virt-builder-repositoryBefore I review the last one, could you post the remaining (3?) patches, rebased on top of master and adjusted to make them compile? Thanks, Rich. -- Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones Read my programming and virtualization blog: http://rwmj.wordpress.com Fedora Windows cross-compiler. Compile Windows programs, test, and build Windows installers. Over 100 libraries supported. http://fedoraproject.org/wiki/MinGW