[Libguestfs] [PATCH] v2v: Add the test-harness used by external tests.

Richard W.M. Jones rjones at redhat.com
Tue Mar 10 18:31:41 UTC 2015


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




More information about the Libguestfs mailing list