Extract the yajl object_get_* helpers in the Yajl module since this could be useful for any Yajl user code. --- builder/simplestreams_parser.ml | 52 -------------------------------------- builder/yajl.ml | 55 +++++++++++++++++++++++++++++++++++++++++ builder/yajl.mli | 29 ++++++++++++++++++++++ 3 files changed, 84 insertions(+), 52 deletions(-) diff --git a/builder/simplestreams_parser.ml b/builder/simplestreams_parser.ml index 81e70189a..8844d476b 100644 --- a/builder/simplestreams_parser.ml +++ b/builder/simplestreams_parser.ml @@ -28,58 +28,6 @@ let ensure_trailing_slash str = if String.length str > 0 && str.[String.length str - 1] <> '/' then str ^ "/" else str -let object_find_optional key = function - | Yajl_object o -> - (match List.filter (fun (k, _) -> k = key) (Array.to_list o) with - | [(k, v)] -> Some v - | [] -> None - | _ -> error (f_"more than value for the key '%s'") key) - | _ -> error (f_"the value of the key '%s' is not an object") key - -let object_find key yv = - match object_find_optional key yv with - | None -> error (f_"missing value for the key '%s'") key - | Some v -> v - -let object_get_string key yv = - match object_find key yv with - | Yajl_string s -> s - | _ -> error (f_"the value for the key '%s' is not a string") key - -let object_find_object key yv = - match object_find key yv with - | Yajl_object _ as o -> o - | _ -> error (f_"the value for the key '%s' is not an object") key - -let object_find_objects fn = function - | Yajl_object o -> filter_map fn (Array.to_list o) - | _ -> error (f_"the value is not an object") - -let object_get_object key yv = - match object_find_object key yv with - | Yajl_object o -> o - | _ -> assert false (* object_find_object already errors out. *) - -let object_get_number key yv = - match object_find key yv with - | Yajl_number n -> n - | Yajl_double d -> Int64.of_float d - | _ -> error (f_"the value for the key '%s' is not an integer") key - -let objects_get_string key yvs = - let rec loop = function - | [] -> None - | x :: xs -> - (match object_find_optional key x with - | Some (Yajl_string s) -> Some s - | Some _ -> error (f_"the value for key '%s' is not a string as expected") key - | None -> loop xs - ) - in - match loop yvs with - | Some s -> s - | None -> error (f_"the key '%s' was not found in a list of objects") key - let get_index ~downloader ~sigchecker { Sources.uri = uri; proxy = proxy } = diff --git a/builder/yajl.ml b/builder/yajl.ml index 00e4dac4b..e53706abc 100644 --- a/builder/yajl.ml +++ b/builder/yajl.ml @@ -16,6 +16,9 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) +open Common_gettext.Gettext +open Common_utils + type yajl_val = | Yajl_null | Yajl_string of string @@ -26,3 +29,55 @@ type yajl_val = | Yajl_bool of bool external yajl_tree_parse : string -> yajl_val = "virt_builder_yajl_tree_parse" + +let object_find_optional key = function + | Yajl_object o -> + (match List.filter (fun (k, _) -> k = key) (Array.to_list o) with + | [(k, v)] -> Some v + | [] -> None + | _ -> error (f_"more than value for the key '%s'") key) + | _ -> error (f_"the value of the key '%s' is not an object") key + +let object_find key yv = + match object_find_optional key yv with + | None -> error (f_"missing value for the key '%s'") key + | Some v -> v + +let object_get_string key yv = + match object_find key yv with + | Yajl_string s -> s + | _ -> error (f_"the value for the key '%s' is not a string") key + +let object_find_object key yv = + match object_find key yv with + | Yajl_object _ as o -> o + | _ -> error (f_"the value for the key '%s' is not an object") key + +let object_find_objects fn = function + | Yajl_object o -> filter_map fn (Array.to_list o) + | _ -> error (f_"the value is not an object") + +let object_get_object key yv = + match object_find_object key yv with + | Yajl_object o -> o + | _ -> assert false (* object_find_object already errors out. *) + +let object_get_number key yv = + match object_find key yv with + | Yajl_number n -> n + | Yajl_double d -> Int64.of_float d + | _ -> error (f_"the value for the key '%s' is not an integer") key + +let objects_get_string key yvs = + let rec loop = function + | [] -> None + | x :: xs -> + (match object_find_optional key x with + | Some (Yajl_string s) -> Some s + | Some _ -> error (f_"the value for key '%s' is not a string as expected") key + | None -> loop xs + ) + in + match loop yvs with + | Some s -> s + | None -> error (f_"the key '%s' was not found in a list of objects") key diff --git a/builder/yajl.mli b/builder/yajl.mli index 9771e5399..ca0eb92f4 100644 --- a/builder/yajl.mli +++ b/builder/yajl.mli @@ -27,3 +27,32 @@ type yajl_val = val yajl_tree_parse : string -> yajl_val (** Parse the JSON string. *) + +val object_get_string : string -> yajl_val -> string +(** [object_get_string key yv] gets the value of the [key] field as a string + in the [yv] structure *) + +val object_find_object : string -> yajl_val -> yajl_val +(** [object_get_object key yv] gets the value of the [key] field as a yajl + value in the [yv] structure. + + Mind the returned type is different from [object_get_object] *) + +val object_get_object : string -> yajl_val -> (string * yajl_val) array +(** [object_get_object key yv] gets the value of the [key] field as a Yajl + object in the [yv] structure *) + +val object_get_number : string -> yajl_val -> int64 +(** [object_get_number key yv] gets the value of the [key] field as an + integer in the [yv] structure *) + +val objects_get_string : string -> yajl_val list -> string +(** [objects_get_string key yvs] gets the value of the [key] field as a string + in an [yvs] list of yajl_val structure. + + The key may not be found at all in the list, in which case an error + is raised *) + +val object_find_objects : ((string * yajl_val) -> 'a option) -> yajl_val -> 'a list +(** [object_find_objects fn obj] returns all the Yajl objects matching the [fn] + function in [obj] list. *) -- 2.11.0

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

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

There is already a libosinfo reading function located in src folder to get the iso informations. Provide a similar but more generic function to be used in ocaml tools. --- mllib/Makefile.am | 12 ++++++++-- mllib/osinfo.ml | 64 +++++++++++++++++++++++++++++++++++++++++++++++++++++ mllib/osinfo.mli | 21 ++++++++++++++++++ mllib/osinfopath.ml | 1 + 4 files changed, 96 insertions(+), 2 deletions(-) create mode 100644 mllib/osinfo.ml create mode 100644 mllib/osinfo.mli create mode 100644 mllib/osinfopath.ml diff --git a/mllib/Makefile.am b/mllib/Makefile.am index 1a21f825f..eb9753e45 100644 --- a/mllib/Makefile.am +++ b/mllib/Makefile.am @@ -19,7 +19,7 @@ include $(top_srcdir)/subdir-rules.mk EXTRA_DIST = \ $(SOURCES_MLI) \ - $(filter-out guestfs_config.ml libdir.ml,$(SOURCES_ML)) \ + $(filter-out guestfs_config.ml libdir.ml osinfopath.ml,$(SOURCES_ML)) \ $(SOURCES_C) \ common_utils_tests.ml \ getopt_tests.ml \ @@ -40,6 +40,7 @@ SOURCES_MLI = \ getopt.mli \ JSON.mli \ mkdtemp.mli \ + osinfo.mli \ planner.mli \ progress.mli \ regedit.mli \ @@ -71,7 +72,9 @@ SOURCES_ML = \ exit.ml \ checksums.ml \ xml.ml \ - xpath_helpers.ml + xpath_helpers.ml \ + osinfopath.ml \ + osinfo.ml SOURCES_C = \ ../cat/visit.c \ @@ -173,6 +176,11 @@ libdir.ml: Makefile echo 'let libdir = "$(libdir)"' > $@-t mv $@-t $@ +osinfopath.ml: Makefile + echo 'let osinfopath = "$(datadir)/libosinfo/db"' > $@-t + mv $@-t $@ + + # Tests. common_utils_tests_SOURCES = dummy.c diff --git a/mllib/osinfo.ml b/mllib/osinfo.ml new file mode 100644 index 000000000..7630c4f9c --- /dev/null +++ b/mllib/osinfo.ml @@ -0,0 +1,64 @@ +(* virt-builder + * Copyright (C) 2016 - SUSE Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License along + * with this program; if not, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) +open Common_utils +open Osinfopath + +let osinfo_db_read_three_levels os_path filter = + let distros = Array.to_list (Sys.readdir os_path) in + remove_duplicates ( + List.concat ( + List.map ( + fun distro -> + let distro_path = os_path // distro in + let os_files = Array.to_list (Sys.readdir distro_path) in + List.map ( + fun os_file -> + let file_path = distro_path // os_file in + let xml = read_whole_file file_path in + let doc = Xml.parse_memory xml in + let xpathctx = Xml.xpath_new_context doc in + filter xpathctx + ) os_files + ) distros + ) + ) + +let osinfo_db_read_flat os_path filter = + let os_files = Array.to_list (Sys.readdir os_path) in + remove_duplicates ( + List.map ( + fun os_file -> + let file_path = os_path // os_file in + let xml = read_whole_file file_path in + let doc = Xml.parse_memory xml in + let xpathctx = Xml.xpath_new_context doc in + filter xpathctx + ) os_files + ) + +let osinfo_read_db filter = + let path = try + Sys.getenv "OSINFO_SYSTEM_DIR" + with Not_found -> "/usr/share/osinfo" in + + try osinfo_db_read_three_levels (path // "os") filter with + | _ -> + try osinfo_db_read_three_levels (osinfopath // "os") filter with + | _ -> + try osinfo_db_read_flat (osinfopath // "oses") filter with + | _ -> [] diff --git a/mllib/osinfo.mli b/mllib/osinfo.mli new file mode 100644 index 000000000..4b881408e --- /dev/null +++ b/mllib/osinfo.mli @@ -0,0 +1,21 @@ +(* virt-builder + * Copyright (C) 2016 - SUSE Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License along + * with this program; if not, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +val osinfo_read_db : (Xml.xpathctx -> 'a) -> 'a list +(** [osinfo_read_db filter] runs the [filter] function on the + XPath context of every osinfo os description XML file. *) diff --git a/mllib/osinfopath.ml b/mllib/osinfopath.ml new file mode 100644 index 000000000..a58b8d60f --- /dev/null +++ b/mllib/osinfopath.ml @@ -0,0 +1 @@ +let osinfopath = "/usr/local/share/libosinfo/db" -- 2.11.0

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