New tool: virt-sparsify to make disk images sparse.

9 files changed, 1070 insertions, 0 deletions

diff --git a/sparsify/.depend b/sparsify/.depend
new file mode 100644
index 00000000..9b7f865a
--- /dev/null
+++ b/sparsify/.depend
@@ -0,0 +1,7 @@
+progress.cmi:
+progress.cmo: utils.cmo progress.cmi
+progress.cmx: utils.cmx progress.cmi
+sparsify.cmo: utils.cmo progress.cmi
+sparsify.cmx: utils.cmx progress.cmx
+utils.cmo:
+utils.cmx:
diff --git a/sparsify/Makefile.am b/sparsify/Makefile.am
new file mode 100644
index 00000000..7d950b41
--- /dev/null
+++ b/sparsify/Makefile.am
@@ -0,0 +1,122 @@
+# libguestfs virt-sparsify tool
+# Copyright (C) 2011 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.
+
+include $(top_srcdir)/subdir-rules.mk
+
+EXTRA_DIST = \
+	$(SOURCES) \
+	virt-sparsify.pod \
+	test-virt-sparsify.sh
+
+CLEANFILES = *~ *.cmi *.cmo *.cmx *.cmxa *.o virt-sparsify test.img
+
+if HAVE_OCAML
+
+# Alphabetical order.
+SOURCES = \
+	progress_c.c \
+	progress.mli \
+	progress.ml \
+	sparsify.ml \
+	utils.ml
+
+# Note this list must be in dependency order.
+OBJECTS = \
+	../fish/guestfish-progress.o \
+	progress_c.o \
+	utils.cmx \
+	progress.cmx \
+	sparsify.cmx
+
+bin_SCRIPTS = virt-sparsify
+
+# -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 unix -I $(top_builddir)/src/.libs -I ../ocaml
+
+OCAMLCFLAGS = -g -warn-error CDEFLMPSUVYZX $(OCAMLPACKAGES)
+OCAMLOPTFLAGS = $(OCAMLCFLAGS)
+
+virt-sparsify: $(OBJECTS)
+	$(OCAMLFIND) ocamlopt $(OCAMLOPTFLAGS) \
+	  mlguestfs.cmxa -linkpkg $^ -cclib -lncurses -o $@
+
+.mli.cmi:
+	$(OCAMLFIND) ocamlc $(OCAMLCFLAGS) -c $< -o $@
+.ml.cmo:
+	$(OCAMLFIND) ocamlc $(OCAMLCFLAGS) -c $< -o $@
+.ml.cmx:
+	$(OCAMLFIND) ocamlopt $(OCAMLCFLAGS) -c $< -o $@
+
+# automake will decide we don't need C support in this file.  Really
+# we do, so we have to provide it ourselves.
+
+DEFAULT_INCLUDES = -I. -I$(top_builddir) -I$(shell $(OCAMLC) -where) -I../fish
+
+.c.o:
+	$(CC) $(CFLAGS) $(PROF_CFLAGS) $(DEFAULT_INCLUDES) -c $< -o $@
+
+# Manual pages and HTML files for the website.
+
+man_MANS = virt-sparsify.1
+
+noinst_DATA = $(top_builddir)/html/virt-sparsify.1.html
+
+virt-sparsify.1 $(top_builddir)/html/virt-sparsify.1.html: stamp-virt-sparsify.pod
+
+stamp-virt-sparsify.pod: virt-sparsify.pod
+	$(top_builddir)/podwrapper.sh \
+	  --man virt-sparsify.1 \
+	  --html $(top_builddir)/html/virt-sparsify.1.html \
+	  $<
+	touch $@
+
+CLEANFILES += stamp-virt-sparsify.pod
+
+# Tests.
+
+random_val := $(shell awk 'BEGIN{srand(); print 1+int(255*rand())}' < /dev/null)
+
+TESTS_ENVIRONMENT = \
+	MALLOC_PERTURB_=$(random_val) \
+	LD_LIBRARY_PATH=$(top_builddir)/src/.libs \
+	LIBGUESTFS_PATH=$(top_builddir)/appliance \
+	TMPDIR=$(top_builddir)
+
+TESTS = test-virt-sparsify.sh
+
+# Dependencies.
+depend: .depend
+
+.depend: $(wildcard *.mli) $(wildcard *.ml)
+	rm -f $@ $@-t
+	$(OCAMLFIND) ocamldep $^ | \
+	  $(SED) 's/ *$$//' | \
+	  $(SED) -e :a -e '/ *\\$$/N; s/ *\\\n */ /; ta' | \
+	  sort > $@-t
+	mv $@-t $@
+
+include .depend
+
+.PHONY: depend docs
+
+endif
+
+# Parallel builds don't obey dependencies for some reason we
+# don't understand.
+.NOTPARALLEL:
diff --git a/sparsify/progress.ml b/sparsify/progress.ml
new file mode 100644
index 00000000..6eca40f9
--- /dev/null
+++ b/sparsify/progress.ml
@@ -0,0 +1,54 @@
+(* virt-sparsify
+ * Copyright (C) 2010-2011 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 Printf
+
+open Utils
+
+module G = Guestfs
+
+type progress_bar
+external progress_bar_init : machine_readable:bool -> progress_bar
+  = "virt_sparsify_progress_bar_init"
+external progress_bar_reset : progress_bar -> unit
+  = "virt_sparsify_progress_bar_reset"
+external progress_bar_set : progress_bar -> int64 -> int64 -> unit
+  = "virt_sparsify_progress_bar_set"
+
+let set_up_progress_bar ?(machine_readable = false) (g : Guestfs.guestfs) =
+  (* Initialize the C mini library. *)
+  let bar = progress_bar_init ~machine_readable in
+
+  (* Reset the progress bar before every libguestfs function. *)
+  let enter_callback g event evh buf array =
+    if event = G.EVENT_ENTER then
+      progress_bar_reset bar
+  in
+
+  (* A progress event: move the progress bar. *)
+  let progress_callback g event evh buf array =
+    if event = G.EVENT_PROGRESS && Array.length array >= 4 then (
+      let position = array.(2)
+      and total = array.(3) in
+
+      progress_bar_set bar position total
+    )
+  in
+
+  ignore (g#set_event_callback enter_callback [G.EVENT_ENTER]);
+  ignore (g#set_event_callback progress_callback [G.EVENT_PROGRESS])
diff --git a/sparsify/progress.mli b/sparsify/progress.mli
new file mode 100644
index 00000000..c95d2800
--- /dev/null
+++ b/sparsify/progress.mli
@@ -0,0 +1,19 @@
+(* virt-sparsify
+ * Copyright (C) 2010-2011 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+val set_up_progress_bar : ?machine_readable:bool -> Guestfs.guestfs -> unit
diff --git a/sparsify/progress_c.c b/sparsify/progress_c.c
new file mode 100644
index 00000000..046ed34c
--- /dev/null
+++ b/sparsify/progress_c.c
@@ -0,0 +1,105 @@
+/* virt-sparsify - interface to progress bar mini library
+ * Copyright (C) 2011 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.
+ */
+
+#include <config.h>
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdint.h>
+#include <string.h>
+#include <locale.h>
+
+#include <caml/alloc.h>
+#include <caml/custom.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
+
+#include "progress.h"
+
+#define Bar_val(v) (*((struct progress_bar **)Data_custom_val(v)))
+
+static void
+progress_bar_finalize (value barv)
+{
+  struct progress_bar *bar = Bar_val (barv);
+
+  if (bar)
+    progress_bar_free (bar);
+}
+
+static struct custom_operations progress_bar_custom_operations = {
+  (char *) "progress_bar_custom_operations",
+  progress_bar_finalize,
+  custom_compare_default,
+  custom_hash_default,
+  custom_serialize_default,
+  custom_deserialize_default
+};
+
+value
+virt_sparsify_progress_bar_init (value machine_readablev)
+{
+  CAMLparam1 (machine_readablev);
+  CAMLlocal1 (barv);
+  struct progress_bar *bar;
+  int machine_readable = Bool_val (machine_readablev);
+  unsigned flags = 0;
+
+  /* XXX Have to do this to get nl_langinfo to work properly.  However
+   * we should really only call this from main.
+   */
+  setlocale (LC_ALL, "");
+
+  if (machine_readable)
+    flags |= PROGRESS_BAR_MACHINE_READABLE;
+  bar = progress_bar_init (flags);
+  if (bar == NULL)
+    caml_raise_out_of_memory ();
+
+  barv = caml_alloc_custom (&progress_bar_custom_operations,
+                            sizeof (struct progress_bar *), 0, 1);
+  Bar_val (barv) = bar;
+
+  CAMLreturn (barv);
+}
+
+value
+virt_sparsify_progress_bar_reset (value barv)
+{
+  CAMLparam1 (barv);
+  struct progress_bar *bar = Bar_val (barv);
+
+  progress_bar_reset (bar);
+
+  CAMLreturn (Val_unit);
+}
+
+value
+virt_sparsify_progress_bar_set (value barv,
+                                value positionv, value totalv)
+{
+  CAMLparam3 (barv, positionv, totalv);
+  struct progress_bar *bar = Bar_val (barv);
+  uint64_t position = Int64_val (positionv);
+  uint64_t total = Int64_val (totalv);
+
+  progress_bar_set (bar, position, total);
+
+  CAMLreturn (Val_unit);
+}
diff --git a/sparsify/sparsify.ml b/sparsify/sparsify.ml
new file mode 100644
index 00000000..89a2c137
--- /dev/null
+++ b/sparsify/sparsify.ml
@@ -0,0 +1,298 @@
+(* virt-sparsify
+ * Copyright (C) 2011 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 Unix
+open Printf
+
+module G = Guestfs
+
+open Utils
+
+let () = Random.self_init ()
+
+(* Command line argument parsing. *)
+let prog = Filename.basename Sys.executable_name
+
+let indisk, outdisk, convert, format, ignores, machine_readable, quiet,
+  verbose, trace =
+  let display_version () =
+    let g = new G.guestfs () in
+    let version = g#version () in
+    printf "virt-sparsify %Ld.%Ld.%Ld%s\n"
+      version.G.major version.G.minor version.G.release version.G.extra;
+    exit 0
+  in
+
+  let add xs s = xs := s :: !xs in
+
+  let convert = ref "" in
+  let format = ref "" in
+  let ignores = ref [] in
+  let machine_readable = ref false in
+  let quiet = ref false in
+  let verbose = ref false in
+  let trace = ref false in
+
+  let argspec = Arg.align [
+    "--convert", Arg.Set_string convert,    "format Format of output disk (default: same as input)";
+    "--format",  Arg.Set_string format,     "format Format of input disk";
+    "--ignore",  Arg.String (add ignores),  "fs Ignore filesystem";
+    "--machine-readable", Arg.Set machine_readable, " Make output machine readable";
+    "-q",        Arg.Set quiet,             " Quiet output";
+    "--quiet",   Arg.Set quiet,             " -\"-";
+    "-v",        Arg.Set verbose,           " Enable debugging messages";
+    "--verbose", Arg.Set verbose,           " -\"-";
+    "-V",        Arg.Unit display_version,  " Display version and exit";
+    "--version", Arg.Unit display_version,  " -\"-";
+    "-x",        Arg.Set trace,             " Enable tracing of libguestfs calls";
+  ] in
+  let disks = ref [] in
+  let anon_fun s = disks := s :: !disks in
+  let usage_msg =
+    sprintf "\
+%s: sparsify a virtual machine disk
+
+ virt-sparsify [--options] indisk outdisk
+
+A short summary of the options is given below.  For detailed help please
+read the man page virt-sparsify(1).
+"
+      prog in
+  Arg.parse argspec anon_fun usage_msg;
+
+  (* Dereference the rest of the args. *)
+  let convert = match !convert with "" -> None | str -> Some str in
+  let format = match !format with "" -> None | str -> Some str in
+  let ignores = List.rev !ignores in
+  let machine_readable = !machine_readable in
+  let quiet = !quiet in
+  let verbose = !verbose in
+  let trace = !trace in
+
+  (* No arguments and machine-readable mode?  Print out some facts
+   * about what this binary supports.
+   *)
+  if !disks = [] && machine_readable then (
+    printf "virt-sparsify\n";
+    let g = new G.guestfs () in
+    g#add_drive_opts "/dev/null";
+    g#launch ();
+    if feature_available g [| "ntfsprogs"; "ntfs3g" |] then
+      printf "ntfs\n";
+    if feature_available g [| "btrfs" |] then
+      printf "btrfs\n";
+    exit 0
+  );
+
+  (* Verify we got exactly 2 disks. *)
+  let indisk, outdisk =
+    match List.rev !disks with
+    | [indisk; outdisk] -> indisk, outdisk
+    | _ ->
+        error "usage is: %s [--options] indisk outdisk" prog in
+
+  (* The input disk must be an absolute path, so we can store the name
+   * in the overlay disk.
+   *)
+  let indisk =
+    if not (Filename.is_relative indisk) then
+      indisk
+    else
+      Sys.getcwd () // indisk in
+
+  (* Check indisk filename doesn't contain a comma (limitation of qemu-img). *)
+  let contains_comma =
+    try ignore (String.index indisk ','); true
+    with Not_found -> false in
+  if contains_comma then
+    error "input filename '%s' contains a comma; qemu-img command line syntax prevents us from using such an image" indisk;
+
+  indisk, outdisk, convert, format, ignores, machine_readable, quiet,
+  verbose, trace
+
+let () =
+  if not quiet then
+    printf "Create overlay file to protect source disk ...\n%!"
+
+(* Create the temporary overlay file. *)
+let overlaydisk =
+  let tmp = Filename.temp_file "sparsify" ".qcow2" in
+
+  (* Unlink on exit. *)
+  at_exit (fun () -> try unlink tmp with _ -> ());
+
+  (* Create it with the indisk as the backing file. *)
+  let cmd =
+    sprintf "qemu-img create -f qcow2 -o backing_file=%s%s %s > /dev/null"
+      (Filename.quote indisk)
+      (match format with
+      | None -> ""
+      | Some fmt -> sprintf ",backing_fmt=%s" (Filename.quote fmt))
+      (Filename.quote tmp) in
+  if verbose then
+    printf "%s\n%!" cmd;
+  if Sys.command cmd <> 0 then
+    error "external command failed: %s" cmd;
+
+  tmp
+
+let () =
+  if not quiet then
+    printf "Examine source disk ...\n%!"
+
+(* Connect to libguestfs. *)
+let g =
+  let g = new G.guestfs () in
+  if trace then g#set_trace true;
+  if verbose then g#set_verbose true;
+
+  (* Note that the temporary overlay disk is always qcow2 format. *)
+  g#add_drive_opts ~format:"qcow2" ~readonly:false overlaydisk;
+
+  if not quiet then Progress.set_up_progress_bar ~machine_readable g;
+  g#launch ();
+
+  g
+
+(* Get the size in bytes of the input disk. *)
+let insize = g#blockdev_getsize64 "/dev/sda"
+
+(* Write zeroes for non-ignored filesystems that we are able to mount. *)
+let () =
+  let filesystems = g#list_filesystems () in
+  let filesystems = List.map fst filesystems in
+  let filesystems = List.sort compare filesystems in
+  List.iter (
+    fun fs ->
+      if not (List.mem fs ignores) then (
+
+        let mounted =
+          try g#mount_options "" fs "/"; true
+          with _ -> false in
+
+        if mounted then (
+          if not quiet then
+            printf "Fill free space in %s with zero ...\n%!" fs;
+
+          (* Choose a random filename, just letters and numbers, in
+           * 8.3 format.  This ought to be compatible with any
+           * filesystem and not clash with existing files.
+           *)
+          let filename = "/" ^ string_random8 () ^ ".tmp" in
+
+          (* This command is expected to fail. *)
+          (try g#dd "/dev/zero" filename with _ -> ());
+
+          (* Make sure the last part of the file is written to disk. *)
+          g#sync ();
+
+          g#rm filename
+        );
+
+        g#umount_all ()
+      )
+  ) filesystems
+
+(* Fill unused space in volume groups. *)
+let () =
+  let vgs = g#vgs () in
+  let vgs = Array.to_list vgs in
+  let vgs = List.sort compare vgs in
+  List.iter (
+    fun vg ->
+      if not (List.mem vg ignores) then (
+        let lvname = string_random8 () in
+        let lvdev = "/dev/" ^ vg ^ "/" ^ lvname in
+
+        let created =
+          try g#lvcreate lvname vg 32; true
+          with _ -> false in
+
+        if created then (
+          if not quiet then
+            printf "Fill free space in volgroup %s with zero ...\n%!" vg;
+
+          (* XXX Don't have lvcreate -l 100%FREE.  Fake it. *)
+          g#lvresize_free lvdev 100;
+
+          (* This command is expected to fail. *)
+          (try g#dd "/dev/zero" lvdev with _ -> ());
+
+           g#sync ();
+           g#lvremove lvdev
+        )
+      )
+  ) vgs
+
+(* Don't need libguestfs now. *)
+let () =
+  g#close ()
+
+(* What should the output format be?  If the user specified an
+ * input format, use that, else detect it from the source image.
+ *)
+let output_format =
+  match convert with
+  | Some fmt -> fmt             (* user specified output conversion *)
+  | None ->
+    match format with
+    | Some fmt -> fmt           (* user specified input format, use that *)
+    | None ->
+      (* Don't know, so we must autodetect. *)
+      let cmd = sprintf "file -bsL %s" (Filename.quote indisk) in
+      let chan = open_process_in cmd in
+      let line = input_line chan in
+      let stat = close_process_in chan in
+      (match stat with
+      | WEXITED 0 -> ()
+      | WEXITED _ ->
+        error "external command failed: %s" cmd
+      | WSIGNALED i ->
+        error "external command '%s' killed by signal %d" cmd i
+      | WSTOPPED i ->
+        error "external command '%s' stopped by signal %d" cmd i
+      );
+      if string_prefix line "QEMU QCOW Image (v2)" then
+        "qcow2"
+      else
+        "raw" (* XXX guess *)
+
+(* Now run qemu-img convert which copies the overlay to the
+ * destination and automatically does sparsification.
+ *)
+let () =
+  if not quiet then
+    printf "Copy to destination and make sparse ...\n%!";
+
+  let cmd =
+    sprintf "qemu-img convert -f qcow2 -O %s %s %s"
+      (Filename.quote output_format)
+      (Filename.quote overlaydisk) (Filename.quote outdisk) in
+  if verbose then
+    printf "%s\n%!" cmd;
+  if Sys.command cmd <> 0 then
+    error "external command failed: %s" cmd
+
+(* Finished. *)
+let () =
+  if not quiet then (
+    print_newline ();
+    wrap "Sparsify operation completed with no errors.  Before deleting the old disk, carefully check that the target disk boots and works correctly.\n";
+  );
+
+  exit 0
diff --git a/sparsify/test-virt-sparsify.sh b/sparsify/test-virt-sparsify.sh
new file mode 100755
index 00000000..4a054dba
--- /dev/null
+++ b/sparsify/test-virt-sparsify.sh
@@ -0,0 +1,58 @@
+#!/bin/bash -
+# libguestfs virt-sparsify test script
+# Copyright (C) 2011 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.
+
+export LANG=C
+set -e
+
+rm -f test1.img test2.img
+
+# Create a filesystem, fill it with data, then delete the data.  Then
+# prove that sparsifying it reduces the size of the final filesystem.
+
+../fish/guestfish \
+    -N bootrootlv:/dev/VG/LV:ext2:ext4:400M:32M:gpt <<EOF
+mount-options "" /dev/VG/LV /
+mkdir /boot
+mount-options "" /dev/sda1 /boot
+fill 1 300M /big
+fill 1 10M /boot/big
+sync
+rm /big
+rm /boot/big
+umount-all
+EOF
+
+./virt-sparsify --format raw test1.img --convert qcow2 test2.img
+
+size_before=$(du -s test1.img | awk '{print $1}')
+size_after=$(du -s test2.img | awk '{print $1}')
+
+echo "test virt-sparsify: $size_before K -> $size_after K"
+
+if [ $size_before -lt 310000 ]; then
+    echo "test virt-sparsify: size_before ($size_before) too small"
+    exit 1
+fi
+
+if [ $size_after -gt 5000 ]; then
+    echo "test virt-sparsify: size_after ($size_after) too large"
+    echo "sparsification failed"
+    exit 1
+fi
+
+rm -f test1.img test2.img
diff --git a/sparsify/utils.ml b/sparsify/utils.ml
new file mode 100644
index 00000000..4f5631d6
--- /dev/null
+++ b/sparsify/utils.ml
@@ -0,0 +1,123 @@
+(* virt-sparsify
+ * Copyright (C) 2010-2011 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.
+ *)
+
+(* XXX This was copied from virt-resize, and probably some of the
+   functions here are not used in virt-sparsify and could be
+   deleted. *)
+
+open Printf
+
+module G = Guestfs
+
+let (//) = Filename.concat
+
+let ( +^ ) = Int64.add
+let ( -^ ) = Int64.sub
+let ( *^ ) = Int64.mul
+let ( /^ ) = Int64.div
+let ( &^ ) = Int64.logand
+let ( ~^ ) = Int64.lognot
+
+let output_spaces chan n = for i = 0 to n-1 do output_char chan ' ' done
+
+let wrap ?(chan = stdout) ?(hanging = 0) str =
+  let rec _wrap col str =
+    let n = String.length str in
+    let i = try String.index str ' ' with Not_found -> n in
+    let col =
+      if col+i >= 72 then (
+        output_char chan '\n';
+        output_spaces chan hanging;
+        i+hanging+1
+      ) else col+i+1 in
+    output_string chan (String.sub str 0 i);
+    if i < n then (
+      output_char chan ' ';
+      _wrap col (String.sub str (i+1) (n-(i+1)))
+    )
+  in
+  _wrap 0 str
+
+let string_prefix str prefix =
+  let n = String.length prefix in
+  String.length str >= n && String.sub str 0 n = prefix
+
+let string_random8 =
+  let chars = "abcdefghijklmnopqrstuvwxyz0123456789" in
+  fun () ->
+    String.concat "" (
+      List.map (
+        fun _ ->
+          let c = Random.int 36 in
+          let c = chars.[c] in
+          String.make 1 c
+      ) [1;2;3;4;5;6;7;8]
+    )
+
+let error fs =
+  let display str =
+    wrap ~chan:stderr ("virt-sparsify: error: " ^ str);
+    prerr_newline ();
+    prerr_newline ();
+    wrap ~chan:stderr
+      "If reporting bugs, run virt-sparsify with the '-v' and '-x' options and include the complete output.";
+    prerr_newline ();
+    exit 1
+  in
+  ksprintf display fs
+
+(* The reverse of device name translation, see
+ * BLOCK DEVICE NAMING in guestfs(3).
+ *)
+let canonicalize dev =
+  if String.length dev >= 8 &&
+    dev.[0] = '/' && dev.[1] = 'd' && dev.[2] = 'e' && dev.[3] = 'v' &&
+    dev.[4] = '/' && (dev.[5] = 'h' || dev.[5] = 'v') && dev.[6] = 'd' then (
+      let dev = String.copy dev in
+      dev.[5] <- 's';
+      dev
+    )
+  else
+    dev
+
+let feature_available (g : Guestfs.guestfs) names =
+  try g#available names; true
+  with G.Error _ -> false
+
+let human_size i =
+  let sign, i = if i < 0L then "-", Int64.neg i else "", i in
+
+  if i < 1024L then
+    sprintf "%s%Ld" sign i
+  else (
+    let f = Int64.to_float i /. 1024. in
+    let i = i /^ 1024L in
+    if i < 1024L then
+      sprintf "%s%.1fK" sign f
+    else (
+      let f = Int64.to_float i /. 1024. in
+      let i = i /^ 1024L in
+      if i < 1024L then
+        sprintf "%s%.1fM" sign f
+      else (
+        let f = Int64.to_float i /. 1024. in
+        (*let i = i /^ 1024L in*)
+        sprintf "%s%.1fG" sign f
+      )
+    )
+  )
diff --git a/sparsify/virt-sparsify.pod b/sparsify/virt-sparsify.pod
new file mode 100644
index 00000000..3d88a5fe
--- /dev/null
+++ b/sparsify/virt-sparsify.pod
@@ -0,0 +1,284 @@
+=encoding utf8
+
+=head1 NAME
+
+virt-sparsify - Make a virtual machine disk sparse
+
+=head1 SYNOPSIS
+
+ virt-sparsify [--options] indisk outdisk
+
+=head1 DESCRIPTION
+
+Virt-sparsify is a tool which can make a virtual machine disk (or any
+disk image) sparse a.k.a. thin-provisioned.  This means that free
+space within the disk image can be converted back to free space on the
+host.
+
+Virt-sparsify can locate and sparsify free space in most filesystems
+(eg. ext2/3/4, btrfs, NTFS, etc.), and also in LVM physical volumes.
+
+Virt-sparsify can also convert between some disk formats, for example
+converting a raw disk image to a thin-provisioned qcow2 image.
+
+Virt-sparsify can operate on any disk image, not just ones from
+virtual machines.  If a virtual machine has multiple disk images, then
+you must sparsify each one separately.
+
+=head2 IMPORTANT LIMITATIONS
+
+=over 4
+
+=item *
+
+Virt-sparsify does not do in-place modifications.  It copies from a
+source image to a destination image, leaving the source unchanged.
+I<Check that the sparsification was successful before deleting the
+source image>.
+
+=item *
+
+The virtual machine I<must be shut down> before using this tool.
+
+=item *
+
+Virt-sparsify may require up to 2x the virtual size of the source disk
+image (1 temporary copy + 1 destination image).  This is in the worst
+case and usually much less space is required.
+
+=item *
+
+Virt-sparsify cannot resize disk images.  To do that, use
+L<virt-resize(1)>.
+
+=item *
+
+Virt-sparsify cannot handle encrypted disks.
+
+=item *
+
+Virt-sparsify cannot yet sparsify the space between partitions.  Note
+that this space is often used for critical items like bootloaders so
+it's not really unused.
+
+=item *
+
+Virt-sparsify does not yet know how to sparsify swapspace.  It is not
+safe to do this unless we can be sure there is no hibernation data, so
+at the moment swap partitions are ignored.
+
+=back
+
+You may also want to read the manual pages for the associated tools
+L<virt-filesystems(1)> and L<virt-df(1)> before starting.
+
+=head1 EXAMPLES
+
+Typical usage is:
+
+ virt-sparsify indisk outdisk
+
+which copies C<indisk> to C<outdisk>, making the output sparse.
+C<outdisk> is created, or overwritten if it already exists.  The
+format of the input disk is detected (eg. qcow2) and the same format
+is used for the output disk.
+
+To convert between formats, use the I<--convert> option:
+
+ virt-sparsify disk.raw --convert qcow2 disk.qcow2
+
+Virt-sparsify tries to zero and sparsify free space on every
+filesystem it can find within the source disk image.  You can get it
+to ignore (don't zero free space on) certain filesystems by doing:
+
+ virt-sparsify --ignore /dev/sda1 indisk outdisk
+
+See L<virt-filesystems(1)> to get a list of filesystems within a disk
+image.
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<--help>
+
+Display help.
+
+=item B<--convert> raw
+
+=item B<--convert> qcow2
+
+=item B<--convert> [other formats]
+
+Use C<output-format> as the format for the destination image.  If this
+is not specified, then the input format is used.
+
+Supported and known-working output formats are: C<raw>, C<qcow2>.
+
+You can also use any format supported by the L<qemu-img(1)> program,
+eg. C<vdi> or C<vmdk>, but support for other formats is reliant on
+qemu.
+
+Specifying the I<--convert> option is usually a good idea, because
+then virt-sparsify doesn't need to try to guess the input format.
+
+=item B<--format> raw
+
+=item B<--format> qcow2
+
+Specify the format of the input disk image.  If this flag is not
+given then it is auto-detected from the image itself.
+
+If working with untrusted raw-format guest disk images, you should
+ensure the format is always specified.
+
+=item B<--ignore> filesystem
+
+=item B<--ignore> volgroup
+
+Ignore the named filesystem.  Free space on the filesystem will not be
+zeroed, but existing blocks of zeroes will still be sparsified.
+
+In the second form, this ignores the named volume group.  Use the
+volume group name without the C</dev/> prefix, eg. I<--ignore vg_foo>
+
+You can give this option multiple times.
+
+=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<-q>
+
+=item B<--quiet>
+
+This disables progress bars and other unnecessary output.
+
+=item B<-v>
+
+=item B<--verbose>
+
+Enable verbose messages for debugging.
+
+=item B<-V>
+
+=item B<--version>
+
+Display version number and exit.
+
+=item B<-x>
+
+Enable tracing of libguestfs API calls.
+
+=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-sparsify from
+other programs, GUIs etc.
+
+There are two ways to use this option.
+
+Firstly use the option on its own to query the capabilities of the
+virt-sparsify binary.  Typical output looks like this:
+
+ $ virt-sparsify --machine-readable
+ virt-sparsify
+ ntfs
+ btrfs
+
+A list of features is printed, one per line, and the program exits
+with status 0.
+
+Secondly use the option in conjunction with other options to make the
+regular program output more machine friendly.
+
+At the moment this means:
+
+=over 4
+
+=item 1.
+
+Progress bar messages can be parsed from stdout by looking for this
+regular expression:
+
+ ^[0-9]+/[0-9]+$
+
+=item 2.
+
+The calling program should treat messages sent to stdout (except for
+progress bar messages) as status messages.  They can be logged and/or
+displayed to the user.
+
+=item 3.
+
+The calling program should treat messages sent to stderr as error
+messages.  In addition, virt-sparsify exits with a non-zero status
+code if there was a fatal error.
+
+=back
+
+All versions of virt-sparsify have supported the I<--machine-readable>
+option.
+
+=head1 EXIT STATUS
+
+This program returns 0 if successful, or non-zero if there was an
+error.
+
+=head1 ENVIRONMENT VARIABLES
+
+=over 4
+
+=item TMPDIR
+
+Location of the temporary directory used for the potentially large
+temporary overlay file.
+
+You should ensure there is enough free space in the worst case for a
+full copy of the source disk (I<virtual> size), or else set C<$TMPDIR>
+to point to another directory that has enough space.
+
+This defaults to C</tmp>.
+
+=back
+
+For other environment variables, see L<guestfs(3)/ENVIRONMENT VARIABLES>.
+
+=head1 SEE ALSO
+
+L<virt-filesystems(1)>,
+L<virt-df(1)>,
+L<virt-resize(1)>,
+L<virt-rescue(1)>,
+L<guestfs(3)>,
+L<guestfish(1)>,
+L<truncate(1)>,
+L<fallocate(1)>,
+L<qemu-img(1)>,
+L<http://libguestfs.org/>.
+
+=head1 AUTHOR
+
+Richard W.M. Jones L<http://people.redhat.com/~rjones/>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2011 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.