From 5ab93688683250e5403bedde64d98f9f69e9ab8e Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 14 Feb 2023 13:08:20 +0000 Subject: [PATCH] Remove virt-dib (RHBZ#2169550) --- 0001-Remove-virt-dib.patch | 3629 ++++++++++++++++++++++++++++++++++++ guestfs-tools.spec | 9 +- 2 files changed, 3636 insertions(+), 2 deletions(-) create mode 100644 0001-Remove-virt-dib.patch diff --git a/0001-Remove-virt-dib.patch b/0001-Remove-virt-dib.patch new file mode 100644 index 0000000..b31f036 --- /dev/null +++ b/0001-Remove-virt-dib.patch @@ -0,0 +1,3629 @@ +From 57423d907270526ea664ff15601cce956353820e 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 +--- + .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 da2a0266b5..b0ada2e3ce 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 311789ed12..ca1fc03c97 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 000fab5eb8..9a63736d23 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 b93a00118f..bb9a71ebfd 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 1f8acced2d..e7fcff136e 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 7581feb787..0000000000 +--- 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 11ff573419..0000000000 +--- 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 5c82efd604..0000000000 +--- 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 a4ba360400..0000000000 +--- 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.may g#set_memsize cmdline.memsize; +- Option.may 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 84aa4fcdb7..0000000000 +--- 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 ebab6198cd..0000000000 +--- 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 5a904baefc..0000000000 +--- 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 f351afeffb..0000000000 +--- 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 247f33540d..0000000000 +--- 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 d545891b1e..0000000000 +--- 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 7f254ba965..0000000000 +--- 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 d12605620b..0000000000 +--- 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 a366798948..0000000000 +--- 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 d81589b092..0000000000 +--- 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 6f749f870a..0000000000 +--- 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 447dfe6d93..0000000000 +--- 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 1d56947a63..0000000000 +--- 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 2ce7223f36..0000000000 +--- 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 856705d096..0000000000 +--- 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 dbbf82113b..0000000000 +--- 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 c0119d2784..0000000000 +--- 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