[Libguestfs] [PATCH v4] RFC: New tool: virt-dib

Pino Toscano
Tue, 16 Jun 2015 10:15:22 -0000

virt-dib is a new tool to run the elements of diskimage-builder using
libguestfs.
---

I would like to have it reviewed at this point, so it can be used.

Documentation and code can be improved and polished following feedback.

 .gitignore               |   5 +
 Makefile.am              |   3 +-
 appliance/packagelist.in |   7 +
 configure.ac             |   1 +
 dib/Makefile.am          | 144 ++++++++
 dib/cmdline.ml           | 242 +++++++++++++
 dib/dib.ml               | 917 +++++++++++++++++++++++++++++++++++++++++++++++
 dib/elements.ml          | 187 ++++++++++
 dib/utils.ml             | 134 +++++++
 dib/virt-dib.pod         | 628 ++++++++++++++++++++++++++++++++
 po-docs/podfiles         |   1 +
 po/POTFILES-ml           |   4 +
 run.in                   |   1 +
 src/guestfs.pod          |   4 +
 14 files changed, 2277 insertions(+), 1 deletion(-)
 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 6f14915..697e5cd 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
@@ -245,6 +249,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 ad6d9d3..b51a3eb 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -133,6 +133,7 @@ SUBDIRS += \
 	mllib \
 	customize \
 	builder builder/website \
+	dib \
 	get-kernel \
 	resize \
 	sparsify \
@@ -354,7 +355,7 @@ all-local:
 	grep -v -E '^python/utils.c$$' | \
 	LC_ALL=C sort > po/POTFILES
 	cd $(srcdir); \
-	find builder customize get-kernel mllib resize sparsify sysprep v2v -name
'*.ml' | \
+	find builder customize dib get-kernel mllib resize sparsify sysprep v2v -name
'*.ml' | \
 	LC_ALL=C sort > po/POTFILES-ml

 # Try to stop people using 'make install' without 'DESTDIR'.
diff --git a/appliance/packagelist.in b/appliance/packagelist.in
index 76c7293..a4f814b 100644
--- a/appliance/packagelist.in
+++ b/appliance/packagelist.in
@@ -255,5 +255,12 @@ zerofree

 ifelse(VALGRIND_DAEMON,1,valgrind)

+dnl tools needed by virt-dib
+curl
+qemu-img
+debootstrap
+apt
+which
+
 dnl Define this by doing: ./configure --with-extra-packages="..."
 EXTRA_PACKAGES
diff --git a/configure.ac b/configure.ac
index e0da1ad..9356566 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..2fe77da
--- /dev/null
+++ b/dib/cmdline.ml
@@ -0,0 +1,242 @@
+(* 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 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 ["qcow2"] in
+  let set_format arg +    let fmts = remove_dups (string_nsplit ","
arg) 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";
+    "--skip-base",  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.Int set_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..b9c0588
--- /dev/null
+++ b/dib/dib.ml
@@ -0,0 +1,917 @@
+(* 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 = 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 +  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. *)
+  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..216a5f6
--- /dev/null
+++ b/dib/elements.ml
@@ -0,0 +1,187 @@
+(* 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 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 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/utils.ml b/dib/utils.ml
new file mode 100644
index 0000000..d20f7b3
--- /dev/null
+++ b/dib/utils.ml
@@ -0,0 +1,134 @@
+(* 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. *)
+  match Config.host_cpu with
+  | "amd64" | "x86_64" -> "amd64"
+  | "i386" | "i486" | "i586" | "i686"
-> "i386"
+  | arch when string_prefix arch "armv" -> "armhf"
+  | arch -> arch
+
+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 destdir +  run_command (sprintf "cp -t %s -a %s" (quote
destdir) (quote src))
+
+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..8951cd4
--- /dev/null
+++ b/dib/virt-dib.pod
@@ -0,0 +1,628 @@
+=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<-B> PATH
+
+Set the path to the library directory of C<diskimage-builder>. This is
+usually the F<lib> subdirectory in the sources and when installed,
+and F</usr/share/diskimage-builder/lib> when installed in F</usr>.
+
+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<--arch> ARCHITECURE
+
+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<ARCH>
+environment variable for the elements, and it's up to them to
+produce an image for the requested architecture.
+
+=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 I<-x> and I<-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
+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<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 , 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<--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 .
+
+Set to C<package> to use package based installations by default.
+
+=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<--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<--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<--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>, etc.
+
+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, eg: S<C<--size 10737418240b>>.
+
+See also L<virt-resize(1)> for resizing partitions of an existing
+disk image.
+
+=item B<--skip-base>
+
+Skip the inclusion of the C element.
+
+=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> 10G or even more, as elements
+will cache disk images, distribution packages, etc.  As with any disk
+image, the helper disk can be easily resized using L<virt-resize(1)>
+if more space in it is needed.
+
+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.
+
+=head2 RESOURCES INSIDE THE DRIVE
+
+Inside the helper drive, it is possible to find the following
+resources:
+
+=over 4
+
+=item F</home>
+
+This directory is set as C<HOME> environment variable during the
+build.  It contains mostly the image cache (saved as
+F</home/.cache/image-create>), and whichever other resource is
+cached in the home directory of the user running the various tools.
+
+=item F</virt-dib-*.log>
+
+These are the logs of the elements being run within the libguestfs
+appliance, which means all the hooks except C<extra-data.d>.
+
+=back
+
+=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 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:
+
+ disk-image-create             virt-dib
+ -----------------             --------
+ -a ARCH                       --arch ARCH
+ --image-size SIZE             --size SIZE
+ --max-online-resize SIZE      doable using --mkfs-options
+ -n                            --skip-base
+ -o IMAGENAME                  --name IMAGENAME
+ -p PACKAGE(S)                 --extra-packages PACKAGE(S)
+ -t FORMAT(S)                  --formats FORMAT(S)
+ -x                            --debug N
+
+=item
+
+the location of non-image output files (like ramdisks and kernels)
+
+=item
+
+the way some of the 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 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 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 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/po/POTFILES-ml b/po/POTFILES-ml
index 8725385..cddd02f 100644
--- a/po/POTFILES-ml
+++ b/po/POTFILES-ml
@@ -25,6 +25,10 @@ customize/random_seed.ml
 customize/ssh_key.ml
 customize/timezone.ml
 customize/urandom.ml
+dib/cmdline.ml
+dib/dib.ml
+dib/elements.ml
+dib/utils.ml
 get-kernel/get_kernel.ml
 mllib/JSON.ml
 mllib/JSON_tests.ml
diff --git a/run.in b/run.in
index 6709cdd..42f8cc8 100755
--- a/run.in
+++ b/run.in
@@ -86,6 +86,7 @@ prepend PATH "$b/builder"
 prepend PATH "$b/cat"
 prepend PATH "$b/customize"
 prepend PATH "$b/df"
+prepend PATH "$b/dib"
 prepend PATH "$b/diff"
 prepend PATH "$b/edit"
 prepend PATH "$b/erlang"
diff --git a/src/guestfs.pod b/src/guestfs.pod
index fa04c86..739110e 100644
--- a/src/guestfs.pod
+++ b/src/guestfs.pod
@@ -4353,6 +4353,10 @@ actions.

 L<virt-df(1)> command and documentation.

+=item F<dib>
+
+L<virt-dib(1)> command and documentation.
+
 =item F<diff>

 L<virt-diff(1)> command and documentation.
--
2.1.0