Richard W.M. Jones
2014-Apr-03 09:01 UTC
[Libguestfs] [PATCH v1 NOT TO BE APPLIED] New tool: virt-v2v.
This incomplete patch is the beginning of a translation of virt-v2v & virt-p2v, including them as part of the libguestfs tree. Rich.
Richard W.M. Jones
2014-Apr-03 09:01 UTC
[Libguestfs] [PATCH v1 NOT TO BE APPLIED] New tool: virt-v2v.
This is a rewrite of the original virt-v2v tool. The original was
written by Matt Booth et al in Perl between 2009 and 2013.
---
.gitignore | 5 ++
Makefile.am | 6 +-
configure.ac | 3 +-
fish/guestfish.pod | 1 +
po/POTFILES | 1 +
po/POTFILES-ml | 6 ++
src/guestfs.pod | 5 ++
v2v/Makefile.am | 167 ++++++++++++++++++++++++++++++++++
v2v/cmdline.ml | 141 +++++++++++++++++++++++++++++
v2v/source_libvirt.ml | 110 +++++++++++++++++++++++
v2v/source_libvirt.mli | 27 ++++++
v2v/types.ml | 35 ++++++++
v2v/types.mli | 38 ++++++++
v2v/utils.ml | 31 +++++++
v2v/v2v.ml | 200 +++++++++++++++++++++++++++++++++++++++++
v2v/virt-v2v.pod | 204 +++++++++++++++++++++++++++++++++++++++++
v2v/xml-c.c | 240 +++++++++++++++++++++++++++++++++++++++++++++++++
v2v/xml.ml | 50 +++++++++++
v2v/xml.mli | 57 ++++++++++++
19 files changed, 1324 insertions(+), 3 deletions(-)
create mode 100644 v2v/Makefile.am
create mode 100644 v2v/cmdline.ml
create mode 100644 v2v/source_libvirt.ml
create mode 100644 v2v/source_libvirt.mli
create mode 100644 v2v/types.ml
create mode 100644 v2v/types.mli
create mode 100644 v2v/utils.ml
create mode 100644 v2v/v2v.ml
create mode 100644 v2v/virt-v2v.pod
create mode 100644 v2v/xml-c.c
create mode 100644 v2v/xml.ml
create mode 100644 v2v/xml.mli
diff --git a/.gitignore b/.gitignore
index dc8aaf8..9032597 100644
--- a/.gitignore
+++ b/.gitignore
@@ -256,6 +256,7 @@ Makefile.in
/html/virt-tar.1.html
/html/virt-tar-in.1.html
/html/virt-tar-out.1.html
+/html/virt-v2v.1.html
/html/virt-win-reg.1.html
/inspector/actual-*.xml
/inspector/stamp-virt-inspector.pod
@@ -526,3 +527,7 @@ Makefile.in
/test-tool/libguestfs-test-tool-helper
/test-tool/stamp-libguestfs-test-tool.pod
/tools/virt-*.1
+/v2v/.depend
+/v2v/stamp-virt-v2v.pod
+/v2v/virt-v2v
+/v2v/virt-v2v.1
diff --git a/Makefile.am b/Makefile.am
index b135d65..3102e0b 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -132,7 +132,8 @@ SUBDIRS += \
builder builder/website \
resize \
sparsify \
- sysprep
+ sysprep \
+ v2v
endif
# Perl tools.
@@ -257,6 +258,7 @@ HTMLFILES = \
html/virt-tar.1.html \
html/virt-tar-in.1.html \
html/virt-tar-out.1.html \
+ html/virt-v2v.1.html \
html/virt-win-reg.1.html
HTMLSUPPORTFILES = \
@@ -319,7 +321,7 @@ all-local:
grep -v -E '^python/utils.c$$' | \
LC_ALL=C sort > po/POTFILES
cd $(srcdir); \
- find builder customize mllib resize sparsify sysprep -name '*.ml' | \
+ find builder customize mllib resize sparsify sysprep v2v -name '*.ml'
| \
LC_ALL=C sort > po/POTFILES-ml
# Manual pages in top level directory.
diff --git a/configure.ac b/configure.ac
index 70d5afc..e70a730 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1709,7 +1709,8 @@ AC_CONFIG_FILES([Makefile
tests/tmpdirs/Makefile
tests/xfs/Makefile
tests/xml/Makefile
- tools/Makefile])
+ tools/Makefile
+ v2v/Makefile])
AC_OUTPUT
dnl Produce summary.
diff --git a/fish/guestfish.pod b/fish/guestfish.pod
index 25279fb..5cf6ebc 100644
--- a/fish/guestfish.pod
+++ b/fish/guestfish.pod
@@ -1624,6 +1624,7 @@ L<virt-sysprep(1)>,
L<virt-tar(1)>,
L<virt-tar-in(1)>,
L<virt-tar-out(1)>,
+L<virt-v2v(1)>,
L<virt-win-reg(1)>,
L<libguestfs-tools.conf(5)>,
L<display(1)>,
diff --git a/po/POTFILES b/po/POTFILES
index 0fac8fe..4d42dfd 100644
--- a/po/POTFILES
+++ b/po/POTFILES
@@ -318,3 +318,4 @@ src/test-utils.c
src/tmpdirs.c
src/utils.c
test-tool/test-tool.c
+v2v/xml-c.c
diff --git a/po/POTFILES-ml b/po/POTFILES-ml
index 4dce0e5..d04cca9 100644
--- a/po/POTFILES-ml
+++ b/po/POTFILES-ml
@@ -80,3 +80,9 @@ sysprep/sysprep_operation_udev_persistent_net.ml
sysprep/sysprep_operation_user_account.ml
sysprep/sysprep_operation_utmp.ml
sysprep/sysprep_operation_yum_uuid.ml
+v2v/cmdline.ml
+v2v/source_libvirt.ml
+v2v/types.ml
+v2v/utils.ml
+v2v/v2v.ml
+v2v/xml.ml
diff --git a/src/guestfs.pod b/src/guestfs.pod
index 0f54625..f634442 100644
--- a/src/guestfs.pod
+++ b/src/guestfs.pod
@@ -4396,6 +4396,10 @@ created by another.
Command line tools written in Perl (L<virt-win-reg(1)> and many others).
+=item C<v2v>
+
+L<virt-v2v(1)> command and documentation.
+
=item C<csharp>
=item C<erlang>
@@ -4749,6 +4753,7 @@ L<virt-sysprep(1)>,
L<virt-tar(1)>,
L<virt-tar-in(1)>,
L<virt-tar-out(1)>,
+L<virt-v2v(1)>,
L<virt-win-reg(1)>,
L<guestfs-faq(1)>,
L<guestfs-performance(1)>,
diff --git a/v2v/Makefile.am b/v2v/Makefile.am
new file mode 100644
index 0000000..53bc8f2
--- /dev/null
+++ b/v2v/Makefile.am
@@ -0,0 +1,167 @@
+# libguestfs virt-v2v tool
+# Copyright (C) 2009-2014 Red Hat Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+include $(top_srcdir)/subdir-rules.mk
+
+EXTRA_DIST = \
+ $(SOURCES) \
+ virt-v2v.pod
+
+CLEANFILES = *~ *.cmi *.cmo *.cmx *.cmxa *.o virt-v2v
+
+# Alphabetical order.
+SOURCES = \
+ cmdline.ml \
+ source_libvirt.ml \
+ source_libvirt.mli \
+ types.ml \
+ types.mli \
+ utils.ml \
+ v2v.ml \
+ xml.ml \
+ xml.mli
+
+if HAVE_OCAML
+
+# Note this list must be in dependency order.
+deps = \
+ $(top_builddir)/fish/guestfish-progress.o \
+ $(top_builddir)/mllib/tty-c.o \
+ $(top_builddir)/mllib/progress-c.o \
+ $(top_builddir)/mllib/common_gettext.cmx \
+ $(top_builddir)/mllib/common_utils.cmx \
+ $(top_builddir)/mllib/tTY.cmx \
+ $(top_builddir)/mllib/progress.cmx \
+ $(top_builddir)/mllib/config.cmx \
+ types.cmx \
+ utils.cmx \
+ xml-c.o \
+ xml.cmx \
+ source_libvirt.cmx \
+ cmdline.cmx \
+ v2v.cmx
+
+if HAVE_OCAMLOPT
+OBJECTS = $(deps)
+else
+OBJECTS = $(patsubst %.cmx,%.cmo,$(deps))
+endif
+
+bin_SCRIPTS = virt-v2v
+
+# -I $(top_builddir)/src/.libs is a hack which forces corresponding -L
+# option to be passed to gcc, so we don't try linking against an
+# installed copy of libguestfs.
+OCAMLPACKAGES = \
+ -package str,unix \
+ -I $(top_builddir)/src/.libs \
+ -I ../gnulib/lib/.libs \
+ -I $(top_builddir)/ocaml \
+ -I $(top_builddir)/mllib
+if HAVE_OCAML_PKG_GETTEXT
+OCAMLPACKAGES += -package gettext-stub
+endif
+
+OCAMLCFLAGS = -g -warn-error CDEFLMPSUVYZX $(OCAMLPACKAGES)
+OCAMLOPTFLAGS = $(OCAMLCFLAGS)
+
+if HAVE_OCAMLOPT
+virt-v2v: $(OBJECTS)
+ $(OCAMLFIND) ocamlopt $(OCAMLOPTFLAGS) \
+ mlguestfs.cmxa -linkpkg $^ \
+ -cclib '-lutils -lncurses $(LIBXML2_LIBS) -lgnu' \
+ $(OCAML_GCOV_LDFLAGS) \
+ -o $@
+else
+virt-v2v: $(OBJECTS)
+ $(OCAMLFIND) ocamlc $(OCAMLCFLAGS) \
+ mlguestfs.cma -linkpkg $^ \
+ -cclib '-lutils -lncurses $(LIBXML2_LIBS) -lgnu' \
+ -custom \
+ $(OCAML_GCOV_LDFLAGS) \
+ -o $@
+endif
+
+.mli.cmi:
+ $(OCAMLFIND) ocamlc $(OCAMLCFLAGS) -c $< -o $@
+.ml.cmo:
+ $(OCAMLFIND) ocamlc $(OCAMLCFLAGS) -c $< -o $@
+.ml.cmx:
+ $(OCAMLFIND) ocamlopt $(OCAMLOPTFLAGS) -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$(top_srcdir)/src \
+ -I$(top_srcdir)/fish \
+ $(LIBXML2_CFLAGS)
+
+.c.o:
+ $(CC) $(CFLAGS) $(PROF_CFLAGS) $(DEFAULT_INCLUDES) -c $< -o $@
+
+# Manual pages and HTML files for the website.
+
+man_MANS = virt-v2v.1
+
+noinst_DATA = $(top_builddir)/html/virt-v2v.1.html
+
+virt-v2v.1 $(top_builddir)/html/virt-v2v.1.html: stamp-virt-v2v.pod
+
+stamp-virt-v2v.pod: virt-v2v.pod
+ $(PODWRAPPER) \
+ --man virt-v2v.1 \
+ --html $(top_builddir)/html/virt-v2v.1.html \
+ --license GPLv2+ \
+ $<
+ touch $@
+
+CLEANFILES += stamp-virt-v2v.pod
+
+# Tests.
+
+TESTS_ENVIRONMENT = $(top_builddir)/run --test
+
+if ENABLE_APPLIANCE
+TESTS +endif ENABLE_APPLIANCE
+
+check-valgrind:
+ $(MAKE) VG="$(top_builddir)/run @VG@" check
+
+# Dependencies.
+depend: .depend
+
+.depend: $(wildcard $(abs_srcdir)/*.mli) $(wildcard $(abs_srcdir)/*.ml)
+ rm -f $@ $@-t
+ $(OCAMLFIND) ocamldep -I ../ocaml -I $(abs_srcdir) -I
$(abs_top_builddir)/mllib $^ | \
+ $(SED) 's/ *$$//' | \
+ $(SED) -e :a -e '/ *\\$$/N; s/ *\\\n */ /; ta' | \
+ $(SED) -e 's,$(abs_srcdir)/,$(builddir)/,g' | \
+ sort > $@-t
+ mv $@-t $@
+
+-include .depend
+
+endif
+
+DISTCLEANFILES = .depend
+
+.PHONY: depend docs
diff --git a/v2v/cmdline.ml b/v2v/cmdline.ml
new file mode 100644
index 0000000..ac58576
--- /dev/null
+++ b/v2v/cmdline.ml
@@ -0,0 +1,141 @@
+(* virt-v2v
+ * Copyright (C) 2009-2014 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+(* Command line argument parsing. *)
+
+open Printf
+
+open Common_gettext.Gettext
+open Common_utils
+
+open Types
+open Utils
+
+let parse_cmdline () + let display_version () + printf "virt-v2v
%s\n" Config.package_version;
+ exit 0
+ in
+
+ let debug_gc = ref false in
+ let input_conn = ref "" in
+ let machine_readable = ref false in
+ let quiet = ref false in
+ let verbose = ref false in
+ let trace = ref false in
+
+ let input_mode = ref `Libvirt in
+ let set_input_mode = function
+ | "libvirt" -> input_mode := `Libvirt
+ | "libvirtxml" -> input_mode := `LibvirtXML
+ | s ->
+ error (f_"unknown -i option: %s") s
+ in
+
+ let root_choice = ref `Ask in
+ let set_root_choice = function
+ | "ask" -> root_choice := `Ask
+ | "single" -> root_choice := `Single
+ | "first" -> root_choice := `First
+ | dev when string_prefix dev "/dev/" -> root_choice := `Dev
dev
+ | s ->
+ error (f_"unknown --root option: %s") s
+ in
+
+ let ditto = " -\"-" in
+ let argspec = Arg.align [
+ "--debug-gc",Arg.Set debug_gc, " " ^
s_"Debug GC and memory allocations";
+ "-i", Arg.String set_input_mode, "libvirtxml|libvirt
" ^ s_"Set input mode (default: libvirt)";
+ "-ic", Arg.Set_string input_conn, "uri " ^
s_"Libvirt URI";
+ "--long-options", Arg.Unit display_long_options, " " ^
s_"List long options";
+ "--machine-readable", Arg.Set machine_readable, " " ^
s_"Make output machine readable";
+ "-q", Arg.Set quiet, " " ^
s_"Quiet output";
+ "--quiet", Arg.Set quiet, ditto;
+ "--root", Arg.String set_root_choice,"ask|... " ^
s_"How to choose root filesystem";
+ "-v", Arg.Set verbose, " " ^
s_"Enable debugging messages";
+ "--verbose", Arg.Set verbose, ditto;
+ "-V", Arg.Unit display_version, " " ^
s_"Display version and exit";
+ "--version", Arg.Unit display_version, ditto;
+ "-x", Arg.Set trace, " " ^
s_"Enable tracing of libguestfs calls";
+ ] in
+ long_options := argspec;
+ let args = ref [] in
+ let anon_fun s = args := s :: !args in
+ let usage_msg + sprintf (f_"\
+%s: convert a guest to use KVM
+
+ virt-v2v -ic esx://esx.example.com/ -os imported esx_guest
+
+ virt-v2v -ic esx://esx.example.com/ \
+ -o rhev -os rhev.nfs:/export_domain --network rhevm esx_guest
+
+ virt-v2v -i libvirtxml guest-domain.xml
+
+There is a companion front-end called \"virt-p2v\" which comes as an
+ISO or CD image that can be booted on physical machines.
+
+A short summary of the options is given below. For detailed help please
+read the man page virt-v2v(1).
+")
+ prog in
+ Arg.parse argspec anon_fun usage_msg;
+
+ (* Dereference the arguments. *)
+ let args = List.rev !args in
+ let debug_gc = !debug_gc in
+ let input_conn = match !input_conn with "" -> None | s ->
Some s in
+ let input_mode = !input_mode in
+ let machine_readable = !machine_readable in
+ let quiet = !quiet in
+ let root_choice = !root_choice 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 args = [] && machine_readable then (
+ printf "virt-v2v\n";
+ printf "libguestfs-rewrite\n";
+ exit 0
+ );
+
+ (* Parsing of the argument(s) depends on the input mode. *)
+ let input + match input_mode with
+ | `Libvirt ->
+ (* -i libvirt: Expecting a single argument which is the name
+ * of the libvirt guest.
+ *)
+ let guest + match args with
+ | [guest] -> guest
+ | _ ->
+ error (f_"expecting a libvirt guest name on the command
line") in
+ Libvirt (input_conn, guest)
+ | `LibvirtXML ->
+ (* -i libvirtxml: Expecting a filename (XML file). *)
+ let filename + match args with
+ | [filename] -> filename
+ | _ ->
+ error (f_"expecting a libvirt XML file name on the command
line") in
+ LibvirtXML filename in
+
+ debug_gc, quiet, input, root_choice, trace, verbose
diff --git a/v2v/source_libvirt.ml b/v2v/source_libvirt.ml
new file mode 100644
index 0000000..4dc8b59
--- /dev/null
+++ b/v2v/source_libvirt.ml
@@ -0,0 +1,110 @@
+(* virt-v2v
+ * Copyright (C) 2009-2014 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+open Printf
+
+open Common_gettext.Gettext
+open Common_utils
+
+open Types
+open Utils
+
+let create_xml xml + let doc = Xml.parse_memory xml in
+ let xpathctx = Xml.xpath_new_context doc in
+
+ let xpath_to_string expr default + let obj = Xml.xpath_eval_expression
xpathctx expr in
+ if Xml.xpathobj_nr_nodes obj < 1 then default
+ else (
+ let node = Xml.xpathobj_node doc obj 0 in
+ Xml.node_as_string node
+ ) in
+ let xpath_to_int expr default + let obj = Xml.xpath_eval_expression
xpathctx expr in
+ if Xml.xpathobj_nr_nodes obj < 1 then default
+ else (
+ let node = Xml.xpathobj_node doc obj 0 in
+ let str = Xml.node_as_string node in
+ try int_of_string str
+ with Failure "int_of_string" ->
+ error (f_"expecting XML expression to return an integer
(expression: %s)")
+ expr
+ ) in
+
+ let dom_type = xpath_to_string "/domain/@type" "" in
+ let name = xpath_to_string "/domain/name/text()" "" in
+ let memory = xpath_to_int "/domain/memory/text()" 0 in
+ let memory = Int64.of_int memory *^ 1024L in
+ let vcpu = xpath_to_int "/domain/vcpu/text()" 0 in
+ let arch = xpath_to_string "/domain/os/type/@arch" "" in
+
+ let features + let features = ref [] in
+ let obj = Xml.xpath_eval_expression xpathctx "/domain/features/*"
in
+ let nr_nodes = Xml.xpathobj_nr_nodes obj in
+ for i = 0 to nr_nodes-1 do
+ let node = Xml.xpathobj_node doc obj i in
+ features := Xml.node_name node :: !features
+ done;
+ !features in
+
+ (* Non-removable disk devices. *)
+ let disks + let disks = ref [] in
+ let obj + Xml.xpath_eval_expression xpathctx
+ "/domain/devices/disk[@device='disk']" in
+ let nr_nodes = Xml.xpathobj_nr_nodes obj in
+ if nr_nodes < 1 then
+ error (f_"this guest has no non-removable disks");
+ for i = 0 to nr_nodes-1 do
+ let node = Xml.xpathobj_node doc obj i in
+ Xml.xpathctx_set_current_context xpathctx node;
+ let path = xpath_to_string "source/@file | source/@dev"
"" in
+ if path <> "" then (
+ let format + let format = xpath_to_string
"driver/@type" "" in
+ if format <> "" then Some format else None in
+ disks := (path, format) :: !disks
+ )
+ done;
+ List.rev !disks in
+
+ {
+ s_dom_type = dom_type;
+ s_name = name;
+ s_memory = memory;
+ s_vcpu = vcpu;
+ s_arch = arch;
+ s_features = features;
+ s_disks = disks;
+ }
+
+let create_from_xml file + let xml = read_whole_file file in
+ create_xml xml
+
+let create libvirt_uri guest + let cmd + match libvirt_uri with
+ | None -> sprintf "virsh dumpxml %s" (quote guest)
+ | Some uri -> sprintf "virsh -c %s dumpxml %s" (quote uri)
(quote guest) in
+ let lines = external_command ~prog cmd in
+ let xml = String.concat "\n" lines in
+ create_xml xml
diff --git a/v2v/source_libvirt.mli b/v2v/source_libvirt.mli
new file mode 100644
index 0000000..1e3b1e1
--- /dev/null
+++ b/v2v/source_libvirt.mli
@@ -0,0 +1,27 @@
+(* virt-v2v
+ * Copyright (C) 2009-2014 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+(** [-i libvirt] and [-i libvirtxml] sources. *)
+
+val create : string option -> string -> Types.source
+(** [create libvirt_uri guest] reads the source metadata from the
+ named libvirt guest. *)
+
+val create_from_xml : string -> Types.source
+(** [create_from_xml filename] reads the source metadata from the
+ libvirt XML file. *)
diff --git a/v2v/types.ml b/v2v/types.ml
new file mode 100644
index 0000000..447e18a
--- /dev/null
+++ b/v2v/types.ml
@@ -0,0 +1,35 @@
+(* virt-v2v
+ * Copyright (C) 2009-2014 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+(* Types. See types.mli for documentation. *)
+
+type input +| Libvirt of string option * string
+| LibvirtXML of string
+
+type source = {
+ s_dom_type : string;
+ s_name : string;
+ s_memory : int64;
+ s_vcpu : int;
+ s_arch : string;
+ s_features : string list;
+ s_disks : source_disk list;
+}
+
+and source_disk = string * string option
diff --git a/v2v/types.mli b/v2v/types.mli
new file mode 100644
index 0000000..7272e9b
--- /dev/null
+++ b/v2v/types.mli
@@ -0,0 +1,38 @@
+(* virt-v2v
+ * Copyright (C) 2009-2014 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+(** Types. *)
+
+type input +| Libvirt of string option * string (* -i libvirt: -ic + guest
name *)
+| LibvirtXML of string (* -i libvirtxml: XML file name *)
+(** The input arguments as specified on the command line. *)
+
+type source = {
+ s_dom_type : string; (** Source domain type, eg
"kvm" *)
+ s_name : string; (** Guest name. *)
+ s_memory : int64; (** Memory size (bytes). *)
+ s_vcpu : int; (** Number of CPUs. *)
+ s_arch : string; (** Architecture. *)
+ s_features : string list; (** Machine features. *)
+ s_disks : source_disk list; (** Disk images. *)
+}
+(** The source: metadata, disk images. *)
+
+and source_disk = string * string option
+(** A source file is a qemu URI and a format. *)
diff --git a/v2v/utils.ml b/v2v/utils.ml
new file mode 100644
index 0000000..d7c41dd
--- /dev/null
+++ b/v2v/utils.ml
@@ -0,0 +1,31 @@
+(* virt-v2v
+ * Copyright (C) 2009-2014 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+(* Utilities used in virt-v2v only. *)
+
+open Printf
+
+open Common_gettext.Gettext
+open Common_utils
+
+open Types
+
+let prog = Filename.basename Sys.executable_name
+let error ?exit_code fs = error ~prog ?exit_code fs
+
+let quote = Filename.quote
diff --git a/v2v/v2v.ml b/v2v/v2v.ml
new file mode 100644
index 0000000..4749d98
--- /dev/null
+++ b/v2v/v2v.ml
@@ -0,0 +1,200 @@
+(* virt-v2v
+ * Copyright (C) 2009-2014 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+open Unix
+open Printf
+
+open Common_gettext.Gettext
+
+module G = Guestfs
+
+open Common_utils
+open Types
+open Utils
+
+let () = Random.self_init ()
+
+let rec main () + (* Handle the command line. *)
+ let debug_gc, quiet, input, root_choice, trace, verbose +
Cmdline.parse_cmdline () in
+
+ let msg fs = make_message_function ~quiet fs in
+
+ let source + match input with
+ | Libvirt (libvirt_uri, guest) -> Source_libvirt.create libvirt_uri
guest
+ | LibvirtXML filename -> Source_libvirt.create_from_xml filename in
+
+ (* Create a qcow2 v3 overlay to protect the source image(s). There
+ * is a specific reason to use the newer qcow2 variant: Because the
+ * L2 table can store zero clusters efficiently, and because
+ * discarded blocks are stored as zero clusters, this should allow us
+ * to fstrim/blkdiscard and avoid copying significant parts of the
+ * data over the wire.
+ *)
+ msg (f_"Creating an overlay to protect the source from being
modified");
+ let overlays + List.map (
+ fun (qemu_uri, format) ->
+ let overlay = Filename.temp_file "v2vovl" ".qcow2"
in
+ let options + "compat=1.1,lazy_refcounts=on" ^
+ (match format with None -> ""
+ | Some fmt -> ",backing_fmt=" ^ fmt) in
+ let cmd + sprintf "qemu-img create -q -f qcow2 -b %s -o
%s %s"
+ (quote qemu_uri) (quote options) overlay in
+ if Sys.command cmd <> 0 then
+ error (f_"qemu-img command failed, see earlier errors");
+ overlay
+ ) source.s_disks in
+
+ (* Open the guestfs handle. *)
+ msg (f_"Opening the source");
+ let g = new G.guestfs () in
+ g#set_trace trace;
+ g#set_verbose verbose;
+ List.iter (
+ fun overlay ->
+ g#add_drive_opts overlay
+ ~format:"qcow2" ~cachemode:"unsafe"
~discard:"besteffort"
+ ) overlays;
+
+ g#launch ();
+
+ (* Inspection. *)
+ msg (f_"Inspecting the source");
+ let root = inspect_source g root_choice in
+
+ (* Conversion. *)
+ let () + let prod = g#inspect_get_product_name root in
+ let name + match prod with
+ | "unknown" -> s_"source"
+ | prod -> prod in
+ msg (f_"Converting %s to run on KVM") name in
+
+ (* XXX conversion *)
+
+ (* XXX fstrim here to reduce transfer sizes XXX *)
+
+ g#shutdown ();
+ g#close ();
+
+(*
+ (* Copy the source to the output. *)
+ iteri (
+ fun i overlay ->
+ msg (f_"Copying disk %d/%d") i (List.length overlays);
+
+ let cmd + sprintf "qemu-img convert -f qcow2 %s -O %s
%s"
+ overlay output_format XXX in
+ if Sys.command cmd <> 0 then
+ error (f_"qemu-img command failed, see earlier errors");
+ ) overlays;
+*)
+
+ (* XXX Metadata, etc. *)
+
+ msg (f_"Finishing off");
+
+ if debug_gc then
+ Gc.compact ()
+
+and inspect_source g root_choice + let roots = g#inspect_os () in
+ let roots = Array.to_list roots in
+
+ match roots with
+ | [] ->
+ error (f_"no root device found in this operating system image.");
+ | [root] -> root
+ | roots ->
+ match root_choice with
+ | `Ask ->
+ (* List out the roots and ask the user to choose. *)
+ printf "\n***\n";
+ printf (f_"dual- or multi-boot operating system detected. Choose the
root filesystem\nthat contains the main operating system from the list
below:\n");
+ printf "\n";
+ iteri (
+ fun i root ->
+ let prod = g#inspect_get_product_name root in
+ match prod with
+ | "unknown" -> printf " [%d] %s\n" i root
+ | prod -> printf " [%d] %s (%s)\n" i root prod
+ ) roots;
+ printf "\n";
+ let i = ref 0 in
+ let n = List.length roots in
+ while !i < 1 || !i > n do
+ printf (f_"Enter number between 1 and %d: ") n;
+ (try i := int_of_string (read_line ())
+ with
+ | End_of_file -> error (f_"connection closed")
+ | Failure "int_of_string" -> ()
+ )
+ done;
+ List.nth roots (!i - 1)
+
+ | `Single ->
+ error (f_"multi-boot operating systems are not supported by
virt-v2v. Use the --root option to change how virt-v2v handles this.")
+
+ | `First ->
+ List.hd roots
+
+ | `Dev dev ->
+ if List.mem dev roots then dev
+ else (
+ error (f_"root device %s not found. Roots found were: %s")
+ dev (String.concat " " roots)
+ )
+
+let () + try main ()
+ with
+ | Unix.Unix_error (code, fname, "") -> (* from a syscall *)
+ eprintf (f_"%s: error: %s: %s\n") prog fname (Unix.error_message
code);
+ exit 1
+ | Unix.Unix_error (code, fname, param) -> (* from a syscall *)
+ eprintf (f_"%s: error: %s: %s: %s\n") prog fname
(Unix.error_message code)
+ param;
+ exit 1
+ | Sys_error msg -> (* from a syscall *)
+ eprintf (f_"%s: error: %s\n") prog msg;
+ exit 1
+ | G.Error msg -> (* from libguestfs *)
+ eprintf (f_"%s: libguestfs error: %s\n") prog msg;
+ exit 1
+ | Failure msg -> (* from failwith/failwithf *)
+ eprintf (f_"%s: failure: %s\n") prog msg;
+ exit 1
+ | Invalid_argument msg -> (* probably should never happen *)
+ eprintf (f_"%s: internal error: invalid argument: %s\n") prog
msg;
+ exit 1
+ | Assert_failure (file, line, char) -> (* should never happen *)
+ eprintf (f_"%s: internal error: assertion failed at %s, line %d, char
%d\n") prog file line char;
+ exit 1
+ | Not_found -> (* should never happen *)
+ eprintf (f_"%s: internal error: Not_found exception was
thrown\n") prog;
+ exit 1
+ | exn -> (* something not matched above *)
+ eprintf (f_"%s: exception: %s\n") prog (Printexc.to_string exn);
+ exit 1
diff --git a/v2v/virt-v2v.pod b/v2v/virt-v2v.pod
new file mode 100644
index 0000000..7580c6b
--- /dev/null
+++ b/v2v/virt-v2v.pod
@@ -0,0 +1,204 @@
+=head1 NAME
+
+virt-v2v - Convert a guest to use KVM
+
+=head1 SYNOPSIS
+
+ virt-v2v -ic esx://esx.example.com/ -os imported esx_guest
+
+ virt-v2v -ic esx://esx.example.com/ \
+ -o rhev -os rhev.nfs:/export_domain --network rhevm esx_guest
+
+ virt-v2v -i libvirtxml guest-domain.xml
+
+=head1 DESCRIPTION
+
+Virt-v2v converts guests from a foreign hypervisor to run on KVM,
+managed by libvirt or Red Hat Enterprise Virtualisation (RHEV) version
+2.2 or later. It can currently convert Red Hat Enterprise Linux and
+Windows guests running on Xen and VMware ESX.
+
+There is also a companion front-end called "virt-p2v" which comes as
an
+ISO or CD image that can be booted on physical machines.
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<--help>
+
+Display help.
+
+=item B<--debug-gc>
+
+Debug garbage collection and memory allocation. This is only useful
+when debugging memory problems in virt-v2v or the OCaml libguestfs
+bindings.
+
+=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<--root ask>
+
+=item B<--root single>
+
+=item B<--root first>
+
+=item B<--root> /dev/sdX
+
+=item B<--root> /dev/VG/LV
+
+Choose the root filesystem to be converted.
+
+In the case where the virtual machine is dual-boot or multi-boot, or
+where the VM has other filesystems that look like operating systems,
+this option can be used to select the root filesystem (a.k.a. C<C:>
+drive or C</>) of the operating system that is to be converted. The
+Windows Recovery Console, certain attached DVD drives, and bugs in
+libguestfs inspection heuristics, can make a guest look like a
+multi-boot operating system.
+
+The default in virt-v2v E<le> 0.7.1 was S<I<--root single>>,
which
+causes virt-v2v to die if a multi-boot operating system is found.
+
+Since virt-v2v E<ge> 0.7.2 the default is now S<I<--root
ask>>: If the
+VM is found to be multi-boot, then virt-v2v will stop and list the
+possible root filesystems and ask the user which to use. This
+requires that virt-v2v is run interactively.
+
+S<I<--root first>> means to choose the first root device in the
case
+of a multi-boot operating system. Since this is a heuristic, it may
+sometimes choose the wrong one.
+
+You can also name a specific root device, eg. S<I<--root
/dev/sda2>>
+would mean to use the second partition on the first hard drive. If
+the named root device does not exist or was not detected as a root
+device, then virt-v2v will fail.
+
+Note that there is a bug in grub which prevents it from successfully
+booting a multiboot system if VirtIO is enabled. Grub is only able to
+boot an operating system from the first VirtIO disk. Specifically,
+C</boot> must be on the first VirtIO disk, and it cannot chainload an
+OS which is not in the first VirtIO disk.
+
+=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-v2v 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-v2v binary. Typical output looks like this:
+
+ $ virt-v2v --machine-readable
+ virt-v2v
+ libguestfs-rewrite
+
+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-v2v exits with a non-zero status
+code if there was a fatal error.
+
+=back
+
+Virt-v2v E<le> 0.9.1 did not support the I<--machine-readable>
+option at all. The option was added when virt-v2v was rewritten in 2014.
+
+=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>.
+
+Note that if C<$TMPDIR> is a tmpfs (eg. if C</tmp> is on tmpfs, or
if
+you use C<TMPDIR=/dev/shm>), tmpfs defaults to a maximum size of
+I<half> of physical RAM. If virt-v2v exceeds this, it will hang.
+The solution is either to use a real disk, or to increase the maximum
+size of the tmpfs mountpoint, eg:
+
+ mount -o remount,size=10G /tmp
+
+=back
+
+For other environment variables, see L<guestfs(3)/ENVIRONMENT VARIABLES>.
+
+=head1 SEE ALSO
+
+L<virt-df(1)>,
+L<virt-filesystems(1)>,
+L<guestfs(3)>,
+L<guestfish(1)>,
+L<qemu-img(1)>,
+L<http://libguestfs.org/>.
+
+=head1 AUTHORS
+
+Richard W.M. Jones L<http://people.redhat.com/~rjones/>
+
+Matthew Booth
+
+=head1 COPYRIGHT
+
+Copyright (C) 2009-2014 Red Hat Inc.
diff --git a/v2v/xml-c.c b/v2v/xml-c.c
new file mode 100644
index 0000000..9b79c6b
--- /dev/null
+++ b/v2v/xml-c.c
@@ -0,0 +1,240 @@
+/* virt-v2v
+ * Copyright (C) 2009-2014 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ */
+
+/* Mini interface to libxml2 for parsing libvirt XML. */
+
+#include <config.h>
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+
+#include <caml/alloc.h>
+#include <caml/custom.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
+
+#include <libxml/xpath.h>
+
+#include "guestfs.h"
+#include "guestfs-internal-frontend.h"
+
+/* xmlDocPtr type */
+#define Doc_val(v) (*((xmlDocPtr *)Data_custom_val(v)))
+
+static void
+doc_finalize (value docv)
+{
+ xmlDocPtr doc = Doc_val (docv);
+
+ if (doc)
+ xmlFreeDoc (doc);
+}
+
+static struct custom_operations doc_custom_operations = {
+ (char *) "doc_custom_operations",
+ doc_finalize,
+ custom_compare_default,
+ custom_hash_default,
+ custom_serialize_default,
+ custom_deserialize_default
+};
+
+/* xmlXPathContextPtr type */
+#define Xpathctx_val(v) (*((xmlXPathContextPtr *)Data_custom_val(v)))
+
+static void
+xpathctx_finalize (value xpathctxv)
+{
+ xmlXPathContextPtr xpathctx = Xpathctx_val (xpathctxv);
+
+ if (xpathctx)
+ xmlXPathFreeContext (xpathctx);
+}
+
+static struct custom_operations xpathctx_custom_operations = {
+ (char *) "xpathctx_custom_operations",
+ xpathctx_finalize,
+ custom_compare_default,
+ custom_hash_default,
+ custom_serialize_default,
+ custom_deserialize_default
+};
+
+/* xmlXPathObjectPtr type */
+#define Xpathobj_val(v) (*((xmlXPathObjectPtr *)Data_custom_val(v)))
+
+static void
+xpathobj_finalize (value xpathobjv)
+{
+ xmlXPathObjectPtr xpathobj = Xpathobj_val (xpathobjv);
+
+ if (xpathobj)
+ xmlXPathFreeObject (xpathobj);
+}
+
+static struct custom_operations xpathobj_custom_operations = {
+ (char *) "xpathobj_custom_operations",
+ xpathobj_finalize,
+ custom_compare_default,
+ custom_hash_default,
+ custom_serialize_default,
+ custom_deserialize_default
+};
+
+value
+v2v_xml_parse_memory (value xmlv)
+{
+ CAMLparam1 (xmlv);
+ CAMLlocal1 (docv);
+ xmlDocPtr doc;
+
+ doc = xmlParseMemory (String_val (xmlv), caml_string_length (xmlv));
+ if (doc == NULL)
+ caml_invalid_argument ("parse_memory: unable to parse XML from
libvirt");
+
+ docv = caml_alloc_custom (&doc_custom_operations, sizeof (xmlDocPtr), 0,
1);
+ Doc_val (docv) = doc;
+
+ CAMLreturn (docv);
+}
+
+value
+v2v_xml_xpath_new_context (value docv)
+{
+ CAMLparam1 (docv);
+ CAMLlocal1 (xpathctxv);
+ xmlDocPtr doc;
+ xmlXPathContextPtr xpathctx;
+
+ doc = Doc_val (docv);
+ xpathctx = xmlXPathNewContext (doc);
+ if (xpathctx == NULL)
+ caml_invalid_argument ("xpath_new_context: unable to create
xmlXPathNewContext");
+
+ xpathctxv = caml_alloc_custom (&xpathctx_custom_operations,
+ sizeof (xmlXPathContextPtr), 0, 1);
+ Xpathctx_val (xpathctxv) = xpathctx;
+
+ CAMLreturn (xpathctxv);
+}
+
+value
+v2v_xml_xpath_eval_expression (value xpathctxv, value exprv)
+{
+ CAMLparam2 (xpathctxv, exprv);
+ CAMLlocal1 (xpathobjv);
+ xmlXPathContextPtr xpathctx;
+ xmlXPathObjectPtr xpathobj;
+
+ xpathctx = Xpathctx_val (xpathctxv);
+ xpathobj = xmlXPathEvalExpression (BAD_CAST String_val (exprv), xpathctx);
+ if (xpathobj == NULL)
+ caml_invalid_argument ("xpath_eval_expression: unable to evaluate
XPath expression");
+
+ xpathobjv = caml_alloc_custom (&xpathobj_custom_operations,
+ sizeof (xmlXPathObjectPtr), 0, 1);
+ Xpathobj_val (xpathobjv) = xpathobj;
+
+ CAMLreturn (xpathobjv);
+}
+
+value
+v2v_xml_xpathobj_nr_nodes (value xpathobjv)
+{
+ CAMLparam1 (xpathobjv);
+ xmlXPathObjectPtr xpathobj = Xpathobj_val (xpathobjv);
+
+ CAMLreturn (Val_int (xpathobj->nodesetval->nodeNr));
+}
+
+value
+v2v_xml_xpathobj_get_node_ptr (value xpathobjv, value iv)
+{
+ CAMLparam2 (xpathobjv, iv);
+ xmlXPathObjectPtr xpathobj = Xpathobj_val (xpathobjv);
+ int i = Int_val (iv);
+
+ /* Because xmlNodePtrs are owned by the document, we don't want to
+ * wrap this up with a finalizer, so just pass the pointer straight
+ * back to OCaml as a value. OCaml will ignore it because it's
+ * outside the heap, and just pass it back to us when needed. This
+ * relies on the xmlDocPtr not being freed, but we pair the node
+ * pointer with the doc in the OCaml layer so the GC will not free
+ * one without freeing the other.
+ */
+ CAMLreturn ((value) xpathobj->nodesetval->nodeTab[i]);
+}
+
+value
+v2v_xml_xpathctx_set_node_ptr (value xpathctxv, value nodev)
+{
+ CAMLparam2 (xpathctxv, nodev);
+ xmlXPathContextPtr xpathctx = Xpathctx_val (xpathctxv);
+ xmlNodePtr node = (xmlNodePtr) nodev;
+
+ xpathctx->node = node;
+
+ CAMLreturn (Val_unit);
+}
+
+value
+v2v_xml_node_ptr_name (value nodev)
+{
+ CAMLparam1 (nodev);
+ xmlNodePtr node = (xmlNodePtr) nodev;
+
+ switch (node->type) {
+ case XML_ATTRIBUTE_NODE:
+ case XML_ELEMENT_NODE:
+ CAMLreturn (caml_copy_string ((char *) node->name));
+
+ default:
+ caml_invalid_argument ("node_name: don't know how to get the name
of this node");
+ }
+}
+
+value
+v2v_xml_node_ptr_as_string (value docv, value nodev)
+{
+ CAMLparam2 (docv, nodev);
+ xmlDocPtr doc = Doc_val (docv);
+ xmlNodePtr node = (xmlNodePtr) nodev;
+ CLEANUP_FREE char *str = NULL;
+
+ switch (node->type) {
+ case XML_TEXT_NODE:
+ case XML_COMMENT_NODE:
+ case XML_CDATA_SECTION_NODE:
+ case XML_PI_NODE:
+ CAMLreturn (caml_copy_string ((char *) node->content));
+
+ case XML_ATTRIBUTE_NODE:
+ case XML_ELEMENT_NODE:
+ str = (char *) xmlNodeListGetString (doc, node->children, 1);
+
+ if (str == NULL)
+ caml_invalid_argument ("node_as_string: xmlNodeListGetString cannot
convert node to string");
+
+ CAMLreturn (caml_copy_string (str));
+
+ default:
+ caml_invalid_argument ("node_as_string: don't know how to convert
this node to a string");
+ }
+}
diff --git a/v2v/xml.ml b/v2v/xml.ml
new file mode 100644
index 0000000..5cd75c1
--- /dev/null
+++ b/v2v/xml.ml
@@ -0,0 +1,50 @@
+(* virt-v2v
+ * Copyright (C) 2009-2014 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+(* Mini interface to libxml2 for parsing libvirt XML. *)
+
+type doc
+type node_ptr
+type xpathctx
+type xpathobj
+
+(* Since node is owned by doc, we have to make that explicit to the
+ * garbage collector.
+ *)
+type node = doc * node_ptr
+
+external parse_memory : string -> doc = "v2v_xml_parse_memory"
+external xpath_new_context : doc -> xpathctx =
"v2v_xml_xpath_new_context"
+external xpath_eval_expression : xpathctx -> string -> xpathobj =
"v2v_xml_xpath_eval_expression"
+
+external xpathobj_nr_nodes : xpathobj -> int =
"v2v_xml_xpathobj_nr_nodes"
+external xpathobj_get_node_ptr : xpathobj -> int -> node_ptr =
"v2v_xml_xpathobj_get_node_ptr"
+let xpathobj_node doc xpathobj i + let n = xpathobj_get_node_ptr xpathobj i in
+ (doc, n)
+
+external xpathctx_set_node_ptr : xpathctx -> node_ptr -> unit =
"v2v_xml_xpathctx_set_node_ptr"
+let xpathctx_set_current_context xpathctx (_, node) + xpathctx_set_node_ptr
xpathctx node
+
+external node_ptr_name : node_ptr -> string =
"v2v_xml_node_ptr_name"
+let node_name (_, node) = node_ptr_name node
+
+external node_ptr_as_string : doc -> node_ptr -> string =
"v2v_xml_node_ptr_as_string"
+let node_as_string (doc, node) + node_ptr_as_string doc node
diff --git a/v2v/xml.mli b/v2v/xml.mli
new file mode 100644
index 0000000..c4363ad
--- /dev/null
+++ b/v2v/xml.mli
@@ -0,0 +1,57 @@
+(* virt-v2v
+ * Copyright (C) 2009-2014 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+(** Mini interface to libxml2 for parsing libvirt XML. *)
+
+type doc (** xmlDocPtr *)
+type node (** xmlNodePtr *)
+type xpathctx (** xmlXPathContextPtr *)
+type xpathobj (** xmlXPathObjectPtr *)
+
+val parse_memory : string -> doc
+(** xmlParseMemory *)
+val xpath_new_context : doc -> xpathctx
+(** xmlXPathNewContext *)
+val xpath_eval_expression : xpathctx -> string -> xpathobj
+(** xmlXPathEvalExpression *)
+
+val xpathobj_nr_nodes : xpathobj -> int
+(** Get the number of nodes in the node set of the xmlXPathObjectPtr. *)
+val xpathobj_node : doc -> xpathobj -> int -> node
+(** Get the number of nodes in the node set of the xmlXPathObjectPtr. *)
+
+val xpathctx_set_current_context : xpathctx -> node -> unit
+(** Set the current context of an xmlXPathContextPtr to the node.
+ Basically the same as the following C code:
+
+ {v
+ xpathctx->node = node
+ v}
+
+ It means the next expression you evaluate within this context will
+ start at this node, when evaluating relative paths
+ (eg. [./@attr]).
+*)
+
+val node_name : node -> string
+(** Get the name of the node. Note that only things like elements and
+ attributes have names. Other types of nodes will return an
+ error. *)
+
+val node_as_string : node -> string
+(** Converter to turn a node into a string *)
--
1.8.5.3