diff --git a/.gitignore b/.gitignore index 0386dfd..0ba5ef6 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,2 @@ -SOURCES/guestfs-tools-1.50.1.tar.gz +SOURCES/guestfs-tools-1.51.6.tar.gz SOURCES/libguestfs.keyring diff --git a/.guestfs-tools.metadata b/.guestfs-tools.metadata index f2fd52a..7f3840b 100644 --- a/.guestfs-tools.metadata +++ b/.guestfs-tools.metadata @@ -1,2 +1,2 @@ -e1fbf090056a2c559f85df7fffe10d2e28a88c37 SOURCES/guestfs-tools-1.50.1.tar.gz +7a64ba52bca3a3591d2e639a6bc9002d61e7d374 SOURCES/guestfs-tools-1.51.6.tar.gz 1bbc40f501a7fef9eef2a39b701a71aee2fea7c4 SOURCES/libguestfs.keyring diff --git a/SOURCES/0001-Update-common-submodule.patch b/SOURCES/0001-Update-common-submodule.patch new file mode 100644 index 0000000..1970bb1 --- /dev/null +++ b/SOURCES/0001-Update-common-submodule.patch @@ -0,0 +1,26 @@ +From 28ecb8693bbded3e1c70c1baa57f3498a6b8127e Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Sat, 9 Dec 2023 12:59:13 +0000 +Subject: [PATCH] Update common submodule + +Pick up this bug fix: + + mltools/libosinfo-c.c: Fix off-by-one error +--- + common | 2 +- + 1 file changed, 1 insertion(+), 1 deletion(-) + +Submodule common cd29aee91..0dba002c2: +diff --git a/common/mltools/libosinfo-c.c b/common/mltools/libosinfo-c.c +index 93357fd91..a48c8989f 100644 +--- a/common/mltools/libosinfo-c.c ++++ b/common/mltools/libosinfo-c.c +@@ -296,7 +296,7 @@ v2v_osinfo_os_get_device_drivers (value osv) + + driver = OSINFO_DEVICE_DRIVER(osinfo_list_get_nth (OSINFO_LIST(list), i)); + +- vi = caml_alloc (6, 0); ++ vi = caml_alloc (7, 0); + str = osinfo_device_driver_get_architecture (driver); + copyv = caml_copy_string (str); + Store_field (vi, 0, copyv); diff --git a/SOURCES/0002-builder-Add-a-test-of-the-chown-parameter.patch b/SOURCES/0002-builder-Add-a-test-of-the-chown-parameter.patch new file mode 100644 index 0000000..751ebec --- /dev/null +++ b/SOURCES/0002-builder-Add-a-test-of-the-chown-parameter.patch @@ -0,0 +1,63 @@ +From 5f9beb89443f84640efc52ee6cd68f7f880fb66b Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Fri, 19 Jan 2024 13:22:51 +0000 +Subject: [PATCH] builder: Add a test of the --chown parameter + +Also update the libguestfs common submodule, pulling in this change +from libguestfs: + + generator/customize.ml: Split --chown parameter on ':' character + +and this patch to common/mltools: + + mltools/libosinfo-c.c: Fix off-by-one error + +(cherry picked from commit 299dc5ec2a0bdd9adecef75adc6a5eca0dc685b1) +--- + builder/test-virt-builder.sh | 4 ++++ + common | 2 +- + 2 files changed, 5 insertions(+), 1 deletion(-) + +diff --git a/builder/test-virt-builder.sh b/builder/test-virt-builder.sh +index 705788a3c..f839fd7af 100755 +--- a/builder/test-virt-builder.sh ++++ b/builder/test-virt-builder.sh +@@ -69,6 +69,7 @@ virt-builder phony-fedora \ + --write '/etc/append6: + ' \ + --append-line '/etc/append6:line2' \ ++ --chown 1:1:/etc/append6 \ + --firstboot Makefile --firstboot-command 'echo "hello"' \ + --firstboot-install "minicom,inkscape" + +@@ -112,6 +113,7 @@ echo append5: + cat /etc/append5 + echo append6: + cat /etc/append6 ++stat /etc/append6 | grep '^[ug]id:' + + echo ----- + EOF +@@ -154,6 +156,8 @@ append6: + + line2 + ++uid: 1 ++gid: 1 + -----" ]; then + echo "$0: unexpected output:" + cat test-virt-builder.out +Submodule common 0dba002c2..54869c987: +diff --git a/common/mlcustomize/customize_cmdline.ml b/common/mlcustomize/customize_cmdline.ml +index 245d9960a..48ee33445 100644 +--- a/common/mlcustomize/customize_cmdline.ml ++++ b/common/mlcustomize/customize_cmdline.ml +@@ -157,7 +157,7 @@ let rec argspec () = + let len = String.length arg in + String.sub arg 0 i, String.sub arg (i+1) (len-(i+1)) + and split_string_triplet option_name arg = +- match String.nsplit ~max:3 "," arg with ++ match String.nsplit ~max:3 ":" arg with + | [a; b; c] -> a, b, c + | _ -> + error (f_"invalid format for '--%s' parameter, see the man page") diff --git a/SOURCES/0001-RHEL-Reject-use-of-libguestfs-winsupport-features-ex.patch b/SOURCES/0003-RHEL-Reject-use-of-libguestfs-winsupport-features-ex.patch similarity index 91% rename from SOURCES/0001-RHEL-Reject-use-of-libguestfs-winsupport-features-ex.patch rename to SOURCES/0003-RHEL-Reject-use-of-libguestfs-winsupport-features-ex.patch index 1253d15..dc5d573 100644 --- a/SOURCES/0001-RHEL-Reject-use-of-libguestfs-winsupport-features-ex.patch +++ b/SOURCES/0003-RHEL-Reject-use-of-libguestfs-winsupport-features-ex.patch @@ -1,4 +1,4 @@ -From b4f4e1906b8de6286889690047e35969d2dfaa91 Mon Sep 17 00:00:00 2001 +From b5fdf9eac368a1c5df4ddd93ce40884924e6092a Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 7 Jul 2015 09:28:03 -0400 Subject: [PATCH] RHEL: Reject use of libguestfs-winsupport features except for diff --git a/SOURCES/0003-Remove-virt-dib.patch b/SOURCES/0003-Remove-virt-dib.patch deleted file mode 100644 index 4887d2d..0000000 --- a/SOURCES/0003-Remove-virt-dib.patch +++ /dev/null @@ -1,3627 +0,0 @@ -From e9f49fd262d0ce5e18789cb2e03225246fc65658 Mon Sep 17 00:00:00 2001 -From: "Richard W.M. Jones" -Date: Tue, 7 Feb 2023 13:20:36 +0000 -Subject: [PATCH] Remove virt-dib - -The tool only supports an older version of the diskimage-builder -metadata, and we do not have the time or inclination to update it to a -newer version. - -Fixes: https://bugzilla.redhat.com/show_bug.cgi?id=1910039 -(cherry picked from commit 57423d907270526ea664ff15601cce956353820e) ---- - .gitignore | 4 - - Makefile.am | 3 +- - bash/Makefile.am | 3 +- - bash/virt-alignment-scan | 6 - - configure.ac | 1 - - dib/Makefile.am | 169 ------ - dib/cmdline.ml | 267 --------- - dib/cmdline.mli | 52 -- - dib/dib.ml | 1007 --------------------------------- - dib/dib.mli | 19 - - dib/dummy.c | 2 - - dib/elements.ml | 207 ------- - dib/elements.mli | 61 -- - dib/output_format.ml | 192 ------- - dib/output_format.mli | 131 ----- - dib/output_format_docker.ml | 57 -- - dib/output_format_qcow2.ml | 56 -- - dib/output_format_raw.ml | 31 - - dib/output_format_squashfs.ml | 39 -- - dib/output_format_tar.ml | 35 -- - dib/output_format_tgz.ml | 35 -- - dib/output_format_vhd.ml | 47 -- - dib/test-virt-dib-docs.sh | 23 - - dib/utils.ml | 111 ---- - dib/utils.mli | 66 --- - dib/virt-dib.pod | 727 ------------------------ - run.in | 1 - - 27 files changed, 2 insertions(+), 3350 deletions(-) - delete mode 100644 dib/Makefile.am - delete mode 100644 dib/cmdline.ml - delete mode 100644 dib/cmdline.mli - delete mode 100644 dib/dib.ml - delete mode 100644 dib/dib.mli - delete mode 100644 dib/dummy.c - delete mode 100644 dib/elements.ml - delete mode 100644 dib/elements.mli - delete mode 100644 dib/output_format.ml - delete mode 100644 dib/output_format.mli - delete mode 100644 dib/output_format_docker.ml - delete mode 100644 dib/output_format_qcow2.ml - delete mode 100644 dib/output_format_raw.ml - delete mode 100644 dib/output_format_squashfs.ml - delete mode 100644 dib/output_format_tar.ml - delete mode 100644 dib/output_format_tgz.ml - delete mode 100644 dib/output_format_vhd.ml - delete mode 100755 dib/test-virt-dib-docs.sh - delete mode 100644 dib/utils.ml - delete mode 100644 dib/utils.mli - delete mode 100644 dib/virt-dib.pod - -diff --git a/.gitignore b/.gitignore -index da2a0266b..b0ada2e3c 100644 ---- a/.gitignore -+++ b/.gitignore -@@ -30,7 +30,6 @@ Makefile.in - /bash/virt-cat - /bash/virt-customize - /bash/virt-df --/bash/virt-dib - /bash/virt-diff - /bash/virt-drivers - /bash/virt-edit -@@ -95,9 +94,6 @@ Makefile.in - /customize/test-settings-*.sh - /customize/virt-customize - /df/virt-df --/dib/.depend --/dib/output_format_*.mli --/dib/virt-dib - /drivers/.depend - /drivers/virt-drivers - /diff/virt-diff -diff --git a/Makefile.am b/Makefile.am -index 311789ed1..ca1fc03c9 100644 ---- a/Makefile.am -+++ b/Makefile.am -@@ -60,7 +60,6 @@ SUBDIRS += get-kernel - SUBDIRS += resize - SUBDIRS += sparsify - SUBDIRS += sysprep --SUBDIRS += dib - endif - - # bash-completion -@@ -121,7 +120,7 @@ po/POTFILES: configure.ac - po/POTFILES-ml: configure.ac - rm -f $@ $@-t - cd $(srcdir); \ -- find builder common/ml* customize dib drivers get-kernel resize sparsify sysprep -name '*.ml' | \ -+ find builder common/ml* customize drivers get-kernel resize sparsify sysprep -name '*.ml' | \ - grep -v '^builder/templates/' | \ - grep -v '^common/mlv2v/' | \ - grep -v -E '.*_tests\.ml$$' | \ -diff --git a/bash/Makefile.am b/bash/Makefile.am -index 000fab5eb..9a63736d2 100644 ---- a/bash/Makefile.am -+++ b/bash/Makefile.am -@@ -28,7 +28,6 @@ symlinks = \ - virt-customize \ - virt-diff \ - virt-df \ -- virt-dib \ - virt-drivers \ - virt-edit \ - virt-filesystems \ -@@ -55,7 +54,7 @@ CLEANFILES += \ - # common options like -d is handled by this common script. However - # this script cannot deal with commands that use --ro/--rw - # (eg. virt-rescue). Those tools have to be handled individually. --virt-builder virt-cat virt-customize virt-df virt-dib virt-diff virt-drivers \ -+virt-builder virt-cat virt-customize virt-df virt-diff virt-drivers \ - virt-edit virt-filesystems virt-format virt-get-kernel virt-inspector \ - virt-log virt-ls \ - virt-resize virt-sparsify virt-sysprep \ -diff --git a/bash/virt-alignment-scan b/bash/virt-alignment-scan -index b93a00118..bb9a71ebf 100644 ---- a/bash/virt-alignment-scan -+++ b/bash/virt-alignment-scan -@@ -109,12 +109,6 @@ _virt_customize () - } && - complete -o default -F _virt_customize virt-customize - --_virt_dib () --{ -- _guestfs_virttools "virt-dib" 0 --} && --complete -o default -F _virt_dib virt-dib -- - _virt_df () - { - _guestfs_virttools "virt-df" 1 -diff --git a/configure.ac b/configure.ac -index 24a89d640..34c66b80e 100644 ---- a/configure.ac -+++ b/configure.ac -@@ -136,7 +136,6 @@ AC_CONFIG_FILES([Makefile - customize/Makefile - docs/Makefile - df/Makefile -- dib/Makefile - diff/Makefile - drivers/Makefile - edit/Makefile -diff --git a/dib/Makefile.am b/dib/Makefile.am -deleted file mode 100644 -index 7581feb78..000000000 ---- a/dib/Makefile.am -+++ /dev/null -@@ -1,169 +0,0 @@ --# libguestfs virt-dib tool --# Copyright (C) 2015 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. -- --include $(top_srcdir)/subdir-rules.mk -- --EXTRA_DIST = \ -- $(SOURCES_MLI) $(SOURCES_ML) $(SOURCES_C) \ -- test-virt-dib-docs.sh \ -- virt-dib.pod -- --SOURCES_MLI = \ -- cmdline.mli \ -- dib.mli \ -- elements.mli \ -- output_format.mli \ -- $(patsubst %,output_format_%.mli,$(formats)) \ -- utils.mli -- --# Filenames output_format_.ml in alphabetical order. --formats = \ -- docker \ -- qcow2 \ -- raw \ -- squashfs \ -- tar \ -- tgz \ -- vhd -- --SOURCES_ML = \ -- utils.ml \ -- output_format.ml \ -- cmdline.ml \ -- elements.ml \ -- $(patsubst %,output_format_%.ml,$(formats)) \ -- dib.ml -- --SOURCES_C = \ -- dummy.c -- --bin_PROGRAMS = -- --if HAVE_OCAML -- --bin_PROGRAMS += virt-dib -- --virt_dib_SOURCES = $(SOURCES_C) --virt_dib_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)/common/utils \ -- -I$(top_srcdir)/lib --virt_dib_CFLAGS = \ -- -pthread \ -- $(WARN_CFLAGS) $(WERROR_CFLAGS) -- --BOBJECTS = \ -- $(SOURCES_ML:.ml=.cmo) --XOBJECTS = $(BOBJECTS:.cmo=.cmx) -- --OCAMLPACKAGES = \ -- -package str,unix,guestfs \ -- -I $(top_builddir)/common/utils/.libs \ -- -I $(top_builddir)/gnulib/lib/.libs \ -- -I $(top_builddir)/ocaml \ -- -I $(top_builddir)/common/mlstdutils \ -- -I $(top_builddir)/common/mlutils \ -- -I $(top_builddir)/common/mlgettext \ -- -I $(top_builddir)/common/mlpcre \ -- -I $(top_builddir)/common/mltools --if HAVE_OCAML_PKG_GETTEXT --OCAMLPACKAGES += -package gettext-stub --endif -- --OCAMLCLIBS = \ -- -pthread -lpthread \ -- -lutils \ -- $(LIBXML2_LIBS) \ -- $(LIBGUESTFS_LIBS) \ -- $(LIBINTL) \ -- -lgnu -- --OCAMLFLAGS = $(OCAML_FLAGS) $(OCAML_WARN_ERROR) -ccopt '$(CFLAGS)' -- --if !HAVE_OCAMLOPT --OBJECTS = $(BOBJECTS) --else --OBJECTS = $(XOBJECTS) --endif -- --OCAMLLINKFLAGS = \ -- mlstdutils.$(MLARCHIVE) \ -- mlguestfs.$(MLARCHIVE) \ -- mlcutils.$(MLARCHIVE) \ -- mlgettext.$(MLARCHIVE) \ -- mlpcre.$(MLARCHIVE) \ -- mltools.$(MLARCHIVE) \ -- $(LINK_CUSTOM_OCAMLC_ONLY) -- --virt_dib_DEPENDENCIES = \ -- $(OBJECTS) \ -- ../common/mlstdutils/mlstdutils.$(MLARCHIVE) \ -- ../common/mlutils/mlcutils.$(MLARCHIVE) \ -- ../common/mlgettext/mlgettext.$(MLARCHIVE) \ -- ../common/mlpcre/mlpcre.$(MLARCHIVE) \ -- ../common/mltools/mltools.$(MLARCHIVE) \ -- $(top_builddir)/ocaml-link.sh --virt_dib_LINK = \ -- $(top_builddir)/ocaml-link.sh -cclib '$(OCAMLCLIBS)' -- \ -- $(OCAMLFIND) $(BEST) $(OCAMLFLAGS) $(OCAMLPACKAGES) $(OCAMLLINKFLAGS) \ -- $(OBJECTS) -o $@ -- --# The output_format_*.mli files are all empty and autogenerated. --CLEANFILES += \ -- $(patsubst %,output_format_%.mli,$(formats)) -- --output_format_%.mli: -- rm -f $@ $@-t -- echo '(* This file is generated by Makefile.am. *)' >> $@-t -- echo '(* Nothing is exported from output format modules. *)' >> $@-t -- mv $@-t $@ -- --# Tests. -- --TESTS_ENVIRONMENT = $(top_builddir)/run --test -- --TESTS = test-virt-dib-docs.sh -- --# Manual pages and HTML files for the website. -- --man_MANS = virt-dib.1 -- --noinst_DATA = $(top_builddir)/website/virt-dib.1.html -- --virt-dib.1 $(top_builddir)/website/virt-dib.1.html: stamp-virt-dib.pod -- --stamp-virt-dib.pod: virt-dib.pod -- $(PODWRAPPER) \ -- --man virt-dib.1 \ -- --html $(top_builddir)/website/virt-dib.1.html \ -- --license GPLv2+ \ -- --warning safe \ -- $< -- touch $@ -- --# OCaml dependencies. --.depend: $(SOURCES_MLI) $(SOURCES_ML) -- $(top_builddir)/ocaml-dep.sh $^ ---include .depend -- --endif -- --.PHONY: docs -diff --git a/dib/cmdline.ml b/dib/cmdline.ml -deleted file mode 100644 -index 11ff57341..000000000 ---- a/dib/cmdline.ml -+++ /dev/null -@@ -1,267 +0,0 @@ --(* virt-dib -- * Copyright (C) 2015 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. -- *) -- --(* Command line argument parsing. *) -- --open Std_utils --open Tools_utils --open Common_gettext.Gettext --open Getopt.OptionName -- --open Utils -- --open Printf -- --type cmdline = { -- debug : int; -- basepath : string; -- elements : string list; -- excluded_elements : string list; -- element_paths : string list; -- excluded_scripts : string list; -- use_base : bool; -- drive : string option; -- drive_format : string option; -- image_name : string; -- fs_type : string; -- size : int64; -- root_label : string option; -- install_type : string; -- image_cache : string option; -- mkfs_options : string option; -- is_ramdisk : bool; -- ramdisk_element : string; -- extra_packages : string list; -- memsize : int option; -- network : bool; -- smp : int option; -- delete_on_failure : bool; -- formats : Output_format.set; -- arch : string; -- envvars : string list; -- checksum : bool; -- python : string option; --} -- --let parse_cmdline () = -- let usage_msg = -- sprintf (f_"\ --%s: run diskimage-builder elements to generate images -- -- virt-dib -B DIB-LIB -p ELEMENTS-PATH elements... -- --A short summary of the options is given below. For detailed help please --read the man page virt-dib(1). --") -- prog in -- -- let elements = ref [] in -- let append_element element = List.push_front element elements in -- -- let excluded_elements = ref [] in -- let append_excluded_element element = List.push_front element excluded_elements in -- -- let element_paths = ref [] in -- let append_element_path arg = List.push_front arg element_paths in -- -- let excluded_scripts = ref [] in -- let append_excluded_script arg = List.push_front arg excluded_scripts in -- -- let debug = ref 0 in -- let set_debug arg = -- if arg < 0 then -- error (f_"--debug parameter must be >= 0"); -- debug := arg in -- -- let basepath = ref "" in -- -- let image_name = ref "image" in -- -- let fs_type = ref "ext4" in -- -- let size = ref (unit_GB 5) in -- let set_size arg = size := parse_size arg in -- -- let memsize = ref None in -- let set_memsize arg = memsize := Some arg in -- -- let network = ref true in -- -- let smp = ref None in -- let set_smp arg = smp := Some arg in -- -- let formats = ref None in -- let set_format arg = -- let fmts = List.remove_duplicates (String.nsplit "," arg) in -- let fmtset = -- List.fold_left ( -- fun fmtset fmt -> -- try Output_format.add_to_set fmt fmtset -- with Not_found -> -- error (f_"invalid format ‘%s’ in --formats") fmt -- ) Output_format.empty_set fmts in -- formats := Some fmtset in -- -- let envvars = ref [] in -- let append_envvar arg = List.push_front arg envvars in -- -- let use_base = ref true in -- -- let arch = ref "" in -- -- let drive = ref None in -- let set_drive arg = drive := Some arg in -- let drive_format = ref None in -- let set_drive_format arg = drive_format := Some arg in -- -- let root_label = ref None in -- let set_root_label arg = root_label := Some arg in -- -- let install_type = ref "source" in -- -- let image_cache = ref None in -- let set_image_cache arg = image_cache := Some arg in -- -- let delete_on_failure = ref true in -- -- let is_ramdisk = ref false in -- let ramdisk_element = ref "ramdisk" in -- -- let mkfs_options = ref None in -- let set_mkfs_options arg = mkfs_options := Some arg in -- -- let extra_packages = ref [] in -- let append_extra_packages arg = -- List.push_front_list (List.rev (String.nsplit "," arg)) extra_packages in -- -- let checksum = ref false in -- -- let python = ref None in -- let set_python arg = python := Some arg in -- -- let argspec = [ -- [ S 'p'; L"element-path" ], Getopt.String ("path", append_element_path), s_"Add new a elements location"; -- [ L"exclude-element" ], Getopt.String ("element", append_excluded_element), -- s_"Exclude the specified element"; -- [ L"exclude-script" ], Getopt.String ("script", append_excluded_script), -- s_"Exclude the specified script"; -- [ L"envvar" ], Getopt.String ("envvar[=value]", append_envvar), s_"Carry/set this environment variable"; -- [ L"skip-base" ], Getopt.Clear use_base, s_"Skip the inclusion of the ‘base’ element"; -- [ L"root-label" ], Getopt.String ("label", set_root_label), s_"Label for the root fs"; -- [ L"install-type" ], Getopt.Set_string ("type", install_type), s_"Installation type"; -- [ L"image-cache" ], Getopt.String ("directory", set_image_cache), s_"Location for cached images"; -- [ L"mkfs-options" ], Getopt.String ("option", set_mkfs_options), -- s_"Add mkfs options"; -- [ L"extra-packages" ], Getopt.String ("pkg,...", append_extra_packages), -- s_"Add extra packages to install"; -- [ L"checksum" ], Getopt.Set checksum, s_"Generate MD5 and SHA256 checksum files"; -- [ L"python" ], Getopt.String ("python", set_python), s_"Set Python interpreter"; -- -- [ L"ramdisk" ], Getopt.Set is_ramdisk, "Switch to a ramdisk build"; -- [ L"ramdisk-element" ], Getopt.Set_string ("name", ramdisk_element), s_"Main element for building ramdisks"; -- -- [ L"name" ], Getopt.Set_string ("name", image_name), s_"Name of the image"; -- [ L"fs-type" ], Getopt.Set_string ("fs", fs_type), s_"Filesystem for the image"; -- [ L"size" ], Getopt.String ("size", set_size), s_"Set output disk size"; -- [ L"formats" ], Getopt.String ("qcow2,tgz,...", set_format), s_"Output formats"; -- [ L"arch" ], Getopt.Set_string ("arch", arch), s_"Output architecture"; -- [ L"drive" ], Getopt.String ("path", set_drive), s_"Optional drive for caches"; -- [ L"drive-format" ], Getopt.String (s_"format", set_drive_format), s_"Format of optional drive"; -- -- [ S 'm'; L"memsize" ], Getopt.Int ("mb", set_memsize), s_"Set memory size"; -- [ L"network" ], Getopt.Set network, s_"Enable appliance network (default)"; -- [ L"no-network" ], Getopt.Clear network, s_"Disable appliance network"; -- [ L"smp" ], Getopt.Int ("vcpus", set_smp), s_"Set number of vCPUs"; -- [ L"no-delete-on-failure" ], Getopt.Clear delete_on_failure, -- s_"Don’t delete output file on failure"; -- -- [ L"debug" ], Getopt.Int ("level", set_debug), s_"Set debug level"; -- [ S 'B' ], Getopt.Set_string ("path", basepath), s_"Base path of diskimage-builder library"; -- ] in -- let argspec = argspec @ Output_format.extra_args () in -- -- let opthandle = create_standard_options argspec ~anon_fun:append_element ~machine_readable:true usage_msg in -- Getopt.parse opthandle.getopt; -- -- let debug = !debug in -- let basepath = !basepath in -- let elements = List.rev !elements in -- let excluded_elements = List.rev !excluded_elements in -- let element_paths = List.rev !element_paths in -- let excluded_scripts = List.rev !excluded_scripts in -- let image_name = !image_name in -- let fs_type = !fs_type in -- let size = !size in -- let memsize = !memsize in -- let network = !network in -- let smp = !smp in -- let formats = !formats in -- let envvars = !envvars in -- let use_base = !use_base in -- let arch = !arch in -- let drive = !drive in -- let drive_format = !drive_format in -- let root_label = !root_label in -- let install_type = !install_type in -- let image_cache = !image_cache in -- let delete_on_failure = !delete_on_failure in -- let is_ramdisk = !is_ramdisk in -- let ramdisk_element = !ramdisk_element in -- let mkfs_options = !mkfs_options in -- let extra_packages = List.rev !extra_packages in -- let checksum = !checksum in -- let python = !python in -- -- (* No elements and machine-readable mode? Print some facts. *) -- (match elements, machine_readable () with -- | [], Some { pr } -> -- pr "virt-dib\n"; -- let formats_list = Output_format.list_formats () in -- List.iter (pr "output:%s\n") formats_list; -- exit 0 -- | _, _ -> () -- ); -- -- if basepath = "" then -- error (f_"-B must be specified"); -- -- let formats = -- match formats with -- | None -> Output_format.add_to_set "qcow2" Output_format.empty_set -- | Some fmtset -> -- if Output_format.set_cardinal fmtset = 0 then -- error (f_"the list of output formats cannot be empty"); -- fmtset in -- -- if elements = [] then -- error (f_"at least one distribution root element must be specified"); -- -- let python = Option.map get_required_tool python in -- -- { debug = debug; basepath = basepath; elements = elements; -- excluded_elements = excluded_elements; element_paths = element_paths; -- excluded_scripts = excluded_scripts; use_base = use_base; drive = drive; -- drive_format = drive_format; image_name = image_name; fs_type = fs_type; -- size = size; root_label = root_label; install_type = install_type; -- image_cache = image_cache; mkfs_options = mkfs_options; -- is_ramdisk = is_ramdisk; ramdisk_element = ramdisk_element; -- extra_packages = extra_packages; memsize = memsize; network = network; -- smp = smp; delete_on_failure = delete_on_failure; -- formats = formats; arch = arch; envvars = envvars; -- checksum = checksum; python = python; -- } -diff --git a/dib/cmdline.mli b/dib/cmdline.mli -deleted file mode 100644 -index 5c82efd60..000000000 ---- a/dib/cmdline.mli -+++ /dev/null -@@ -1,52 +0,0 @@ --(* virt-dib -- * Copyright (C) 2015 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. -- *) -- --(** Command line argument parsing. *) -- --type cmdline = { -- debug : int; -- basepath : string; -- elements : string list; -- excluded_elements : string list; -- element_paths : string list; -- excluded_scripts : string list; -- use_base : bool; -- drive : string option; -- drive_format : string option; -- image_name : string; -- fs_type : string; -- size : int64; -- root_label : string option; -- install_type : string; -- image_cache : string option; -- mkfs_options : string option; -- is_ramdisk : bool; -- ramdisk_element : string; -- extra_packages : string list; -- memsize : int option; -- network : bool; -- smp : int option; -- delete_on_failure : bool; -- formats : Output_format.set; -- arch : string; -- envvars : string list; -- checksum : bool; -- python : string option; --} -- --val parse_cmdline : unit -> cmdline -diff --git a/dib/dib.ml b/dib/dib.ml -deleted file mode 100644 -index 9ae154b86..000000000 ---- a/dib/dib.ml -+++ /dev/null -@@ -1,1007 +0,0 @@ --(* virt-dib -- * Copyright (C) 2015 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 Unix_utils --open Common_gettext.Gettext -- --open Cmdline --open Utils --open Elements -- --open Printf -- --module G = Guestfs -- --let checksums = [ "md5"; "sha256" ] --and tool_of_checksum csum = -- csum ^ "sum" -- --let exclude_elements elements = function -- | [] -> -- (* No elements to filter out, so just don't bother iterating through -- * the elements. *) -- elements -- | excl -> StringSet.filter (not_in_list excl) elements -- --let read_envvars envvars = -- List.filter_map ( -- fun var -> -- let i = String.find var "=" in -- if i = -1 then ( -- try Some (var, Sys.getenv var) -- with Not_found -> None -- ) else ( -- let len = String.length var in -- Some (String.sub var 0 i, String.sub var (i + 1) (len - i - 1)) -- ) -- ) envvars -- --let read_dib_envvars () = -- let vars = Array.to_list (Unix.environment ()) in -- let vars = List.filter (fun x -> String.is_prefix x "DIB_") vars in -- let vars = List.map (fun x -> x ^ "\n") vars in -- String.concat "" vars -- --let write_script fn text = -- with_open_out fn ( -- fun oc -> -- output_string oc text; -- flush oc -- ); -- Unix.chmod fn 0o755 -- --let envvars_string l = -- let l = List.map ( -- fun (var, value) -> -- sprintf "export %s=%s" var (quote value) -- ) l in -- String.concat "\n" l -- --let prepare_external ~envvars ~dib_args ~dib_vars ~out_name ~root_label -- ~rootfs_uuid ~image_cache ~arch ~network ~debug ~fs_type ~checksum -- ~python -- destdir libdir fakebindir loaded_elements all_elements element_paths = -- let network_string = if network then "" else "1" in -- let checksum_string = if checksum then "1" else "" in -- let elements_paths_yaml = -- List.map ( -- fun e -> -- sprintf "%s: %s" e (quote (Hashtbl.find loaded_elements e).directory) -- ) (StringSet.elements all_elements) in -- let elements_paths_yaml = String.concat ", " elements_paths_yaml in -- let elements_paths_array = -- List.map ( -- fun e -> -- sprintf "[%s]=%s" e (quote (Hashtbl.find loaded_elements e).directory) -- ) (StringSet.elements all_elements) in -- let elements_paths_array = String.concat " " elements_paths_array in -- -- let run_extra = sprintf "\ --#!/bin/bash --set -e --%s --mount_dir=$1 --shift --hooks_dir=$1 --shift --target_dir=$1 --shift --script=$1 --shift -- --VIRT_DIB_OURPATH=$(dirname $(realpath $0)) -- --# user variables --%s -- --export PATH=%s:$PATH -- --# d-i-b variables --export TMP_MOUNT_PATH=\"$mount_dir\" --export DIB_OFFLINE=%s --export IMAGE_NAME=\"%s\" --export DIB_ROOT_LABEL=\"%s\" --export DIB_IMAGE_ROOT_FS_UUID=%s --export DIB_IMAGE_CACHE=\"%s\" --export _LIB=%s --export ARCH=%s --export TMP_HOOKS_PATH=\"$hooks_dir\" --export DIB_ARGS=\"%s\" --export IMAGE_ELEMENT=\"%s\" --export ELEMENTS_PATH=\"%s\" --export DIB_ENV=%s --export TMPDIR=\"${TMP_MOUNT_PATH}/tmp\" --export TMP_DIR=\"${TMPDIR}\" --export DIB_DEBUG_TRACE=%d --export FS_TYPE=%s --export DIB_CHECKSUM=%s --export DIB_PYTHON_EXEC=%s -- --elinfo_out=$(<${VIRT_DIB_OURPATH}/elinfo_out) --eval \"$elinfo_out\" -- --ENVIRONMENT_D_DIR=$target_dir/../environment.d -- --if [ -d $ENVIRONMENT_D_DIR ] ; then -- env_files=$(find $ENVIRONMENT_D_DIR -maxdepth 1 -xtype f | \ -- grep -E \"/[0-9A-Za-z_\\.-]+$\" | \ -- LANG=C sort -n) -- for env_file in $env_files ; do -- source $env_file -- done --fi -- --source $_LIB/die -- --$target_dir/$script --" -- (if debug >= 1 then "set -x\n" else "") -- (envvars_string envvars) -- fakebindir -- network_string -- out_name -- root_label -- rootfs_uuid -- image_cache -- (quote libdir) -- arch -- dib_args -- (String.concat " " (StringSet.elements all_elements)) -- (String.concat ":" element_paths) -- (quote dib_vars) -- debug -- fs_type -- checksum_string -- python in -- write_script (destdir // "run-part-extra.sh") run_extra; -- let elinfo_out = sprintf "\ --export IMAGE_ELEMENT_YAML=\"{%s}\" --function get_image_element_array { -- echo \"%s\" --}; --export -f get_image_element_array; --" -- elements_paths_yaml -- elements_paths_array in -- write_script (destdir // "elinfo_out") elinfo_out -- --let prepare_aux ~envvars ~dib_args ~dib_vars ~log_file ~out_name ~rootfs_uuid -- ~arch ~network ~root_label ~install_type ~debug ~extra_packages ~fs_type -- ~checksum destdir all_elements = -- let network_string = if network then "" else "1" in -- let checksum_string = if checksum then "1" else "" in -- -- let script_run_part = sprintf "\ --#!/bin/bash --set -e --%s --sysroot=$1 --shift --mysysroot=$1 --shift --blockdev=$1 --shift --target_dir=$1 --shift --new_wd=$1 --shift --script=$1 --shift -- --# user variables --%s -- --# system variables --export HOME=$mysysroot/tmp/in_target.aux/perm/home --export PATH=$mysysroot/tmp/in_target.aux/hooks/bin:$PATH --export TMP=$mysysroot/tmp --export TMPDIR=$TMP --export TMP_DIR=$TMP -- --# d-i-b variables --export TMP_MOUNT_PATH=$sysroot --export TARGET_ROOT=$sysroot --export DIB_OFFLINE=%s --export IMAGE_NAME=\"%s\" --export DIB_IMAGE_ROOT_FS_UUID=%s --export DIB_IMAGE_CACHE=$HOME/.cache/image-create --export DIB_ROOT_LABEL=\"%s\" --export _LIB=$mysysroot/tmp/in_target.aux/lib --export _PREFIX=$mysysroot/tmp/in_target.aux/elements --export ARCH=%s --export TMP_HOOKS_PATH=$mysysroot/tmp/in_target.aux/hooks --export DIB_ARGS=\"%s\" --export DIB_MANIFEST_SAVE_DIR=\"$mysysroot/tmp/in_target.aux/out/${IMAGE_NAME}.d\" --export IMAGE_BLOCK_DEVICE=$blockdev --export IMAGE_BLOCK_DEVICE_WITHOUT_PART=$(echo ${IMAGE_BLOCK_DEVICE} | sed -e \"s|^\\(.*loop[0-9]*\\)p[0-9]*$|\\1|g\") --export IMAGE_ELEMENT=\"%s\" --export DIB_ENV=%s --export DIB_DEBUG_TRACE=%d --export DIB_NO_TMPFS=1 --export FS_TYPE=%s --export DIB_CHECKSUM=%s -- --export TMP_BUILD_DIR=$mysysroot/tmp/in_target.aux --export TMP_IMAGE_DIR=$mysysroot/tmp/in_target.aux -- --if [ -n \"$mysysroot\" ]; then -- export PATH=$mysysroot/tmp/in_target.aux/fake-bin:$PATH -- source $_LIB/die --else -- export PATH=\"$PATH:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin\" --fi -- --ENVIRONMENT_D_DIR=$target_dir/../environment.d -- --if [ -d $ENVIRONMENT_D_DIR ] ; then -- env_files=$(find $ENVIRONMENT_D_DIR -maxdepth 1 -xtype f | \ -- grep -E \"/[0-9A-Za-z_\\.-]+$\" | \ -- LANG=C sort -n) -- for env_file in $env_files ; do -- source $env_file -- done --fi -- --if [ -n \"$new_wd\" ]; then -- cd \"$mysysroot/$new_wd\" --fi -- --$target_dir/$script --" -- (if debug >= 1 then "set -x\n" else "") -- (envvars_string envvars) -- network_string -- out_name -- rootfs_uuid -- root_label -- arch -- dib_args -- (String.concat " " (StringSet.elements all_elements)) -- (quote dib_vars) -- debug -- fs_type -- checksum_string in -- write_script (destdir // "run-part.sh") script_run_part; -- let script_run_and_log = "\ --#!/bin/bash --logfile=$1 --shift --exec 3>&1 --exit `( ( ( $(dirname $0)/run-part.sh \"$@\" ) 2>&1 3>&-; echo $? >&4) | tee -a $logfile >&3 >&2) 4>&1` --" in -- write_script (destdir // "run-and-log.sh") script_run_and_log; -- -- (* Create the fake sudo support. *) -- do_mkdir (destdir // "fake-bin"); -- let fake_sudo = "\ --#!/bin/bash --set -e -- --SCRIPTNAME=fake-sudo -- --ARGS_SHORT=\"EHiu:\" --ARGS_LONG=\"\" --TEMP=`POSIXLY_CORRECT=1 getopt ${ARGS_SHORT:+-o $ARGS_SHORT} ${ARGS_LONG:+--long $ARGS_LONG} \ -- -n \"$SCRIPTNAME\" -- \"$@\"` --if [ $? != 0 ]; then echo \"$SCRIPTNAME: terminating...\" >&2 ; exit 1 ; fi --eval set -- \"$TEMP\" -- --preserve_env= --set_home= --login_shell= --user= -- --while true; do -- case \"$1\" in -- -E) preserve_env=1; shift;; -- -H) set_home=1; shift;; -- -i) login_shell=1; shift;; -- -u) user=$2; shift 2;; -- --) shift; break;; -- *) echo \"$SCRIPTNAME: internal arguments error\"; exit 1;; -- esac --done -- --if [ -n \"$user\" ]; then -- if [ $user != root -a $user != `whoami` ]; then -- echo \"$SCRIPTNAME: cannot use the sudo user $user, only root and $(whoami) handled\" >&2 -- exit 1 -- fi --fi -- --if [ -z \"$preserve_env\" ]; then -- for envvar in `awk 'BEGIN{for (i in ENVIRON) {print i}}'`; do -- case \"$envvar\" in -- PATH | USER | USERNAME | HOSTNAME | TERM | LANG | HOME | SHELL | LOGNAME ) ;; -- BASH_FUNC_* ) unset -f $envvar ;; -- *) unset $envvar ;; -- esac -- done --fi --# TMPDIR needs to be unset, regardless of -E --unset TMPDIR --# ... and do that also to the other \"TMPDIR\"-like variables --unset TMP --unset TMP_DIR -- --cmd=$1 --shift --$cmd \"$@\" --" in -- write_script (destdir // "fake-bin" // "sudo") fake_sudo; -- (* Pick dib-run-parts from the host, if available, otherwise put -- * a fake executable which will error out if used. -- *) -- (try -- let loc = which "dib-run-parts" in -- do_cp loc (destdir // "fake-bin") -- with Executable_not_found _ -> -- let fake_dib_run_parts = "\ --#!/bin/sh --echo \"Please install dib-run-parts on the host\" --exit 1 --" in -- write_script (destdir // "fake-bin" // "dib-run-parts") fake_dib_run_parts; -- ); -- -- (* Write the custom hooks. *) -- let script_install_type_env = sprintf "\ --export DIB_DEFAULT_INSTALLTYPE=${DIB_DEFAULT_INSTALLTYPE:-\"%s\"} --" -- install_type in -- write_script (destdir // "hooks" // "environment.d" // "11-dib-install-type.bash") script_install_type_env; -- -- (* Write install-packages.sh if needed. *) -- if extra_packages <> [] then ( -- let script_install_packages = sprintf "\ --#!/bin/bash --install-packages %s --" -- (String.concat " " extra_packages) in -- write_script (destdir // "install-packages.sh") script_install_packages; -- ); -- -- do_mkdir (destdir // "perm") -- --let timing_output ~target_name entries timings = -- let buf = Buffer.create 4096 in -- Buffer.add_string buf "----------------------- PROFILING -----------------------\n"; -- Buffer.add_char buf '\n'; -- bprintf buf "Target: %s\n" target_name; -- Buffer.add_char buf '\n'; -- bprintf buf "%-40s %9s\n" "Script" "Seconds"; -- bprintf buf "%-40s %9s\n" "---------------------------------------" "----------"; -- Buffer.add_char buf '\n'; -- List.iter ( -- fun x -> -- bprintf buf "%-40s %10.3f\n" x (Hashtbl.find timings x); -- ) entries; -- Buffer.add_char buf '\n'; -- Buffer.add_string buf "--------------------- END PROFILING ---------------------\n"; -- Buffer.contents buf -- --type sysroot_type = -- | In -- | Out -- | Subroot -- --let timed_run fn = -- let time_before = Unix.gettimeofday () in -- fn (); -- let time_after = Unix.gettimeofday () in -- time_after -. time_before -- --let run_parts ~debug ~sysroot ~blockdev ~log_file ?(new_wd = "") -- (g : Guestfs.guestfs) hook_name scripts = -- let hook_dir = "/tmp/in_target.aux/hooks/" ^ hook_name in -- let scripts = List.sort digit_prefix_compare scripts in -- let outbuf = Buffer.create 16384 in -- let timings = Hashtbl.create 13 in -- let new_wd = -- match sysroot, new_wd with -- | (Out|Subroot), "" -> "''" -- | (In|Out|Subroot), dir -> dir in -- List.iter ( -- fun x -> -- message (f_"Running: %s/%s") hook_name x; -- g#write_append log_file (sprintf "Running %s/%s...\n" hook_name x); -- let out = ref "" in -- let run () = -- let outstr = -- match sysroot with -- | In -> -- g#sh (sprintf "/tmp/in_target.aux/run-and-log.sh '%s' '' '' '%s' '%s' '%s' '%s'" log_file blockdev hook_dir new_wd x) -- | Out -> -- g#debug "sh" [| "/sysroot/tmp/in_target.aux/run-and-log.sh"; "/sysroot" ^ log_file; "/sysroot"; "/sysroot"; blockdev; "/sysroot" ^ hook_dir; new_wd; x |] -- | Subroot -> -- g#debug "sh" [| "/sysroot/tmp/in_target.aux/run-and-log.sh"; "/sysroot" ^ log_file; "/sysroot/subroot"; "/sysroot"; blockdev; "/sysroot" ^ hook_dir; new_wd; x |] in -- out := outstr; -- Buffer.add_string outbuf outstr in -- let delta_t = timed_run run in -- Buffer.add_char outbuf '\n'; -- out := ensure_trailing_newline !out; -- printf "%s%!" !out; -- if debug >= 1 then ( -- printf "%s completed after %.3f s\n" x delta_t -- ); -- Hashtbl.add timings x delta_t; -- ) scripts; -- g#write_append log_file (timing_output ~target_name:hook_name scripts timings); -- flush_all (); -- Buffer.contents outbuf -- --let run_parts_host ~debug (g : Guestfs.guestfs) hook_name base_mount_dir scripts run_script = -- let scripts = List.sort digit_prefix_compare scripts in -- let mount_dir = base_mount_dir // hook_name in -- (* Point to the in-guest hooks, so that changes there can affect -- * other phases. -- *) -- let hooks_dir = mount_dir // "tmp" // "in_target.aux" // "hooks" in -- let hook_dir = hooks_dir // hook_name in -- do_mkdir mount_dir; -- -- let rec fork_and_run () = -- let pid = Unix.fork () in -- if pid = 0 then ( (* child *) -- let retcode = run_scripts () in -- flush_all (); -- let cmd = [ "guestunmount"; mount_dir ] in -- ignore (run_command cmd); -- Exit._exit retcode -- ); -- pid -- and run_scripts () = -- let timings = Hashtbl.create 13 in -- let rec loop = function -- | x :: xs -> -- message (f_"Running: %s/%s") hook_name x; -- let cmd = [ run_script; mount_dir; hooks_dir; hook_dir; x ] in -- let retcode = ref 0 in -- let run () = -- retcode := run_command cmd in -- let delta_t = timed_run run in -- if debug >= 1 then ( -- printf "\n"; -- printf "%s completed after %.3f s\n" x delta_t -- ); -- Hashtbl.add timings x delta_t; -- let retcode = !retcode in -- if retcode <> 0 then retcode -- else loop xs -- | [] -> 0 -- in -- let retcode = loop scripts in -- if debug >= 1 then ( -- print_string (timing_output ~target_name:hook_name scripts timings) -- ); -- retcode -- in -- -- g#mount_local mount_dir; -- let pid = fork_and_run () in -- g#mount_local_run (); -- -- (match snd (Unix.waitpid [] pid) with -- | Unix.WEXITED 0 -> () -- | Unix.WEXITED i -> exit i -- | Unix.WSIGNALED i -- | Unix.WSTOPPED i -> -- error (f_"sub-process killed by signal (%d)") i -- ); -- -- flush_all () -- --let run_install_packages ~debug ~blockdev ~log_file -- (g : Guestfs.guestfs) packages = -- let pkgs_string = String.concat " " packages in -- message (f_"Installing: %s") pkgs_string; -- g#write_append log_file (sprintf "Installing %s...\n" pkgs_string); -- let out = g#sh (sprintf "/tmp/in_target.aux/run-and-log.sh '%s' '' '' '%s' '/tmp/in_target.aux' '' 'install-packages.sh'" log_file blockdev) in -- let out = ensure_trailing_newline out in -- if debug >= 1 then ( -- printf "%s%!" out; -- printf "package installation completed\n"; -- ); -- flush_all (); -- out -- --(* Finalize the list of output formats. *) --let () = Output_format.bake () -- --let main () = -- let cmdline = parse_cmdline () in -- let debug = cmdline.debug in -- -- (* Check that the specified base directory of diskimage-builder -- * has the "die" script in it, so we know the directory is the -- * right one (hopefully so, at least). -- *) -- if not (Sys.file_exists (cmdline.basepath // "die")) then -- error (f_"the specified base path is not the diskimage-builder library"); -- -- (* Check for required tools. *) -- let python = -- match cmdline.python with -- | None -> get_required_tool "python" -- | Some exe -> exe in -- require_tool "uuidgen"; -- Output_format.check_formats_prerequisites cmdline.formats; -- if cmdline.checksum then -- List.iter (fun x -> require_tool (tool_of_checksum x)) checksums; -- -- let image_basename = Filename.basename cmdline.image_name in -- let image_basename_d = image_basename ^ ".d" in -- -- let tmpdir = Mkdtemp.temp_dir "dib." in -- On_exit.rm_rf tmpdir; -- let auxtmpdir = tmpdir // "in_target.aux" in -- do_mkdir auxtmpdir; -- let hookstmpdir = auxtmpdir // "hooks" in -- do_mkdir (hookstmpdir // "environment.d"); (* Just like d-i-b does. *) -- do_mkdir (auxtmpdir // "out" // image_basename_d); -- let elements = -- if cmdline.use_base then ["base"] @ cmdline.elements -- else cmdline.elements in -- let elements = -- if cmdline.is_ramdisk then [cmdline.ramdisk_element] @ elements -- else elements in -- info (f_"Elements: %s") (String.concat " " elements); -- if debug >= 1 then ( -- printf "tmpdir: %s\n" tmpdir; -- printf "element paths: %s\n" (String.concat ":" cmdline.element_paths); -- ); -- -- let loaded_elements = load_elements ~debug cmdline.element_paths in -- if debug >= 1 then ( -- printf "loaded elements:\n"; -- Hashtbl.iter ( -- fun k v -> -- printf " %s => %s\n" k v.directory; -- Hashtbl.iter ( -- fun k v -> -- printf "\t%-20s %s\n" k (String.concat " " (List.sort compare v)) -- ) v.hooks; -- ) loaded_elements; -- printf "\n"; -- ); -- let all_elements = load_dependencies elements loaded_elements in -- let all_elements = exclude_elements all_elements -- (cmdline.excluded_elements @ builtin_elements_blacklist) in -- -- info (f_"Expanded elements: %s") -- (String.concat " " (StringSet.elements all_elements)); -- -- let envvars = read_envvars cmdline.envvars in -- info (f_"Carried environment variables: %s") -- (String.concat " " (List.map fst envvars)); -- if debug >= 1 then ( -- printf "carried over envvars:\n"; -- if envvars <> [] then -- List.iter ( -- fun (var, value) -> -- printf " %s=%s\n" var value -- ) envvars -- else -- printf " (none)\n"; -- printf "\n"; -- ); -- let dib_args = stringify_args (Array.to_list Sys.argv) in -- let dib_vars = read_dib_envvars () in -- if debug >= 1 then ( -- printf "DIB args:\n%s\n" dib_args; -- printf "DIB envvars:\n%s\n" dib_vars -- ); -- -- message (f_"Preparing auxiliary data"); -- -- copy_elements all_elements loaded_elements -- (cmdline.excluded_scripts @ builtin_scripts_blacklist) hookstmpdir; -- -- (* Re-read the hook scripts from the hooks dir, as d-i-b (and we too) -- * has basically copied over anything found in elements. -- *) -- let final_hooks = load_hooks ~debug hookstmpdir in -- -- let log_file = "/tmp/in_target.aux/perm/" ^ (log_filename ()) in -- -- let arch = -- match cmdline.arch with -- | "" -> current_arch () -- | arch -> arch in -- -- let root_label = -- match cmdline.root_label with -- | None -> -- (* XFS has a limit of 12 characters for filesystem labels. -- * Not changing the default for other filesystems to maintain -- * backwards compatibility. -- *) -- (match cmdline.fs_type with -- | "xfs" -> "img-rootfs" -- | _ -> "cloudimg-rootfs") -- | Some label -> label in -- -- let image_cache = -- match cmdline.image_cache with -- | None -> Sys.getenv "HOME" // ".cache" // "image-create" -- | Some dir -> dir in -- do_mkdir image_cache; -- -- let rootfs_uuid = uuidgen () in -- -- prepare_aux ~envvars ~dib_args ~dib_vars ~log_file ~out_name:image_basename -- ~rootfs_uuid ~arch ~network:cmdline.network ~root_label -- ~install_type:cmdline.install_type ~debug -- ~extra_packages:cmdline.extra_packages -- ~fs_type:cmdline.fs_type -- ~checksum:cmdline.checksum -- auxtmpdir all_elements; -- -- let delete_output_file = ref cmdline.delete_on_failure in -- let delete_file () = -- if !delete_output_file then ( -- let filenames = Output_format.get_filenames cmdline.formats cmdline.image_name in -- List.iter ( -- fun fn -> -- try Unix.unlink fn with _ -> () -- ) filenames -- ) -- in -- at_exit delete_file; -- -- prepare_external ~envvars ~dib_args ~dib_vars ~out_name:image_basename -- ~root_label ~rootfs_uuid ~image_cache ~arch -- ~network:cmdline.network ~debug -- ~fs_type:cmdline.fs_type -- ~checksum:cmdline.checksum -- ~python -- tmpdir cmdline.basepath -- (auxtmpdir // "fake-bin") -- loaded_elements all_elements cmdline.element_paths; -- -- let run_hook ~blockdev ~sysroot ?(new_wd = "") (g : Guestfs.guestfs) hook = -- try -- let scripts = -- (* Sadly, scripts (especially in root.d and extra-data.d) -- * can add (by copying or symlinking) new scripts for other -- * phases, which would be ignored if we were using the lists -- * collected after composing the tree of hooks. -- * As result, when running in-chroot hooks, re-read the list -- * of scripts actually available for each hook. -- *) -- match hook with -- | "pre-install.d" | "install.d" | "post-install.d" | "finalise.d" -> -- let scripts_path = "/tmp/in_target.aux/hooks/" ^ hook in -- (* Cleanly handle cases when the phase directory does not exist. *) -- if g#is_dir ~followsymlinks:true scripts_path then -- load_scripts g scripts_path -- else -- raise Not_found -- | _ -> -- Hashtbl.find final_hooks hook in -- if debug >= 1 then ( -- printf "Running hooks for %s...\n%!" hook; -- ); -- run_parts ~debug ~sysroot ~blockdev ~log_file ~new_wd g hook scripts -- with Not_found -> "" in -- -- let copy_in (g : Guestfs.guestfs) srcdir destdir = -- let desttar = Filename.temp_file ~temp_dir:tmpdir "virt-dib." ".tar.gz" in -- let cmd = [ "tar"; "czf"; desttar; "-C"; srcdir; "--owner=root"; -- "--group=root"; "." ] in -- if run_command cmd <> 0 then exit 1; -- g#mkdir_p destdir; -- g#tar_in ~compress:"gzip" desttar destdir; -- Sys.remove desttar in -- -- if debug >= 1 then -- ignore (run_command [ "tree"; "-ps"; tmpdir ]); -- -- message (f_"Opening the disks"); -- -- let is_ramdisk_build = -- cmdline.is_ramdisk || StringSet.mem "ironic-agent" all_elements in -- -- let g, tmpdisk, tmpdiskfmt, drive_partition = -- let g = open_guestfs () in -- Option.iter g#set_memsize cmdline.memsize; -- Option.iter g#set_smp cmdline.smp; -- g#set_network cmdline.network; -- -- (* Main disk with the built image. *) -- let fmt = "raw" in -- let fn = -- (* If "raw" is among the selected outputs, use it as main backing -- * disk, otherwise create a temporary disk. -- *) -- if not is_ramdisk_build && Output_format.set_mem "raw" cmdline.formats then -- cmdline.image_name -- else -- Filename.temp_file ~temp_dir:tmpdir "image." "" in -- let fn = output_filename fn fmt in -- (* Produce the output image. *) -- g#disk_create fn fmt cmdline.size; -- g#add_drive ~readonly:false ~format:fmt fn; -- -- (* Helper drive for elements and binaries. *) -- g#add_drive_scratch (unit_GB 5); -- -- (match cmdline.drive with -- | None -> -- g#add_drive_scratch (unit_GB 5) -- | Some drive -> -- g#add_drive ?format:cmdline.drive_format drive; -- ); -- -- g#launch (); -- -- Output_format.check_formats_appliance_prerequisites cmdline.formats g; -- -- (* Prepare the /in_target.aux partition. *) -- g#mkfs "ext2" "/dev/sdb"; -- g#mount "/dev/sdb" "/"; -- -- copy_in g auxtmpdir "/"; -- copy_in g cmdline.basepath "/lib"; -- g#umount "/"; -- -- (* Prepare the /in_target.aux/perm partition. *) -- let drive_partition = -- match cmdline.drive with -- | None -> -- g#mkfs "ext2" "/dev/sdc"; -- "/dev/sdc" -- | Some _ -> -- let partitions = Array.to_list (g#list_partitions ()) in -- (match partitions with -- | [] -> "/dev/sdc" -- | p -> -- let p = List.filter (fun x -> String.is_prefix x "/dev/sdc") p in -- if p = [] then -- error (f_"no partitions found in the helper drive"); -- List.hd p -- ) in -- g#mount drive_partition "/"; -- g#mkdir_p "/home/.cache/image-create"; -- g#umount "/"; -- -- g, fn, fmt, drive_partition in -- -- let mount_aux () = -- g#mkmountpoint "/tmp/in_target.aux"; -- g#mount "/dev/sdb" "/tmp/in_target.aux"; -- g#mount drive_partition "/tmp/in_target.aux/perm" in -- -- (* Small kludge: try to umount all first: if that fails, use lsof and fuser -- * to find out what might have caused the failure, run udevadm to try -- * to settle things down (udev, you never know), and try umount all again. -- *) -- let checked_umount_all () = -- try g#umount_all () -- with G.Error _ -> -- if debug >= 1 then ( -- (try printf "lsof:\n%s\nEND\n" (g#debug "sh" [| "lsof"; "/sysroot"; |]) with _ -> ()); -- (try printf "fuser:\n%s\nEND\n" (g#debug "sh" [| "fuser"; "-v"; "-m"; "/sysroot"; |]) with _ -> ()); -- (try printf "losetup:\n%s\nEND\n" (g#debug "sh" [| "losetup"; "--list"; "--all" |]) with _ -> ()); -- ); -- ignore (g#debug "sh" [| "udevadm"; "--debug"; "settle" |]); -- g#umount_all () in -- -- g#mkmountpoint "/tmp"; -- mount_aux (); -- -- let blockdev = -- (* Setup a loopback device, just like d-i-b would tie an image in the host -- * environment. -- *) -- let run_losetup device = -- let lines = g#debug "sh" [| "losetup"; "--show"; "-f"; device |] in -- let lines = String.nsplit "\n" lines in -- let lines = List.filter ((<>) "") lines in -- (match lines with -- | [] -> device -- | x :: _ -> x -- ) in -- let blockdev = run_losetup "/dev/sda" in -- -- let run_hook_out_eval hook envvar = -- let lines = run_hook ~sysroot:Out ~blockdev g hook in -- let lines = String.nsplit "\n" lines in -- let lines = List.filter ((<>) "") lines in -- if lines = [] then None -- else (try Some (var_from_lines envvar lines) with _ -> None) in -- -- (match run_hook_out_eval "block-device.d" "IMAGE_BLOCK_DEVICE" with -- | None -> blockdev -- | Some x -> x -- ) in -- -- let rec run_hook_out ?(new_wd = "") hook = -- do_run_hooks_noout ~sysroot:Out ~new_wd hook -- and run_hook_in hook = -- do_run_hooks_noout ~sysroot:In hook -- and run_hook_subroot hook = -- do_run_hooks_noout ~sysroot:Subroot hook -- and do_run_hooks_noout ~sysroot ?(new_wd = "") hook = -- ignore (run_hook ~sysroot ~blockdev ~new_wd g hook) -- and run_hook_host hook = -- try -- let scripts = Hashtbl.find final_hooks hook in -- if debug >= 1 then ( -- printf "Running hooks for %s...\n%!" hook; -- ); -- run_parts_host ~debug g hook tmpdir scripts -- (tmpdir // "run-part-extra.sh") -- with Not_found -> () in -- -- g#sync (); -- checked_umount_all (); -- flush_all (); -- -- message (f_"Setting up the destination root"); -- -- (* Create and mount the target filesystem. *) -- let mkfs_options = -- match cmdline.mkfs_options with -- | None -> [] -- | Some o -> [ o ] in -- let mkfs_options = -- [ "-t"; cmdline.fs_type ] @ -- (match cmdline.fs_type with -- | "ext4" -> -- (* Very conservative to handle images being resized a lot -- * Without -J option specified, default journal size will be set to 32M -- * and online resize will be failed with error of needs too many credits. -- *) -- [ "-i"; "4096"; "-J"; "size=64" ] -- | _ -> [] -- ) @ mkfs_options @ [ blockdev ] in -- ignore (g#debug "sh" (Array.of_list ([ "mkfs" ] @ mkfs_options))); -- g#set_label blockdev root_label; -- if String.is_prefix cmdline.fs_type "ext" then -- g#set_uuid blockdev rootfs_uuid; -- g#mount blockdev "/"; -- g#mkmountpoint "/tmp"; -- mount_aux (); -- g#mkdir "/subroot"; -- -- run_hook_subroot "root.d"; -- -- g#sync (); -- g#umount "/tmp/in_target.aux/perm"; -- g#umount "/tmp/in_target.aux"; -- g#rm_rf "/tmp"; -- let subroot_items = -- let l = Array.to_list (g#ls "/subroot") in -- let l_lost_plus_found, l = List.partition ((=) "lost+found") l in -- if l_lost_plus_found <> [] then ( -- g#rm_rf "/subroot/lost+found"; -- ); -- l in -- List.iter (fun x -> g#mv ("/subroot/" ^ x) ("/" ^ x)) subroot_items; -- g#rmdir "/subroot"; -- (* Check /tmp exists already. *) -- ignore (g#is_dir "/tmp"); -- mount_aux (); -- g#ln_s "in_target.aux/hooks" "/tmp/in_target.d"; -- -- run_hook_host "extra-data.d"; -- -- run_hook_in "pre-install.d"; -- -- if cmdline.extra_packages <> [] then -- ignore (run_install_packages ~debug ~blockdev ~log_file g -- cmdline.extra_packages); -- -- run_hook_in "install.d"; -- -- run_hook_in "post-install.d"; -- -- (* Unmount and remount the image, as d-i-b does at this point too. *) -- g#sync (); -- checked_umount_all (); -- flush_all (); -- g#mount blockdev "/"; -- (* Check /tmp/in_target.aux still exists. *) -- ignore (g#is_dir "/tmp/in_target.aux"); -- g#mount "/dev/sdb" "/tmp/in_target.aux"; -- g#mount drive_partition "/tmp/in_target.aux/perm"; -- -- run_hook_in "finalise.d"; -- -- let out_dir = "/tmp/in_target.aux/out/" ^ image_basename_d in -- -- run_hook_out ~new_wd:out_dir "cleanup.d"; -- -- g#sync (); -- -- if g#ls out_dir <> [||] then ( -- message (f_"Extracting data out of the image"); -- do_mkdir (cmdline.image_name ^ ".d"); -- g#copy_out out_dir (Filename.dirname cmdline.image_name); -- ); -- -- (* Unmount everything, and remount only the root to cleanup -- * its /tmp; this way we should be pretty sure that there is -- * nothing left mounted over /tmp, so it is safe to empty it. -- *) -- checked_umount_all (); -- flush_all (); -- g#mount blockdev "/"; -- Array.iter (fun x -> g#rm_rf ("/tmp/" ^ x)) (g#ls "/tmp"); -- (* Truncate /var/log files in preparation for first boot. *) -- truncate_recursive g "/var/log"; -- let non_log fn = -- not (String.is_suffix fn ".log") -- in -- (* Remove root logs. *) -- rm_rf_only_files g ~filter:non_log "/root"; -- -- flush_all (); -- -- Output_format.run_formats_on_filesystem cmdline.formats g cmdline.image_name tmpdir; -- -- message (f_"Umounting the disks"); -- -- (* Now that we've finished the build, don't delete the output file on -- * exit. -- *) -- delete_output_file := false; -- -- g#sync (); -- checked_umount_all (); -- g#shutdown (); -- g#close (); -- -- flush_all (); -- -- (* Don't produce images as output when doing a ramdisk build. *) -- if not is_ramdisk_build then -- Output_format.run_formats_on_file cmdline.formats cmdline.image_name (tmpdisk, tmpdiskfmt) tmpdir; -- -- if not is_ramdisk_build && cmdline.checksum then ( -- let file_flags = [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC; ] in -- let filenames = Output_format.get_filenames cmdline.formats cmdline.image_name in -- List.iter ( -- fun fn -> -- message (f_"Generating checksums for %s") fn; -- let cmds = -- List.map ( -- fun csum -> -- let csum_fn = fn ^ "." ^ csum in -- let csum_tool = tool_of_checksum csum in -- let outfd = Unix.openfile csum_fn file_flags 0o640 in -- [ csum_tool; fn ], Some outfd, None -- ) checksums in -- let res = run_commands cmds in -- List.iteri ( -- fun i code -> -- if code <> 0 then ( -- let args, _, _ = List.nth cmds i in -- error (f_"external command ‘%s’ exited with error %d") -- (List.hd args) code -- ) -- ) res; -- ) filenames; -- ); -- -- message (f_"Done") -- --let () = run_main_and_handle_errors main -diff --git a/dib/dib.mli b/dib/dib.mli -deleted file mode 100644 -index 84aa4fcdb..000000000 ---- a/dib/dib.mli -+++ /dev/null -@@ -1,19 +0,0 @@ --(* virt-dib -- * Copyright (C) 2015 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. -- *) -- --(* Nothing is exported. *) -diff --git a/dib/dummy.c b/dib/dummy.c -deleted file mode 100644 -index ebab6198c..000000000 ---- a/dib/dummy.c -+++ /dev/null -@@ -1,2 +0,0 @@ --/* Dummy source, to be used for OCaml-based tools with no C sources. */ --enum { foo = 1 }; -diff --git a/dib/elements.ml b/dib/elements.ml -deleted file mode 100644 -index 5a904baef..000000000 ---- a/dib/elements.ml -+++ /dev/null -@@ -1,207 +0,0 @@ --(* virt-dib -- * Copyright (C) 2015 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. -- *) -- --(* Parsing and handling of elements. *) -- --open Std_utils --open Tools_utils --open Common_gettext.Gettext -- --open Utils -- --open Printf -- --type element = { -- directory : string; -- hooks : hooks_map; --} --and hooks_map = (string, string list) Hashtbl.t (* hook name, scripts *) -- --exception Duplicate_script of string * string (* hook, script *) -- --let builtin_elements_blacklist = [ --] -- --let builtin_scripts_blacklist = [ -- "01-sahara-version"; (* Gets the Git commit ID of the d-i-b and -- * sahara-image-elements repositories. *) --] -- --let valid_script_name n = -- let is_char_valid = function -- | 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' | '-' -> true -- | _ -> false in -- try ignore (string_index_fn (fun c -> not (is_char_valid c)) n); false -- with Not_found -> true -- --let stringset_of_list l = -- List.fold_left (fun acc x -> StringSet.add x acc) StringSet.empty l -- --let load_hooks ~debug path = -- let hooks = Hashtbl.create 13 in -- let entries = Array.to_list (Sys.readdir path) in -- let entries = List.filter (fun x -> Filename.check_suffix x ".d") entries in -- let entries = List.map (fun x -> (x, path // x)) entries in -- let entries = List.filter (fun (_, x) -> is_directory x) entries in -- List.iter ( -- fun (hook, p) -> -- let listing = Array.to_list (Sys.readdir p) in -- let scripts = List.filter valid_script_name listing in -- let scripts = List.filter ( -- fun x -> -- try -- let s = Unix.stat (p // x) in -- s.Unix.st_kind = Unix.S_REG && s.Unix.st_perm land 0o111 > 0 -- with Unix.Unix_error _ -> false -- ) scripts in -- if scripts <> [] then -- Hashtbl.add hooks hook scripts -- ) entries; -- hooks -- --let load_scripts (g : Guestfs.guestfs) path = -- let listing = Array.to_list (g#readdir path) in -- let scripts = List.filter ( -- function -- | { Guestfs.ftyp = ('r'|'l'|'u'|'?') } -> true -- | _ -> false -- ) listing in -- let scripts = List.filter (fun x -> valid_script_name x.Guestfs.name) scripts in -- List.filter_map ( -- fun x -> -- let { Guestfs.st_mode = mode } = g#statns (path ^ "/" ^ x.Guestfs.name) in -- if mode &^ 0o111_L > 0_L then Some x.Guestfs.name -- else None -- ) scripts -- --let load_elements ~debug paths = -- let loaded_elements = Hashtbl.create 13 in -- let paths = List.filter is_directory paths in -- List.iter ( -- fun path -> -- let listing = Array.to_list (Sys.readdir path) in -- let listing = List.map (fun x -> (x, path // x)) listing in -- let listing = List.filter (fun (_, x) -> is_directory x) listing in -- List.iter ( -- fun (p, dir) -> -- if not (Hashtbl.mem loaded_elements p) then ( -- let elem = { directory = dir; hooks = load_hooks ~debug dir } in -- Hashtbl.add loaded_elements p elem -- ) else if debug >= 1 then ( -- printf "element %s (in %s) already present" p path; -- ) -- ) listing -- ) paths; -- loaded_elements -- --let load_dependencies elements loaded_elements = -- let get filename element = -- try -- let path = (Hashtbl.find loaded_elements element).directory in -- let path = path // filename in -- if Sys.file_exists path then ( -- let lines = read_whole_file path in -- let lines = String.nsplit "\n" lines in -- let lines = List.filter ((<>) "") lines in -- stringset_of_list lines -- ) else -- StringSet.empty -- with Not_found -> -- error (f_"element %s not found") element in -- let get_deps = get "element-deps" in -- let get_provides = get "element-provides" in -- -- let queue = Queue.create () in -- let final = ref StringSet.empty in -- let provided = ref StringSet.empty in -- let provided_by = Hashtbl.create 13 in -- List.iter (fun x -> Queue.push x queue) elements; -- final := stringset_of_list elements; -- while not (Queue.is_empty queue) do -- let elem = Queue.pop queue in -- if StringSet.mem elem !provided <> true then ( -- let element_deps = get_deps elem in -- let element_provides = get_provides elem in -- (* Save which elements provide another element for potential -- * error message. -- *) -- StringSet.iter (fun x -> Hashtbl.add provided_by x elem) element_provides; -- provided := StringSet.union !provided element_provides; -- StringSet.iter (fun x -> Queue.push x queue) -- (StringSet.diff element_deps (StringSet.union !final !provided)); -- final := StringSet.union !final element_deps -- ) -- done; -- let conflicts = StringSet.inter (stringset_of_list elements) !provided in -- if not (StringSet.is_empty conflicts) then ( -- let buf = Buffer.create 100 in -- StringSet.iter ( -- fun elem -> -- let s = sprintf (f_" %s: already provided by %s") -- elem (Hashtbl.find provided_by elem) in -- Buffer.add_string buf s -- ) conflicts; -- error (f_"following elements are already provided by another element:\n%s") -- (Buffer.contents buf) -- ); -- if not (StringSet.mem "operating-system" !provided) then -- error (f_"please include an operating system element"); -- StringSet.diff !final !provided -- --let copy_element element destdir blacklist = -- let entries = Array.to_list (Sys.readdir element.directory) in -- let entries = List.filter ((<>) "tests") entries in -- let entries = List.filter ((<>) "test-elements") entries in -- let dirs, nondirs = List.partition is_directory entries in -- let dirs = List.map (fun x -> (x, element.directory // x, destdir // x)) dirs in -- let nondirs = List.map (fun x -> element.directory // x) nondirs in -- List.iter ( -- fun (e, path, destpath) -> -- do_mkdir destpath; -- let subentries = Array.to_list (Sys.readdir path) in -- let subentries = List.filter (not_in_list blacklist) subentries in -- List.iter ( -- fun sube -> -- if is_regular_file (destpath // sube) then ( -- raise (Duplicate_script (e, sube)) -- ) else -- do_cp (path // sube) destpath -- ) subentries; -- ) dirs; -- List.iter ( -- fun path -> -- do_cp path destdir -- ) nondirs -- --let copy_elements elements loaded_elements blacklist destdir = -- do_mkdir destdir; -- StringSet.iter ( -- fun element -> -- try -- copy_element (Hashtbl.find loaded_elements element) destdir blacklist -- with -- | Duplicate_script (hook, script) -> -- let element_has_script e = -- try -- let s = Hashtbl.find (Hashtbl.find loaded_elements e).hooks hook in -- List.exists ((=) script) s -- with Not_found -> false in -- let dups = StringSet.filter element_has_script elements in -- error (f_"There is a duplicated script in your elements:\n%s/%s in: %s") -- hook script (String.concat " " (StringSet.elements dups)) -- ) elements -diff --git a/dib/elements.mli b/dib/elements.mli -deleted file mode 100644 -index f351afeff..000000000 ---- a/dib/elements.mli -+++ /dev/null -@@ -1,61 +0,0 @@ --(* virt-dib -- * Copyright (C) 2015 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. -- *) -- --(** Parsing and handling of elements. *) -- --type element = { -- directory : string; (** directory of the element *) -- hooks : hooks_map; (** available hooks, and scripts for each hook*) --} --and hooks_map = (string, string list) Hashtbl.t (** hook name, scripts *) -- --val builtin_elements_blacklist : string list --(** These are the elements which we don't ever try to use. *) -- --val builtin_scripts_blacklist : string list --(** These are the scripts which we don't ever try to run. -- -- Usual reason could be that they are not compatible the way -- virt-dib works, e.g. they expect the tree of elements outside -- the chroot, which is not available in the appliance. *) -- --val load_elements : debug:int -> string list -> (string, element) Hashtbl.t --(** [load_elements ~debug paths] loads elements from the specified -- [paths]; returns a [Hashtbl.t] of {!element} structs indexed by -- the element name. *) -- --val load_dependencies : StringSet.elt list -> (string, element) Hashtbl.t -> StringSet.t --(** [load_dependencies element_set elements] returns the whole set of -- elements needed to use [element_set], including [element_list] -- themselves. In other words, this recursively resolves the -- dependencies of [element_set]. *) -- --val copy_elements : StringSet.t -> (string, element) Hashtbl.t -> string list -> string -> unit --(** [copy_elements element_set elements blacklisted_scripts destdir] -- copies the elements in [element_set] (with the element definitions -- provided as [elements]) into the [destdir] directory. -- -- [blacklisted_scripts] contains names of scripts to never copy. *) -- --val load_hooks : debug:int -> string -> hooks_map --(** [load_hooks ~debug path] loads the hooks from the specified -- [path] (which usually represents an element). *) -- --val load_scripts : Guestfs.guestfs -> string -> string list --(** [load_scripts g path] loads the scripts from the specified [path] -- (which usually represents a directory of an hook). *) -diff --git a/dib/output_format.ml b/dib/output_format.ml -deleted file mode 100644 -index 247f33540..000000000 ---- a/dib/output_format.ml -+++ /dev/null -@@ -1,192 +0,0 @@ --(* virt-dib -- * Copyright (C) 2012-2023 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 Common_gettext.Gettext --open Getopt.OptionName -- --open Utils -- --type format = { -- name : string; -- extra_args : extra_arg list; -- output_to_file : bool; -- check_prerequisites : (unit -> unit) option; -- check_appliance_prerequisites : (Guestfs.guestfs -> unit) option; -- run_on_filesystem : (Guestfs.guestfs -> string -> string -> unit) option; -- run_on_file : (string -> (string * string) -> string -> unit) option; --} --and extra_arg = { -- extra_argspec : Getopt.keys * Getopt.spec * Getopt.doc; --} -- --let defaults = { -- name = ""; -- extra_args = []; -- output_to_file = true; -- check_prerequisites = None; -- check_appliance_prerequisites = None; -- run_on_filesystem = None; -- run_on_file = None; --} -- --let all_formats = ref [] -- --module FormatSet = Set.Make ( -- struct -- type t = format -- let compare a b = compare a.name b.name -- end --) --type set = FormatSet.t -- --let empty_set = FormatSet.empty -- --let add_to_set name set = -- let op = List.find (fun { name = n } -> name = n) !all_formats in -- FormatSet.add op set -- --let set_mem x set = -- FormatSet.exists (fun { name = n } -> n = x) set -- --let set_cardinal set = -- FormatSet.cardinal set -- --let register_format op = -- List.push_front op all_formats -- --let baked = ref false --let rec bake () = -- (* Note we actually want all_formats to be sorted by name, -- * ignoring the order field. -- *) -- let ops = -- List.sort (fun { name = a } { name = b } -> compare a b) !all_formats in -- check_no_dupes ops; -- List.iter check ops; -- all_formats := ops; -- baked := true --and check_no_dupes ops = -- ignore ( -- List.fold_left ( -- fun opset op -> -- if FormatSet.mem op opset then -- error (f_"duplicate format name (%s)") op.name; -- add_to_set op.name opset -- ) empty_set ops -- ) --and check op = -- let n = String.length op.name in -- if n = 0 then -- error (f_"format name is an empty string"); -- for i = 0 to n-1 do -- match String.unsafe_get op.name i with -- | 'a'..'z' | 'A'..'Z' | '0'..'9' | '-' -> () -- | c -> -- error (f_"disallowed character (%c) in format name") c -- done -- --let extra_args () = -- assert !baked; -- -- List.flatten ( -- List.map (fun { extra_args } -> -- List.map (fun { extra_argspec = argspec } -> argspec) extra_args -- ) !all_formats -- ) -- --let list_formats () = -- assert !baked; -- -- List.map (fun { name = n } -> n) !all_formats -- --let compare_formats { name = n1 } { name = n2 } = -- compare n1 n2 -- --let check_formats_prerequisites ~formats = -- assert !baked; -- -- (* Run the formats in alphabetical, rather than random order. *) -- let formats = List.sort compare_formats (FormatSet.elements formats) in -- -- List.iter ( -- function -- | { check_prerequisites = Some fn } -> -- fn () -- | { check_prerequisites = None } -> () -- ) formats -- --let check_formats_appliance_prerequisites ~formats g = -- assert !baked; -- -- (* Run the formats in alphabetical, rather than random order. *) -- let formats = List.sort compare_formats (FormatSet.elements formats) in -- -- List.iter ( -- function -- | { check_appliance_prerequisites = Some fn } -> -- fn g -- | { check_appliance_prerequisites = None } -> () -- ) formats -- --let run_formats_on_filesystem ~formats g image_name tmpdir = -- assert !baked; -- -- (* Run the formats in alphabetical, rather than random order. *) -- let formats = List.sort compare_formats (FormatSet.elements formats) in -- -- List.iter ( -- function -- | { run_on_filesystem = Some fn; name; output_to_file } -> -- let filename = -- if output_to_file then output_filename image_name name -- else "" in -- fn g filename tmpdir -- | { run_on_filesystem = None } -> () -- ) formats -- --let run_formats_on_file ~formats image_name tmpdisk tmpdir = -- assert !baked; -- -- (* Run the formats in alphabetical, rather than random order. *) -- let formats = List.sort compare_formats (FormatSet.elements formats) in -- -- List.iter ( -- function -- | { run_on_file = Some fn; name; output_to_file } -> -- let filename = -- if output_to_file then output_filename image_name name -- else "" in -- fn filename tmpdisk tmpdir -- | { run_on_file = None } -> () -- ) formats -- --let get_filenames ~formats image_name = -- assert !baked; -- -- (* Run the formats in alphabetical, rather than random order. *) -- let formats = List.sort compare_formats (FormatSet.elements formats) in -- -- List.filter_map ( -- function -- | { output_to_file = true; name } -> -- Some (output_filename image_name name) -- | { output_to_file = false } -> -- None -- ) formats -diff --git a/dib/output_format.mli b/dib/output_format.mli -deleted file mode 100644 -index d545891b1..000000000 ---- a/dib/output_format.mli -+++ /dev/null -@@ -1,131 +0,0 @@ --(* virt-dib -- * Copyright (C) 2012-2023 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. -- *) -- --(** Handling of output formats. *) -- --(** Structure used to describe output formats. *) --type format = { -- name : string; -- (** The name of the format, which is exposed via the [--formats] -- command line parameter. Must contain only alphanumeric and -- '-' (dash) character. *) -- -- extra_args : extra_arg list; -- (** Extra command-line arguments, if any. eg. The [docker] -- format has an extra [--docker-target] parameter. -- -- For a description of each list element, see {!extra_arg} below. -- -- You can decide the types of the arguments, whether they are -- mandatory etc. *) -- -- output_to_file : bool; -- (** Whether the format writes to a file. Most of the formats -- produce a file as result, although some (e.g. docker) do -- not. *) -- -- check_prerequisites : (unit -> unit) option; -- (** The function which is called after the command line processing -- to check whether the requirements for this format (available -- tools, values for command line arguments, etc) are fulfilled. *) -- -- check_appliance_prerequisites : (Guestfs.guestfs -> unit) option; -- (** The function which is called after the appliance start to check -- whether the requirements in the appliance for this format -- (available features, filesystems, etc) are fulfilled. *) -- -- run_on_filesystem : (Guestfs.guestfs -> string -> string -> unit) option; -- (** The function which is called to perform the export while the -- guest is mounted. -- -- The parameters are: -- - [g]: the libguestfs handle -- - [filename]: the output filename for the format, or an empty -- string if {!output_to_file} is [false] -- - [tmpdir]: the temporary directory currently in use *) -- -- run_on_file : (string -> (string * string) -> string -> unit) option; -- (** The function which is called to perform the export using the -- temporary disk as reference. -- -- The parameters are: -- - [filename]: the output filename for the format, or an empty -- string if {!output_to_file} is [false] -- - [tmpdisk]: a tuple representing the temporary disk, as -- [(filename, format)] -- - [tmpdir]: the temporary directory currently in use *) --} -- --and extra_arg = { -- extra_argspec : Getopt.keys * Getopt.spec * Getopt.doc; -- (** The argspec. See [Getopt] module in [common/mltools]. *) --} -- --val defaults : format --(** This is so formats can write [let op = { defaults with ... }]. *) -- --val register_format : format -> unit --(** Register a format. *) -- --val bake : unit -> unit --(** 'Bake' is called after all modules have been registered. We -- finalize the list of formats, sort it, and run some checks. *) -- --val extra_args : unit -> Getopt.speclist --(** Get the list of extra arguments for the command line. *) -- --val list_formats : unit -> string list --(** List supported formats. *) -- --type set --(** A (sub-)set of formats. *) -- --val empty_set : set --(** Empty set of formats. *) -- --val add_to_set : string -> set -> set --(** [add_to_set name set] adds the format named [name] to [set]. -- -- Note that this will raise [Not_found] if [name] is not -- a valid format name. *) -- --val set_mem : string -> set -> bool --(** Check whether the specified format is in the set. *) -- --val set_cardinal : set -> int --(** Return the size of the formats set. *) -- --val check_formats_prerequisites : formats:set -> unit --(** Check the prerequisites in all the formats listed in the [formats] set. *) -- --val check_formats_appliance_prerequisites : formats:set -> Guestfs.guestfs -> unit --(** Check the appliance prerequisites in all the formats listed in the -- [formats] set. *) -- --val run_formats_on_filesystem : formats:set -> Guestfs.guestfs -> string -> string -> unit --(** Run the filesystem-based export for all the formats listed in the -- [formats] set. *) -- --val run_formats_on_file : formats:set -> string -> (string * string) -> string -> unit --(** Run the disk-based export for all the formats listed in the -- [formats] set. *) -- --val get_filenames : formats:set -> string -> string list --(** Return the list of all the output filenames for formats in the -- [formats] set. Only formats with {!output_to_file} as [true] -- will be taken into account. *) -diff --git a/dib/output_format_docker.ml b/dib/output_format_docker.ml -deleted file mode 100644 -index 7f254ba96..000000000 ---- a/dib/output_format_docker.ml -+++ /dev/null -@@ -1,57 +0,0 @@ --(* virt-dib -- * Copyright (C) 2016-2023 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 Tools_utils --open Common_gettext.Gettext --open Getopt.OptionName -- --open Utils --open Output_format -- --let docker_target = ref None --let set_docker_target arg = docker_target := Some arg -- --let docker_check () = -- require_tool "docker"; -- if !docker_target = None then -- error (f_"docker: a target was not specified, use ‘--docker-target’") -- --let docker_run_fs (g : Guestfs.guestfs) _ temp_dir = -- let docker_target = -- match !docker_target with -- | None -> assert false (* checked earlier *) -- | Some t -> t in -- message (f_"Importing the image to docker as ‘%s’") docker_target; -- let dockertmp = Filename.temp_file ~temp_dir "docker." ".tar" in -- g#tar_out ~excludes:[| "./sys/*"; "./proc/*" |] ~xattrs:true ~selinux:true -- "/" dockertmp; -- let cmd = [ "sudo"; "docker"; "import"; dockertmp; docker_target ] in -- if run_command cmd <> 0 then exit 1 -- --let fmt = { -- defaults with -- name = "docker"; -- output_to_file = false; -- extra_args = [ -- { extra_argspec = [ L"docker-target" ], Getopt.String ("target", set_docker_target), s_"Repo and tag for docker"; }; -- ]; -- check_prerequisites = Some docker_check; -- run_on_filesystem = Some docker_run_fs; --} -- --let () = register_format fmt -diff --git a/dib/output_format_qcow2.ml b/dib/output_format_qcow2.ml -deleted file mode 100644 -index d12605620..000000000 ---- a/dib/output_format_qcow2.ml -+++ /dev/null -@@ -1,56 +0,0 @@ --(* virt-dib -- * Copyright (C) 2015-2023 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 Common_gettext.Gettext --open Getopt.OptionName -- --open Utils --open Output_format -- --let compressed = ref true --let qemu_img_options = ref None --let set_qemu_img_options arg = qemu_img_options := Some arg -- --let qcow2_check () = -- require_tool "qemu-img" -- --let qcow2_run_file filename (tmpdisk, tmpdiskfmt) _ = -- message (f_"Converting to qcow2"); -- let cmd = [ "qemu-img"; "convert" ] @ -- (if !compressed then [ "-c" ] else []) @ -- [ "-f"; tmpdiskfmt; tmpdisk; "-O"; "qcow2" ] @ -- (match !qemu_img_options with -- | None -> [] -- | Some opt -> [ "-o"; opt ]) @ -- [ qemu_input_filename filename ] in -- if run_command cmd <> 0 then exit 1 -- --let fmt = { -- defaults with -- name = "qcow2"; -- extra_args = [ -- { extra_argspec = [ S 'u' ], Getopt.Clear compressed, s_"Do not compress the qcow2 image"; }; -- { extra_argspec = [ L"qemu-img-options" ], Getopt.String ("option", set_qemu_img_options), s_"Add qemu-img options"; }; -- ]; -- check_prerequisites = Some qcow2_check; -- run_on_file = Some qcow2_run_file; --} -- --let () = register_format fmt -diff --git a/dib/output_format_raw.ml b/dib/output_format_raw.ml -deleted file mode 100644 -index a36679894..000000000 ---- a/dib/output_format_raw.ml -+++ /dev/null -@@ -1,31 +0,0 @@ --(* virt-dib -- * Copyright (C) 2015-2023 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 Output_format -- --(* The raw format is currently handled on its own in virt-dib, -- * so this is merely to add the output format to the available -- * ones. This might change in the future, though. -- *) -- --let fmt = { -- defaults with -- name = "raw"; --} -- --let () = register_format fmt -diff --git a/dib/output_format_squashfs.ml b/dib/output_format_squashfs.ml -deleted file mode 100644 -index d81589b09..000000000 ---- a/dib/output_format_squashfs.ml -+++ /dev/null -@@ -1,39 +0,0 @@ --(* virt-dib -- * 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 Tools_utils --open Common_gettext.Gettext -- --open Output_format -- --let squashfs_check (g : Guestfs.guestfs) = -- g#available [| "squashfs" |] -- --let squashfs_run_fs (g : Guestfs.guestfs) filename _ = -- message (f_"Compressing the image as squashfs"); -- g#mksquashfs ~excludes:[| "sys/*"; "proc/*"; "dev/*" |] ~compress:"xz" -- "/" filename -- --let fmt = { -- defaults with -- name = "squashfs"; -- check_appliance_prerequisites = Some squashfs_check; -- run_on_filesystem = Some squashfs_run_fs; --} -- --let () = register_format fmt -diff --git a/dib/output_format_tar.ml b/dib/output_format_tar.ml -deleted file mode 100644 -index 6f749f870..000000000 ---- a/dib/output_format_tar.ml -+++ /dev/null -@@ -1,35 +0,0 @@ --(* virt-dib -- * Copyright (C) 2015-2023 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 Tools_utils --open Common_gettext.Gettext -- --open Output_format -- --let tar_run_fs (g : Guestfs.guestfs) filename _ = -- message (f_"Compressing the image as tar"); -- g#tar_out ~excludes:[| "./sys/*"; "./proc/*" |] ~xattrs:true ~selinux:true -- "/" filename -- --let fmt = { -- defaults with -- name = "tar"; -- run_on_filesystem = Some tar_run_fs; --} -- --let () = register_format fmt -diff --git a/dib/output_format_tgz.ml b/dib/output_format_tgz.ml -deleted file mode 100644 -index 447dfe6d9..000000000 ---- a/dib/output_format_tgz.ml -+++ /dev/null -@@ -1,35 +0,0 @@ --(* virt-dib -- * 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 Tools_utils --open Common_gettext.Gettext -- --open Output_format -- --let tgz_run_fs (g : Guestfs.guestfs) filename _ = -- message (f_"Compressing the image as tar.gz"); -- g#tar_out ~excludes:[| "./sys/*"; "./proc/*" |] ~xattrs:true ~selinux:true -- ~compress:"gzip" "/" filename -- --let fmt = { -- defaults with -- name = "tgz"; -- run_on_filesystem = Some tgz_run_fs; --} -- --let () = register_format fmt -diff --git a/dib/output_format_vhd.ml b/dib/output_format_vhd.ml -deleted file mode 100644 -index 1d56947a6..000000000 ---- a/dib/output_format_vhd.ml -+++ /dev/null -@@ -1,47 +0,0 @@ --(* virt-dib -- * Copyright (C) 2015-2023 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 Tools_utils --open Common_gettext.Gettext -- --open Utils --open Output_format -- --let vhd_check () = -- require_tool "vhd-util" -- --let vhd_run_file filename (tmpdisk, _) temp_dir = -- message (f_"Converting to VHD"); -- let fn_intermediate = Filename.temp_file ~temp_dir "vhd-intermediate." "" in -- let cmd = [ "vhd-util"; "convert"; "-s"; "0"; "-t"; "1"; -- "-i"; tmpdisk; "-o"; fn_intermediate ] in -- if run_command cmd <> 0 then exit 1; -- let cmd = [ "vhd-util"; "convert"; "-s"; "1"; "-t"; "2"; -- "-i"; fn_intermediate; "-o"; filename ] in -- if run_command cmd <> 0 then exit 1; -- if not (Sys.file_exists filename) then -- error (f_"VHD output not produced, most probably vhd-util is old or not patched for ‘convert’") -- --let fmt = { -- defaults with -- name = "vhd"; -- check_prerequisites = Some vhd_check; -- run_on_file = Some vhd_run_file; --} -- --let () = register_format fmt -diff --git a/dib/test-virt-dib-docs.sh b/dib/test-virt-dib-docs.sh -deleted file mode 100755 -index 2ce7223f3..000000000 ---- a/dib/test-virt-dib-docs.sh -+++ /dev/null -@@ -1,23 +0,0 @@ --#!/bin/bash - --# libguestfs --# Copyright (C) 2016 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. -- --set -e -- --$TEST_FUNCTIONS -- --$top_srcdir/podcheck.pl "$srcdir/virt-dib.pod" virt-dib -diff --git a/dib/utils.ml b/dib/utils.ml -deleted file mode 100644 -index 856705d09..000000000 ---- a/dib/utils.ml -+++ /dev/null -@@ -1,111 +0,0 @@ --(* virt-dib -- * Copyright (C) 2015 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 Common_gettext.Gettext -- --open Printf -- --let unit_GB howmany = -- (Int64.of_int howmany) *^ 1024_L *^ 1024_L *^ 1024_L -- --let current_arch () = -- (* Turn a CPU into the dpkg architecture naming. *) -- match Guestfs_config.host_cpu with -- | "amd64" | "x86_64" -> "amd64" -- | "i386" | "i486" | "i586" | "i686" -> "i386" -- | arch when String.is_prefix arch "armv" -> "armhf" -- | arch -> arch -- --let output_filename image_name = function -- | "squashfs" -> image_name ^ ".squash" -- | fmt -> image_name ^ "." ^ fmt -- --let log_filename () = -- let tm = Unix.gmtime (Unix.time ()) in -- sprintf "%s-%d%02d%02d-%02d%02d%02d.log" -- prog (tm.Unix.tm_year + 1900) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday -- tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec -- --let var_from_lines var lines = -- let var_with_equal = var ^ "=" in -- let var_lines = List.filter (fun x -> String.is_prefix x var_with_equal) lines in -- match var_lines with -- | [] -> -- error (f_"variable ‘%s’ not found in lines:\n%s") -- var (String.concat "\n" lines) -- | [x] -> snd (String.split "=" x) -- | _ -> -- error (f_"variable ‘%s’ has more than one occurrency in lines:\n%s") -- var (String.concat "\n" lines) -- --let string_index_fn fn str = -- let len = String.length str in -- let rec loop i = -- if i = len then raise Not_found -- else if fn str.[i] then i -- else loop (i + 1) in -- loop 0 -- --let digit_prefix_compare a b = -- let myint str = -- try int_of_string str -- with _ -> 0 in -- let mylength str = -- match String.length str with -- | 0 -> max_int -- | x -> x in -- let split_prefix str = -- let len = String.length str in -- let digits = -- try string_index_fn (fun x -> not (Char.isdigit x)) str -- with Not_found -> len in -- match digits with -- | 0 -> "", str -- | x when x = len -> str, "" -- | _ -> String.sub str 0 digits, String.sub str digits (len - digits) in -- -- let pref_a, rest_a = split_prefix a in -- let pref_b, rest_b = split_prefix b in -- match mylength pref_a, mylength pref_b, compare (myint pref_a) (myint pref_b) with -- | x, y, 0 when x = y -> compare rest_a rest_b -- | x, y, 0 -> x - y -- | _, _, x -> x -- --let do_mkdir dir = -- mkdir_p dir 0o755 -- --let get_required_tool tool = -- try which tool -- with Executable_not_found tool -> -- error (f_"%s needed but not found") tool -- --let require_tool tool = -- ignore (get_required_tool tool) -- --let do_cp src destdir = -- let cmd = [ "cp"; "-t"; destdir; "-a"; src ] in -- if run_command cmd <> 0 then exit 1 -- --let ensure_trailing_newline str = -- if String.length str > 0 && str.[String.length str - 1] <> '\n' then str ^ "\n" -- else str -- --let not_in_list l e = -- not (List.mem e l) -diff --git a/dib/utils.mli b/dib/utils.mli -deleted file mode 100644 -index dbbf82113..000000000 ---- a/dib/utils.mli -+++ /dev/null -@@ -1,66 +0,0 @@ --(* virt-dib -- * Copyright (C) 2015 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 unit_GB : int -> int64 --(** [unit_GB n] returns n * 2^30 *) -- --val current_arch : unit -> string --(** Turn the host_cpu into the dpkg architecture naming. *) -- --val output_filename : string -> string -> string --(** [output_filename image_name format] generates a suitable output -- filename based on the image filename and output format. *) -- --val log_filename : unit -> string --(** Generate a name for the log file containing the program name and -- current date/time. *) -- --val var_from_lines : string -> string list -> string --(** Find variable definition in a set of lines of the form [var=value]. *) -- --val string_index_fn : (char -> bool) -> string -> int --(** Apply function to each character in the string. If the function -- returns true, return the index of the character. -- -- In other words, like {!String.index} but using a function -- instead of a single character. -- -- @raise Not_found if no match *) -- --val digit_prefix_compare : string -> string -> int -- --val do_mkdir : string -> unit --(** Wrapper around [mkdir -p -m 0755] *) -- --val get_required_tool : string -> string --(** Ensure external program is installed. Return the full path of the -- program or fail with an error message. *) -- --val require_tool : string -> unit --(** Same as {!get_required_tool} but only checks the external program -- is installed and does not return the path. *) -- --val do_cp : string -> string -> unit --(** Wrapper around [cp -a src destdir]. *) -- --val ensure_trailing_newline : string -> string --(** If the input string is not [""], ensure there is a trailing ['\n'], -- adding one if necessary. *) -- --val not_in_list : 'a list -> 'a -> bool --(** Opposite of {!List.mem}. *) -diff --git a/dib/virt-dib.pod b/dib/virt-dib.pod -deleted file mode 100644 -index c0119d278..000000000 ---- a/dib/virt-dib.pod -+++ /dev/null -@@ -1,727 +0,0 @@ --=head1 NAME -- --virt-dib - Run diskimage-builder elements -- --=head1 SYNOPSIS -- -- virt-dib -B DIB-LIB [options] elements... -- --=head1 DESCRIPTION -- --Virt-dib is a tool for using the elements of C --to build a new disk image, generate new ramdisks, etc. -- --Virt-dib is intended as safe replacement for C --and its C mode, see --L for a quick comparison with --usage of C. -- --C is part of the TripleO OpenStack project: --L. -- --=head1 EXAMPLES -- --=head2 Build simple images of distributions -- -- virt-dib \ -- -B /path/to/diskimage-builder/lib \ -- -p /path/to/diskimage-builder/elements \ -- --envvar DIB_RELEASE=jessie \ -- --name debian-jessie \ -- debian vm -- --This builds a Debian Jessie (8.x) disk image, suitable for running --as virtual machine, saved as F. -- --=head2 Build ramdisks -- -- virt-dib \ -- -B /path/to/diskimage-builder/lib \ -- -p /path/to/diskimage-builder/elements \ -- --ramdisk \ -- --name ramdisk \ -- ubuntu deploy-ironic -- --This builds a ramdisk for the Ironic OpenStack component based --on the Ubuntu distribution. -- --=head1 OPTIONS -- --=over 4 -- --=item B<--help> -- --Display help. -- --=item B<-B> PATH -- --Set the path to the library directory of C. This is --usually the F subdirectory in the sources and when installed, --and F when installed in F. -- --This parameter is B, as virt-dib needs to provide it for --the elements (as some of them might use scripts in it). --Virt-dib itself does not make use of the library directory. -- --=item B<--arch> ARCHITECTURE -- --Use the specified architecture for the output image. The default --value is the same as the host running virt-dib. -- --Right now this option does nothing more than setting the C --environment variable for the elements, and it’s up to them to --produce an image for the requested architecture. -- --=item B<--checksum> -- --Generate checksum files for the generated image. The supported --checksums are MD5, and SHA256. -- --=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<--debug> LEVEL -- --Set the debug level to C, which is a non-negative integer --number. The default is C<0>. -- --This debug level is different than what I<-x> and I<-v> set, --and it increases the debugging information printed out. --Specifically, this sets the C, and any value --E C<0> enables tracing in the scripts executed. -- --=item B<--docker-target> TARGET -- --Set the repository and tag for docker. -- --This is used only when the formats include C, and it is --required in that case. -- --=item B<--drive> DISK -- --Add the specified disk to be used as helper drive where to cache --files of the elements, like disk images, distribution packages, etc. -- --See L. -- --=item B<--drive-format> raw -- --=item B<--drive-format> qcow2 -- --Specify the format of the helper drive. If this flag is not given --then it is auto-detected from the drive itself. -- --If working with untrusted raw-format guest disk images, you should --ensure the format is always specified. -- --This option is used only if I<--drive> is specified. -- --See L. -- --=item B<-p> PATH -- --=item B<--element-path> PATH -- --Add a new path with elements. Paths are used in the same order as the --I<-p> parameters appear, so a path specified first is looked first, --and so on. -- --Obviously, it is recommended to add the path to the own elements of --C, as most of the other elements will rely on them. -- --=item B<--extra-packages> PACKAGE,... -- --Install additional packages in the image being built. -- --This relies on the C binary provided by the --package management elements. -- --This option can be specified multiple times, each time with multiple --packages separated by comma. -- --=item B<--envvar> VARIABLE -- --=item B<--envvar> VARIABLE=VALUE -- --Carry or set an environment variable for the elements. -- --See L below for more information on the --interaction and usage of environment variables. -- --This option can be used in two ways: -- --=over 4 -- --=item B<--envvar> VARIABLE -- --Carry the environment variable C. If it is not set, nothing --is exported to the elements. -- --=item B<--envvar> VARIABLE=VALUE -- --Set the environment variable C with value C for the --elements, regardless whether an environment variable with the same --name exists. -- --This can be useful to pass environment variable without exporting --them in the environment where virt-dib runs. -- --=back -- --=item B<--exclude-element> ELEMENT -- --Ignore the specified element. -- --=item B<--exclude-script> SCRIPT -- --Ignore any element script named C