virt-dib is a new tool to run the elements of diskimage-builder using
libguestfs.
---
Work in progress (debug stuff here and there), although I've submitting
it for initial review, for being included later when polished for good.
TODO items open:
- move Uname from builder to mllib
- improve the documentation
- review
- getting more testing (although it has been successfully tested for
a while, not only by myself)
- polish
.gitignore | 6 +
Makefile.am | 1 +
appliance/packagelist.in | 4 +
configure.ac | 3 +
dib/Makefile.am | 148 ++++++++
dib/cmdline.ml | 247 +++++++++++++
dib/dib.ml | 930 +++++++++++++++++++++++++++++++++++++++++++++++
dib/elements.ml | 219 +++++++++++
dib/link.sh.in | 22 ++
dib/uname-c.c | 57 +++
dib/uname.ml | 27 ++
dib/uname.mli | 28 ++
dib/utils.ml | 148 ++++++++
dib/virt-dib.pod | 541 +++++++++++++++++++++++++++
po-docs/podfiles | 1 +
run.in | 1 +
16 files changed, 2383 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/link.sh.in
create mode 100644 dib/uname-c.c
create mode 100644 dib/uname.ml
create mode 100644 dib/uname.mli
create mode 100644 dib/utils.ml
create mode 100644 dib/virt-dib.pod
diff --git a/.gitignore b/.gitignore
index 9c329a0..27aae29 100644
--- a/.gitignore
+++ b/.gitignore
@@ -120,6 +120,11 @@ Makefile.in
/df/stamp-virt-df.pod
/df/virt-df
/df/virt-df.1
+/dib/.depend
+/dib/link.sh
+/dib/stamp-virt-dib.pod
+/dib/virt-dib
+/dib/virt-dib.1
/diff/stamp-virt-diff.pod
/diff/virt-diff
/diff/virt-diff.1
@@ -243,6 +248,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 580404a..c02d714 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..2f6878e 100644
--- a/appliance/packagelist.in
+++ b/appliance/packagelist.in
@@ -257,3 +257,7 @@ ifelse(VALGRIND_DAEMON,1,valgrind)
dnl Define this by doing: ./configure --with-extra-packages="..."
EXTRA_PACKAGES
+curl
+qemu-img
+debootstrap
+apt
diff --git a/configure.ac b/configure.ac
index d4137f6..1f6d21c 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1703,6 +1703,8 @@ AC_CONFIG_FILES([builder/link.sh],
[chmod +x,-w builder/link.sh])
AC_CONFIG_FILES([customize/link.sh],
[chmod +x,-w customize/link.sh])
+AC_CONFIG_FILES([dib/link.sh],
+ [chmod +x,-w dib/link.sh])
AC_CONFIG_FILES([inspector/test-xmllint.sh],
[chmod +x,-w inspector/test-xmllint.sh])
AC_CONFIG_FILES([mllib/link.sh],
@@ -1742,6 +1744,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..b472a67
--- /dev/null
+++ b/dib/Makefile.am
@@ -0,0 +1,148 @@
+# 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
+
+AM_YFLAGS = -d
+
+EXTRA_DIST = \
+ $(SOURCES_MLI) $(SOURCES_ML) $(SOURCES_C) \
+ virt-dib.pod
+
+CLEANFILES = *~ *.annot *.cmi *.cmo *.cmx *.cmxa *.o virt-dib
+
+SOURCES_MLI = \
+ uname.mli \
+ utils.mli
+
+SOURCES_ML = \
+ uname.ml \
+ utils.ml \
+ cmdline.ml \
+ elements.ml \
+ dib.ml
+
+SOURCES_C = \
+ $(top_srcdir)/mllib/mkdtemp-c.c \
+ uname-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 \
+ -I$(top_srcdir)/fish
+virt_dib_CFLAGS = \
+ -pthread \
+ $(WARN_CFLAGS) $(WERROR_CFLAGS) \
+ -Wno-unused-macros
+
+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
+
+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)
+virt_dib_LINK = \
+ ./link.sh \
+ $(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..9563260
--- /dev/null
+++ b/dib/cmdline.ml
@@ -0,0 +1,247 @@
+(* 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 ~prog + let display_version () + printf "%s %s\n"
prog Config.package_version;
+ exit 0
+ in
+
+ 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 blacklist = ref [] in
+ let append_blacklisted_script arg + blacklist := arg :: !blacklist in
+
+ let trace = ref false in
+ let verbose = ref false in
+ let debug = ref 0 in
+ let set_debug arg + debug := arg in
+
+ let dryrun = ref false 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 ~prog 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" -> ()
+ | 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 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";
+ "--blacklist", Arg.String append_blacklisted_script,
+ "script" ^ " " ^ s_"Blacklist (ignore) this
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";
+ "--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 display_version, " " ^
s_"Display version and exit";
+ "--version", Arg.Unit display_version, " " ^
s_"Display version and exit";
+ "-v", Arg.Set verbose, " " ^
s_"Enable libguestfs debugging messages";
+ "--verbose", Arg.Set verbose, " " ^
s_"Enable libguestfs debugging messages";
+ "-x", Arg.Set trace, " " ^
s_"Enable tracing of libguestfs calls";
+ "--debug", Arg.Int set_debug, "level" ^
" " ^ s_"Set debug level";
+ "-d", Arg.Set dryrun, " " ^
s_"Set the dry-run mode";
+ "-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 verbose = !verbose in
+ let trace = !trace in
+ let debug = !debug in
+ let dryrun = !dryrun 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 blacklist = List.rev !blacklist 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 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";
+ 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");
+
+ verbose, trace, debug, dryrun, basepath, elements, excluded_elements,
element_paths,
+ blacklist, use_base, drive,
+ image_name, fs_type, size, root_label, install_type, image_cache, compressed,
+ qemu_img_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..cf3fda6
--- /dev/null
+++ b/dib/dib.ml
@@ -0,0 +1,930 @@
+(* 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
+open Unix
+
+module G = Guestfs
+
+let exclude_elements elements excluded_elements + StringSet.filter (fun x
-> List.mem x excluded_elements <> true) elements
+
+let read_envvars envvars + filter_map (
+ fun var ->
+ let len = String.length var in
+ let i = string_find var "=" in
+ if i = -1 then (
+ try Some (var, Sys.getenv var)
+ with Not_found -> None
+ ) else (
+ Some (String.sub var 0 i, String.sub var (i + 1) (len - i - 1))
+ )
+ ) envvars
+
+let read_dib_envvars () + let vars = Array.to_list (environment ()) in
+ let vars = List.filter (fun x -> string_prefix x "DIB_") vars in
+ List.fold_left (fun acc x -> acc ^ x ^ "\n") "" vars
+
+let make_dib_args args + let args = Array.to_list args in
+ let rec quote_args = function
+ | [] -> ""
+ | x :: xs -> sprintf " %s" (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;
+ 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 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/bin:/usr/local/sbin
+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 \"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 \"Internal 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 | 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.
+ *)
+ if check_tool ~param:"--list ." "dib-run-parts" then (
+ let lines = external_command ~prog (sprintf "which
dib-run-parts") in
+ let lines = List.filter (fun x -> x <> "") lines in
+ let loc + match lines with
+ | [] -> error (f_"empty output of `which dib-run-parts`")
+ | x :: _ -> x in
+ do_cp loc (destdir // "fake-bin")
+ ) else (
+ 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=\"%s\"
+"
+ install_type in
+ write_script (destdir // "hooks" // "environment.d" //
"11-dib-install-type.bash") script_install_type_env;
+
+ (* Write install-packages.sh *)
+ 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
+
+let is_string_valid str + let is_char_valid = function
+ | 'A'..'Z' | 'a'..'z' |
'0'..'9' | '_' | '-' -> true
+ | _ -> false in
+ let rec loop str i len + if i = len then
+ true
+ else if not (is_char_valid str.[i]) then
+ false
+ else
+ loop str (i + 1) len in
+ loop str 0 (String.length str)
+
+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 ~dryrun ~sysroot ~blockdev ~log_file ?(new_wd =
"")
+ (g : Guestfs.guestfs) hook_dir + let msg fs = make_message_function
~quiet:false fs in (* XXX *)
+ let hook_name = Filename.basename hook_dir in
+ let entries = Array.to_list (g#ls hook_dir) in
+ let entries = List.filter (fun x -> is_string_valid x) entries in
+ let entries = List.filter (
+ fun x ->
+ let fn = hook_dir ^ "/" ^ x in
+ ((g#stat fn).G.mode &^ 0o111_L > 0_L) && g#is_file
~followsymlinks:true fn
+ ) entries in
+ let entries = List.sort digit_prefix_compare entries in
+ let outbuf = Buffer.create 16384 in
+ if dryrun then (
+ List.iter (fun x -> msg (f_"Would run: %s/%s") hook_name x)
entries
+ ) else (
+ let timings = Hashtbl.create 13 in
+ let new_wd + match sysroot, new_wd with
+ | (Out|Subroot), "" -> "''"
+ | _, dir -> dir in
+ List.iter (
+ fun x ->
+ msg (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\n" x
+ );
+ Hashtbl.add timings x delta_t;
+ ) entries;
+ g#write_append log_file (timing_output ~target_name:hook_name entries
timings)
+ );
+ flush_all ();
+ Buffer.contents outbuf
+
+let run_parts_host ~dryrun ~debug hook_dir run_script + let msg fs =
make_message_function ~quiet:false fs in (* XXX *)
+ let hook_name = Filename.basename hook_dir in
+ let entries = Array.to_list (Sys.readdir hook_dir) in
+ let entries = List.filter (fun x -> is_string_valid x) entries in
+ let entries = List.filter (
+ fun x ->
+ try
+ let s = Unix.stat (hook_dir // x) in
+ s.Unix.st_kind = Unix.S_REG && s.Unix.st_perm land 0o111 > 0
+ with Unix.Unix_error _ -> false
+ ) entries in
+ let entries = List.sort digit_prefix_compare entries in
+ if dryrun then (
+ List.iter (fun x -> msg (f_"Would run: %s/%s") hook_name x)
entries
+ ) else (
+ let timings = Hashtbl.create 13 in
+ List.iter (
+ fun x ->
+ msg (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 ~tool:(Filename.basename run_script)
cmd in
+ let delta_t = timed_run run in
+ if debug >= 1 then (
+ printf "\n";
+ printf "%s completed\n" x
+ );
+ Hashtbl.add timings x delta_t;
+
+ ) entries;
+ if debug >= 1 then (
+ print_string (timing_output ~target_name:hook_name entries timings)
+ )
+ );
+ flush_all ()
+
+let run_install_packages ~debug ~dryrun ~blockdev ~log_file
+ (g : Guestfs.guestfs) packages + let msg fs = make_message_function
~quiet:false fs in (* XXX *)
+ let pkgs_string = String.concat " " packages in
+ let outbuf = Buffer.create 16384 in
+ if dryrun then (
+ msg (f_"Would install: %s") pkgs_string
+ ) else (
+ msg (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
+ Buffer.add_string outbuf out;
+ Buffer.add_char outbuf '\n';
+ let out = ensure_trailing_newline out in
+ printf "%s%!" out;
+ if debug >= 1 then (
+ printf "package installation completed\n";
+ );
+ );
+ flush_all ();
+ Buffer.contents outbuf
+
+let main () + let verbose, trace, debug, dryrun, basepath, elements,
excluded_elements, element_paths,
+ blacklist, use_base, drive,
+ image_name, fs_type, size, root_label, install_type, image_cache,
compressed,
+ qemu_img_options, is_ramdisk, ramdisk_element, extra_packages,
+ memsize, network, smp, delete_on_failure, formats, arch, envvars +
parse_args ~prog in
+ let msg fs = make_message_function ~quiet:false fs in (* XXX *)
+
+ (* 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");
+
+ require_tool "uuidgen";
+
+ 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;
+ let extradatatmpdir = tmpdir // "extra-data" in
+ do_mkdir extradatatmpdir;
+ do_mkdir_p (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
+ msg (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.map (fun x -> Filename.basename x) v))
+ ) v.hooks;
+ ) loaded_elements;
+ printf "\n";
+ );
+ let all_elements = load_dependencies elements element_paths in
+ let all_elements = exclude_elements all_elements
+ (excluded_elements @ builtin_elements_blacklist) in
+
+ msg (f_"Expanded elements: %s") (String.concat " "
(StringSet.elements all_elements));
+
+ let envvars = read_envvars envvars in
+ msg (f_"Carried environment variables: %s") (String.concat "
" (List.map (fun (var, value) -> var) 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
+ );
+
+ msg (f_"Preparing auxiliary data");
+
+ copy_elements all_elements loaded_elements
+ (blacklist @ builtin_scripts_blacklist) hookstmpdir;
+
+ let log_file = "/tmp/aux/perm/" ^ (log_filename ~prog) 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_p image_cache;
+
+ let rootfs_uuid = uuidgen ~prog () in
+
+ let formats_img, formats_archive = List.partition (
+ function
+ | "qcow2" | "raw" -> true
+ | _ -> false
+ ) formats in
+ let formats_img_nonraw = List.filter (fun x -> x <> "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 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 + let hook_dir = hookstmpdir // (hook ^
".d") in
+ if is_directory hook_dir then (
+ if debug >= 1 then (
+ printf "Running hooks for %s...\n%!" hook;
+ printf "run-parts %s\n%!" (quote hook_dir)
+ );
+ run_parts_host ~dryrun ~debug hook_dir (tmpdir //
"run-part-extra.sh")
+ )
+ and run_hook ~blockdev ~sysroot ?(new_wd = "")
+ (g : Guestfs.guestfs) hook + let hook_dir = sprintf
"/tmp/aux/hooks/%s.d" hook in
+ if g#is_dir hook_dir then (
+ if debug >= 1 then (
+ printf "Running hooks for %s...\n%!" hook;
+ printf "run-parts %s\n%!" (quote hook_dir)
+ );
+ run_parts ~debug ~dryrun ~sysroot ~blockdev ~log_file ~new_wd g hook_dir
+ ) else (
+ ""
+ ) in
+
+ run_hook_host "extra-data";
+
+ 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)));
+
+ msg (f_"Opening the disks");
+
+ 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 && not (StringSet.mem "ironic-agent"
all_elements) && 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"
+ | partitions ->
+ let partitions = List.filter (
+ fun x ->
+ string_prefix x "/dev/sdc"
+ ) partitions in
+ if partitions = [] then
+ error (f_"no partitions found in the helper drive");
+ List.hd partitions
+ ) 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 (fun x -> x <> "") 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 (fun x -> x <> "") lines in
+ if lines = [] then None
+ else (try Some (var_from_lines envvar lines) with _ -> None) in
+
+ (match run_hook_out_eval "block-device"
"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 ();
+
+ msg (f_"Setting up the destination root");
+
+ (* Create and mount the target filesystem. *)
+ let mkfs_options = [] in
+ let mkfs_options + 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"
]
+ | _ -> []
+ ) in
+ let mkfs_options = 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";
+
+ g#sync ();
+ checked_umount_all ();
+ flush_all ();
+
+ g#mount blockdev "/";
+ g#rm_rf "/tmp";
+ let subroot_items + let l = Array.to_list (g#ls "/subroot") in
+ let l_lost_plus_found, l = List.partition (fun x -> x =
"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";
+
+ if extra_packages <> [] then
+ ignore (run_install_packages ~debug ~dryrun ~blockdev ~log_file g
extra_packages);
+
+ run_hook_in "install";
+
+ run_hook_in "post-install";
+
+ run_hook_in "finalise";
+
+ run_hook_out ~new_wd:("/tmp/aux/out/" ^ image_name_d)
"cleanup";
+
+ g#sync ();
+
+ if g#ls "/tmp/aux/out/" <> [||] then (
+ msg (f_"Extracting data out of the image");
+ do_mkdir image_name_d;
+ g#copy_out ("/tmp/aux/out/" ^ image_name_d) ".";
+ );
+
+ g#rm "/tmp/in_target.d";
+ g#umount "/tmp/aux/perm";
+ g#umount "/tmp/aux";
+ g#rmdir "/tmp/aux";
+
+ flush_all ();
+
+ List.iter (
+ fun fmt ->
+ let fn = output_filename image_name fmt in
+ match fmt with
+ | "tar" ->
+ msg (f_"Compressing the image as tar");
+ g#tar_out ~excludes:[| "./sys/*"; "./proc/*";
"./tmp/*"; |]
+ "/" fn
+ | _ as fmt -> error "unhandled format: %s" fmt
+ ) formats_archive;
+
+ msg (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 ();
+
+ if not is_ramdisk && not (StringSet.mem "ironic-agent"
all_elements) && formats_img_nonraw <> [] then (
+ let can_compress = function
+ | "qcow2" -> true
+ | _ -> false in
+ let tmpdisk = quote tmpdisk in
+ List.iter (
+ fun fmt ->
+ let fn = output_filename image_name fmt in
+ msg (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 && can_compress fmt then " -c"
else "")
+ tmpdiskfmt
+ tmpdisk
+ fmt
+ (match qemu_img_options with
+ | None -> ""
+ | Some opt -> " -o " ^ quote opt)
+ (quote fn) in
+ if debug >= 1 then
+ printf "%s\n%!" cmd;
+ run_command cmd
+ | _ as fmt -> error "unhandled format: %s" fmt
+ ) formats_img_nonraw;
+ );
+
+ msg (f_"Done")
+
+let () = run_main_and_handle_errors ~prog main
diff --git a/dib/elements.ml b/dib/elements.ml
new file mode 100644
index 0000000..cae6c3c
--- /dev/null
+++ b/dib/elements.ml
@@ -0,0 +1,219 @@
+(* 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
+
+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 stringset_of_list l + List.fold_left (fun acc x -> StringSet.add x acc)
StringSet.empty l
+
+let quote = Filename.quote
+
+let load_hooks ~debug path +(*
+ if debug >= 2 then
+ printf "load_hooks %s\n" path;
+*)
+ let hooks = Hashtbl.create 13 in
+ let entries = Sys.readdir path in
+ Array.iter (
+ fun e ->
+(*
+ if debug >= 2 then
+ printf "moo! %s\n" path;
+*)
+ let p = path // e in
+ if is_directory p && (Filename.check_suffix e ".d")
then (
+ let listing = Sys.readdir p in
+ let hook = String.sub e 0 ((String.length e) - 2) in
+ Array.iter (
+ fun script ->
+(*
+ if debug >= 2 then
+ printf "%s, %s\n" path p;
+*)
+ try
+ (match script.[0] with
+ | '0'..'9' ->
+ let d = p // script in
+ let l = try Hashtbl.find hooks hook with Not_found -> [] in
+ let l = d :: l in
+ Hashtbl.replace hooks hook l
+ | _ -> ()
+ )
+ with Invalid_argument _ -> ()
+ ) listing
+ )
+ ) entries;
+ hooks
+
+let load_elements ~debug paths + let loaded_elements = Hashtbl.create 13 in
+ List.iter (
+ fun path ->
+(* printf "moo! %s\n" path; *)
+ if Sys.is_directory path then (
+ let listing = Sys.readdir path in
+ Array.iter (
+ fun p ->
+(* printf "%s, %s\n" path p; *)
+ let dir = path // p in
+ if is_directory dir then (
+ 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 element_paths + let get filename element +
let rec loop = function
+ | [] ->
+ error (f_"element %s not found in %s") element (String.concat
":" element_paths)
+ | x :: tl ->
+(* printf "@@@ element %s, path %s\n" element x; *)
+ if is_directory (x // element) then (
+ let path = x // element // 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 (fun x -> x <> "") lines
in
+ stringset_of_list lines
+ ) else
+ StringSet.empty
+ ) else
+ loop tl in
+ loop element_paths 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
+(* printf "@@ %s\n" elem; *)
+ if StringSet.mem elem !provided <> true then (
+ let deps = get_deps elem in
+(* printf ">> %s, deps: %s\n" elem (String.concat ","
(StringSet.elements deps)); *)
+(* printf ">> %s, prov: %s\n" elem (String.concat ","
(StringSet.elements (get "element-provides" elem))); *)
+ 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 (
+ fun p ->
+ Filename.basename p = 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 (
+ fun e -> e <> "tests"
+ ) entries in
+ List.iter (
+ fun e ->
+ let path = element.directory // e in
+ let destpath = destdir // e in
+ if is_directory path then (
+ do_mkdir destpath;
+ let subentries = Sys.readdir path in
+ Array.iter (
+ fun sube ->
+ if is_file_or_link (destpath // sube) then (
+ let hook + if Filename.check_suffix e
".d" then
+ String.sub e 0 ((String.length e) - 2)
+ else
+ e in
+ raise (Duplicate_script (hook, sube))
+ ) else if not (List.mem sube blacklist) then
+ do_cp (path // sube) destpath
+ ) subentries;
+ ) else (
+ do_cp path destdir
+ )
+ ) entries
+
+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 hook in your elements:\n%s.d/%s
in: %s")
+ hook script (String.concat " " (StringSet.elements dups))
+ ) elements
diff --git a/dib/link.sh.in b/dib/link.sh.in
new file mode 100644
index 0000000..71e65ee
--- /dev/null
+++ b/dib/link.sh.in
@@ -0,0 +1,22 @@
+# libguestfs Makefile.am
+# @configure_input@
+# (C) Copyright 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., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+# Hack automake to link binary properly. There is no other way to add
+# the -cclib parameter to the end of the command line.
+
+exec "$@" -linkpkg -cclib '-pthread -lpthread -lutils @LIBINTL@
-lgnu'
diff --git a/dib/uname-c.c b/dib/uname-c.c
new file mode 100644
index 0000000..fc63233
--- /dev/null
+++ b/dib/uname-c.c
@@ -0,0 +1,57 @@
+/* virt-builder
+ * Copyright (C) 2014 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 <config.h>
+
+#include <errno.h>
+#include <sys/utsname.h>
+
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
+
+#ifdef HAVE_CAML_UNIXSUPPORT_H
+#include <caml/unixsupport.h>
+#else
+#define Nothing ((value) 0)
+extern void unix_error (int errcode, char * cmdname, value arg) Noreturn;
+#endif
+
+extern value virt_builder_uname (value unit);
+
+value
+virt_builder_uname (value unit)
+{
+ CAMLparam0 ();
+ CAMLlocal1 (rv);
+ struct utsname u;
+
+ if (uname (&u) < 0)
+ unix_error (errno, (char *) "uname", Val_int (0));
+
+ rv = caml_alloc (5, 0);
+
+ Store_field (rv, 0, caml_copy_string (u.sysname));
+ Store_field (rv, 1, caml_copy_string (u.nodename));
+ Store_field (rv, 2, caml_copy_string (u.release));
+ Store_field (rv, 3, caml_copy_string (u.version));
+ Store_field (rv, 4, caml_copy_string (u.machine));
+
+ CAMLreturn (rv);
+}
diff --git a/dib/uname.ml b/dib/uname.ml
new file mode 100644
index 0000000..c370c2c
--- /dev/null
+++ b/dib/uname.ml
@@ -0,0 +1,27 @@
+(* virt-builder
+ * Copyright (C) 2014 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.
+ *)
+
+type uname_struct = {
+ sysname : string;
+ nodename : string;
+ release : string;
+ version : string;
+ machine : string;
+}
+
+external uname : unit -> uname_struct = "virt_builder_uname"
diff --git a/dib/uname.mli b/dib/uname.mli
new file mode 100644
index 0000000..aea441b
--- /dev/null
+++ b/dib/uname.mli
@@ -0,0 +1,28 @@
+(* virt-builder
+ * Copyright (C) 2014 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.
+ *)
+
+type uname_struct = {
+ sysname : string;
+ nodename : string;
+ release : string;
+ version : string;
+ machine : string;
+}
+
+val uname : unit -> uname_struct
+(** [uname] Tiny wrapper to the C [uname]. *)
diff --git a/dib/utils.ml b/dib/utils.ml
new file mode 100644
index 0000000..b18b4fe
--- /dev/null
+++ b/dib/utils.ml
@@ -0,0 +1,148 @@
+(* 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
+
+let prog = Filename.basename Sys.executable_name
+let error ?exit_code fs = error ~prog ?exit_code fs
+let warning fs = warning ~prog fs
+let info fs = info ~prog fs
+
+let unit_GB howmany + (Int64.of_int howmany) *^ 1024_L *^ 1024_L *^ 1024_L
+
+let current_arch () + let normalize_arch = function
+ | "amd64" | "x86_64" | "x64" ->
"amd64"
+ | "i386"| "i486"| "i586"| "i686"
-> "i386"
+ | arch when string_prefix arch "armv" -> "armhf"
+ | arch -> arch in
+
+ try normalize_arch ((Uname.uname ()).Uname.machine)
+ with Unix.Unix_error _ -> "unknown"
+
+let output_filename image_name = function
+ | "tgz" -> image_name ^ ".tar.gz"
+ | fmt -> image_name ^ "." ^ fmt
+
+let log_filename ~prog + 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 lines = List.filter (fun x -> string_prefix x var_with_equal) lines in
+ let values = List.map (
+ fun x ->
+ let name, value = string_split "=" x in
+ value
+ ) lines in
+ (match values with
+ | [] ->
+ error (f_"variable '%s' not found in lines:\n%s")
+ var (String.concat "\n" lines)
+ | [x] -> x
+ | _ ->
+ error (f_"variable '%s' has more than one occurrency in
lines:\n%s")
+ var (String.concat "\n" lines)
+ )
+
+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 count_leading_digits str + let rec loop str i len + if i = len
then
+ i
+ else match str.[i] with
+ | '0'..'9' -> loop str (i + 1) len
+ | _ -> i in
+ loop str 0 (String.length str) in
+ let split_prefix str + let len = String.length str in
+ let digits = count_leading_digits str 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 do_mkdir_p dir + mkdir_p dir 0o755
+
+let rec remove_dups = function
+ | [] -> []
+ | x :: xs ->
+ x :: (remove_dups (List.filter (fun x -> x <> x) xs))
+
+let run_command ?(tool = "") cmd + let res = Sys.command cmd in
+ if res <> 0 then (
+ (* Extract the executable name, if not provided. *)
+ let tool + match tool with
+ | "" ->
+ let tool, _ = string_split " " cmd in
+ tool
+ | tool -> tool
+ in
+ error (f_"%s command (%s) failed with %d") tool cmd res
+ )
+
+let check_tool ?(param = "--version") tool + let cmd = sprintf
"%s %s 2>&1 >/dev/null" tool param in
+ let res = Sys.command cmd in
+ res = 0
+
+let require_tool ?(param = "--version") tool + if not (check_tool
~param tool) then
+ error (f_"%s needed but not found (or '%s %s' could not be
run)") tool tool param
+
+let is_file_or_link file + try
+ match (Unix.stat file).Unix.st_kind with
+ | Unix.S_REG | Unix.S_LNK -> true
+ | _ -> false
+ with Unix.Unix_error _ -> false
+
+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
diff --git a/dib/virt-dib.pod b/dib/virt-dib.pod
new file mode 100644
index 0000000..60b821c
--- /dev/null
+++ b/dib/virt-dib.pod
@@ -0,0 +1,541 @@
+=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=wheezy \
+ --name debian-wheezy \
+ debian vm
+
+This builds a Debian Wheezy disk image, suitable for running
+as virtual machine, saved as F<debian-wheezy.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<--blacklist> SCRIPT
+
+Blacklist the use of any element script named C<SCRIPT>.
+
+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<-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<--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.
+
+=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> 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<-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.gz>.
+
+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>).
+
+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
+
+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>
+
+=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
+
+due to the way C<root.d> elements are run, bind mounts set up to
+share dpkg/yum cache will not work in later phases
+
+=back
+
+=head1 TESTING
+
+Virt-dib has been tested with C<diskimage-builder> (and its elements)
+E<ge> 0.1.41; 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
