virt-dib is a new tool to run the elements of diskimage-builder using
libguestfs.
---
More or less stable now, although with debug stuff here and there;
needs initial review, for being included. I would like to have it
reviewed at this point, so it can be broadly used.
TODO items open:
- improve the documentation
- review
- getting more testing (although it has been successfully tested for
a while, not only by myself)
- polish
.gitignore | 5 +
Makefile.am | 1 +
appliance/packagelist.in | 5 +
configure.ac | 1 +
dib/Makefile.am | 144 ++++++++
dib/cmdline.ml | 239 ++++++++++++
dib/dib.ml | 920 +++++++++++++++++++++++++++++++++++++++++++++++
dib/elements.ml | 191 ++++++++++
dib/utils.ml | 137 +++++++
dib/virt-dib.pod | 591 ++++++++++++++++++++++++++++++
po-docs/podfiles | 1 +
run.in | 1 +
12 files changed, 2236 insertions(+)
create mode 100644 dib/Makefile.am
create mode 100644 dib/cmdline.ml
create mode 100644 dib/dib.ml
create mode 100644 dib/elements.ml
create mode 100644 dib/utils.ml
create mode 100644 dib/virt-dib.pod
diff --git a/.gitignore b/.gitignore
index 29f9d6d..054657a 100644
--- a/.gitignore
+++ b/.gitignore
@@ -118,6 +118,10 @@ Makefile.in
/df/stamp-virt-df.pod
/df/virt-df
/df/virt-df.1
+/dib/.depend
+/dib/stamp-virt-dib.pod
+/dib/virt-dib
+/dib/virt-dib.1
/diff/stamp-virt-diff.pod
/diff/virt-diff
/diff/virt-diff.1
@@ -241,6 +245,7 @@ Makefile.in
/html/virt-copy-out.1.html
/html/virt-customize.1.html
/html/virt-df.1.html
+/html/virt-dib.1.html
/html/virt-diff.1.html
/html/virt-edit.1.html
/html/virt-filesystems.1.html
diff --git a/Makefile.am b/Makefile.am
index 331a34e..194ee19 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -133,6 +133,7 @@ SUBDIRS += \
mllib \
customize \
builder builder/website \
+ dib \
resize \
sparsify \
sysprep \
diff --git a/appliance/packagelist.in b/appliance/packagelist.in
index 76c7293..160d9e8 100644
--- a/appliance/packagelist.in
+++ b/appliance/packagelist.in
@@ -257,3 +257,8 @@ ifelse(VALGRIND_DAEMON,1,valgrind)
dnl Define this by doing: ./configure --with-extra-packages="..."
EXTRA_PACKAGES
+curl
+qemu-img
+debootstrap
+apt
+which
diff --git a/configure.ac b/configure.ac
index 1552bff..8194bb6 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1740,6 +1740,7 @@ AC_CONFIG_FILES([Makefile
customize/Makefile
daemon/Makefile
df/Makefile
+ dib/Makefile
diff/Makefile
edit/Makefile
erlang/Makefile
diff --git a/dib/Makefile.am b/dib/Makefile.am
new file mode 100644
index 0000000..8932e64
--- /dev/null
+++ b/dib/Makefile.am
@@ -0,0 +1,144 @@
+# 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_ML) $(SOURCES_C) \
+ virt-dib.pod
+
+CLEANFILES = *~ *.annot *.cmi *.cmo *.cmx *.cmxa *.o virt-dib
+
+SOURCES_ML = \
+ utils.ml \
+ cmdline.ml \
+ elements.ml \
+ dib.ml
+
+SOURCES_C = \
+ $(top_srcdir)/mllib/mkdtemp-c.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)/src
+virt_dib_CFLAGS = \
+ -pthread \
+ $(WARN_CFLAGS) $(WERROR_CFLAGS)
+
+BOBJECTS = \
+ $(top_builddir)/mllib/libdir.cmo \
+ $(top_builddir)/mllib/config.cmo \
+ $(top_builddir)/mllib/common_gettext.cmo \
+ $(top_builddir)/mllib/common_utils.cmo \
+ $(top_builddir)/mllib/mkdtemp.cmo \
+ $(SOURCES_ML:.ml=.cmo)
+XOBJECTS = $(BOBJECTS:.cmo=.cmx)
+
+# -I $(top_builddir)/src/.libs is a hack which forces corresponding -L
+# option to be passed to gcc, so we don't try linking against an
+# installed copy of libguestfs.
+OCAMLPACKAGES = \
+ -package str,unix \
+ -I $(top_builddir)/src/.libs \
+ -I $(top_builddir)/gnulib/lib/.libs \
+ -I $(top_builddir)/ocaml \
+ -I $(top_builddir)/mllib
+if HAVE_OCAML_PKG_GETTEXT
+OCAMLPACKAGES += -package gettext-stub
+endif
+
+OCAMLCLIBS = \
+ -pthread -lpthread \
+ -lutils \
+ $(LIBINTL) \
+ -lgnu
+
+OCAMLFLAGS = $(OCAML_FLAGS) $(OCAML_WARN_ERROR)
+
+if !HAVE_OCAMLOPT
+OBJECTS = $(BOBJECTS)
+BEST = c
+OCAMLLINKFLAGS = mlguestfs.cma -custom
+else
+OBJECTS = $(XOBJECTS)
+BEST = opt
+OCAMLLINKFLAGS = mlguestfs.cmxa
+endif
+
+virt_dib_DEPENDENCIES = $(OBJECTS) $(top_srcdir)/ocaml-link.sh
+virt_dib_LINK = \
+ $(top_srcdir)/ocaml-link.sh -cclib '$(OCAMLCLIBS)' -- \
+ $(OCAMLFIND) $(BEST) $(OCAMLFLAGS) $(OCAMLPACKAGES) $(OCAMLLINKFLAGS) \
+ $(OBJECTS) -o $@
+
+.mli.cmi:
+ $(OCAMLFIND) ocamlc $(OCAMLFLAGS) $(OCAMLPACKAGES) -c $< -o $@
+.ml.cmo:
+ $(OCAMLFIND) ocamlc $(OCAMLFLAGS) $(OCAMLPACKAGES) -c $< -o $@
+if HAVE_OCAMLOPT
+.ml.cmx:
+ $(OCAMLFIND) ocamlopt $(OCAMLFLAGS) $(OCAMLPACKAGES) -c $< -o $@
+endif
+
+# Manual pages and HTML files for the website.
+
+man_MANS = virt-dib.1
+
+noinst_DATA = $(top_builddir)/html/virt-dib.1.html
+
+virt-dib.1 $(top_builddir)/html/virt-dib.1.html: stamp-virt-dib.pod
+
+stamp-virt-dib.pod: virt-dib.pod
+ $(PODWRAPPER) \
+ --man virt-dib.1 \
+ --html $(top_builddir)/html/virt-dib.1.html \
+ --license GPLv2+ \
+ $<
+ touch $@
+
+CLEANFILES += stamp-virt-dib.pod
+
+# Dependencies.
+depend: .depend
+
+.depend: $(wildcard $(abs_srcdir)/*.mli) $(wildcard $(abs_srcdir)/*.ml)
+ rm -f $@ $@-t
+ $(OCAMLFIND) ocamldep -I ../ocaml -I $(abs_srcdir) -I
$(abs_top_builddir)/mllib $^ | \
+ $(SED) 's/ *$$//' | \
+ $(SED) -e :a -e '/ *\\$$/N; s/ *\\\n */ /; ta' | \
+ $(SED) -e 's,$(abs_srcdir)/,$(builddir)/,g' | \
+ sort > $@-t
+ mv $@-t $@
+
+-include .depend
+
+endif
+
+DISTCLEANFILES = .depend
+
+.PHONY: depend docs
diff --git a/dib/cmdline.ml b/dib/cmdline.ml
new file mode 100644
index 0000000..252465b
--- /dev/null
+++ b/dib/cmdline.ml
@@ -0,0 +1,239 @@
+(* 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 Common_gettext.Gettext
+open Common_utils
+
+open Utils
+
+open Printf
+
+let parse_args () + 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 + elements := element :: !elements in
+
+ let excluded_elements = ref [] in
+ let append_excluded_element element + excluded_elements := element ::
!excluded_elements in
+
+ let element_paths = ref [] in
+ let append_element_path arg + element_paths := arg :: !element_paths in
+
+ let excluded_scripts = ref [] in
+ let append_excluded_script arg + excluded_scripts := arg ::
!excluded_scripts in
+
+ let debug = ref 0 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 ["qcow2"] in
+ let set_format arg + let fmts = string_nsplit "," arg in
+ let fmts = remove_dups fmts in
+ List.iter (
+ function
+ | "qcow2" | "tar" | "raw" | "vhd"
-> ()
+ | fmt ->
+ error (f_"invalid format '%s' in --formats") fmt
+ ) fmts;
+ formats := fmts in
+
+ let envvars = ref [] in
+ let append_envvar arg + envvars := 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 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 compressed = ref true in
+
+ let delete_on_failure = ref true in
+
+ let is_ramdisk = ref false in
+ let ramdisk_element = ref "ramdisk" in
+
+ let qemu_img_options = ref None in
+ let set_qemu_img_options arg = qemu_img_options := Some arg in
+
+ let mkfs_options = ref None in
+ let set_mkfs_options arg = mkfs_options := Some arg in
+
+ let machine_readable = ref false in
+
+ let extra_packages = ref [] in
+ let append_extra_packages arg + extra_packages := List.rev (string_nsplit
"," arg) @ !extra_packages in
+
+ let argspec = [
+ "--short-options", Arg.Unit display_short_options, " "
^ s_"List short options";
+ "--long-options", Arg.Unit display_long_options, " " ^
s_"List long options";
+
+ "-p", Arg.String append_element_path, "path"
^ " " ^ s_"Add new a elements location";
+ "--element-path", Arg.String append_element_path,
"path" ^ " " ^ s_"Add new a elements location";
+ "--exclude-element", Arg.String append_excluded_element,
+ "element" ^ " " ^ s_"Exclude the specified
element";
+ "--exclude-script", Arg.String append_excluded_script,
+ "script" ^ " " ^ s_"Exclude the specified
script";
+ "--envvar", Arg.String append_envvar,
"envvar[=value]" ^ " " ^ s_"Carry/set this environment
variable";
+ "-n", Arg.Clear use_base, " " ^
s_"Skip the inclusion of the 'base' element";
+ "--root-label", Arg.String set_root_label, "label" ^
" " ^ s_"Label for the root fs";
+ "--install-type", Arg.Set_string install_type, "type" ^
" " ^ s_"Installation type";
+ "--image-cache", Arg.String set_image_cache,
"directory" ^ " " ^ s_"Location for cached
images";
+ "-u", Arg.Clear compressed, " " ^
"Do not compress the qcow2 image";
+ "--qemu-img-options", Arg.String set_qemu_img_options,
+ "option" ^ "
" ^ s_"Add qemu-img options";
+ "--mkfs-options", Arg.String set_mkfs_options,
+ "option" ^ "
" ^ s_"Add mkfs options";
+ "--extra-packages", Arg.String append_extra_packages,
+ "pkg,..." ^ " " ^ s_"Add extra packages to
install";
+
+ "--ramdisk", Arg.Set is_ramdisk, " " ^
"Switch to a ramdisk build";
+ "--ramdisk-element", Arg.Set_string ramdisk_element,
"name" ^ " " ^ s_"Main element for building
ramdisks";
+
+ "--name", Arg.Set_string image_name, "name" ^
" " ^ s_"Name of the image";
+ "--fs-type", Arg.Set_string fs_type, "fs" ^
" " ^ s_"Filesystem for the image";
+ "--size", Arg.String set_size, "size" ^
" " ^ s_"Set output disk size";
+ "--formats", Arg.String set_format,
"qcow2,tgz,..." ^ " " ^ s_"Output formats";
+ "--arch", Arg.Set_string arch, "arch" ^
" " ^ s_"Output architecture";
+ "--drive", Arg.String set_drive, "path" ^
" " ^ s_"Optional drive for caches";
+
+ "-m", Arg.Int set_memsize, "mb" ^
" " ^ s_"Set memory size";
+ "--memsize", Arg.Int set_memsize, "mb" ^
" " ^ s_"Set memory size";
+ "--network", Arg.Set network, " " ^
s_"Enable appliance network (default)";
+ "--no-network", Arg.Clear network, " " ^
s_"Disable appliance network";
+ "--smp", Arg.Int set_smp, "vcpus" ^
" " ^ s_"Set number of vCPUs";
+ "--no-delete-on-failure", Arg.Clear delete_on_failure,
+ " " ^
s_"Don't delete output file on failure";
+ "--machine-readable", Arg.Set machine_readable, " " ^
s_"Make output machine readable";
+
+ "-V", Arg.Unit print_version_and_exit, " " ^
s_"Display version and exit";
+ "--version", Arg.Unit print_version_and_exit, " " ^
s_"Display version and exit";
+ "-v", Arg.Unit set_verbose, " " ^
s_"Enable libguestfs debugging messages";
+ "--verbose", Arg.Unit set_verbose, " " ^
s_"Enable libguestfs debugging messages";
+ "-x", Arg.Unit set_trace, " " ^
s_"Enable tracing of libguestfs calls";
+ "--debug", Arg.Set_int debug, "level" ^
" " ^ s_"Set debug level";
+ "-B", Arg.Set_string basepath, "path" ^
" " ^ s_"Base path of diskimage-builder library";
+ ] in
+
+ let argspec + let cmp (arg1, _, _) (arg2, _, _) + let arg1 =
skip_dashes arg1 and arg2 = skip_dashes arg2 in
+ compare (String.lowercase arg1) (String.lowercase arg2)
+ in
+ List.sort cmp argspec in
+ let argspec = Arg.align argspec in
+ long_options := argspec;
+
+ Arg.parse argspec append_element usage_msg;
+
+ 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 root_label = !root_label in
+ let install_type = !install_type in
+ let image_cache = !image_cache in
+ let compressed = !compressed in
+ let delete_on_failure = !delete_on_failure in
+ let is_ramdisk = !is_ramdisk in
+ let ramdisk_element = !ramdisk_element in
+ let qemu_img_options = !qemu_img_options in
+ let mkfs_options = !mkfs_options in
+ let machine_readable = !machine_readable in
+ let extra_packages = List.rev !extra_packages in
+
+ (* No elements and machine-readable mode? Print some facts. *)
+ if elements = [] && machine_readable then (
+ printf "virt-dib\n";
+ printf "output:qcow2\n";
+ printf "output:tar\n";
+ printf "output:raw\n";
+ printf "output:vhd\n";
+ exit 0
+ );
+
+ if basepath = "" then
+ error (f_"-B must be specified");
+
+ if formats = [] then
+ error (f_"the list of output formats cannot be empty");
+
+ if elements = [] then
+ error (f_"at least one distribution root element must be
specified");
+
+ debug, basepath, elements, excluded_elements, element_paths,
+ excluded_scripts, use_base, drive,
+ image_name, fs_type, size, root_label, install_type, image_cache, compressed,
+ qemu_img_options, mkfs_options, is_ramdisk, ramdisk_element, extra_packages,
+ memsize, network, smp, delete_on_failure, formats, arch, envvars
diff --git a/dib/dib.ml b/dib/dib.ml
new file mode 100644
index 0000000..3dba88f
--- /dev/null
+++ b/dib/dib.ml
@@ -0,0 +1,920 @@
+(* 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 Common_gettext.Gettext
+open Common_utils
+
+open Cmdline
+open Utils
+open Elements
+
+open Printf
+
+module G = Guestfs
+
+let exclude_elements elements excluded_elements + match excluded_elements with
+ | [] ->
+ (* 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 + 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_prefix x "DIB_") vars in
+ let vars = List.map (fun x -> x ^ "\n") vars in
+ String.concat "" vars
+
+let make_dib_args args + let args = Array.to_list args in
+ let rec quote_args = function
+ | [] -> ""
+ | x :: xs -> " " ^ (quote x) ^ quote_args xs
+ in
+ match args with
+ | [] -> ""
+ | app :: xs -> app ^ quote_args xs
+
+let write_script fn text + let oc = open_out fn in
+ output_string oc text;
+ flush oc;
+ close_out oc;
+ Unix.chmod fn 0o755
+
+let prepare_external ~dib_args ~dib_vars ~out_name ~root_label ~rootfs_uuid
+ ~image_cache ~arch ~network ~debug
+ destdir libdir hooksdir tmpdir fakebindir all_elements element_paths + let
network_string = if network then "" else "1" in
+
+ let run_extra = sprintf "\
+#!/bin/bash
+%s
+target_dir=$1
+shift
+script=$1
+shift
+
+export PATH=%s:$PATH
+
+# d-i-b variables
+export TMP_MOUNT_PATH=%s
+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=%s
+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
+
+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
+
+$target_dir/$script
+"
+ (if debug >= 1 then "set -x\n" else "")
+ fakebindir
+ (quote tmpdir)
+ network_string
+ out_name
+ root_label
+ rootfs_uuid
+ image_cache
+ (quote libdir)
+ arch
+ (quote hooksdir)
+ dib_args
+ (String.concat " " (StringSet.elements all_elements))
+ (String.concat ":" element_paths)
+ (quote dib_vars)
+ debug in
+ write_script (destdir // "run-part-extra.sh") run_extra;
+
+ (* Needed as TMPDIR for the extra-data hooks *)
+ do_mkdir (tmpdir // "tmp")
+
+let prepare_aux ~envvars ~dib_args ~dib_vars ~log_file ~out_name ~rootfs_uuid
+ ~arch ~network ~root_label ~install_type ~debug ~extra_packages
+ destdir all_elements + let envvars_string = List.map (
+ fun (var, value) ->
+ sprintf "export %s=%s" var (quote value)
+ ) envvars in
+ let network_string = if network then "" else "1" in
+
+ let script_run_part = sprintf "\
+#!/bin/bash
+%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/aux/perm/home
+export PATH=$mysysroot/tmp/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/aux/lib
+export _PREFIX=$mysysroot/tmp/aux/elements
+export ARCH=%s
+export TMP_HOOKS_PATH=$mysysroot/tmp/aux/hooks
+export DIB_ARGS=\"%s\"
+export
DIB_MANIFEST_SAVE_DIR=\"$mysysroot/tmp/aux/out/${IMAGE_NAME}.d\"
+export IMAGE_BLOCK_DEVICE=$blockdev
+export IMAGE_ELEMENT=\"%s\"
+export DIB_ENV=%s
+export DIB_DEBUG_TRACE=%d
+export DIB_NO_TMPFS=1
+
+export TMP_BUILD_DIR=$mysysroot/tmp/aux
+export TMP_IMAGE_DIR=$mysysroot/tmp/aux
+
+if [ -n \"$mysysroot\" ]; then
+ export PATH=$mysysroot/tmp/aux/fake-bin:$PATH
+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 "")
+ (String.concat "\n" envvars_string)
+ network_string
+ out_name
+ rootfs_uuid
+ root_label
+ arch
+ dib_args
+ (String.concat " " (StringSet.elements all_elements))
+ (quote dib_vars)
+ debug 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
+
+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 `env | grep '^\\w' | cut -d= -f1`; do
+ case \"$envvar\" in
+ PATH | USER | USERNAME | HOSTNAME | TERM | LANG | HOME | SHELL | LOGNAME
) ;;
+ *) unset $envvar ;;
+ esac
+ done
+fi
+
+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 Tool_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/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), "" -> "''"
+ | _, 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/aux/run-and-log.sh '%s'
'' '' '%s' '%s' '%s' '%s'"
log_file blockdev hook_dir new_wd x)
+ | Out ->
+ g#debug "sh" [|
"/sysroot/tmp/aux/run-and-log.sh"; "/sysroot" ^ log_file;
"/sysroot"; "/sysroot"; blockdev; "/sysroot" ^
hook_dir; new_wd; x |]
+ | Subroot ->
+ g#debug "sh" [|
"/sysroot/tmp/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 hooks_dir hook_name scripts run_script + let
hook_dir = hooks_dir // hook_name in
+ let scripts = List.sort digit_prefix_compare scripts in
+ let timings = Hashtbl.create 13 in
+ List.iter (
+ fun x ->
+ message (f_"Running: %s/%s") hook_name x;
+ let cmd = sprintf "%s %s %s" (quote run_script) (quote
hook_dir) (quote x) in
+ let run () + 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;
+ ) scripts;
+ if debug >= 1 then (
+ print_string (timing_output ~target_name:hook_name scripts timings)
+ );
+ 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/aux/run-and-log.sh '%s' ''
'' '%s' '/tmp/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
+
+let main () + let debug, basepath, elements, excluded_elements, element_paths,
+ excluded_scripts, use_base, drive,
+ image_name, fs_type, size, root_label, install_type, image_cache,
compressed,
+ qemu_img_options, mkfs_options, is_ramdisk, ramdisk_element,
extra_packages,
+ memsize, network, smp, delete_on_failure, formats, arch, envvars +
parse_args () 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 (basepath // "die")) then
+ error (f_"the specified base path is not the diskimage-builder
library");
+
+ (* Check for required tools. *)
+ require_tool "uuidgen";
+ if List.mem "qcow2" formats then
+ require_tool "qemu-img";
+ if List.mem "vhd" formats then
+ require_tool "vhd-util";
+
+ let image_name_d = image_name ^ ".d" in
+
+ let tmpdir = Mkdtemp.temp_dir "dib." "" in
+ rmdir_on_exit tmpdir;
+ let auxtmpdir = tmpdir // "aux" in
+ do_mkdir auxtmpdir;
+ let hookstmpdir = auxtmpdir // "hooks" in
+ do_mkdir (hookstmpdir // "environment.d"); (* Just like d-i-b
does. *)
+ let extradatatmpdir = tmpdir // "extra-data" in
+ do_mkdir extradatatmpdir;
+ do_mkdir (auxtmpdir // "out" // image_name_d);
+ let elements = if use_base then ["base"] @ elements else elements
in
+ let elements = if is_ramdisk then [ramdisk_element] @ elements else elements
in
+ message (f_"Elements: %s") (String.concat " " elements);
+ if debug >= 1 then (
+ printf "tmpdir: %s\n" tmpdir;
+ printf "element paths: %s\n" (String.concat ":"
element_paths);
+ );
+
+ let loaded_elements = load_elements ~debug 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
+ (excluded_elements @ builtin_elements_blacklist) in
+
+ message (f_"Expanded elements: %s") (String.concat " "
(StringSet.elements all_elements));
+
+ let envvars = read_envvars envvars in
+ message (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 = make_dib_args 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
+ (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/aux/perm/" ^ (log_filename ()) in
+
+ let arch + match arch with
+ | "" -> current_arch ()
+ | arch -> arch in
+
+ let root_label + match 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 fs_type with
+ | "xfs" -> "img-rootfs"
+ | _ -> "cloudimg-rootfs")
+ | Some label -> label in
+
+ let image_cache + match image_cache with
+ | None -> Sys.getenv "HOME" // ".cache" //
"image-create"
+ | Some dir -> dir in
+ do_mkdir image_cache;
+
+ let rootfs_uuid = uuidgen () in
+
+ let formats_img, formats_archive = List.partition (
+ function
+ | "qcow2" | "raw" | "vhd" -> true
+ | _ -> false
+ ) formats in
+ let formats_img_nonraw = List.filter ((<>) "raw") formats_img
in
+
+ prepare_aux ~envvars ~dib_args ~dib_vars ~log_file ~out_name:image_name
~rootfs_uuid
+ ~arch ~network ~root_label ~install_type ~debug ~extra_packages
+ auxtmpdir all_elements;
+
+ let delete_output_file = ref delete_on_failure in
+ let delete_file () + if !delete_output_file then (
+ List.iter (
+ fun fmt ->
+ try Unix.unlink (output_filename image_name fmt) with _ -> ()
+ ) formats
+ )
+ in
+ at_exit delete_file;
+
+ prepare_external ~dib_args ~dib_vars ~out_name:image_name ~root_label
~rootfs_uuid
+ ~image_cache ~arch ~network ~debug
+ tmpdir basepath hookstmpdir extradatatmpdir (auxtmpdir //
"fake-bin")
+ all_elements element_paths;
+
+ let 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 hookstmpdir hook scripts
+ (tmpdir // "run-part-extra.sh")
+ with Not_found -> ()
+ and run_hook ~blockdev ~sysroot ?(new_wd = "") (g :
Guestfs.guestfs) hook + try
+ let scripts = 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
+
+ run_hook_host "extra-data.d";
+
+ let copy_in (g : Guestfs.guestfs) srcdir destdir + let desttar =
Filename.temp_file ~temp_dir:tmpdir "virt-dib." ".tar.gz" in
+ let cmd = sprintf "tar czf %s -C %s --owner=root --group=root ."
+ (quote desttar) (quote srcdir) in
+ run_command cmd;
+ g#mkdir_p destdir;
+ g#tar_in ~compress:"gzip" desttar destdir;
+ Sys.remove desttar in
+
+ let copy_preserve_in (g : Guestfs.guestfs) srcdir destdir + let desttar =
Filename.temp_file ~temp_dir:tmpdir "virt-dib." ".tar.gz" in
+ let remotetar = "/tmp/aux/" ^ (Filename.basename desttar) in
+ let cmd = sprintf "tar czf %s -C %s --owner=root --group=root ."
+ (quote desttar) (quote srcdir) in
+ run_command cmd;
+ g#upload desttar remotetar;
+ let verbose_flag = if debug > 0 then "v" else "" in
+ ignore (g#debug "sh" [| "tar"; "-C";
"/sysroot" ^ destdir; "--no-overwrite-dir"; "-x" ^
verbose_flag ^ "zf"; "/sysroot" ^ remotetar |]);
+ Sys.remove desttar;
+ g#rm remotetar in
+
+ if debug >= 1 then
+ ignore (Sys.command (sprintf "tree -ps %s" (quote tmpdir)));
+
+ message (f_"Opening the disks");
+
+ let is_ramdisk_build = is_ramdisk || StringSet.mem "ironic-agent"
all_elements in
+
+ let g, tmpdisk, tmpdiskfmt, drive_partition + let g = new G.guestfs () in
+ if verbose () then g#set_verbose true;
+ if trace () then g#set_trace true;
+
+ (match memsize with None -> () | Some memsize -> g#set_memsize
memsize);
+ (match smp with None -> () | Some smp -> g#set_smp smp);
+ g#set_network network;
+
+ (* Make sure to turn SELinux off to avoid awkward interactions
+ * between the appliance kernel and applications/libraries interacting
+ * with SELinux xattrs.
+ *)
+ g#set_selinux false;
+
+ (* 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 && List.mem "raw" formats_img
then 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 size;
+ g#add_drive ~readonly:false ~format:fmt fn;
+
+ (* Helper drive for elements and binaries. *)
+ g#add_drive_scratch (unit_GB 5);
+
+ (match drive with
+ | None ->
+ g#add_drive_scratch (unit_GB 5)
+ | Some drive ->
+ g#add_drive drive;
+ );
+
+ g#launch ();
+
+ (* Prepare the /aux partition. *)
+ g#mkfs "ext2" "/dev/sdb";
+ g#mount "/dev/sdb" "/";
+
+ copy_in g auxtmpdir "/";
+ copy_in g basepath "/lib";
+ g#umount "/";
+
+ (* Prepare the /aux/perm partition. *)
+ let drive_partition + match 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_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/aux";
+ g#mount "/dev/sdb" "/tmp/aux";
+ g#mount drive_partition "/tmp/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) 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 mkfs_options with
+ | None -> []
+ | Some o -> [ o ] in
+ let mkfs_options + (match 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 @ [ "-t"; fs_type; blockdev ] in
+ ignore (g#debug "sh" (Array.of_list ([ "mkfs" ] @
mkfs_options)));
+ g#set_label blockdev root_label;
+ (match fs_type with
+ | x when string_prefix x "ext" -> 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/aux/perm";
+ g#umount "/tmp/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 "aux/hooks" "/tmp/in_target.d";
+
+ copy_preserve_in g extradatatmpdir "/";
+
+ run_hook_in "pre-install.d";
+
+ if extra_packages <> [] then
+ ignore (run_install_packages ~debug ~blockdev ~log_file g 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/aux still exists. *)
+ ignore (g#is_dir "/tmp/aux");
+ g#mount "/dev/sdb" "/tmp/aux";
+ g#mount drive_partition "/tmp/aux/perm";
+
+ run_hook_in "finalise.d";
+
+ let out_dir = "/tmp/aux/out/" ^ image_name_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 image_name_d;
+ g#copy_out out_dir ".";
+ );
+
+ (* 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");
+
+ flush_all ();
+
+ List.iter (
+ fun fmt ->
+ let fn = output_filename image_name fmt in
+ match fmt with
+ | "tar" ->
+ message (f_"Compressing the image as tar");
+ g#tar_out ~excludes:[| "./sys/*"; "./proc/*" |]
"/" fn
+ | _ as fmt -> error "unhandled format: %s" fmt
+ ) formats_archive;
+
+ 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,
+ * or ironic-agent is one of the elements (d-i-b does this too).
+ *)
+ if not is_ramdisk_build then (
+ List.iter (
+ fun fmt ->
+ let fn = output_filename image_name fmt in
+ message (f_"Converting to %s") fmt;
+ match fmt with
+ | "qcow2" ->
+ let cmd + sprintf "qemu-img convert%s -f %s %s -O
%s%s %s"
+ (if compressed then " -c" else "")
+ tmpdiskfmt
+ (quote tmpdisk)
+ fmt
+ (match qemu_img_options with
+ | None -> ""
+ | Some opt -> " -o " ^ quote opt)
+ (quote (qemu_input_filename fn)) in
+ if debug >= 1 then
+ printf "%s\n%!" cmd;
+ run_command cmd
+ | "vhd" ->
+ let fn_intermediate = Filename.temp_file ~temp_dir:tmpdir
"vhd-intermediate." "" in
+ let cmd + sprintf "vhd-util convert -s 0 -t 1 -i %s
-o %s"
+ (quote tmpdisk)
+ (quote fn_intermediate) in
+ if debug >= 1 then
+ printf "%s\n%!" cmd;
+ run_command cmd;
+ let cmd + sprintf "vhd-util convert -s 1 -t 2 -i %s
-o %s"
+ (quote fn_intermediate)
+ (quote fn) in
+ if debug >= 1 then
+ printf "%s\n%!" cmd;
+ run_command cmd;
+ if not (Sys.file_exists fn) then
+ error (f_"VHD output not produced, most probably vhd-util is
old or not patched for 'convert'")
+ | _ as fmt -> error "unhandled format: %s" fmt
+ ) formats_img_nonraw;
+ );
+
+ message (f_"Done")
+
+let () = run_main_and_handle_errors main
diff --git a/dib/elements.ml b/dib/elements.ml
new file mode 100644
index 0000000..db7c302
--- /dev/null
+++ b/dib/elements.ml
@@ -0,0 +1,191 @@
+(* 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 Common_gettext.Gettext
+open Common_utils
+
+open Utils
+
+open Printf
+
+module StringSet = Set.Make (String)
+
+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 *)
+
+(* These are the elements which we don't ever try to use. *)
+let builtin_elements_blacklist = [
+]
+
+(* 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. *)
+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_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
+ 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 deps = get_deps elem in
+ provided := StringSet.union !provided (get_provides elem);
+ StringSet.iter (fun x -> Queue.push x queue)
+ (StringSet.diff deps (StringSet.union !final !provided));
+ final := StringSet.union !final deps
+ )
+ done;
+ let conflicts = StringSet.inter (stringset_of_list elements) !provided in
+ if not (StringSet.is_empty conflicts) then
+ error (f_"following elements were explicitly required but are provided
by other included elements: %s")
+ (String.concat "," (StringSet.elements conflicts));
+ if not (StringSet.mem "operating-system" !provided) then
+ error (f_"please include an operating system element");
+ StringSet.diff !final !provided
+
+let elements_with_script elements loaded_elements hook scriptname +
StringSet.filter (
+ fun e ->
+ try
+ let s = Hashtbl.find (Hashtbl.find loaded_elements e).hooks hook in
+ List.exists ((=) scriptname) s
+ with Not_found -> false
+ ) elements
+
+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
+ let is_regular_file file + try (Unix.stat file).Unix.st_kind = Unix.S_REG
+ with Unix.Unix_error _ -> false 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 dups = elements_with_script elements loaded_elements hook script 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/utils.ml b/dib/utils.ml
new file mode 100644
index 0000000..def2eee
--- /dev/null
+++ b/dib/utils.ml
@@ -0,0 +1,137 @@
+(* 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 Common_gettext.Gettext
+open Common_utils
+
+open Printf
+
+exception Tool_not_found of string (* tool *)
+
+let quote = Filename.quote
+
+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. *)
+ let normalize_arch = function
+ | "amd64" | "x86_64" -> "amd64"
+ | "i386"| "i486" | "i586" | "i686"
-> "i386"
+ | arch when string_prefix arch "armv" -> "armhf"
+ | arch -> arch in
+ normalize_arch Config.host_cpu
+
+let output_filename image_name = function
+ | 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_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 + let isdigit = function
+ | '0'..'9' -> true
+ | _ -> false in
+ try string_index_fn (fun x -> not (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 rec remove_dups = function
+ | [] -> []
+ | x :: xs -> x :: (remove_dups (List.filter ((<>) x) xs))
+
+let which tool + (* XXX ugly but effective *)
+ let lines = external_command (sprintf "sh -c \"which %s
2>/dev/null || true\"" tool) in
+ let lines = List.filter ((<>) "") lines in
+ (match lines with
+ | [] -> raise (Tool_not_found tool)
+ | [x] -> x
+ | x :: _ ->
+ error (f_"output of `which %s` contains more than one line:\n%s")
+ tool (String.concat "\n" lines))
+
+let run_command cmd + ignore (external_command cmd)
+
+let check_tool tool + try ignore (which tool); true
+ with Tool_not_found _ -> false
+
+let require_tool tool + try ignore (which tool)
+ with Tool_not_found tool ->
+ error (f_"%s needed but not found") tool
+
+let do_cp src dest + let cmd = sprintf "cp -t %s -a %s"
(Filename.quote dest) (Filename.quote src) in
+ run_command cmd
+
+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/virt-dib.pod b/dib/virt-dib.pod
new file mode 100644
index 0000000..aa5a1ae
--- /dev/null
+++ b/dib/virt-dib.pod
@@ -0,0 +1,591 @@
+=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<diskimage-builder>
+to build a new disk image, generate new ramdisks, etc.
+
+Virt-dib is intended as safe replacement for C<diskimage-builder>
+and its C<ramdisk-image-create> mode, see
+L</COMPARISON WITH DISKIMAGE-BUILDER> for a quick comparison with
+usage of C<diskimage-builder>.
+
+C<diskimage-builder> is part of the TripleO OpenStack project:
+L<https://wiki.openstack.org/wiki/TripleO>.
+
+=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<debian-jessie.qcow2>.
+
+=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<--arch> ARCHITECURE
+
+Use the specified architecture for the output image. The default
+value is the same as the host running virt-dib.
+
+Notes: right now it does nothing more than setting the C<ARCH>
+environment variable for the elements.
+
+=item B<-B> PATH
+
+Set the path to the library directory of C<diskimage-builder>. This is
+usually the C<lib> subdirectory.
+
+This parameter is B<mandatory>, 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<--debug> LEVEL
+
+Set the debug level to C<LEVEL>, which is a non-negative integer
+number. The default is C<0>.
+
+This debug level is different than what C<-x> and C<-v> set,
+and it increases the debugging information printed out.
+Specifically, this sets the C<DIB_DEBUG_TRACE>, and any value
+E<gt> C<0> enables tracing in the scripts executed.
+
+=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</HELPER DRIVE>.
+
+=item B<-p> PATH
+
+=item B<--element-path> PATH
+
+Add a new path with elements. Paths are used in the same order as the
+C<-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<diskimage-builder>, 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<install-packages> 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</ENVIRONMENT VARIABLES> 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<VARIABLE>. If it is not set, nothing
+is exported to the elements.
+
+=item B<--envvar> VARIABLE=VALUE
+
+Set the environment variable C<VARIABLE> with value C<VALUE> 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<SCRIPT>, whichever element it is in.
+
+This can be useful in case some script does not run well with virt-dib,
+for example when they really need C<diskimage-builder>'s environment.
+
+=item B<--formats> FORMAT,...
+
+Set the list of output formats, separating them with comma.
+
+Supported formats are:
+
+=over 4
+
+=item C<qcow2> (enabled by default)
+
+QEMU's qcow2.
+
+=item C<raw>
+
+Raw disk format.
+
+=item C<tar>
+
+An uncompressed tarball.
+
+=item C<vhd>
+
+C<Virtual Hard Disk> disk image. This output format requires
+the C<vhd-util> tool.
+
+Please note that the version of C<vhd-util> tool needs to be patched
+to support the C<convert> subcommand, and to be bootable.
+The patch is available here:
+L<https://github.com/emonty/vhd-util/blob/master/debian/patches/citrix>.
+
+=back
+
+=item B<--fs-type> FILESYSTEM
+
+Set the filesystem type to use for the root filesystem. The default
+is C<ext4>.
+
+See also L<guestfs(3)/guestfs_filesystem_available>.
+
+=item B<--machine-readable>
+
+This option is used to make the output more machine friendly
+when being parsed by other programs. See
+L</MACHINE READABLE OUTPUT> below.
+
+=item B<-m> MB
+
+=item B<--memsize> MB
+
+Change the amount of memory allocated to the appliance. Increase
+this if you find that the virt-dib execution runs out of memory.
+
+The default can be found with this command:
+
+ guestfish get-memsize
+
+=item B<--network>
+
+=item B<--no-network>
+
+Enable or disable network access from the guest during the installation.
+
+Enabled is the default. Use I<--no-network> to disable access.
+
+The network only allows outgoing connections and has other minor
+limitations. See L<virt-rescue(1)/NETWORK>.
+
+This does not affect whether the guest can access the network once it
+has been booted, because that is controlled by your hypervisor or
+cloud environment and has nothing to do with virt-dib.
+
+If you use I<--no-network>, then the environment variable
+C<DIB_OFFLINE> is set to C<1>, signaling the elements that they
+should use only cached resources when available. Note also that,
+unlike with C<diskimage-builder> where elements may still be able
+to access to the network even with C<DIB_OFFLINE=>, under virt-dib
+network will be fully unaccessible.
+
+=item B<--image-cache> DIRECTORY
+
+Set the path in the host where cache the resources used by the elements
+of the C<extra-data.d> phase. The default is
F<~/.cache/image-create>.
+
+Please note that most of the resources fetched after C<extra-data>
+will be cached in the helper drive specified with I<--drive>;
+see also L</HELPER DRIVE>.
+
+=item B<--install-type> TYPE
+
+Specify the default installation type. Defaults to C<source>.
+
+Set to C<package> to use package based installations by default.
+
+=item B<--mkfs-options> C<OPTION STRING>
+
+Add the specified options to L<mkfs(1)>, to be able to fine-tune
+the root filesystem creation. Note that this is not possible
+to override the filesystem type.
+
+You should use I<--mkfs-options> at most once. To pass multiple
+options, separate them with space, eg:
+
+ virt-dib ... --mkfs-options '-O someopt -I foo'
+
+=item B<-n>
+
+Skip the inclusion of the C<base> element.
+
+=item B<--name> NAME
+
+Set the name of the output image file. The default is C<image>.
+
+According to the chosen name, there will be the following in the
+current directory:
+
+=over 4
+
+=item F<$NAME.ext>
+
+For each output format, a disk image named after the outout image
+with the extension depending on the format; for example:
+F<$NAME.qcow2>, F<$NAME.raw>, F<$NAME.tar>.
+
+Not applicable in ramdisk mode, see L</RAMDISK BUILDING>.
+
+=item F<$NAME.d>
+
+A directory containing any files created by the elements, for example
+F<dib-manifests> directory (created by the C<manifests> element),
+ramdisks and kernels in ramdisk mode, and so on.
+
+=back
+
+=item B<--no-delete-on-failure>
+
+Don't delete the output files on failure to build. You can use this to
+debug failures to run scripts.
+
+The default is to delete the output file if virt-dib fails (or,
+for example, some script that it runs fails).
+
+=item B<--qemu-img-options> option[,option,...]
+
+Pass I<--qemu-img-options> option(s) to the L<qemu-img(1)> command
+to fine-tune the output format. Options available depend on
+the output format (see I<--formats>) and the installed version
+of the qemu-img program.
+
+You should use I<--qemu-img-options> at most once. To pass multiple
+options, separate them with commas, eg:
+
+ virt-dib ... --qemu-img-options cluster_size=512,preallocation=metadata ...
+
+=item B<--ramdisk>
+
+Set the ramdisk building mode.
+
+See L</RAMDISK BUILDING>.
+
+=item B<--ramdisk-element> NAME
+
+Set the name for the additional element added in ramdisk building mode.
+The default is C<ramdisk>.
+
+See L</RAMDISK BUILDING>.
+
+=item B<--root-label> LABEL
+
+Set the label for the root filesystem in the created image.
+
+Please note that some filesystems have different restrictions on
+the length of their labels; for example, on C<ext2/3/4> filesystems
+labels cannot be longer than 16 characters, while on C<xfs> they have
+at most 12 characters.
+
+The default depends on the actual filesystem for the root partition
+(see I<--fs-type>): on C<xfs> is C<img-rootfs>, while
+C<cloudimg-rootfs> on any other filesystem.
+
+=item B<--size> SIZE
+
+Select the size of the output disk, where the size can be specified
+using common names such as C<32G> (32 gigabytes) etc.
+The default size is C<5G>.
+
+To specify size in bytes, the number must be followed by the lowercase
+letter I<b>, eg: S<C<--size 10737418240b>>.
+
+See also L<virt-resize(1)> for resizing partitions of an existing
+disk image.
+
+=item B<--smp> N
+
+Enable N E<ge> 2 virtual CPUs for scripts to use.
+
+=item B<-u>
+
+Do not compress resulting qcow2 images. The default is
+to compressed them.
+
+=item B<-v>
+
+=item B<--verbose>
+
+Enable debugging messages.
+
+=item B<-V>
+
+=item B<--version>
+
+Display version number and exit.
+
+=item B<-x>
+
+Enable tracing of libguestfs API calls.
+
+=back
+
+=head1 ENVIRONMENT VARIABLES
+
+Unlike with C<diskimage-builder>, the environment of the host is
+B<not> inherited in the appliance when running most of the elements
+(i.e. all the ones different than C<extra-data.d>).
+
+To set environment for the elements being run, it is necessary to tell
+virt-dib to use them, with the option I<--envvar>. Such option
+allows to selectively export environment variables when running the
+elements, and it is the preferred way to pass environment variables
+to the elements.
+
+To recap: if you want the environment variable C<MYVAR>
+(and its content) to be available to the elements, you can do either
+
+ export MYVAR # whichever is its value
+ virt-dib ... --envvar MYVAR ...
+
+or
+
+ virt-dib ... --envvar MYVAR=value_of_it ...
+
+=head1 HELPER DRIVE
+
+Virt-dib runs most of the element in its own appliance, and thus not
+on the host. Because of this, there is no possibility for elements
+to cache resources directly on the host.
+
+To solve this issue, virt-dib allows the usage of an helper drive
+where to store cached resources, like disk images,
+distribution packages, etc. While this means that there is a smaller
+space available for caching, at least it allows to limit the space
+on the host for caches, without assuming that elements will do that
+by themselves.
+
+Currently this disk is either required to have a single partition
+on it, or the first partition on it will be used. A disk with
+the latter configuration can be easily created with L<guestfish(1)>
+like the following:
+
+ guestfish -N filename.img=fs:ext4:10G
+
+The above will create a disk image called F<filename.img>, 10G big,
+with a single partition of type ext4;
+see L<guestfish(1)/PREPARED DISK IMAGES>.
+
+It is recommended for it to be E<ge> 5G or even more, as elements
+will cache disk images, distribution packages, etc.
+
+The disk is also used as C<$HOME> during the elements run.
+Virt-dib stores in it the logs of the scripts executed in the appliance.
+
+The drive can be accessed like any other disk image, for example using
+other tools of libguestfs such as L<guestfish(1)>:
+
+ guestfish -a filename.img -m /dev/sda1
+
+If no helper drive is specified with I<--drive>, all the resources
+cached during a virt-dib run will be discarded.
+
+=head1 RAMDISK BUILDING
+
+Virt-dib can emulate also C<ramdisk-image-create>, which is a secondary
+operation mode of C<diskimage-builder>. Instead of being a different
+tool name, virt-dib provides easy access to this mode using the
+I<--ramdisk> switch.
+
+In this mode:
+
+=over 4
+
+=item
+
+there is an additional ramdisk element added (see I<--ramdisk-element>)
+
+=item
+
+no image is produced (so I<--formats> is ignored)
+
+=item
+
+F<$NAME.d> (see I<--name>) will contain initrd, kernel, etc
+
+=back
+
+=head1 TEMPORARY DIRECTORY
+
+Virt-dib uses the standard temporary directory used by libguestfs,
+see L<guestfs(3)/ENVIRONMENT VARIABLES>.
+
+By default this location is F</tmp> (default value for C<$TMPDIR>),
+which on some systems may be on a tmpfs filesystem, and thus
+defaulting to a maximum size of I<half> of physical RAM.
+If virt-dib exceeds this, it may hang or exit early with an error.
+The solution is to point C<$TMPDIR> to a permanent location used
+as temporary location, for example:
+
+ $ mkdir local-tmp
+ $ env TMPDIR=$PWD/local-tmp virt-dib ...
+ $ rm -rf local-tmp
+
+=head1 MACHINE READABLE OUTPUT
+
+The I<--machine-readable> option can be used to make the output more
+machine friendly, which is useful when calling virt-dib from other
+programs, GUIs etc.
+
+Use the option on its own to query the capabilities of the
+virt-dib binary. Typical output looks like this:
+
+ $ virt-dib --machine-readable
+ virt-dib
+ output:qcow2
+ output:tar
+ output:raw
+ output:vhd
+
+A list of features is printed, one per line, and the program exits
+with status 0.
+
+=head1 COMPARISON WITH DISKIMAGE-BUILDER
+
+Virt-dib is intended as safe replacement for C<diskimage-builder>
+and its C<ramdisk-image-create> mode; the user-notable differences
+consist in:
+
+=over 4
+
+=item
+
+the command line arguments; some of the arguments are the same as
+available in C<diskimage-builder>, while some have different names
+
+=item
+
+the location of non-image output files (like ramdisks and kernels)
+
+=item
+
+the way cached resources are saved: using an helper drive, not directly
+on the disk where virt-dib is run
+
+=item
+
+the need to specify a target size for the output disk, as opposed
+to C<diskimage-builder> calculating an optimal one
+
+=item
+
+the handling of environment variables, see L</ENVIRONMENT VARIABLES>.
+
+Furthermore, other than the libguestfs own environment variables
+(see L<guestfs(3)/ENVIRONMENT VARIABLES>), virt-dib does not read
+any other environment variable: this means that all the options
+and behaviour changes are specified solely using command line
+arguments
+
+=item
+
+C<extra-data.d> scripts run before in the host environment, before
+all the other ones (even C<root.d>); this means that, depending
+on the configuration for the elements, some of them may fail due to
+missing content (usually directories) in C<$TMP_HOOKS_PATH>.
+
+Workarounds for this may be either:
+
+=over 4
+
+=item
+
+fix the C<extra-data.d> scripts to create the missing directories
+
+=item
+
+create (and use) a simple element with a C<extra-data.d> script
+named e.g. F<00-create-missing-dirs> to create the missing
+directories
+
+=back
+
+=back
+
+Elements themselves should notice no difference in they way
+they are run; behaviour differences may due to wrong assumptions in
+elements, or not correct virt-dib emulation.
+
+Known issues at the moment:
+
+=over 4
+
+=item
+
+(none)
+
+=back
+
+=head1 TESTING
+
+Virt-dib has been tested with C<diskimage-builder> (and its elements)
+E<ge> 0.1.43; from time to time also with C<tripleo-image-elements>
+and C<sahara-image-elements>.
+
+Previous versions may work, but it is not guaranteed.
+
+=head1 EXIT STATUS
+
+This program returns 0 if successful, or non-zero if there was an
+error.
+
+=head1 SEE ALSO
+
+L<guestfs(3)>,
+L<guestfish(1)>,
+L<virt-resize(1)>,
+L<http://libguestfs.org/>.
+
+=head1 AUTHOR
+
+Pino Toscano (C<ptoscano at redhat dot com>)
+
+=head1 COPYRIGHT
+
+Copyright (C) 2015 Red Hat Inc.
diff --git a/po-docs/podfiles b/po-docs/podfiles
index c76f1b1..26bd880 100644
--- a/po-docs/podfiles
+++ b/po-docs/podfiles
@@ -11,6 +11,7 @@
../customize/virt-customize.pod
../daemon/guestfsd.pod
../df/virt-df.pod
+../dib/virt-dib.pod
../diff/virt-diff.pod
../edit/virt-edit.pod
../erlang/examples/guestfs-erlang.pod
diff --git a/run.in b/run.in
index 8fdf454..5d30bf4 100755
--- a/run.in
+++ b/run.in
@@ -102,6 +102,7 @@ prepend PATH "$b/sysprep"
prepend PATH "$b/test-tool"
prepend PATH "$b/tools"
prepend PATH "$b/v2v"
+prepend PATH "$b/dib"
export PATH
# Set LD_LIBRARY_PATH and DYLD_LIBRARY_PATH to contain library.
--
2.1.0
