See the new man page virt-v2v-test-harness(1) added in this commit for
details of this library/harness, and also how to get the external
tests.
---
.gitignore | 6 +
Makefile.am | 3 +
README | 2 +
configure.ac | 8 +-
po-docs/ja/Makefile.am | 1 +
po-docs/podfiles | 1 +
po-docs/uk/Makefile.am | 1 +
po/POTFILES-ml | 1 +
v2v/test-harness/META.in | 6 +
v2v/test-harness/Makefile.am | 154 +++++++++++
v2v/test-harness/v2v_test_harness.ml | 409 +++++++++++++++++++++++++++++
v2v/test-harness/v2v_test_harness.mli | 66 +++++
v2v/test-harness/virt-v2v-test-harness.pod | 170 ++++++++++++
v2v/virt-v2v.pod | 1 +
14 files changed, 828 insertions(+), 1 deletion(-)
create mode 100644 v2v/test-harness/META.in
create mode 100644 v2v/test-harness/Makefile.am
create mode 100644 v2v/test-harness/v2v_test_harness.ml
create mode 100644 v2v/test-harness/v2v_test_harness.mli
create mode 100644 v2v/test-harness/virt-v2v-test-harness.pod
diff --git a/.gitignore b/.gitignore
index b165c81..810ed20 100644
--- a/.gitignore
+++ b/.gitignore
@@ -265,6 +265,7 @@ Makefile.in
/html/virt-tar-in.1.html
/html/virt-tar-out.1.html
/html/virt-v2v.1.html
+/html/virt-v2v-test-harness.1.html
/html/virt-win-reg.1.html
/inspector/actual-*.xml
/inspector/stamp-virt-inspector.pod
@@ -567,6 +568,11 @@ Makefile.in
/v2v/rhel-6.5.img
/v2v/rhel-7.0.img
/v2v/stamp-virt-v2v.pod
+/v2v/test-harness/.depend
+/v2v/test-harness/META
+/v2v/test-harness/dllv2v_test_harness.so
+/v2v/test-harness/stamp-virt-v2v-test-harness.pod
+/v2v/test-harness/virt-v2v-test-harness.1
/v2v/test-v2v-networks-and-bridges.xml
/v2v/virt-v2v
/v2v/virt-v2v.1
diff --git a/Makefile.am b/Makefile.am
index 527d4a5..580404a 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -137,6 +137,9 @@ SUBDIRS += \
sparsify \
sysprep \
v2v
+if HAVE_OCAML_PKG_LIBVIRT
+SUBDIRS += v2v/test-harness
+endif
endif
# Perl tools.
diff --git a/README b/README
index 272a74c..e05eeaf 100644
--- a/README
+++ b/README
@@ -244,6 +244,8 @@ The full requirements are described below.
+--------------+-------------+---+-----------------------------------------+
| ocaml-ounit | | O | For the tests of the common OCaml |
| | | | modules. |
++--------------+-------------+---+-----------------------------------------+
+| ocaml-libvirt| 0.6.1.5 | O | For building the virt-v2v test harness. |
+==============+=============+===+=========================================+
R = Required
O = Optional
diff --git a/configure.ac b/configure.ac
index 2e18c9e..9c78c07 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1130,6 +1130,7 @@ AS_IF([test "x$OCAMLC" != "xno"],[
])
OCAML_PKG_gettext=no
+OCAML_PKG_libvirt=no
OCAML_PKG_oUnit=no
AS_IF([test "x$OCAMLC" != "xno"],[
# Create mllib/common_gettext.ml, gettext functions or stubs.
@@ -1140,10 +1141,13 @@ AS_IF([test "x$OCAMLC" != "xno"],[
GUESTFS_CREATE_COMMON_GETTEXT_ML([mllib/common_gettext.ml])
+ AC_CHECK_OCAML_PKG(libvirt)
AC_CHECK_OCAML_PKG(oUnit)
])
AM_CONDITIONAL([HAVE_OCAML_PKG_GETTEXT],
[test "x$OCAMLC" != "xno" && test "x$OCAMLFIND"
!= "xno" && test "x$OCAML_PKG_gettext" != "xno"])
+AM_CONDITIONAL([HAVE_OCAML_PKG_LIBVIRT],
+ [test "x$OCAMLC" != "xno" && test "x$OCAMLFIND"
!= "xno" && test "x$OCAML_PKG_libvirt" != "xno"])
AM_CONDITIONAL([HAVE_OCAML_PKG_OUNIT],
[test "x$OCAMLC" != "xno" && test "x$OCAMLFIND"
!= "xno" && test "x$OCAML_PKG_oUnit" != "xno"])
@@ -1829,7 +1833,9 @@ AC_CONFIG_FILES([Makefile
tests/xml/Makefile
tools/Makefile
v2v/Makefile
- v2v/test-v2v-networks-and-bridges.xml])
+ v2v/test-v2v-networks-and-bridges.xml
+ v2v/test-harness/Makefile
+ v2v/test-harness/META])
AC_OUTPUT
dnl Produce summary.
diff --git a/po-docs/ja/Makefile.am b/po-docs/ja/Makefile.am
index 035c391..0f45b11 100644
--- a/po-docs/ja/Makefile.am
+++ b/po-docs/ja/Makefile.am
@@ -80,6 +80,7 @@ MANPAGES = \
virt-tar-in.1 \
virt-tar-out.1 \
virt-v2v.1 \
+ virt-v2v-test-harness.1 \
virt-win-reg.1
podfiles := $(shell for f in `cat $(top_srcdir)/po-docs/podfiles`; do echo `basename $$f
.pod`.pod; done)
diff --git a/po-docs/podfiles b/po-docs/podfiles
index c280bf2..c76f1b1 100644
--- a/po-docs/podfiles
+++ b/po-docs/podfiles
@@ -59,4 +59,5 @@
../tools/virt-list-partitions
../tools/virt-tar
../tools/virt-win-reg
+../v2v/test-harness/virt-v2v-test-harness.pod
../v2v/virt-v2v.pod
diff --git a/po-docs/uk/Makefile.am b/po-docs/uk/Makefile.am
index 035c391..0f45b11 100644
--- a/po-docs/uk/Makefile.am
+++ b/po-docs/uk/Makefile.am
@@ -80,6 +80,7 @@ MANPAGES = \
virt-tar-in.1 \
virt-tar-out.1 \
virt-v2v.1 \
+ virt-v2v-test-harness.1 \
virt-win-reg.1
podfiles := $(shell for f in `cat $(top_srcdir)/po-docs/podfiles`; do echo `basename $$f
.pod`.pod; done)
diff --git a/po/POTFILES-ml b/po/POTFILES-ml
index 6a0acdd..552fff3 100644
--- a/po/POTFILES-ml
+++ b/po/POTFILES-ml
@@ -111,6 +111,7 @@ v2v/output_qemu.ml
v2v/output_rhev.ml
v2v/output_vdsm.ml
v2v/stringMap.ml
+v2v/test-harness/v2v_test_harness.ml
v2v/types.ml
v2v/utils.ml
v2v/v2v.ml
diff --git a/v2v/test-harness/META.in b/v2v/test-harness/META.in
new file mode 100644
index 0000000..cbf6f06
--- /dev/null
+++ b/v2v/test-harness/META.in
@@ -0,0 +1,6 @@
+name="v2v_test_harness"
+version="@PACKAGE_VERSION@"
+description="virt-v2v test harness"
+requires="unix,libvirt,guestfs"
+archive(byte)="v2v_test_harness.cma"
+archive(native)="v2v_test_harness.cmxa"
diff --git a/v2v/test-harness/Makefile.am b/v2v/test-harness/Makefile.am
new file mode 100644
index 0000000..ef88374
--- /dev/null
+++ b/v2v/test-harness/Makefile.am
@@ -0,0 +1,154 @@
+# libguestfs virt-v2v test harness
+# Copyright (C) 2009-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.
+
+# Build the V2V_test_harness library, used by external repositories
+# that test virt-v2v end-to-end.
+
+include $(top_srcdir)/subdir-rules.mk
+
+EXTRA_DIST = \
+ $(SOURCES_MLI) $(SOURCES_ML) \
+ virt-v2v-test-harness.pod
+
+CLEANFILES = *~ *.annot *.cmi *.cmo *.cmx *.cmxa *.o
+
+SOURCES_MLI = \
+ v2v_test_harness.mli
+
+SOURCES_ML = \
+ v2v_test_harness.ml
+
+if HAVE_OCAML
+if HAVE_OCAML_PKG_LIBVIRT
+
+# -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,libvirt \
+ -I $(top_builddir)/src/.libs \
+ -I $(top_builddir)/gnulib/lib/.libs \
+ -I $(top_builddir)/ocaml \
+ -I $(top_builddir)/mllib \
+ -I $(top_builddir)/v2v
+
+OCAMLFLAGS = $(OCAML_FLAGS) $(OCAML_WARN_ERROR)
+
+BOBJECTS = \
+ $(top_builddir)/mllib/common_gettext.cmo \
+ $(top_builddir)/mllib/common_utils.cmo \
+ $(top_builddir)/v2v/xml.cmo \
+ $(SOURCES_ML:.ml=.cmo) \
+ $(libv2vth_a_OBJECTS)
+XOBJECTS = $(BOBJECTS:.cmo=.cmx)
+
+if !HAVE_OCAMLOPT
+noinst_DATA = v2v_test_harness.cma META
+else
+noinst_DATA = v2v_test_harness.cmxa META
+endif
+
+v2v_test_harness.cma: $(BOBJECTS)
+ $(OCAMLMKLIB) $^ -o v2v_test_harness $(LIBXML2_LIBS)
+
+v2v_test_harness.cmxa: $(XOBJECTS)
+ $(OCAMLMKLIB) $^ -o v2v_test_harness $(LIBXML2_LIBS)
+
+# We have to recompile *.c files with -fPIC. Do that by building an
+# uninstalled library.
+noinst_LIBRARIES = libv2vth.a
+
+libv2vth_a_CPPFLAGS = \
+ -DGUESTFS_PRIVATE=1 \
+ -I$(top_builddir) -I$(OCAMLLIB) -I$(top_srcdir)/ocaml \
+ -I$(top_srcdir)/src -I$(top_builddir)/src \
+ -I$(top_srcdir)/gnulib/lib -I$(top_builddir)/gnulib/lib
+
+libv2vth_a_CFLAGS = \
+ $(WARN_CFLAGS) $(WERROR_CFLAGS) \
+ $(LIBXML2_CFLAGS) \
+ -fPIC
+
+libv2vth_a_SOURCES = \
+ ../xml-c.c
+
+# Dependencies.
+
+.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
+
+# Do the installation by hand, because we want to run ocamlfind.
+data_hook_files = META *.so *.a *.cmi $(srcdir)/*.mli
+if !HAVE_OCAMLOPT
+data_hook_files += *.cmo *.cma
+else
+data_hook_files += *.cmx *.cmxa
+endif
+
+install-data-hook:
+ mkdir -p $(DESTDIR)$(OCAMLLIB)
+ mkdir -p $(DESTDIR)$(OCAMLLIB)/stublibs
+ $(OCAMLFIND) install \
+ -ldconf ignore -destdir $(DESTDIR)$(OCAMLLIB) \
+ v2v_test_harness \
+ $(data_hook_files)
+ rm $(DESTDIR)$(OCAMLLIB)/v2v_test_harness/libv2vth.a
+
+# Manual pages and HTML files for the website.
+
+man_MANS = virt-v2v-test-harness.1
+
+noinst_DATA += $(top_builddir)/html/virt-v2v-test-harness.1.html
+
+virt-v2v-test-harness.1 $(top_builddir)/html/virt-v2v-test-harness.1.html:
stamp-virt-v2v-test-harness.pod
+
+stamp-virt-v2v-test-harness.pod: virt-v2v-test-harness.pod
+ $(PODWRAPPER) \
+ --man virt-v2v-test-harness.1 \
+ --html $(top_builddir)/html/virt-v2v-test-harness.1.html \
+ --license LGPLv2+ \
+ $<
+ touch $@
+
+CLEANFILES += stamp-virt-v2v-test-harness.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 -I
$(abs_top_builddir)/customize $^ | \
+ $(SED) 's/ *$$//' | \
+ $(SED) -e :a -e '/ *\\$$/N; s/ *\\\n */ /; ta' | \
+ $(SED) -e 's,$(abs_srcdir)/,$(builddir)/,g' | \
+ sort > $@-t
+ mv $@-t $@
+
+-include .depend
+
+endif
+endif
+
+DISTCLEANFILES = .depend
+
+.PHONY: depend docs
diff --git a/v2v/test-harness/v2v_test_harness.ml b/v2v/test-harness/v2v_test_harness.ml
new file mode 100644
index 0000000..cd08cd0
--- /dev/null
+++ b/v2v/test-harness/v2v_test_harness.ml
@@ -0,0 +1,409 @@
+(* libguestfs v2v test harness
+ * Copyright (C) 2015 Red Hat Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2 of the License, or (at your option) any later version.
+ *
+ * This library 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
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ *)
+
+module G = Guestfs
+module C = Libvirt.Connect
+module D = Libvirt.Domain
+
+open Unix
+open Printf
+
+open Common_utils
+
+type test_plan = {
+ post_conversion_test : (Guestfs.guestfs -> string -> Xml.doc -> unit) option;
+ boot_plan : boot_plan;
+
+ boot_wait_to_write : int;
+ boot_max_time : int;
+ boot_idle_time : int;
+ boot_known_good_screenshots : string list;
+ boot_graceful_shutdown : int;
+
+ post_boot_test : (Guestfs.guestfs -> string -> Xml.doc -> unit) option;
+}
+and boot_plan =
+| No_boot
+| Boot_to_idle
+| Boot_to_screenshot of string
+
+let default_plan = {
+ post_conversion_test = None;
+ boot_plan = Boot_to_idle;
+ boot_wait_to_write = 120;
+ boot_max_time = 600;
+ boot_idle_time = 60;
+ boot_known_good_screenshots = [];
+ boot_graceful_shutdown = 60;
+ post_boot_test = None;
+}
+
+let failwithf fs = ksprintf failwith fs
+
+let quote = Filename.quote
+
+let run ~test ?input_disk ?input_xml ?(test_plan = default_plan) () =
+ let input_disk =
+ match input_disk with
+ | None -> test ^ ".img.xz"
+ | Some input_disk -> input_disk in
+ let input_xml =
+ match input_xml with
+ | None -> test ^ ".xml"
+ | Some input_xml -> input_xml in
+
+ let inspect_and_mount_disk filename =
+ let g = new G.guestfs () in
+ g#add_drive filename ~readonly:true ~format:"qcow2";
+ g#launch ();
+
+ let roots = g#inspect_os () in
+ let roots = Array.to_list roots in
+ let root =
+ match roots with
+ | [] -> failwithf "no roots found in disk image %s" filename
+ | [x] -> x
+ | _ ->
+ failwithf "multiple roots found in disk image %s" filename in
+
+ let mps = g#inspect_get_mountpoints root in
+ let cmp (a,_) (b,_) = compare (String.length a) (String.length b) in
+ let mps = List.sort cmp mps in
+ List.iter (
+ fun (mp, dev) ->
+ try g#mount_ro dev mp
+ with G.Error msg -> eprintf "%s (ignored)\n" msg
+ ) mps;
+
+ g, root
+ in
+
+ let nodes_of_xpathobj doc xpathobj =
+ let nodes = ref [] in
+ for i = 0 to Xml.xpathobj_nr_nodes xpathobj - 1 do
+ nodes := Xml.xpathobj_node doc xpathobj i :: !nodes
+ done;
+ List.rev !nodes
+ in
+
+ let test_boot boot_disk boot_xml_doc =
+ (* Modify boot XML (in memory). *)
+ let xpathctx = Xml.xpath_new_context boot_xml_doc in
+
+ (* Change <name> to something unique. *)
+ let domname = "tmpv2v-" ^ test in
+ let xpath = Xml.xpath_eval_expression xpathctx "/domain/name" in
+ let nodes = nodes_of_xpathobj boot_xml_doc xpath in
+ List.iter (fun node -> Xml.node_set_content node domname) nodes;
+
+ (* Limit the RAM used by the guest to 2GB. *)
+ let xpath = Xml.xpath_eval_expression xpathctx "/domain/memory" in
+ let nodes = nodes_of_xpathobj boot_xml_doc xpath in
+ let xpath = Xml.xpath_eval_expression xpathctx "/domain/currentMemory" in
+ let nodes = nodes @ nodes_of_xpathobj boot_xml_doc xpath in
+ List.iter (
+ fun node ->
+ let i = int_of_string (Xml.node_as_string node) in
+ if i > 2097152 then
+ Xml.node_set_content node "2097152"
+ ) nodes;
+
+ (* Remove all devices except for a whitelist. *)
+ let xpath = Xml.xpath_eval_expression xpathctx "/domain/devices/*" in
+ let nodes = nodes_of_xpathobj boot_xml_doc xpath in
+ List.iter (
+ fun node ->
+ match Xml.node_name node with
+ | "disk" | "graphics" | "video" -> ()
+ | _ -> Xml.unlink_node node
+ ) nodes;
+
+ (* Remove CDROMs. *)
+ let xpath =
+ Xml.xpath_eval_expression xpathctx
+ "/domain/devices/disk[@device=\"cdrom\"]" in
+ let nodes = nodes_of_xpathobj boot_xml_doc xpath in
+ List.iter Xml.unlink_node nodes;
+
+ (* Change <on_*> settings to destroy ... *)
+ let xpath = Xml.xpath_eval_expression xpathctx "/domain/on_poweroff" in
+ let nodes = nodes_of_xpathobj boot_xml_doc xpath in
+ let xpath = Xml.xpath_eval_expression xpathctx "/domain/on_crash" in
+ let nodes = nodes @ nodes_of_xpathobj boot_xml_doc xpath in
+ List.iter (fun node -> Xml.node_set_content node "destroy") nodes;
+ (* ... except for <on_reboot> which is permitted (for SELinux
+ * relabelling)
+ *)
+ let xpath = Xml.xpath_eval_expression xpathctx "/domain/on_reboot" in
+ let nodes = nodes_of_xpathobj boot_xml_doc xpath in
+ List.iter (fun node -> Xml.node_set_content node "restart") nodes;
+
+ (* Get the name of the disk device (eg. "sda"), which is used
+ * for getting disk stats.
+ *)
+ let xpath =
+ Xml.xpath_eval_expression xpathctx
+ "/domain/devices/disk[@device=\"disk\"]/target/@dev" in
+ let dev =
+ match nodes_of_xpathobj boot_xml_doc xpath with
+ | [node] -> Xml.node_as_string node
+ | _ -> assert false in
+
+ let boot_xml = Xml.to_string boot_xml_doc ~format:true in
+
+ (* Dump out the XML as debug information before running the guest. *)
+ printf "boot XML:\n%s\n" boot_xml;
+
+ (* Boot the guest. *)
+ let conn = C.connect () in
+ let dom = D.create_xml conn boot_xml [D.START_AUTODESTROY] in
+
+ let timestamp t =
+ let tm = localtime t in
+ let y = 1900+tm.tm_year and mo = 1+tm.tm_mon and d = tm.tm_mday
+ and h = tm.tm_hour and m = tm.tm_min and s = tm.tm_sec in
+ sprintf "%04d%02d%02d-%02d%02d%02d" y mo d h m s
+ in
+
+ let take_screenshot t =
+ (* Use 'virsh screenshot' command because our libvirt bindings
+ * don't include virDomainScreenshot, and in any case that API
+ * is complicated to use. Returns the filename.
+ *)
+ let filename = sprintf "%s-%s.scrn" test (timestamp t) in
+ let cmd =
+ sprintf "virsh screenshot %s %s" (quote domname) (quote filename) in
+ printf "%s\n%!" cmd;
+ if Sys.command cmd <> 0 then
+ failwith "virsh screenshot command failed";
+ filename
+ in
+
+ let display_matches_screenshot screenshot1 screenshot2 =
+ let cmd =
+ sprintf "compare -metric MAE %s %s null:"
+ (quote screenshot1) (quote screenshot2) in
+ printf "%s\n%!" cmd;
+ let r = Sys.command cmd in
+ if r < 0 || r > 1 then
+ failwith "compare command failed";
+ r = 0
+ in
+
+ let dom_is_alive () =
+ match (D.get_info dom).D.state with
+ | D.InfoRunning | D.InfoBlocked -> true
+ | _ -> false
+ in
+
+ let get_disk_write_activity stats =
+ let stats' = D.block_stats dom dev in
+ let writes = Int64.sub stats'.D.wr_req stats.D.wr_req in
+ writes > 0L, stats'
+ and get_disk_activity stats =
+ let stats' = D.block_stats dom dev in
+ let writes = Int64.sub stats'.D.wr_req stats.D.wr_req
+ and reads = Int64.sub stats'.D.rd_req stats.D.rd_req in
+ writes > 0L || reads > 0L, stats'
+ in
+
+ let bootfail t fs =
+ let screenshot = take_screenshot t in
+ eprintf "boot failed: see screenshot in %s\n%!" screenshot;
+ ksprintf failwith fs in
+
+ (* The guest is booting. We expect it to write to the disk within
+ * the first boot_wait_to_write seconds.
+ *)
+ let start = time () in
+ let stats = D.block_stats dom dev in
+ let rec loop stats =
+ sleep 10;
+ let t = time () in
+ if t -. start > float test_plan.boot_wait_to_write then
+ bootfail t "guest did not write to disk within %d seconds of boot"
+ test_plan.boot_wait_to_write;
+ let active, stats = get_disk_write_activity stats in
+ if active then
+ printf "%s: disk write detected\n" (timestamp t)
+ else (
+ printf "%s: still waiting for disk write after boot\n" (timestamp t);
+ loop stats
+ )
+ in
+ loop stats;
+
+ (* The guest has written something, so it has probably found its
+ * own disks, which is a good sign. Now we wait until it reaches
+ * the end condition (eg. Boot_to_idle or Boot_to_screenshot).
+ *)
+ let start = time () in
+ let last_activity = start in
+ let stats = D.block_stats dom dev in
+ let rec loop start last_activity stats =
+ sleep 10;
+ let t = time () in
+ if t -. start > float test_plan.boot_max_time then
+ bootfail t "guest timed out before reaching final state";
+ let active, stats = get_disk_activity stats in
+ if active then (
+ printf "%s: disk activity detected\n" (timestamp t);
+ loop start t stats
+ ) else if t -. last_activity <= float test_plan.boot_idle_time then (
+ let screenshot = take_screenshot t in
+ (* Reached the final screenshot? *)
+ let done_ =
+ match test_plan.boot_plan with
+ | Boot_to_screenshot final_screenshot ->
+ if display_matches_screenshot screenshot final_screenshot then (
+ printf "%s: guest reached final screenshot\n" (timestamp t);
+ true
+ ) else false
+ | _ -> false in
+ if not done_ then (
+ (* A screenshot matching one of the screenshots in the set
+ * resets the timeout.
+ *)
+ let waiting_in_known_good_state =
+ List.exists (display_matches_screenshot screenshot)
+ test_plan.boot_known_good_screenshots in
+ if waiting_in_known_good_state then (
+ printf "%s: guest at known-good screenshot\n" (timestamp t);
+ loop t last_activity stats
+ ) else
+ loop start last_activity stats
+ )
+ )
+ in
+ loop start last_activity stats;
+
+ (* Shut down the guest. Eventually kill it if it doesn't shut
+ * down gracefully on its own.
+ *)
+ D.shutdown dom;
+ let start = time () in
+ let rec loop () =
+ sleep 10;
+ let t = time () in
+ if t -. start > float test_plan.boot_graceful_shutdown then (
+ eprintf "warning: guest failed to shut down gracefully, killing it\n";
+ D.destroy dom
+ )
+ else if dom_is_alive () then
+ loop ()
+ in
+ loop ()
+ in
+
+ printf "v2v_test_harness: starting test: %s\n%!" test;
+
+ (* Check we are started in the correct directory, ie. the input_disk
+ * and input_xml files should exist, and they should be local files.
+ *)
+ if not (Sys.file_exists input_disk) || not (Sys.file_exists input_xml) then
+ failwithf "cannot find input files: %s, %s: you are probably running the test
script from the wrong directory" input_disk input_xml;
+
+ (* Uncompress the input, if it doesn't exist already. *)
+ let input_disk =
+ if Filename.check_suffix input_disk ".xz" then (
+ let input_disk_uncomp = Filename.chop_suffix input_disk ".xz" in
+ if not (Sys.file_exists input_disk_uncomp) then (
+ let cmd = sprintf "unxz --keep %s" (quote input_disk) in
+ printf "%s\n%!" cmd;
+ if Sys.command cmd <> 0 then
+ failwith "unxz command failed"
+ );
+ input_disk_uncomp
+ )
+ else input_disk in
+ ignore input_disk;
+
+ (* Run virt-v2v. *)
+ let cmd = sprintf
+ "virt-v2v -i libvirtxml %s -o local -of qcow2 -os . -on %s"
+ (quote input_xml) (quote (test ^ "-converted")) in
+ printf "%s\n%!" cmd;
+ if Sys.command cmd <> 0 then
+ failwith "virt-v2v command failed";
+
+ (* Check the right output files were created. *)
+ let converted_disk = test ^ "-converted-sda" in
+ if not (Sys.file_exists converted_disk) then
+ failwithf "cannot find virt-v2v output disk: %s" converted_disk;
+ let converted_xml = test ^ "-converted.xml" in
+ if not (Sys.file_exists converted_xml) then
+ failwithf "cannot find virt-v2v output XML: %s" converted_xml;
+
+ (* Check the output XML can be parsed into a document. *)
+ let converted_xml_doc = Xml.parse_memory (read_whole_file converted_xml) in
+
+ (* If there's a post-conversion callback, run it now. *)
+ (match test_plan.post_conversion_test with
+ | None -> ()
+ | Some fn ->
+ let g, root = inspect_and_mount_disk converted_disk in
+ fn g root converted_xml_doc;
+ g#close ()
+ );
+
+ match test_plan.boot_plan with
+ | No_boot -> ()
+ | Boot_to_idle | Boot_to_screenshot _ ->
+ (* We want to preserve the converted disk (before booting), so
+ * make an overlay to store writes during the boot test. This
+ * makes post-mortems a bit easier.
+ *)
+ let boot_disk = test ^ "-booted-sda" in
+ (new G.guestfs ())#disk_create boot_disk "qcow2" (-1L)
+ ~backingfile:converted_disk ~backingformat:"qcow2";
+
+ let boot_xml_doc = Xml.copy_doc converted_xml_doc ~recursive:true in
+
+ (* We need to remember to change the XML to point to the boot overlay. *)
+ let () =
+ let xpathctx = Xml.xpath_new_context boot_xml_doc in
+ let xpath =
+ Xml.xpath_eval_expression xpathctx
+ "/domain/devices/disk[@device=\"disk\"]/source" in
+ match nodes_of_xpathobj boot_xml_doc xpath with
+ | [node] ->
+ (* Libvirt requires that the path is absolute. *)
+ let abs_boot_disk = Sys.getcwd () // boot_disk in
+ Xml.set_prop node "file" abs_boot_disk
+ | _ -> assert false in
+
+ (* Test boot the guest. *)
+ (try test_boot boot_disk boot_xml_doc
+ with
+ | Libvirt.Virterror err ->
+ prerr_endline (Libvirt.Virterror.to_string err)
+ | exn -> raise exn
+ );
+
+ (* If there's a post-boot callback, run it now. *)
+ (match test_plan.post_boot_test with
+ | None -> ()
+ | Some fn ->
+ let g, root = inspect_and_mount_disk boot_disk in
+ fn g root converted_xml_doc (* or boot_xml_doc? *);
+ g#close ()
+ )
+
+let skip ~test reason =
+ printf "%s: test skipped because: %s\n%!" test reason;
+ exit 77
diff --git a/v2v/test-harness/v2v_test_harness.mli
b/v2v/test-harness/v2v_test_harness.mli
new file mode 100644
index 0000000..18926b5
--- /dev/null
+++ b/v2v/test-harness/v2v_test_harness.mli
@@ -0,0 +1,66 @@
+(* libguestfs v2v test harness
+ * Copyright (C) 2015 Red Hat Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2 of the License, or (at your option) any later version.
+ *
+ * This library 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
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ *)
+
+(** {1 Virt-v2v test harness}
+
+ This library is used by external repositories that test virt-v2v
+ using real disk images.
+*)
+
+type test_plan = {
+ post_conversion_test : (Guestfs.guestfs -> string -> Xml.doc -> unit) option;
+ (** Arbitrary test that can be run after conversion. *)
+
+ boot_plan : boot_plan;
+ (** How to test-boot the guest, if at all. *)
+
+ boot_wait_to_write : int;
+ (** Guest must write to disk within this nr. seconds (default: 120). *)
+
+ boot_max_time : int;
+ (** Max time we'll wait for guest to finish booting (default: 600).
+ However this timer is reset if the screenshot matches something in
+ the known good set. *)
+
+ boot_idle_time : int;
+ (** For Boot_to_idle, no disk activity counts as idle (default: 60). *)
+
+ boot_known_good_screenshots : string list;
+ (** List of known-good screenshots. If the guest screen looks like
+ one of these, we will keep waiting regardless of timeouts. *)
+
+ boot_graceful_shutdown : int;
+ (** When gracefully shutting down the guest, max time we will wait
+ before we kill it (default: 60). *)
+
+ post_boot_test : (Guestfs.guestfs -> string -> Xml.doc -> unit) option;
+ (** Arbitrary test that be run after booting. *)
+}
+
+and boot_plan =
+| No_boot (** Don't do the boot test at all. *)
+| Boot_to_idle (** Boot until VM is idle. *)
+| Boot_to_screenshot of string (** Boot until screenshot is displayed. *)
+
+val default_plan : test_plan
+
+val run : test:string -> ?input_disk:string -> ?input_xml:string ->
?test_plan:test_plan -> unit -> unit
+(** Run the test. This will exit with an error code on failure. *)
+
+val skip : test:string -> string -> unit
+(** Skip the test. The string parameter is the reason for skipping. *)
diff --git a/v2v/test-harness/virt-v2v-test-harness.pod
b/v2v/test-harness/virt-v2v-test-harness.pod
new file mode 100644
index 0000000..2163827
--- /dev/null
+++ b/v2v/test-harness/virt-v2v-test-harness.pod
@@ -0,0 +1,170 @@
+=head1 NAME
+
+virt-v2v-test-harness - Used to test virt-v2v against real test cases
+
+=head1 SYNOPSIS
+
+ open V2v_test_harness
+
+ let test = "rhel45-i386-fv"
+ let test_plan = {
+ default_plan with
+ boot_plan = Boot_to_screenshot (test ^ ".ppm")
+ }
+
+ let () = run ~test ~test_plan ()
+
+=head1 DESCRIPTION
+
+L<virt-v2v(1)> converts guests from a foreign hypervisor to run on
+KVM, managed by libvirt, OpenStack, oVirt, Red Hat Enterprise
+Virtualisation (RHEV) or several other targets.
+
+Virt-v2v-test-harness is a small library (module name:
+C<V2v_test_harness>) used to run virt-v2v against a set of test cases
+consisting of real virtual machines.
+
+It acts as a test harness, taking a test case, running virt-v2v on it
+(non-destructively), then test-booting the result. It can ensure that
+the test case converts successfully, boots successfully, and reaches a
+milestone (such as a particular screenshot). It can also test that
+the conversion created, modified or deleted the expected files from
+within the guest.
+
+=head2 GETTING THE TEST CASES
+
+Because the test cases are actual virtual machines, we split them into
+two groups: test cases which are freely redistributable and those
+which are proprietary. The former are things like Fedora or CentOS
+images, which are free software. The latter are things like Windows
+or Red Hat Enterprise Linux.
+
+The freely redistributable test cases can be downloaded from:
+I<B<Download location TBD>>
+
+The proprietary test cases are not made available to the public, for
+obvious licensing reasons.
+
+The test cases consist of disk images which are very large, from 250
+MB through to tens of gigabytes I<each>. This means that distributing
+test cases can be very time-consuming and expensive.
+
+=head2 RUNNING THE TEST CASES
+
+To run the test cases you must install the virt-v2v test harness (the
+OCaml module: C<V2v_test_harness>, source in
+C<libguestfs.git/v2v/test-harness>). In Fedora, install the
+C<virt-v2v-test-harness> package.
+
+Once you have checked out the freely redistributed test cases from the
+repository, do:
+
+ ./configure
+ make
+ make check
+
+=head1 WRITING NEW TEST CASES
+
+If you are interested in writing test cases, it is suggested that you
+start by downloading the freely redistributable test cases, or at
+least look at them online.
+
+Also you must install the virt-v2v test harness (the OCaml module:
+C<V2v_test_harness>, source in C<libguestfs.git/v2v/test-harness>).
+In Fedora, install the C<virt-v2v-test-harness> package.
+
+Each test case consists of:
+
+=over 4
+
+=item I<test>.img.xz
+
+The disk image of the virtual machine before conversion. Usually this
+should be converted to raw format and xz-compressed.
+
+=item I<test>.xml
+
+The libvirt XML used as input to virt-v2v. See the discussion of
+I<-i libvirtxml> in L<virt-v2v(1)>.
+
+=item I<test>.ppm
+
+An optional screenshot or screenshots.
+
+You can supply zero or more "known good" screenshots which represent
+intermediate steps where the guest is booting. This is useful where a
+guest sits for some time doing something, and lets the test harness
+know that it should allow the guest to continue to boot.
+
+You can supply zero or one "final" screenshot. This is often a
+screenshot of the login page which indicates that the guest booted
+successfully.
+
+=item I<test>.ml
+
+The test itself - see below.
+
+=back
+
+The test file (C<*.ml>) is used to control the test harness, and
+minimally it would look something like this:
+
+ open V2v_test_harness
+
+ let test = "short-name"
+
+ let () = run ~test ()
+
+That would instruct the test harness to:
+
+=over 4
+
+=item *
+
+Uncompress C<I<short-name>.img.xz>
+
+=item *
+
+Run C<virt-v2v -i libvirtxml I<short-name>.xml [...]>
+
+=item *
+
+Boot the resulting guest and check that it writes to its disk and then
+the disk becomes idle.
+
+=back
+
+The above is a rather simplistic test. A more realistic test is to
+ensure the guest reaches a final milestone (screenshot), eg. a login
+page. To do that you have to supply a C<~test_plan> parameter:
+
+ open V2v_test_harness
+
+ let test = "short-name"
+ let test_plan = {
+ default_plan with
+ boot_plan = Boot_to_screenshot (test ^ ".ppm")
+ }
+
+ let () = run ~test ~test_plan ()
+
+For an even better test, you can supply post-conversion and post-boot
+test cases which examine the disk image (using libguestfs) to verify
+that files have been created, modified or deleted as expected within
+the disk image. See C<V2v_test_harness.mli> for more information on
+how to do that.
+
+=head1 SEE ALSO
+
+L<virt-v2v(1)>,
+L<virt-p2v(1)>,
+L<guestfs(3)>,
+L<http://libguestfs.org/>.
+
+=head1 AUTHORS
+
+Richard W.M. Jones
L<http://people.redhat.com/~rjones/>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2014-2015 Red Hat Inc.
diff --git a/v2v/virt-v2v.pod b/v2v/virt-v2v.pod
index 0a9dbee..04e8f7b 100644
--- a/v2v/virt-v2v.pod
+++ b/v2v/virt-v2v.pod
@@ -1493,6 +1493,7 @@ L<guestfs(3)>,
L<guestfish(1)>,
L<qemu-img(1)>,
L<fstrim(8)>,
+L<virt-v2v-test-harness(1)>,
L<http://libguestfs.org/>.
=head1 AUTHORS
--
2.3.1