[PATCH] builder: isolate all the cache handling to a new Cache module
by Pino Toscano
While there is not that much in it, it groups together the small
scattered-around bits handling the cache directory.
---
builder/Makefile.am | 3 +++
builder/builder.ml | 48 ++++++++++++++-----------------------
builder/cache.ml | 65 ++++++++++++++++++++++++++++++++++++++++++++++++++
builder/cache.mli | 45 ++++++++++++++++++++++++++++++++++
builder/downloader.ml | 12 ++++------
builder/downloader.mli | 7 +-----
po/POTFILES-ml | 1 +
7 files changed, 137 insertions(+), 44 deletions(-)
create mode 100644 builder/cache.ml
create mode 100644 builder/cache.mli
diff --git a/builder/Makefile.am b/builder/Makefile.am
index 7d399d4..21710f1 100644
--- a/builder/Makefile.am
+++ b/builder/Makefile.am
@@ -46,6 +46,8 @@ CLEANFILES = *~ *.cmi *.cmo *.cmx *.cmxa *.o virt-builder
SOURCES = \
architecture.ml \
builder.ml \
+ cache.mli \
+ cache.ml \
cmdline.ml \
downloader.mli \
downloader.ml \
@@ -120,6 +122,7 @@ deps = \
paths.cmx \
languages.cmx \
get_kernel.cmx \
+ cache.cmx \
downloader.cmx \
sigchecker.cmx \
index_parser.cmx \
diff --git a/builder/builder.ml b/builder/builder.ml
index 35f5780..acb6129 100644
--- a/builder/builder.ml
+++ b/builder/builder.ml
@@ -69,8 +69,7 @@ let main () =
(match cache with
| Some cachedir ->
msg "Deleting: %s" cachedir;
- let cmd = sprintf "rm -rf %s" (quote cachedir) in
- ignore (Sys.command cmd);
+ Cache.clean_cachedir cachedir;
exit 0
| None ->
eprintf (f_"%s: error: could not find cache directory. Is $HOME set?\n")
@@ -109,27 +108,17 @@ let main () =
exit 1
);
- (* Create the cache directory. *)
+ (* Create the cache. *)
let cache =
match cache with
| None -> None
| Some dir ->
- (* Annoyingly Sys.is_directory throws an exception on failure
- * (RHBZ#1022431).
- *)
- if (try Sys.is_directory dir with Sys_error _ -> false) then
- Some dir
- else (
- (* Try to make the directory. If that fails, warn and continue
- * without any cache.
- *)
- try mkdir dir 0o755; Some dir
- with exn ->
- eprintf (f_"%s: warning: cache %s: %s\n") prog dir
- (Printexc.to_string exn);
- eprintf (f_"%s: disabling the cache\n%!") prog;
- None
- )
+ try Some (Cache.create ~debug ~directory:dir)
+ with exn ->
+ eprintf (f_"%s: warning: cache %s: %s\n") prog dir
+ (Printexc.to_string exn);
+ eprintf (f_"%s: disabling the cache\n%!") prog;
+ None
in
(* Download the sources. *)
@@ -167,17 +156,16 @@ let main () =
| `Print_cache -> (* --print-cache *)
(match cache with
- | Some cachedir ->
- printf (f_"cache directory: %s\n") cachedir;
- List.iter (
- fun (name, { Index_parser.revision = revision; arch = arch; hidden = hidden }) ->
- if not hidden then (
- let filename = Downloader.cache_of_name cachedir name arch revision in
- let cached = Sys.file_exists filename in
- printf "%-24s %-10s %s\n" name arch
- (if cached then s_"cached" else (*s_*)"no")
- )
- ) index
+ | Some cache ->
+ let l = List.filter (
+ fun (_, { Index_parser.hidden = hidden }) ->
+ hidden <> true
+ ) index in
+ let l = List.map (
+ fun (name, { Index_parser.revision = revision; arch = arch }) ->
+ (name, arch, revision)
+ ) l in
+ Cache.print_item_status cache ~header:true l
| None -> printf (f_"no cache directory\n")
);
exit 0
diff --git a/builder/cache.ml b/builder/cache.ml
new file mode 100644
index 0000000..581b2cf
--- /dev/null
+++ b/builder/cache.ml
@@ -0,0 +1,65 @@
+(* virt-builder
+ * Copyright (C) 2013-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 Common_gettext.Gettext
+open Common_utils
+
+open Unix
+open Printf
+
+let quote = Filename.quote
+
+let clean_cachedir dir =
+ let cmd = sprintf "rm -rf %s" (quote dir) in
+ ignore (Sys.command cmd);
+
+type t = {
+ debug : bool;
+ directory : string;
+}
+
+let create ~debug ~directory =
+ (* Annoyingly Sys.is_directory throws an exception on failure
+ * (RHBZ#1022431).
+ *)
+ let is_dir = try Sys.is_directory directory with Sys_error _ -> false in
+ if is_dir = false then (
+ mkdir directory 0o755
+ );
+ {
+ debug = debug;
+ directory = directory;
+ }
+
+let cache_of_name t name arch revision =
+ t.directory // sprintf "%s.%s.%d" name arch revision
+
+let is_cached t name arch revision =
+ let filename = cache_of_name t name arch revision in
+ Sys.file_exists filename
+
+let print_item_status t ~header l =
+ if header then (
+ printf (f_"cache directory: %s\n") t.directory
+ );
+ List.iter (
+ fun (name, arch, revision) ->
+ let cached = is_cached t name arch revision in
+ printf "%-24s %-10s %s\n" name arch
+ (if cached then s_"cached" else (*s_*)"no")
+ ) l
diff --git a/builder/cache.mli b/builder/cache.mli
new file mode 100644
index 0000000..220ebcb
--- /dev/null
+++ b/builder/cache.mli
@@ -0,0 +1,45 @@
+(* virt-builder
+ * Copyright (C) 2013-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.
+ *)
+
+(** This module represents a local cache. *)
+
+val clean_cachedir : string -> unit
+(** [clean_cachedir dir] clean the specified cache directory. *)
+
+type t
+(** The abstract data type. *)
+
+val create : debug:bool -> directory:string -> t
+(** Create the abstract type. *)
+
+val cache_of_name : t -> string -> string -> int -> string
+(** [cache_of_name t name arch revision] return the filename
+ of the cached file. (Note: It doesn't check if the filename
+ exists, this is just a simple string transformation). *)
+
+val is_cached : t -> string -> string -> int -> bool
+(** [is_cached t name arch revision] return whether the file with
+ specified name, architecture and revision is cached. *)
+
+val print_item_status : t -> header:bool -> (string * string * int) list -> unit
+(** [print_item_status t header items] print the status in the cache
+ of the specified items (which are tuples of name, architecture,
+ and revision).
+
+ If [~header:true] then display a header with the path of the
+ cache. *)
diff --git a/builder/downloader.ml b/builder/downloader.ml
index f8cd7ab..9fed774 100644
--- a/builder/downloader.ml
+++ b/builder/downloader.ml
@@ -23,10 +23,6 @@ open Unix
open Printf
let quote = Filename.quote
-let (//) = Filename.concat
-
-let cache_of_name cachedir name arch revision =
- cachedir // sprintf "%s.%s.%d" name arch revision
type uri = string
type filename = string
@@ -34,7 +30,7 @@ type filename = string
type t = {
debug : bool;
curl : string;
- cache : string option; (* cache directory for templates *)
+ cache : Cache.t option; (* cache for templates *)
}
type proxy_mode =
@@ -62,8 +58,8 @@ let rec download ~prog t ?template ?progress_bar ?(proxy = SystemProxy) uri =
(* Not using the cache at all? *)
download t ~prog ?progress_bar ~proxy uri
- | Some cachedir ->
- let filename = cache_of_name cachedir name arch revision in
+ | Some cache ->
+ let filename = Cache.cache_of_name cache name arch revision in
(* Is the requested template name + revision in the cache already?
* If not, download it.
@@ -81,7 +77,7 @@ and download_to ~prog t ?(progress_bar = false) ~proxy uri filename =
exit 1 in
(* Note because there may be parallel virt-builder instances running
- * and also to avoid partial downloads in the cachedir if the network
+ * and also to avoid partial downloads in the cache if the network
* fails, we download to a random name in the cache and then
* atomically rename it to the final filename.
*)
diff --git a/builder/downloader.mli b/builder/downloader.mli
index 4d24a34..a10cdca 100644
--- a/builder/downloader.mli
+++ b/builder/downloader.mli
@@ -18,11 +18,6 @@
(** This module is a wrapper around curl, plus local caching. *)
-val cache_of_name : string -> string -> string -> int -> string
-(** [cache_of_name cachedir name arch revision] returns the filename
- of the cached file. (Note: It doesn't check if the filename
- exists, this is just a simple string transformation). *)
-
type uri = string
type filename = string
@@ -37,7 +32,7 @@ type proxy_mode =
*)
| ForcedProxy of string (* The proxy is forced to the specified URL. *)
-val create : debug:bool -> curl:string -> cache:string option -> t
+val create : debug:bool -> curl:string -> cache:Cache.t option -> t
(** Create the abstract type. *)
val download : prog:string -> t -> ?template:(string*string*int) -> ?progress_bar:bool -> ?proxy:proxy_mode -> uri -> (filename * bool)
diff --git a/po/POTFILES-ml b/po/POTFILES-ml
index 4dce0e5..8993136 100644
--- a/po/POTFILES-ml
+++ b/po/POTFILES-ml
@@ -1,5 +1,6 @@
builder/architecture.ml
builder/builder.ml
+builder/cache.ml
builder/cmdline.ml
builder/downloader.ml
builder/get_kernel.ml
--
1.9.0
10 years, 7 months
[PATCH] Fix qemu version check
by Hilko Bengen
---
configure.ac | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/configure.ac b/configure.ac
index ab072c3..9c398e0 100644
--- a/configure.ac
+++ b/configure.ac
@@ -777,7 +777,7 @@ working.
fi
AC_MSG_CHECKING([for $QEMU version >= 1])
- if $QEMU -version | grep -sq 'version @<:@1-@:>@'; then
+ if $QEMU -version | grep -sq 'version @<:@1-9@:>@'; then
AC_MSG_RESULT([yes])
else
AC_MSG_RESULT([no])
--
1.9.2
10 years, 7 months
[PATCH 1/2] builder: add an optional suffix string for INI parsing errors
by Pino Toscano
---
builder/index-parse.y | 6 ++++--
builder/index-parser-c.c | 3 ++-
builder/index-struct.h | 1 +
builder/ini_reader.ml | 6 +++---
builder/ini_reader.mli | 2 +-
5 files changed, 11 insertions(+), 7 deletions(-)
diff --git a/builder/index-parse.y b/builder/index-parse.y
index 310870d..7ddef53 100644
--- a/builder/index-parse.y
+++ b/builder/index-parse.y
@@ -150,12 +150,14 @@ emptylines:
void
yyerror (YYLTYPE * yylloc, yyscan_t scanner, struct parse_context *context, const char *msg)
{
- fprintf (stderr, "%s%s%s%ssyntax error at line %d: %s\n",
+ fprintf (stderr, "%s%s%s%ssyntax error at line %d: %s%s%s\n",
context->program_name ? context->program_name : "",
context->program_name ? ": " : "",
context->input_file ? context->input_file : "",
context->input_file ? ": " : "",
- yylloc->first_line, msg);
+ yylloc->first_line, msg,
+ context->error_suffix ? " " : "",
+ context->error_suffix ? context->error_suffix : "");
}
int
diff --git a/builder/index-parser-c.c b/builder/index-parser-c.c
index 5dcc82f..099bdf8 100644
--- a/builder/index-parser-c.c
+++ b/builder/index-parser-c.c
@@ -46,7 +46,7 @@ extern void unix_error (int errcode, char * cmdname, value arg) Noreturn;
extern int do_parse (struct parse_context *context, FILE *in);
value
-virt_builder_parse_index (value progv, value filenamev)
+virt_builder_parse_index (value progv, value error_suffixv, value filenamev)
{
CAMLparam2 (progv, filenamev);
CAMLlocal5 (rv, v, sv, sv2, fv);
@@ -58,6 +58,7 @@ virt_builder_parse_index (value progv, value filenamev)
parse_context_init (&context);
context.program_name = String_val (progv);
context.input_file = String_val (filenamev);
+ context.error_suffix = String_val (error_suffixv);
in = fopen (String_val (filenamev), "r");
if (in == NULL)
diff --git a/builder/index-struct.h b/builder/index-struct.h
index 3edd06d..150535d 100644
--- a/builder/index-struct.h
+++ b/builder/index-struct.h
@@ -45,6 +45,7 @@ struct parse_context {
int seen_comments;
const char *input_file;
const char *program_name;
+ const char *error_suffix;
};
/* Initialize the content of a parse_context. */
diff --git a/builder/ini_reader.ml b/builder/ini_reader.ml
index 68e3863..c64125c 100644
--- a/builder/ini_reader.ml
+++ b/builder/ini_reader.ml
@@ -27,10 +27,10 @@ and c_section = string * c_fields (* [name] + fields *)
and c_fields = field array
(* Calls yyparse in the C code. *)
-external parse_index : prog:string -> string -> c_sections = "virt_builder_parse_index"
+external parse_index : prog:string -> error_suffix:string -> string -> c_sections = "virt_builder_parse_index"
-let read_ini ~prog file =
- let sections = parse_index ~prog file in
+let read_ini ~prog ?(error_suffix = "") file =
+ let sections = parse_index ~prog ~error_suffix file in
let sections = Array.to_list sections in
List.map (
fun (n, fields) ->
diff --git a/builder/ini_reader.mli b/builder/ini_reader.mli
index ac3bebe..1b8e894 100644
--- a/builder/ini_reader.mli
+++ b/builder/ini_reader.mli
@@ -21,4 +21,4 @@ and section = string * fields (* [name] + fields *)
and fields = field list
and field = string * string option * string (* key + subkey + value *)
-val read_ini : prog:string -> string -> sections
+val read_ini : prog:string -> ?error_suffix:string -> string -> sections
--
1.9.0
10 years, 7 months
[PATCH 1/2] ruby: tests: isolate boilerplate in common file
by Pino Toscano
Isolate in a common file all the standard boilerplate in tests, i.e. the
import of the test framework and the guestfs module (including the
import path hack needed for the latter).
Thanks to Vít Ondruch for the precious hints and suggestions.
---
ruby/Makefile.am | 3 ++-
ruby/t/tc_010_load.rb | 5 +----
ruby/t/tc_020_create.rb | 5 +----
ruby/t/tc_030_create_flags.rb | 7 ++-----
ruby/t/tc_040_create_multiple.rb | 7 ++-----
ruby/t/tc_050_handle_properties.rb | 7 ++-----
ruby/t/tc_060_explicit_close.rb | 7 ++-----
ruby/t/tc_070_optargs.rb | 7 ++-----
ruby/t/tc_100_launch.rb | 5 +----
ruby/t/tc_410_close_event.rb | 5 +----
ruby/t/tc_420_log_messages.rb | 5 +----
ruby/t/tc_800_rhbz507346.rb | 7 ++-----
ruby/t/tc_810_rhbz664558c6.rb | 7 ++-----
ruby/t/tc_820_rhbz1046509.rb | 7 ++-----
ruby/t/test_helper.rb | 22 ++++++++++++++++++++++
15 files changed, 45 insertions(+), 61 deletions(-)
create mode 100644 ruby/t/test_helper.rb
diff --git a/ruby/Makefile.am b/ruby/Makefile.am
index 8c96844..f605188 100644
--- a/ruby/Makefile.am
+++ b/ruby/Makefile.am
@@ -29,7 +29,8 @@ EXTRA_DIST = \
lib/guestfs.rb \
run-bindtests \
run-ruby-tests \
- t/tc_*.rb
+ t/tc_*.rb \
+ t/test_helper.rb
CLEANFILES = \
lib/*~ \
diff --git a/ruby/t/tc_010_load.rb b/ruby/t/tc_010_load.rb
index 800d1ff..f1d296c 100644
--- a/ruby/t/tc_010_load.rb
+++ b/ruby/t/tc_010_load.rb
@@ -15,10 +15,7 @@
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-require 'test/unit'
-$:.unshift(File::join(File::dirname(__FILE__), "..", "lib"))
-$:.unshift(File::join(File::dirname(__FILE__), "..", "ext", "guestfs"))
-require 'guestfs'
+require File::join(File::dirname(__FILE__), 'test_helper')
class TestLoad < Test::Unit::TestCase
def test_load
diff --git a/ruby/t/tc_020_create.rb b/ruby/t/tc_020_create.rb
index d765acd..7476439 100644
--- a/ruby/t/tc_020_create.rb
+++ b/ruby/t/tc_020_create.rb
@@ -15,10 +15,7 @@
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-require 'test/unit'
-$:.unshift(File::join(File::dirname(__FILE__), "..", "lib"))
-$:.unshift(File::join(File::dirname(__FILE__), "..", "ext", "guestfs"))
-require 'guestfs'
+require File::join(File::dirname(__FILE__), 'test_helper')
class TestLoad < Test::Unit::TestCase
def test_create
diff --git a/ruby/t/tc_030_create_flags.rb b/ruby/t/tc_030_create_flags.rb
index 7ec2ce9..3286a1f 100644
--- a/ruby/t/tc_030_create_flags.rb
+++ b/ruby/t/tc_030_create_flags.rb
@@ -1,5 +1,5 @@
# libguestfs Ruby bindings -*- ruby -*-
-# Copyright (C) 2013 Red Hat Inc.
+# Copyright (C) 2013-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
@@ -15,10 +15,7 @@
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-require 'test/unit'
-$:.unshift(File::join(File::dirname(__FILE__), "..", "lib"))
-$:.unshift(File::join(File::dirname(__FILE__), "..", "ext", "guestfs"))
-require 'guestfs'
+require File::join(File::dirname(__FILE__), 'test_helper')
class TestLoad < Test::Unit::TestCase
def test_create_flags
diff --git a/ruby/t/tc_040_create_multiple.rb b/ruby/t/tc_040_create_multiple.rb
index 339b699..0d86786 100644
--- a/ruby/t/tc_040_create_multiple.rb
+++ b/ruby/t/tc_040_create_multiple.rb
@@ -1,5 +1,5 @@
# libguestfs Ruby bindings -*- ruby -*-
-# Copyright (C) 2013 Red Hat Inc.
+# Copyright (C) 2013-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
@@ -15,10 +15,7 @@
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-require 'test/unit'
-$:.unshift(File::join(File::dirname(__FILE__), "..", "lib"))
-$:.unshift(File::join(File::dirname(__FILE__), "..", "ext", "guestfs"))
-require 'guestfs'
+require File::join(File::dirname(__FILE__), 'test_helper')
class TestLoad < Test::Unit::TestCase
def test_create_multiple
diff --git a/ruby/t/tc_050_handle_properties.rb b/ruby/t/tc_050_handle_properties.rb
index cf4a7a7..55bb207 100644
--- a/ruby/t/tc_050_handle_properties.rb
+++ b/ruby/t/tc_050_handle_properties.rb
@@ -1,5 +1,5 @@
# libguestfs Ruby bindings -*- ruby -*-
-# Copyright (C) 2013 Red Hat Inc.
+# Copyright (C) 2013-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
@@ -15,10 +15,7 @@
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-require 'test/unit'
-$:.unshift(File::join(File::dirname(__FILE__), "..", "lib"))
-$:.unshift(File::join(File::dirname(__FILE__), "..", "ext", "guestfs"))
-require 'guestfs'
+require File::join(File::dirname(__FILE__), 'test_helper')
class TestLoad < Test::Unit::TestCase
def test_handle_properties
diff --git a/ruby/t/tc_060_explicit_close.rb b/ruby/t/tc_060_explicit_close.rb
index 74456e4..4752d47 100644
--- a/ruby/t/tc_060_explicit_close.rb
+++ b/ruby/t/tc_060_explicit_close.rb
@@ -1,5 +1,5 @@
# libguestfs Ruby bindings -*- ruby -*-
-# Copyright (C) 2013 Red Hat Inc.
+# Copyright (C) 2013-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
@@ -15,10 +15,7 @@
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-require 'test/unit'
-$:.unshift(File::join(File::dirname(__FILE__), "..", "lib"))
-$:.unshift(File::join(File::dirname(__FILE__), "..", "ext", "guestfs"))
-require 'guestfs'
+require File::join(File::dirname(__FILE__), 'test_helper')
class TestLoad < Test::Unit::TestCase
def test_explicit_close
diff --git a/ruby/t/tc_070_optargs.rb b/ruby/t/tc_070_optargs.rb
index e28f944..b8c23e6 100644
--- a/ruby/t/tc_070_optargs.rb
+++ b/ruby/t/tc_070_optargs.rb
@@ -1,5 +1,5 @@
# libguestfs Ruby bindings -*- ruby -*-
-# Copyright (C) 2010 Red Hat Inc.
+# Copyright (C) 2010-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
@@ -15,10 +15,7 @@
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-require 'test/unit'
-$:.unshift(File::join(File::dirname(__FILE__), "..", "lib"))
-$:.unshift(File::join(File::dirname(__FILE__), "..", "ext", "guestfs"))
-require 'guestfs'
+require File::join(File::dirname(__FILE__), 'test_helper')
class TestLoad < Test::Unit::TestCase
def test_optargs
diff --git a/ruby/t/tc_100_launch.rb b/ruby/t/tc_100_launch.rb
index f77a026..68fb119 100644
--- a/ruby/t/tc_100_launch.rb
+++ b/ruby/t/tc_100_launch.rb
@@ -15,10 +15,7 @@
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-require 'test/unit'
-$:.unshift(File::join(File::dirname(__FILE__), "..", "lib"))
-$:.unshift(File::join(File::dirname(__FILE__), "..", "ext", "guestfs"))
-require 'guestfs'
+require File::join(File::dirname(__FILE__), 'test_helper')
class TestLoad < Test::Unit::TestCase
def test_launch
diff --git a/ruby/t/tc_410_close_event.rb b/ruby/t/tc_410_close_event.rb
index f694ca8..d0c4465 100644
--- a/ruby/t/tc_410_close_event.rb
+++ b/ruby/t/tc_410_close_event.rb
@@ -15,10 +15,7 @@
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-require 'test/unit'
-$:.unshift(File::join(File::dirname(__FILE__), "..", "lib"))
-$:.unshift(File::join(File::dirname(__FILE__), "..", "ext", "guestfs"))
-require 'guestfs'
+require File::join(File::dirname(__FILE__), 'test_helper')
class TestLoad < Test::Unit::TestCase
def test_events
diff --git a/ruby/t/tc_420_log_messages.rb b/ruby/t/tc_420_log_messages.rb
index 6757d46..4397e6e 100644
--- a/ruby/t/tc_420_log_messages.rb
+++ b/ruby/t/tc_420_log_messages.rb
@@ -15,10 +15,7 @@
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-require 'test/unit'
-$:.unshift(File::join(File::dirname(__FILE__), "..", "lib"))
-$:.unshift(File::join(File::dirname(__FILE__), "..", "ext", "guestfs"))
-require 'guestfs'
+require File::join(File::dirname(__FILE__), 'test_helper')
class TestLoad < Test::Unit::TestCase
def test_events
diff --git a/ruby/t/tc_800_rhbz507346.rb b/ruby/t/tc_800_rhbz507346.rb
index 66e0e92..100b1fe 100644
--- a/ruby/t/tc_800_rhbz507346.rb
+++ b/ruby/t/tc_800_rhbz507346.rb
@@ -1,5 +1,5 @@
# libguestfs Ruby bindings -*- ruby -*-
-# Copyright (C) 2009 Red Hat Inc.
+# 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
@@ -15,10 +15,7 @@
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-require 'test/unit'
-$:.unshift(File::join(File::dirname(__FILE__), "..", "lib"))
-$:.unshift(File::join(File::dirname(__FILE__), "..", "ext", "guestfs"))
-require 'guestfs'
+require File::join(File::dirname(__FILE__), 'test_helper')
class TestLoad < Test::Unit::TestCase
def test_rhbz507346
diff --git a/ruby/t/tc_810_rhbz664558c6.rb b/ruby/t/tc_810_rhbz664558c6.rb
index 5eb373e..105035b 100644
--- a/ruby/t/tc_810_rhbz664558c6.rb
+++ b/ruby/t/tc_810_rhbz664558c6.rb
@@ -1,5 +1,5 @@
# libguestfs Ruby bindings -*- ruby -*-
-# Copyright (C) 2011 Red Hat Inc.
+# Copyright (C) 2011-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
@@ -19,10 +19,7 @@
# the interpreter to segfault. See:
# https://bugzilla.redhat.com/show_bug.cgi?id=664558#c6
-require 'test/unit'
-$:.unshift(File::join(File::dirname(__FILE__), "..", "lib"))
-$:.unshift(File::join(File::dirname(__FILE__), "..", "ext", "guestfs"))
-require 'guestfs'
+require File::join(File::dirname(__FILE__), 'test_helper')
class TestLoad < Test::Unit::TestCase
def test_rhbz664558c6
diff --git a/ruby/t/tc_820_rhbz1046509.rb b/ruby/t/tc_820_rhbz1046509.rb
index 978decd..831aaf0 100644
--- a/ruby/t/tc_820_rhbz1046509.rb
+++ b/ruby/t/tc_820_rhbz1046509.rb
@@ -1,5 +1,5 @@
# libguestfs Ruby bindings -*- ruby -*-
-# Copyright (C) 2013 Red Hat Inc.
+# Copyright (C) 2013-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
@@ -18,10 +18,7 @@
# Test that we don't break the old ::create module function while
# fixing https://bugzilla.redhat.com/show_bug.cgi?id=1046509
-require 'test/unit'
-$:.unshift(File::join(File::dirname(__FILE__), "..", "lib"))
-$:.unshift(File::join(File::dirname(__FILE__), "..", "ext", "guestfs"))
-require 'guestfs'
+require File::join(File::dirname(__FILE__), 'test_helper')
class TestLoad < Test::Unit::TestCase
def _handleok(g)
diff --git a/ruby/t/test_helper.rb b/ruby/t/test_helper.rb
new file mode 100644
index 0000000..8ebfe2f
--- /dev/null
+++ b/ruby/t/test_helper.rb
@@ -0,0 +1,22 @@
+# libguestfs Ruby bindings -*- ruby -*-
+# 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.
+
+require 'test/unit'
+
+$:.unshift(File::join(File::dirname(__FILE__), "..", "lib"))
+$:.unshift(File::join(File::dirname(__FILE__), "..", "ext", "guestfs"))
+require 'guestfs'
--
1.9.0
10 years, 7 months
[PATCH] daemon: parted: part-get-name: switch from sgdisk to parted (RHBZ#1088424).
by Pino Toscano
Use parted to get the name of partitions in GPT layouts instead of
sgdisk, to reduce the possible discrepancy between output of tools.
The actual case here is that recent parted versions fixed/improved their
UTF-16 handling of partition names in GPT, and sgdisk seems to not be
properly handling them, returning also unicode control bytes.
Since parted can provide partition names already, just make use of it.
Since sgdisk is no more needed for part_get_name, the function is no
more optional on it.
---
daemon/parted.c | 80 ++++++++++++++++++++++++++++++++++++----------------
generator/actions.ml | 1 -
2 files changed, 55 insertions(+), 26 deletions(-)
diff --git a/daemon/parted.c b/daemon/parted.c
index fce4cf9..5b049f5 100644
--- a/daemon/parted.c
+++ b/daemon/parted.c
@@ -886,27 +886,6 @@ extract_uuid (const char *value)
return ret;
}
-static char *
-extract_optionally_quoted (const char *value)
-{
- size_t value_len = strlen (value);
-
- if (value_len >= 2 &&
- ((value[0] == '\'' && value[value_len - 1] == '\'') ||
- (value[0] == '"' && value[value_len - 1] == '"'))) {
- value_len -= 2;
- ++value;
- }
-
- char *ret = strndup (value, value_len);
- if (ret == NULL) {
- reply_with_perror ("strndup");
- return NULL;
- }
-
- return ret;
-}
-
char *
do_part_get_gpt_type (const char *device, int partnum)
{
@@ -919,10 +898,61 @@ do_part_get_name (const char *device, int partnum)
{
CLEANUP_FREE char *parttype = do_part_get_parttype (device);
- if (STREQ (parttype, "gpt"))
- return sgdisk_info_extract_field (device, partnum,
- "Partition name",
- extract_optionally_quoted);
+ if (STREQ (parttype, "gpt")) {
+ int parted_has_m_opt = test_parted_m_opt ();
+ if (parted_has_m_opt == -1)
+ return NULL;
+
+ CLEANUP_FREE char *out = print_partition_table (device, parted_has_m_opt);
+ if (!out)
+ return NULL;
+
+ if (parted_has_m_opt) {
+ /* New-style parsing using the "machine-readable" format from
+ * 'parted -m'.
+ */
+ CLEANUP_FREE_STRING_LIST char **lines = split_lines (out);
+
+ if (!lines)
+ return NULL;
+
+ if (lines[0] == NULL || STRNEQ (lines[0], "BYT;")) {
+ reply_with_error ("unknown signature, expected \"BYT;\" as first line of the output: %s",
+ lines[0] ? lines[0] : "(signature was null)");
+ return NULL;
+ }
+
+ if (lines[1] == NULL) {
+ reply_with_error ("parted didn't return a line describing the device");
+ return NULL;
+ }
+
+ size_t row;
+ int pnum;
+ for (row = 2; lines[row] != NULL; ++row) {
+ if (sscanf (lines[row], "%d:", &pnum) != 1) {
+ reply_with_error ("could not parse row from output of parted print command: %s", lines[row]);
+ return NULL;
+ }
+ if (pnum == partnum)
+ break;
+ }
+
+ if (lines[row] == NULL) {
+ reply_with_error ("partition number %d not found", partnum);
+ return NULL;
+ }
+
+ char *name = get_table_field (lines[row], 5);
+ if (name == NULL)
+ reply_with_error ("cannot get the name field from '%s'", lines[row]);
+
+ return name;
+ }
+ } else {
+ reply_with_error ("parted does not support the machine output (-m)");
+ return NULL;
+ }
reply_with_error ("cannot get the partition name from '%s' layouts", parttype);
return NULL;
diff --git a/generator/actions.ml b/generator/actions.ml
index 3f30d8c..ef3f17e 100644
--- a/generator/actions.ml
+++ b/generator/actions.ml
@@ -11844,7 +11844,6 @@ enables all the other flags, if they are not specified already.
name = "part_get_name";
style = RString "name", [Device "device"; Int "partnum"], [];
proc_nr = Some 416;
- optional = Some "gdisk";
shortdesc = "get partition name";
longdesc = "\
This gets the partition name on partition numbered C<partnum> on
--
1.9.0
10 years, 7 months
Re: [Libguestfs] libguestfs powerpc package
by Richard W.M. Jones
[Please keep message on the list]
On Mon, Sep 30, 2013 at 12:58:38AM +0200, Roberto Innocenti wrote:
> [libguestfs on ppc]
You should be able to compile from the latest source on ppc64, since I
spent some time a few weeks ago getting it to work:
http://comments.gmane.org/gmane.linux.redhat.fedora.virtualization/2268
Start with git (not 1.22), read the README file, and let us know on
the mailing list what precise errors you get when you try to compile it.
Note you'll require the latest supermin (from git) first, and qemu
from git, and IIRC there was an endianness bug in hivex too which is
fixed in git. The latest hivex isn't required unless you're doing
Widows guest inspection.
Rich.
--
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Fedora Windows cross-compiler. Compile Windows programs, test, and
build Windows installers. Over 100 libraries supported.
http://fedoraproject.org/wiki/MinGW
10 years, 7 months
[PATCH] disk-create: Fix this API so it works correctly with block devices (RHBZ#1088262).
by Richard W.M. Jones
When you call guestfs_disk_create on a block device with format=raw
then it will try to discard the blocks on the device.
---
configure.ac | 1 +
daemon/blkdiscard.c | 3 +++
generator/actions.ml | 4 ++++
src/create.c | 46 +++++++++++++++++++++++++++++++++++++++-------
4 files changed, 47 insertions(+), 7 deletions(-)
diff --git a/configure.ac b/configure.ac
index 887feea..014332e 100644
--- a/configure.ac
+++ b/configure.ac
@@ -291,6 +291,7 @@ AC_CHECK_HEADERS([\
byteswap.h \
endian.h \
errno.h \
+ linux/fs.h \
linux/raid/md_u.h \
printf.h \
sys/inotify.h \
diff --git a/daemon/blkdiscard.c b/daemon/blkdiscard.c
index 7b63b99..612c97f 100644
--- a/daemon/blkdiscard.c
+++ b/daemon/blkdiscard.c
@@ -25,7 +25,10 @@
#include <fcntl.h>
#include <unistd.h>
#include <sys/ioctl.h>
+
+#ifdef HAVE_LINUX_FS_H
#include <linux/fs.h>
+#endif
#include "daemon.h"
#include "actions.h"
diff --git a/generator/actions.ml b/generator/actions.ml
index 8825493..3f30d8c 100644
--- a/generator/actions.ml
+++ b/generator/actions.ml
@@ -3084,6 +3084,10 @@ size of the backing file, which is discovered automatically. You
are encouraged to also pass C<backingformat> to describe the format
of C<backingfile>.
+If C<filename> refers to a block device, then the device is
+formatted. The C<size> is ignored since block devices have an
+intrinsic size.
+
The other optional parameters are:
=over 4
diff --git a/src/create.c b/src/create.c
index 40a5cac..0cfe6be 100644
--- a/src/create.c
+++ b/src/create.c
@@ -27,8 +27,13 @@
#include <sys/types.h>
#include <sys/stat.h>
#include <sys/wait.h>
+#include <sys/ioctl.h>
#include <errno.h>
+#ifdef HAVE_LINUX_FS_H
+#include <linux/fs.h>
+#endif
+
#include "guestfs.h"
#include "guestfs-internal.h"
#include "guestfs-internal-actions.h"
@@ -90,6 +95,36 @@ guestfs__disk_create (guestfs_h *g, const char *filename,
}
static int
+disk_create_raw_block (guestfs_h *g, const char *filename)
+{
+ int fd;
+
+ fd = open (filename, O_WRONLY|O_NOCTTY|O_CLOEXEC, 0666);
+ if (fd == -1) {
+ perrorf (g, _("cannot open block device: %s"), filename);
+ return -1;
+ }
+
+ /* Just discard blocks, if possible. However don't try too hard. */
+#if defined(BLKGETSIZE64) && defined(BLKDISCARD)
+ uint64_t size;
+ uint64_t range[2];
+
+ if (ioctl (fd, BLKGETSIZE64, &size) == 0) {
+ range[0] = 0;
+ range[1] = size;
+ if (ioctl (fd, BLKDISCARD, range) == 0)
+ debug (g, "disk_create: %s: BLKDISCARD failed on this device: %m",
+ filename);
+ }
+#endif
+
+ close (fd);
+
+ return 0;
+}
+
+static int
disk_create_raw (guestfs_h *g, const char *filename, int64_t size,
const struct guestfs_disk_create_argv *optargs)
{
@@ -123,18 +158,15 @@ disk_create_raw (guestfs_h *g, const char *filename, int64_t size,
return -1;
}
- /* This version refuses to overwrite block devices or char devices.
- * XXX It would be possible to make it work with block devices.
- */
if (stat (filename, &statbuf) == 0) {
- if (S_ISBLK (statbuf.st_mode)) {
- error (g, _("refusing to overwrite block device '%s'"), filename);
- return -1;
- }
+ /* Refuse to overwrite char devices. */
if (S_ISCHR (statbuf.st_mode)) {
error (g, _("refusing to overwrite char device '%s'"), filename);
return -1;
}
+ /* Block devices have to be handled specially. */
+ if (S_ISBLK (statbuf.st_mode))
+ return disk_create_raw_block (g, filename);
}
fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_TRUNC|O_CLOEXEC, 0666);
--
1.8.5.3
10 years, 7 months
[PATCH] builder: add per-repository proxy configuration
by Pino Toscano
Add the possibility to configure the proxy in each repository .conf
file, specifying whether use no proxy at all, follow the system
configuration or use a specific proxy.
---
builder/builder.ml | 10 +++++-----
builder/downloader.ml | 44 ++++++++++++++++++++++++++++++++++++--------
builder/downloader.mli | 15 +++++++++++++--
builder/index_parser.ml | 4 ++--
builder/index_parser.mli | 2 +-
builder/list_entries.ml | 4 ++--
builder/list_entries.mli | 2 +-
builder/sources.ml | 12 +++++++++++-
builder/sources.mli | 1 +
builder/virt-builder.pod | 25 +++++++++++++++++++++++++
10 files changed, 97 insertions(+), 22 deletions(-)
diff --git a/builder/builder.ml b/builder/builder.ml
index 81eb2d9..062dbb9 100644
--- a/builder/builder.ml
+++ b/builder/builder.ml
@@ -136,25 +136,25 @@ let main () =
let downloader = Downloader.create ~debug ~curl ~cache in
let repos = Sources.read_sources ~prog ~debug in
let repos = List.map (
- fun { Sources.uri = uri; Sources.gpgkey = gpgkey } ->
+ fun { Sources.uri = uri; Sources.gpgkey = gpgkey; Sources.proxy = proxy } ->
let gpgkey =
match gpgkey with
| None -> Sigchecker.No_Key
| Some key -> Sigchecker.KeyFile key in
- uri, gpgkey
+ uri, gpgkey, proxy
) repos in
let sources = List.map (
fun (source, fingerprint) ->
- source, Sigchecker.Fingerprint fingerprint
+ source, Sigchecker.Fingerprint fingerprint, Downloader.SystemProxy
) sources in
let sources = List.append repos sources in
let index : Index_parser.index =
List.concat (
List.map (
- fun (source, key) ->
+ fun (source, key, proxy) ->
let sigchecker =
Sigchecker.create ~debug ~gpg ~check_signature ~gpgkey:key in
- Index_parser.get_index ~prog ~debug ~downloader ~sigchecker source
+ Index_parser.get_index ~prog ~debug ~downloader ~sigchecker ~proxy source
) sources
) in
diff --git a/builder/downloader.ml b/builder/downloader.ml
index e23cb37..f8cd7ab 100644
--- a/builder/downloader.ml
+++ b/builder/downloader.ml
@@ -37,25 +37,30 @@ type t = {
cache : string option; (* cache directory for templates *)
}
+type proxy_mode =
+ | UnsetProxy
+ | SystemProxy
+ | ForcedProxy of string
+
let create ~debug ~curl ~cache = {
debug = debug;
curl = curl;
cache = cache;
}
-let rec download ~prog t ?template ?progress_bar uri =
+let rec download ~prog t ?template ?progress_bar ?(proxy = SystemProxy) uri =
match template with
| None -> (* no cache, simple download *)
(* Create a temporary name. *)
let tmpfile = Filename.temp_file "vbcache" ".txt" in
- download_to ~prog t ?progress_bar uri tmpfile;
+ download_to ~prog t ?progress_bar ~proxy uri tmpfile;
(tmpfile, true)
| Some (name, arch, revision) ->
match t.cache with
| None ->
(* Not using the cache at all? *)
- download t ~prog ?progress_bar uri
+ download t ~prog ?progress_bar ~proxy uri
| Some cachedir ->
let filename = cache_of_name cachedir name arch revision in
@@ -64,11 +69,11 @@ let rec download ~prog t ?template ?progress_bar uri =
* If not, download it.
*)
if not (Sys.file_exists filename) then
- download_to ~prog t ?progress_bar uri filename;
+ download_to ~prog t ?progress_bar ~proxy uri filename;
(filename, false)
-and download_to ~prog t ?(progress_bar = false) uri filename =
+and download_to ~prog t ?(progress_bar = false) ~proxy uri filename =
let parseduri =
try URI.parse_uri uri
with Invalid_argument "URI.parse_uri" ->
@@ -95,9 +100,11 @@ and download_to ~prog t ?(progress_bar = false) uri filename =
prog path;
exit 1
)
- | _ -> (* Any other protocol. *)
+ | _ as protocol -> (* Any other protocol. *)
+ let outenv = proxy_envvar protocol proxy in
(* Get the status code first to ensure the file exists. *)
- let cmd = sprintf "%s%s -g -o /dev/null -I -w '%%{http_code}' %s"
+ let cmd = sprintf "%s%s%s -g -o /dev/null -I -w '%%{http_code}' %s"
+ outenv
t.curl
(if t.debug then "" else " -s -S")
(quote uri) in
@@ -122,7 +129,8 @@ and download_to ~prog t ?(progress_bar = false) uri filename =
);
(* Now download the file. *)
- let cmd = sprintf "%s%s -g -o %s %s"
+ let cmd = sprintf "%s%s%s -g -o %s %s"
+ outenv
t.curl
(if t.debug then "" else if progress_bar then " -#" else " -s -S")
(quote filename_new) (quote uri) in
@@ -137,3 +145,23 @@ and download_to ~prog t ?(progress_bar = false) uri filename =
(* Rename the file if the download was successful. *)
rename filename_new filename
+
+and proxy_envvar protocol = function
+ | UnsetProxy ->
+ (match protocol with
+ | "http" -> "env http_proxy= no_proxy=* "
+ | "https" -> "env https_proxy= no_proxy=* "
+ | "ftp" -> "env ftp_proxy= no_proxy=* "
+ | _ -> "env no_proxy=* "
+ )
+ | SystemProxy ->
+ (* No changes required. *)
+ ""
+ | ForcedProxy proxy ->
+ let proxy = Filename.quote proxy in
+ (match protocol with
+ | "http" -> sprintf "env http_proxy=%s no_proxy= " proxy
+ | "https" -> sprintf "env https_proxy=%s no_proxy= " proxy
+ | "ftp" -> sprintf "env ftp_proxy=%s no_proxy= " proxy
+ | _ -> ""
+ )
diff --git a/builder/downloader.mli b/builder/downloader.mli
index 8daa661..4d24a34 100644
--- a/builder/downloader.mli
+++ b/builder/downloader.mli
@@ -29,10 +29,18 @@ type filename = string
type t
(** The abstract data type. *)
+(** Type of proxy. *)
+type proxy_mode =
+ | UnsetProxy (* The proxy is forced off. *)
+ | SystemProxy (* The proxy is not changed (follows the
+ * system configuration).
+ *)
+ | ForcedProxy of string (* The proxy is forced to the specified URL. *)
+
val create : debug:bool -> curl:string -> cache:string option -> t
(** Create the abstract type. *)
-val download : prog:string -> t -> ?template:(string*string*int) -> ?progress_bar:bool -> uri -> (filename * bool)
+val download : prog:string -> t -> ?template:(string*string*int) -> ?progress_bar:bool -> ?proxy:proxy_mode -> uri -> (filename * bool)
(** Download the URI, returning the downloaded filename and a
temporary file flag. The temporary file flag is [true] iff
the downloaded file is temporary and should be deleted by the
@@ -44,4 +52,7 @@ val download : prog:string -> t -> ?template:(string*string*int) -> ?progress_ba
If [~progress_bar:true] then display a progress bar if the file
doesn't come from the cache. In debug mode, progress messages
- are always displayed. *)
+ are always displayed.
+
+ [proxy] specifies the type of proxy to be used in the transfer,
+ if possible. *)
diff --git a/builder/index_parser.ml b/builder/index_parser.ml
index 5d566f9..2040656 100644
--- a/builder/index_parser.ml
+++ b/builder/index_parser.ml
@@ -102,7 +102,7 @@ let print_entry chan (name, { printable_name = printable_name;
) notes;
if hidden then fp "hidden=true\n"
-let get_index ~prog ~debug ~downloader ~sigchecker source =
+let get_index ~prog ~debug ~downloader ~sigchecker ~proxy source =
let corrupt_file () =
eprintf (f_"\nThe index file downloaded from '%s' is corrupt.\nYou need to ask the supplier of this file to fix it and upload a fixed version.\n")
source;
@@ -111,7 +111,7 @@ let get_index ~prog ~debug ~downloader ~sigchecker source =
let rec get_index () =
(* Get the index page. *)
- let tmpfile, delete_tmpfile = Downloader.download ~prog downloader source in
+ let tmpfile, delete_tmpfile = Downloader.download ~prog downloader ~proxy source in
(* Check index file signature (also verifies it was fully
* downloaded and not corrupted in transit).
diff --git a/builder/index_parser.mli b/builder/index_parser.mli
index 0575dc4..c2c5d11 100644
--- a/builder/index_parser.mli
+++ b/builder/index_parser.mli
@@ -36,4 +36,4 @@ and entry = {
sigchecker : Sigchecker.t;
}
-val get_index : prog:string -> debug:bool -> downloader:Downloader.t -> sigchecker:Sigchecker.t -> string -> index
+val get_index : prog:string -> debug:bool -> downloader:Downloader.t -> sigchecker:Sigchecker.t -> proxy:Downloader.proxy_mode -> string -> index
diff --git a/builder/list_entries.ml b/builder/list_entries.ml
index 2c600d5..505a1b9 100644
--- a/builder/list_entries.ml
+++ b/builder/list_entries.ml
@@ -47,7 +47,7 @@ and list_entries_long ~sources index =
let langs = Languages.languages () in
List.iter (
- fun (source, key) ->
+ fun (source, key, proxy) ->
printf (f_"Source URI: %s\n") source;
(match key with
| Sigchecker.No_Key -> ()
@@ -136,7 +136,7 @@ and list_entries_json ~sources index =
printf " \"version\": %d,\n" 1;
printf " \"sources\": [\n";
iteri (
- fun i (source, key) ->
+ fun i (source, key, proxy) ->
printf " {\n";
(match key with
| Sigchecker.No_Key -> ()
diff --git a/builder/list_entries.mli b/builder/list_entries.mli
index b53ccec..ce012c4 100644
--- a/builder/list_entries.mli
+++ b/builder/list_entries.mli
@@ -16,4 +16,4 @@
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
*)
-val list_entries : list_format:([ `Short | `Long | `Json ]) -> sources:(string * Sigchecker.gpgkey_type) list -> Index_parser.index -> unit
+val list_entries : list_format:([ `Short | `Long | `Json ]) -> sources:(string * Sigchecker.gpgkey_type * Downloader.proxy_mode) list -> Index_parser.index -> unit
diff --git a/builder/sources.ml b/builder/sources.ml
index 90716bd..e7644a2 100644
--- a/builder/sources.ml
+++ b/builder/sources.ml
@@ -26,6 +26,7 @@ type source = {
name : string;
uri : string;
gpgkey : string option;
+ proxy : Downloader.proxy_mode;
}
module StringSet = Set.Make (String)
@@ -65,8 +66,17 @@ let parse_conf ~prog ~debug file =
);
None
) in
+ let proxy =
+ try
+ (match (List.assoc ("proxy", None) fields) with
+ | "no" | "off" -> Downloader.UnsetProxy
+ | "system" -> Downloader.SystemProxy
+ | _ as proxy -> Downloader.ForcedProxy proxy
+ )
+ with
+ Not_found -> Downloader.SystemProxy in
{
- name = n; uri = uri; gpgkey = gpgkey;
+ name = n; uri = uri; gpgkey = gpgkey; proxy = proxy;
}
in
try (give_source n fields) :: acc
diff --git a/builder/sources.mli b/builder/sources.mli
index 76feeda..0ade536 100644
--- a/builder/sources.mli
+++ b/builder/sources.mli
@@ -20,6 +20,7 @@ type source = {
name : string;
uri : string;
gpgkey : string option;
+ proxy : Downloader.proxy_mode;
}
val read_sources : prog:string -> debug:bool -> source list
diff --git a/builder/virt-builder.pod b/builder/virt-builder.pod
index 8d27452..ebe6528 100644
--- a/builder/virt-builder.pod
+++ b/builder/virt-builder.pod
@@ -1010,6 +1010,31 @@ This optional field represents the URI (although only I<file://> URIs
are accepted) of the key used to sign the index file.
If not present, the index file referred by I<uri=..> is not signed.
+=item C<proxy=MODE>
+
+This optional field specifies the proxy mode, to be used when downloading
+the index file of this repository. The possible values are:
+
+=over 4
+
+=item B<no>, B<off>
+
+No proxy is being used at all, even overriding the system configuration.
+
+=item B<system>
+
+The proxy used is the system one.
+
+=item I<anything else>
+
+Specifies the actual proxy configuration to be used, overriding the system
+configuration.
+
+=back
+
+If not present, the assumed value is to respect the proxy settings of the
+system (i.e. as if B<system> would be specified).
+
=back
For serious virt-builder use, you may want to create your own
--
1.9.0
10 years, 7 months
[PATCH v4 NOT TO BE APPLIED] New tool: virt-v2v.
by Richard W.M. Jones
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 | 6 +
Makefile.am | 6 +-
configure.ac | 5 +-
fish/guestfish.pod | 1 +
po/POTFILES | 2 +
po/POTFILES-ml | 11 +
src/guestfs.pod | 5 +
v2v/Makefile.am | 163 ++++++++++
v2v/README | 23 ++
v2v/cmdline.ml | 197 ++++++++++++
v2v/convert_linux_common.ml | 236 +++++++++++++++
v2v/convert_linux_common.mli | 45 +++
v2v/convert_linux_enterprise.ml | 637 +++++++++++++++++++++++++++++++++++++++
v2v/convert_linux_enterprise.mli | 19 ++
v2v/convert_linux_grub.ml | 330 ++++++++++++++++++++
v2v/convert_linux_grub.mli | 43 +++
v2v/convert_windows.ml | 22 ++
v2v/convert_windows.mli | 19 ++
v2v/link.sh.in | 22 ++
v2v/source_libvirt.ml | 118 ++++++++
v2v/source_libvirt.mli | 27 ++
v2v/target_local.ml | 86 ++++++
v2v/target_local.mli | 21 ++
v2v/types.ml | 84 ++++++
v2v/types.mli | 77 +++++
v2v/utils-c.c | 43 +++
v2v/utils.ml | 44 +++
v2v/v2v.ml | 353 ++++++++++++++++++++++
v2v/virt-v2v.pod | 301 ++++++++++++++++++
v2v/xml-c.c | 240 +++++++++++++++
v2v/xml.ml | 50 +++
v2v/xml.mli | 57 ++++
32 files changed, 3290 insertions(+), 3 deletions(-)
create mode 100644 v2v/Makefile.am
create mode 100644 v2v/README
create mode 100644 v2v/cmdline.ml
create mode 100644 v2v/convert_linux_common.ml
create mode 100644 v2v/convert_linux_common.mli
create mode 100644 v2v/convert_linux_enterprise.ml
create mode 100644 v2v/convert_linux_enterprise.mli
create mode 100644 v2v/convert_linux_grub.ml
create mode 100644 v2v/convert_linux_grub.mli
create mode 100644 v2v/convert_windows.ml
create mode 100644 v2v/convert_windows.mli
create mode 100644 v2v/link.sh.in
create mode 100644 v2v/source_libvirt.ml
create mode 100644 v2v/source_libvirt.mli
create mode 100644 v2v/target_local.ml
create mode 100644 v2v/target_local.mli
create mode 100644 v2v/types.ml
create mode 100644 v2v/types.mli
create mode 100644 v2v/utils-c.c
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 4d47d23..25e9358 100644
--- a/.gitignore
+++ b/.gitignore
@@ -252,6 +252,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
@@ -523,3 +524,8 @@ Makefile.in
/test-tool/libguestfs-test-tool-helper
/test-tool/stamp-libguestfs-test-tool.pod
/tools/virt-*.1
+/v2v/.depend
+/v2v/link.sh
+/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 f3e8556..740b9cf 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1585,6 +1585,8 @@ AC_CONFIG_FILES([run],
[chmod +x,-w run])
AC_CONFIG_FILES([sparsify/link.sh],
[chmod +x,-w sparsify/link.sh])
+AC_CONFIG_FILES([v2v/link.sh],
+ [chmod +x,-w v2v/link.sh])
AC_CONFIG_FILES([Makefile
align/Makefile
@@ -1688,7 +1690,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..b481157 100644
--- a/po/POTFILES
+++ b/po/POTFILES
@@ -318,3 +318,5 @@ src/test-utils.c
src/tmpdirs.c
src/utils.c
test-tool/test-tool.c
+v2v/utils-c.c
+v2v/xml-c.c
diff --git a/po/POTFILES-ml b/po/POTFILES-ml
index 4dce0e5..b48a9de 100644
--- a/po/POTFILES-ml
+++ b/po/POTFILES-ml
@@ -80,3 +80,14 @@ 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/convert_linux_common.ml
+v2v/convert_linux_enterprise.ml
+v2v/convert_linux_grub.ml
+v2v/convert_windows.ml
+v2v/source_libvirt.ml
+v2v/target_local.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..3b50a89
--- /dev/null
+++ b/v2v/Makefile.am
@@ -0,0 +1,163 @@
+# 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_MLI) $(SOURCES_ML) $(SOURCES_C) \
+ virt-v2v.pod
+
+CLEANFILES = *~ *.cmi *.cmo *.cmx *.cmxa *.o virt-v2v
+
+SOURCES_MLI = \
+ convert_linux_common.mli \
+ convert_linux_enterprise.mli \
+ convert_linux_grub.mli \
+ convert_windows.mli \
+ source_libvirt.mli \
+ target_local.mli \
+ types.mli \
+ xml.mli
+
+SOURCES_ML = \
+ types.ml \
+ utils.ml \
+ xml.ml \
+ cmdline.ml \
+ source_libvirt.ml \
+ convert_linux_common.ml \
+ convert_linux_grub.ml \
+ convert_linux_enterprise.ml \
+ convert_windows.ml \
+ target_local.ml \
+ v2v.ml
+
+SOURCES_C = \
+ $(top_builddir)/fish/progress.c \
+ $(top_builddir)/mllib/tty-c.c \
+ $(top_builddir)/mllib/progress-c.c \
+ utils-c.c \
+ xml-c.c
+
+if HAVE_OCAML
+
+bin_PROGRAMS = virt-v2v
+
+virt_v2v_SOURCES = $(SOURCES_C)
+virt_v2v_CFLAGS = \
+ -I. \
+ -I$(top_builddir) \
+ -I$(shell $(OCAMLC) -where) \
+ -I$(top_srcdir)/src \
+ -I$(top_srcdir)/fish \
+ $(LIBXML2_CFLAGS)
+
+BOBJECTS = \
+ $(top_builddir)/mllib/common_gettext.cmo \
+ $(top_builddir)/mllib/common_utils.cmo \
+ $(top_builddir)/mllib/tTY.cmo \
+ $(top_builddir)/mllib/progress.cmo \
+ $(top_builddir)/mllib/config.cmo \
+ $(SOURCES_ML:.ml=.cmo)
+XOBJECTS = $(BOBJECTS:.cmo=.cmx)
+
+# -I $(top_builddir)/src/.libs is a hack which forces corresponding -L
+# option to be passed to gcc, so we don't try linking against an
+# installed copy of libguestfs.
+OCAMLPACKAGES = \
+ -package str,unix \
+ -I $(top_builddir)/src/.libs \
+ -I ../gnulib/lib/.libs \
+ -I $(top_builddir)/ocaml \
+ -I $(top_builddir)/mllib
+if HAVE_OCAML_PKG_GETTEXT
+OCAMLPACKAGES += -package gettext-stub
+endif
+
+OCAMLFLAGS = -g -warn-error CDEFLMPSUVYZX
+
+if !HAVE_OCAMLOPT
+OBJECTS = $(BOBJECTS)
+BEST = c
+OCAMLLINKFLAGS = mlguestfs.cma -custom
+else
+OBJECTS = $(XOBJECTS)
+BEST = opt
+OCAMLLINKFLAGS = mlguestfs.cmxa
+endif
+
+virt_v2v_DEPENDENCIES = $(OBJECTS)
+virt_v2v_LINK = \
+ ./link.sh \
+ $(OCAMLFIND) $(BEST) $(OCAMLFLAGS) $(OCAMLPACKAGES) $(OCAMLLINKFLAGS) \
+ $(OBJECTS) -o $@
+
+.mli.cmi:
+ $(OCAMLFIND) ocamlc $(OCAMLFLAGS) $(OCAMLPACKAGES) -c $< -o $@
+.ml.cmo:
+ $(OCAMLFIND) ocamlc $(OCAMLFLAGS) $(OCAMLPACKAGES) -c $< -o $@
+.ml.cmx:
+ $(OCAMLFIND) ocamlopt $(OCAMLFLAGS) $(OCAMLPACKAGES) -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/README b/v2v/README
new file mode 100644
index 0000000..f57d8f3
--- /dev/null
+++ b/v2v/README
@@ -0,0 +1,23 @@
+Missing features compared to Perl version:
+
+ - virt-p2v
+ - user-custom in virt-v2v.conf to install custom packages (virt-customize?)
+ - Windows support
+ - RHEV-M metadata
+ - testing
+
+Notes on the support matrix for upstream virt-v2v:
+
+- All these in 32- and 64-bit variants.
+
+- All these as Xen HV and PV variants, and ESX guests.
+
+- RHEL 3, 4, 5, 6, 7.
+- RHEL 4.5, 4.8, 5.2, 5.4 - tested particularly because virtio was added
+ between these releases.
+
+- Windows XP, 2000, 2003, 2008.
+
+- SUSE: To do.
+
+- VirtualBox: Not tested.
diff --git a/v2v/cmdline.ml b/v2v/cmdline.ml
new file mode 100644
index 0000000..966fe42
--- /dev/null
+++ b/v2v/cmdline.ml
@@ -0,0 +1,197 @@
+(* 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 output_conn = ref "" in
+ let output_format = ref "" in
+ let output_name = ref "" in
+ let output_storage = 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 output_mode = ref `Libvirt in
+ let set_output_mode = function
+ | "libvirt" -> output_mode := `Libvirt
+ | "local" -> output_mode := `Local
+ | "ovirt" | "rhev" -> output_mode := `RHEV
+ | s ->
+ error (f_"unknown -o option: %s") s
+ in
+
+ let output_alloc = ref `Sparse in
+ let set_output_alloc = function
+ | "sparse" -> output_alloc := `Sparse
+ | "preallocated" -> output_alloc := `Preallocated
+ | s ->
+ error (f_"unknown -oa 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";
+ "-o", Arg.String set_output_mode, "libvirt|local|rhev " ^ s_"Set output mode (default: libvirt)";
+ "-oa", Arg.String set_output_alloc, "sparse|preallocated " ^ s_"Set output allocation mode";
+ "-oc", Arg.Set_string output_conn, "uri " ^ s_"Libvirt URI";
+ "-of", Arg.Set_string output_format, "raw|qcow2 " ^ s_"Set output format";
+ "-on", Arg.Set_string output_name, "name " ^ s_"Rename guest when converting";
+ "-os", Arg.Set_string output_storage, "storage " ^ s_"Set output storage location";
+ "-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 -o local -os /tmp 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 output_alloc = !output_alloc in
+ let output_conn = match !output_conn with "" -> None | s -> Some s in
+ let output_format = match !output_format with "" -> None | s -> Some s in
+ let output_mode = !output_mode in
+ let output_name = match !output_name with "" -> None | s -> Some s in
+ let output_storage = !output_storage 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
+ InputLibvirt (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
+ InputLibvirtXML filename in
+
+ (* Parse the output mode. *)
+ let output =
+ match output_mode with
+ | `Libvirt ->
+ if output_storage <> "" then
+ error (f_"-o libvirt: do not use the -os option");
+ OutputLibvirt output_conn
+ | `Local ->
+ if output_storage = "" then
+ error (f_"-o local: output directory was not specified, use '-os /dir'");
+ let dir_exists =
+ try Sys.is_directory output_storage with Sys_error _ -> false in
+ if not dir_exists then
+ error (f_"-os %s: output directory does not exist or is not a directory")
+ output_storage;
+ OutputLocal output_storage
+ | `RHEV ->
+ if output_storage = "" then
+ error (f_"-o local: output storage was not specified, use '-os'");
+ OutputRHEV output_storage in
+
+ input, output,
+ debug_gc, output_alloc, output_format, output_name,
+ quiet, root_choice, trace, verbose
diff --git a/v2v/convert_linux_common.ml b/v2v/convert_linux_common.ml
new file mode 100644
index 0000000..4922e2f
--- /dev/null
+++ b/v2v/convert_linux_common.ml
@@ -0,0 +1,236 @@
+(* 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
+
+module StringMap = Map.Make (String)
+let keys map = StringMap.fold (fun k _ ks -> k :: ks) map []
+
+(* Wrappers around aug_init & aug_load which can dump out full Augeas
+ * parsing problems when debugging is enabled.
+ *)
+let rec augeas_init verbose g =
+ g#aug_init "/" 1;
+ if verbose then augeas_debug_errors g
+
+and augeas_reload verbose g =
+ g#aug_load ();
+ if verbose then augeas_debug_errors g
+
+and augeas_debug_errors g =
+ try
+ let errors = g#aug_match "/augeas/files//error" in
+ let errors = Array.to_list errors in
+ let map =
+ List.fold_left (
+ fun map error ->
+ let detail_paths = g#aug_match (error ^ "//*") in
+ let detail_paths = Array.to_list detail_paths in
+ List.fold_left (
+ fun map path ->
+ (* path is "/augeas/files/<filename>/error/<field>". Put
+ * <filename>, <field> and the value of this Augeas field
+ * into a map.
+ *)
+ let i = string_find path "/error/" in
+ assert (i >= 0);
+ let filename = String.sub path 13 (i-13) in
+ let field = String.sub path (i+7) (String.length path - (i+7)) in
+
+ let detail = g#aug_get path in
+
+ let fmap : string StringMap.t =
+ try StringMap.find filename map
+ with Not_found -> StringMap.empty in
+ let fmap = StringMap.add field detail fmap in
+ StringMap.add filename fmap map
+ ) map detail_paths
+ ) StringMap.empty errors in
+
+ let filenames = keys map in
+ let filenames = List.sort compare filenames in
+
+ List.iter (
+ fun filename ->
+ printf "augeas failed to parse %s:\n" filename;
+ let fmap = StringMap.find filename map in
+ (try
+ let msg = StringMap.find "message" fmap in
+ printf " error \"%s\"" msg
+ with Not_found -> ()
+ );
+ (try
+ let line = StringMap.find "line" fmap
+ and char = StringMap.find "char" fmap in
+ printf " at line %s char %s" line char
+ with Not_found -> ()
+ );
+ (try
+ let lens = StringMap.find "lens" fmap in
+ printf " in lens %s" lens
+ with Not_found -> ()
+ );
+ printf "\n"
+ ) filenames;
+
+ flush stdout
+ with
+ G.Error msg -> eprintf "%s: augeas: %s (ignored)\n" prog msg
+
+let install verbose g inspect packages =
+ assert false
+
+let remove verbose g inspect packages =
+ if packages <> [] then (
+ let root = inspect.i_root in
+ let package_format = g#inspect_get_package_format root in
+ match package_format with
+ | "rpm" ->
+ let cmd = [ "rpm"; "-e" ] @ packages in
+ let cmd = Array.of_list cmd in
+ ignore (g#command cmd);
+
+ (* Reload Augeas in case anything changed. *)
+ augeas_reload verbose g
+
+ | format ->
+ error (f_"don't know how to remove packages using %s: packages: %s")
+ format (String.concat " " packages)
+ )
+
+let file_owned verbose g inspect file =
+ let root = inspect.i_root in
+ let package_format = g#inspect_get_package_format root in
+ match package_format with
+ | "rpm" ->
+ let cmd = [| "rpm"; "-qf"; file |] in
+ (try ignore (g#command cmd); true with G.Error _ -> false)
+
+ | format ->
+ error (f_"don't know how to find package owner using %s") format
+
+type kernel_info = {
+ base_package : string; (* base package, eg. "kernel-PAE" *)
+ version : string; (* kernel version *)
+ modules : string list; (* list of kernel modules *)
+ arch : string; (* kernel arch *)
+}
+
+(* There was some crazy SUSE stuff going on in the Perl version
+ * of virt-v2v, which I have dropped from this as I couldn't
+ * understand what on earth it was doing. - RWMJ
+ *)
+let inspect_linux_kernel verbose (g : Guestfs.guestfs) inspect path =
+ let root = inspect.i_root in
+
+ let base_package =
+ let package_format = g#inspect_get_package_format root in
+ match package_format with
+ | "rpm" ->
+ let cmd = [| "rpm"; "-qf"; "--qf"; "%{NAME}"; path |] in
+ g#command cmd
+ | format ->
+ error (f_"don't know how to inspect kernel using %s") format in
+
+ (* Try to get kernel version by examination of the binary.
+ * See supermin.git/src/kernel.ml
+ *)
+ let version =
+ try
+ let hdrS = g#pread path 4 514L in
+ if hdrS <> "HdrS" then raise Not_found;
+ let s = g#pread path 2 518L in
+ let s = (Char.code s.[1] lsl 8) lor Char.code s.[0] in
+ if s < 0x1ff then raise Not_found;
+ let offset = g#pread path 2 526L in
+ let offset = (Char.code offset.[1] lsl 8) lor Char.code offset.[0] in
+ if offset < 0 then raise Not_found;
+ let buf = g#pread path (offset + 0x200) 132L in
+ let rec loop i =
+ if i < 132 then (
+ if buf.[i] = '\000' || buf.[i] = ' ' ||
+ buf.[i] = '\t' || buf.[i] = '\n' then
+ String.sub buf 0 i
+ else
+ loop (i+1)
+ )
+ else raise Not_found
+ in
+ let v = loop 0 in
+ (* There must be a corresponding modules directory. *)
+ let modpath = sprintf "/lib/modules/%s" v in
+ if not (g#is_dir modpath) then
+ raise Not_found;
+ Some (v, modpath)
+ with Not_found -> None in
+
+ (* Apparently Xen PV kernels don't contain a version number,
+ * so try to guess the version from the filename.
+ *)
+ let version =
+ match version with
+ | Some v -> Some v
+ | None ->
+ let rex = Str.regexp "^/boot/vmlinuz-\\(.*\\)" in
+ if Str.string_match rex path 0 then (
+ let v = Str.matched_group 1 path in
+ let modpath = sprintf "/lib/modules/%s" v in
+ if g#is_dir modpath then Some (v, modpath) else None
+ )
+ else None in
+
+ (* If we sill didn't find a version, give up here. *)
+ match version with
+ | None -> None
+ | Some (version, modpath) ->
+
+ (* List modules. *)
+ let modules = g#find modpath in
+ let modules = Array.to_list modules in
+ let rex = Str.regexp ".*\\.k?o$" in
+ let modules = List.filter (fun m -> Str.string_match rex m 0) modules in
+
+ assert (List.length modules > 0);
+
+ (* Determine the kernel architecture by looking at the architecture
+ * of an arbitrary kernel module.
+ *)
+ let arch =
+ let any_module = modpath ^ List.hd modules in
+ g#file_architecture any_module in
+
+ (* Just return the module names, without path or extension. *)
+ let rex = Str.regexp ".*/\\([^/]+\\)\\.k?o$/" in
+ let modules = filter_map (
+ fun m ->
+ if Str.string_match rex m 0 then
+ Some (Str.matched_group 1 m)
+ else
+ None
+ ) modules in
+
+ Some { base_package = base_package;
+ version = version;
+ modules = modules;
+ arch = arch }
diff --git a/v2v/convert_linux_common.mli b/v2v/convert_linux_common.mli
new file mode 100644
index 0000000..4ab621a
--- /dev/null
+++ b/v2v/convert_linux_common.mli
@@ -0,0 +1,45 @@
+(* 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.
+ *)
+
+(** Common Linux conversion code. *)
+
+val augeas_init : bool -> Guestfs.guestfs -> unit
+val augeas_reload : bool -> Guestfs.guestfs -> unit
+(** Wrappers around [g#aug_init] and [g#aug_load], which (if verbose)
+ provide additional debugging information about parsing problems
+ that augeas found. *)
+
+val install : bool -> Guestfs.guestfs -> Types.inspect -> string list -> unit
+(** Install package(s) from the list in the guest (or ensure they are
+ installed). *)
+
+val remove : bool -> Guestfs.guestfs -> Types.inspect -> string list -> unit
+(** Uninstall package(s). *)
+
+val file_owned : bool -> Guestfs.guestfs -> Types.inspect -> string -> bool
+(** Returns true if the file is owned by an installed package. *)
+
+type kernel_info = {
+ base_package : string; (* base package, eg. "kernel-PAE" *)
+ version : string; (* kernel version *)
+ modules : string list; (* list of kernel modules *)
+ arch : string; (* kernel arch *)
+}
+
+val inspect_linux_kernel : bool -> Guestfs.guestfs -> Types.inspect -> string -> kernel_info option
+(** Inspect a Linux kernel (by path) and return various information. *)
diff --git a/v2v/convert_linux_enterprise.ml b/v2v/convert_linux_enterprise.ml
new file mode 100644
index 0000000..9496f1a
--- /dev/null
+++ b/v2v/convert_linux_enterprise.ml
@@ -0,0 +1,637 @@
+(* 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.
+ *)
+
+(* Convert various RPM-based Linux enterprise distros. This module
+ * handles:
+ *
+ * - RHEL and derivatives like CentOS and ScientificLinux
+ * - SUSE
+ * - OpenSUSE and Fedora (not enterprisey, but similar enough to RHEL/SUSE)
+ *)
+
+open Printf
+
+open Common_gettext.Gettext
+open Common_utils
+
+open Utils
+open Types
+
+let rec convert ?(keep_serial_console = true) verbose (g : Guestfs.guestfs)
+ ({ i_root = root; i_apps = apps }
+ as inspect) source =
+ let typ = g#inspect_get_type root
+ and distro = g#inspect_get_distro root
+ and arch = g#inspect_get_arch root
+ and major_version = g#inspect_get_major_version root
+ and minor_version = g#inspect_get_minor_version root
+ and package_format = g#inspect_get_package_format root
+ and package_management = g#inspect_get_package_management root in
+
+ assert (typ = "linux");
+
+ let is_rhel_family =
+ (distro = "rhel" || distro = "centos"
+ || distro = "scientificlinux" || distro = "redhat-based")
+
+ and is_suse_family =
+ (distro = "sles" || distro = "suse-based" || distro = "opensuse") in
+
+ let rec clean_rpmdb () =
+ (* Clean RPM database. *)
+ assert (package_format = "rpm");
+ let dbfiles = g#glob_expand "/var/lib/rpm/__db.00?" in
+ let dbfiles = Array.to_list dbfiles in
+ List.iter g#rm_f dbfiles
+
+ and autorelabel () =
+ (* Only do autorelabel if load_policy binary exists. Actually
+ * loading the policy is problematic.
+ *)
+ if g#is_file ~followsymlinks:true "/usr/sbin/load_policy" then
+ g#touch "/.autorelabel";
+
+ and get_grub () =
+ (* Detect if grub2 or grub1 is installed by trying to create
+ * an object of each sort.
+ *)
+ try Convert_linux_grub.grub2 verbose g inspect
+ with Failure grub2_error ->
+ try Convert_linux_grub.grub1 verbose g inspect
+ with Failure grub1_error ->
+ error (f_"no grub configuration found in this guest.
+Grub2 error was: %s
+Grub1/grub-legacy error was: %s")
+ grub2_error grub1_error
+
+ and unconfigure_xen () =
+ (* Remove kmod-xenpv-* (RHEL 3). *)
+ let xenmods =
+ filter_map (
+ fun { G.app2_name = name } ->
+ if name = "kmod-xenpv" || string_prefix name "kmod-xenpv-" then
+ Some name
+ else
+ None
+ ) apps in
+ Convert_linux_common.remove verbose g inspect xenmods;
+
+ (* Undo related nastiness if kmod-xenpv was installed. *)
+ if xenmods <> [] then (
+ (* kmod-xenpv modules may have been manually copied to other kernels.
+ * Hunt them down and destroy them.
+ *)
+ let dirs = g#find "/lib/modules" in
+ let dirs = Array.to_list dirs in
+ let dirs = List.filter (fun s -> string_find s "/xenpv" >= 0) dirs in
+ let dirs = List.map ((^) "/lib/modules/") dirs in
+ let dirs = List.filter g#is_dir dirs in
+
+ (* Check it's not owned by an installed application. *)
+ let dirs = List.filter (
+ fun d -> not (Convert_linux_common.file_owned verbose g inspect d)
+ ) dirs in
+
+ (* Remove any unowned xenpv directories. *)
+ List.iter g#rm_rf dirs;
+
+ (* rc.local may contain an insmod or modprobe of the xen-vbd driver,
+ * added by an installation script.
+ *)
+ (try
+ let lines = g#read_lines "/etc/rc.local" in
+ let lines = Array.to_list lines in
+ let rex = Str.regexp ".*\\b\\(insmod|modprobe\\)\b.*\\bxen-vbd.*" in
+ let lines = List.map (
+ fun s ->
+ if Str.string_match rex s 0 then
+ "#" ^ s
+ else
+ s
+ ) lines in
+ let file = String.concat "\n" lines ^ "\n" in
+ g#write "/etc/rc.local" file
+ with
+ G.Error msg -> eprintf "%s: /etc/rc.local: %s (ignored)\n" prog msg
+ );
+ );
+
+ if is_suse_family then (
+ (* Remove xen modules from INITRD_MODULES and DOMU_INITRD_MODULES. *)
+ let variables = ["INITRD_MODULES"; "DOMU_INITRD_MODULES"] in
+ let xen_modules = ["xennet"; "xen-vnif"; "xenblk"; "xen-vbd"] in
+ let modified = ref false in
+ List.iter (
+ fun var ->
+ List.iter (
+ fun xen_mod ->
+ let expr =
+ sprintf "/file/etc/sysconfig/kernel/%s/value[. = '%s']"
+ var xen_mod in
+ let entries = g#aug_match expr in
+ let entries = Array.to_list entries in
+ if entries <> [] then (
+ List.iter (fun e -> ignore (g#aug_rm e)) entries;
+ modified := true
+ )
+ ) xen_modules
+ ) variables;
+ if !modified then g#aug_save ()
+ );
+
+ and unconfigure_vbox () =
+ (* Uninstall VirtualBox Guest Additions. *)
+ let package_name = "virtualbox-guest-additions" in
+ let has_guest_additions =
+ List.exists (
+ fun { G.app2_name = name } -> name = package_name
+ ) apps in
+ if has_guest_additions then
+ Convert_linux_common.remove verbose g inspect [package_name];
+
+ (* Guest Additions might have been installed from a tarball. The
+ * above code won't detect this case. Look for the uninstall tool
+ * and try running it.
+ *
+ * Note that it's important we do this early in the conversion
+ * process, as this uninstallation script naively overwrites
+ * configuration files with versions it cached prior to
+ * installation.
+ *)
+ let vboxconfig = "/var/lib/VBoxGuestAdditions/config" in
+ if g#is_file ~followsymlinks:true vboxconfig then (
+ let lines = g#read_lines vboxconfig in
+ let lines = Array.to_list lines in
+ let rex = Str.regexp "^INSTALL_DIR=\\(.*\\)$" in
+ let lines = filter_map (
+ fun line ->
+ if Str.string_match rex line 0 then (
+ let vboxuninstall = Str.matched_group 1 line ^ "/uninstall.sh" in
+ Some vboxuninstall
+ )
+ else None
+ ) lines in
+ let lines = List.filter (g#is_file ~followsymlinks:true) lines in
+ match lines with
+ | [] -> ()
+ | vboxuninstall :: _ ->
+ try
+ ignore (g#command [| vboxuninstall |]);
+
+ (* Reload Augeas to detect changes made by vbox tools uninst. *)
+ Convert_linux_common.augeas_reload verbose g
+ with
+ G.Error msg ->
+ eprintf (f_"%s: warning: VirtualBox Guest Additions were detected, but uninstallation failed. The error message was: %s (ignored)")
+ prog msg
+ )
+
+ and unconfigure_vmware () =
+ (* Look for any configured VMware yum repos and disable them. *)
+ let repos =
+ g#aug_match "/files/etc/yum.repos.d/*/*[baseurl =~ regexp('https?://([^/]+\\.)?vmware\\.com/.*')]" in
+ let repos = Array.to_list repos in
+ List.iter (
+ fun repo ->
+ g#aug_set (repo ^ "/enabled") "0";
+ g#aug_save ()
+ ) repos;
+
+ (* Uninstall VMware Tools. *)
+ let remove = ref [] and libraries = ref [] in
+ List.iter (
+ fun { G.app2_name = name } ->
+ if name = "open-vm-tools" then
+ remove := name :: !remove
+ else if string_prefix name "vmware-tools-libraries-" then
+ libraries := name :: !libraries
+ else if string_prefix name "vmware-tools-" then
+ remove := name :: !remove
+ ) apps;
+ let libraries = !libraries in
+
+ (* VMware tools includes 'libraries' packages which provide custom
+ * versions of core functionality. We need to install non-custom
+ * versions of everything provided by these packages before
+ * attempting to uninstall them, or we'll hit dependency
+ * issues.
+ *)
+ if libraries <> [] then (
+ (* We only support removal of libraries on systems which use yum. *)
+ if package_management = "yum" then (
+ List.iter (
+ fun library ->
+ let provides =
+ g#command_lines [| "rpm"; "-q"; "--provides"; library |] in
+ let provides = Array.to_list provides in
+
+ (* The packages provide themselves, filter this out. *)
+ let provides =
+ List.filter (fun s -> string_find s library = -1) provides in
+
+ (* Trim whitespace. *)
+ let rex = Str.regexp "^[ \\t]*\\([^ \\t]+\\)[ \\t]*$" in
+ let provides = List.map (Str.replace_first rex "\\1") provides in
+
+ (* Install the dependencies with yum. Use yum explicitly
+ * because we don't have package names and local install is
+ * impractical. - RWMJ: Not convinced the original Perl code
+ * would work, so I'm just installing the dependencies.
+ *)
+ let cmd = [ "yum"; "install"; "-y" ] @ provides in
+ let cmd = Array.of_list cmd in
+ (try
+ ignore (g#command cmd);
+ remove := library :: !remove
+ with G.Error msg ->
+ eprintf "%s: could not install replacement for %s. Error was: %s. %s was not removed.\n"
+ prog library msg library
+ );
+ ) libraries
+ )
+ );
+
+ let remove = !remove in
+ Convert_linux_common.remove verbose g inspect remove;
+
+ (* VMware Tools may have been installed from a tarball, so the
+ * above code won't remove it. Look for the uninstall tool and run
+ * if present.
+ *)
+ let uninstaller = "/usr/bin/vmware-uninstall-tools.pl" in
+ if g#is_file ~followsymlinks:true uninstaller then (
+ try
+ ignore (g#command [| uninstaller |]);
+
+ (* Reload Augeas to detect changes made by vbox tools uninst. *)
+ Convert_linux_common.augeas_reload verbose g
+ with
+ G.Error msg ->
+ eprintf (f_"%s: warning: VMware tools was detected, but uninstallation failed. The error message was: %s (ignored)")
+ prog msg
+ )
+
+ and unconfigure_citrix () =
+ let pkgs =
+ List.filter (
+ fun { G.app2_name = name } -> string_prefix name "xe-guest-utilities"
+ ) apps in
+ let pkgs = List.map (fun { G.app2_name = name } -> name) pkgs in
+
+ if pkgs <> [] then (
+ Convert_linux_common.remove verbose g inspect pkgs;
+
+ (* Installing these guest utilities automatically unconfigures
+ * ttys in /etc/inittab if the system uses it. We need to put
+ * them back.
+ *)
+ let rex = Str.regexp "^\\([1-6]\\):\\([2-5]+\\):respawn:\\(.*\\)" in
+ let updated = ref false in
+ let rec loop () =
+ let comments = g#aug_match "/files/etc/inittab/#comment" in
+ let comments = Array.to_list comments in
+ match comments with
+ | [] -> ()
+ | commentp :: _ ->
+ let comment = g#aug_get commentp in
+ if Str.string_match rex comment 0 then (
+ let name = Str.matched_group 1 comment in
+ let runlevels = Str.matched_group 2 comment in
+ let process = Str.matched_group 3 comment in
+
+ if string_find process "getty" >= 0 then (
+ updated := true;
+
+ (* Create a new entry immediately after the comment. *)
+ g#aug_insert commentp name false;
+ g#aug_set ("/files/etc/inittab/" ^ name ^ "/runlevels") runlevels;
+ g#aug_set ("/files/etc/inittab/" ^ name ^ "/action") "respawn";
+ g#aug_set ("/files/etc/inittab/" ^ name ^ "/process") process;
+
+ (* Delete the comment node. *)
+ ignore (g#aug_rm commentp);
+
+ (* As the aug_rm invalidates the output of aug_match, we
+ * now have to restart the whole loop.
+ *)
+ loop ()
+ )
+ )
+ in
+ loop ();
+ if !updated then g#aug_save ();
+ )
+
+ and install_virtio () =
+ (* How you install virtio depends on the guest type. Note that most
+ * modern guests already support virtio, so we do nothing for them.
+ * In Perl virt-v2v this was done via a configuration database
+ * (virt-v2v.db). This function returns true if virtio is supported
+ * already or if we managed to install it.
+ *)
+ match distro, major_version, minor_version with
+ (* RHEL 6+ has always supported virtio. *)
+ | ("rhel"|"centos"|"scientificlinux"|"redhat-based"), v, _ when v >= 6 ->
+ true
+ | ("rhel"|"centos"|"scientificlinux"|"redhat-based"), 5, _ ->
+ let kernel = upgrade_package "kernel" (0_l, "2.6.18", "128.el5") in
+ let lvm2 = upgrade_package "lvm2" (0_l, "2.02.40", "6.el5") in
+ let selinux =
+ upgrade_package ~ifinstalled:true
+ "selinux-policy-targeted" (0_l, "2.4.6", "203.el5") in
+ kernel && lvm2 && selinux
+ | ("rhel"|"centos"|"scientificlinux"|"redhat-based"), 4, _ ->
+ upgrade_package "kernel" (0_l, "2.6.9", "89.EL")
+
+ (* All supported Fedora versions support virtio. *)
+ | "fedora", _, _ -> true
+
+ (* SLES 11 supports virtio in the kernel. *)
+ | ("sles"|"suse-based"), v, _ when v >= 11 -> true
+ | ("sles"|"suse-based"), 10, _ ->
+ upgrade_package "kernel" (0_l, "2.6.16.60", "0.85.1")
+
+ (* OpenSUSE. *)
+ | "opensuse", v, _ when v >= 11 -> true
+ | "opensuse", 10, _ ->
+ upgrade_package "kernel" (0_l, "2.6.25.5", "1.1")
+
+ | _ ->
+ eprintf (f_"%s: warning: don't know how to install virtio drivers for %s %d")
+ prog distro major_version;
+ false
+
+ and configure_kernel virtio grub =
+ let kernels = grub#list_kernels () in
+
+ let bootable_kernel =
+ let rec loop =
+ function
+ | [] -> None
+ | path :: paths ->
+ let kernel =
+ Convert_linux_common.inspect_linux_kernel verbose g inspect path in
+ match kernel with
+ | None -> loop paths
+ | Some kernel when is_hv_kernel kernel -> loop paths
+ | Some kernel when virtio && not (supports_virtio kernel) ->
+ loop paths
+ | Some kernel -> Some kernel
+ in
+ loop kernels in
+
+ (* If virtio == true, then a virtio kernel should have been
+ * installed. If we didn't find one, it indicates a bug in
+ * virt-v2v.
+ *)
+ if virtio && bootable_kernel = None then
+ error (f_"virtio configured, but no virtio kernel found");
+
+ (* No bootable kernel was found. Install one. *)
+ let bootable_kernel =
+ match bootable_kernel with
+ | Some k -> k
+ | None ->
+ (* Find which kernel is currently used by the guest. *)
+ let current_kernel =
+ let rec loop = function
+ | [] -> "kernel"
+ | path :: paths ->
+ let kernel =
+ Convert_linux_common.inspect_linux_kernel verbose g inspect
+ path in
+ match kernel with
+ | None -> loop paths
+ | Some kernel -> kernel.Convert_linux_common.base_package
+ in
+ loop kernels in
+
+ (* Replace kernel-xen with a suitable kernel. *)
+ let current_kernel =
+ if string_find current_kernel "kernel-xen" >= 0 then
+ xen_replacement_kernel ()
+ else
+ current_kernel in
+
+ (* Install the kernel. However we need a way to detect the
+ * version of the kernel that has just been installed. A quick
+ * way is to compare /lib/modules before and after.
+ *)
+ let files1 = g#ls "/lib/modules" in
+ let files1 = Array.to_list files1 in
+ Convert_linux_common.install verbose g inspect [current_kernel];
+ let files2 = g#ls "/lib/modules" in
+ let files2 = Array.to_list files2 in
+
+ (* Note that g#ls is guaranteed to return the strings in order. *)
+ let rec loop files1 files2 =
+ match files1, files2 with
+ | [], [] ->
+ error (f_"tried to install '%s', but no kernel package was installed") current_kernel
+ | (v1 :: _), [] ->
+ error (f_"tried to install '%s', but there are now fewer directories under /lib/modules!") current_kernel
+ | [], (v2 :: _) -> v2
+ | (v1 :: _), (v2 :: _) when v1 <> v2 -> v2
+ | (_ :: v1s), (_ :: v2s) -> loop v1s v2s
+ in
+ let version = loop files1 files2 in
+
+ { Convert_linux_common.base_package = current_kernel;
+ version = version; modules = []; arch = "" } in
+
+ (* Set /etc/sysconfig/kernel DEFAULTKERNEL to point to the new
+ * kernel package name.
+ *)
+ if g#is_file ~followsymlinks:true "/etc/sysconfig/kernel" then (
+ let base_package = bootable_kernel.Convert_linux_common.base_package in
+ let paths =
+ g#aug_match "/files/etc/sysconfig/kernel/DEFAULTKERNEL/value" in
+ let paths = Array.to_list paths in
+ List.iter (fun path -> g#aug_set path base_package) paths;
+ g#aug_save ()
+ );
+
+ (* Return the installed kernel version. *)
+ bootable_kernel.Convert_linux_common.version
+
+ and supports_virtio { Convert_linux_common.modules = modules } =
+ List.mem "virtio_blk" modules && List.mem "virtio_net" modules
+
+ (* Is it a hypervisor-specific kernel? *)
+ and is_hv_kernel { Convert_linux_common.modules = modules } =
+ List.mem "xennet" modules (* Xen PV kernel. *)
+
+ (* Find a suitable replacement for kernel-xen. *)
+ and xen_replacement_kernel () =
+ if is_rhel_family then (
+ match major_version, arch with
+ | 5, ("i386"|"i486"|"i586"|"i686") -> "kernel-PAE"
+ | 5, _ -> "kernel"
+ | 4, ("i386"|"i486"|"i586"|"i686") ->
+ (* If guest has >= 10GB of RAM, give it a hugemem kernel. *)
+ if source.s_memory >= 10L *^ 1024L *^ 1024L *^ 1024L then
+ "kernel-hugemem"
+ (* SMP kernel for guests with > 1 vCPU. *)
+ else if source.s_vcpu > 1 then
+ "kernel-smp"
+ else
+ "kernel"
+ | 4, _ ->
+ if source.s_vcpu > 8 then "kernel-largesmp"
+ else if source.s_vcpu > 1 then "kernel-smp"
+ else "kernel"
+ | _, _ -> "kernel"
+ )
+ else if is_suse_family then (
+ match distro, major_version, arch with
+ | "opensuse", _, _ -> "kernel-default"
+ | _, v, ("i386"|"i486"|"i586"|"i686") when v >= 11 ->
+ if source.s_memory >= 10L *^ 1024L *^ 1024L *^ 1024L then
+ "kernel-pae"
+ else
+ "kernel"
+ | _, v, _ when v >= 11 -> "kernel-default"
+ | _, 10, ("i386"|"i486"|"i586"|"i686") ->
+ if source.s_memory >= 10L *^ 1024L *^ 1024L *^ 1024L then
+ "kernel-bigsmp"
+ else if source.s_vcpu > 1 then
+ "kernel-smp"
+ else
+ "kernel-default"
+ | _, 10, _ ->
+ if source.s_vcpu > 1 then
+ "kernel-smp"
+ else
+ "kernel-default"
+ | _ -> "kernel-default"
+ )
+ else
+ "kernel" (* conservative default *)
+
+ (* We configure a console on ttyS0. Make sure existing console
+ * references use it. N.B. Note that the RHEL 6 xen guest kernel
+ * presents a console device called /dev/hvc0, whereas previous xen
+ * guest kernels presented /dev/xvc0. The regular kernel running
+ * under KVM also presents a virtio console device called /dev/hvc0,
+ * so ideally we would just leave it alone. However, RHEL 6 libvirt
+ * doesn't yet support this device so we can't attach to it. We
+ * therefore use /dev/ttyS0 for RHEL 6 anyway.
+ *)
+ and configure_console () =
+ (* Look for gettys using xvc0 or hvc0. RHEL 6 doesn't use inittab
+ * but this still works.
+ *)
+ let paths = g#aug_match "/files/etc/inittab/*/process" in
+ let paths = Array.to_list paths in
+ let rex = Str.regexp "\\(.*\\)\\b\\([xh]vc0\\)\\b\\(.*\\)" in
+ List.iter (
+ fun path ->
+ let proc = g#aug_get path in
+ if Str.string_match rex proc 0 then (
+ let proc = Str.global_replace rex "\\1ttyS0\\3" proc in
+ g#aug_set path proc
+ );
+ ) paths;
+
+ let paths = g#aug_match "/files/etc/securetty/*" in
+ let paths = Array.to_list paths in
+ List.iter (
+ fun path ->
+ let tty = g#aug_get path in
+ if tty = "xvc0" || tty = "hvc0" then
+ g#aug_set path "ttyS0"
+ ) paths;
+
+ g#aug_save ()
+
+ (* If the target doesn't support a serial console, we want to remove
+ * all references to it instead.
+ *)
+ and remove_console () =
+ (* Look for gettys using xvc0 or hvc0. RHEL 6 doesn't use inittab
+ * but this still works.
+ *)
+ let paths = g#aug_match "/files/etc/inittab/*/process" in
+ let paths = Array.to_list paths in
+ let rex = Str.regexp ".*\\b\\([xh]vc0|ttyS0\\)\\b.*" in
+ List.iter (
+ fun path ->
+ let proc = g#aug_get path in
+ if Str.string_match rex proc 0 then
+ ignore (g#aug_rm (path ^ "/.."))
+ ) paths;
+
+ let paths = g#aug_match "/files/etc/securetty/*" in
+ let paths = Array.to_list paths in
+ List.iter (
+ fun path ->
+ let tty = g#aug_get path in
+ if tty = "xvc0" || tty = "hvc0" then
+ ignore (g#aug_rm path)
+ ) paths;
+
+ g#aug_save ()
+
+ (* Upgrade 'pkg' to >= minversion. Returns true if that was possible. *)
+ and upgrade_package ?(ifinstalled = false) name minversion =
+
+
+
+
+
+ (* XXX *)
+ true
+
+
+ in
+
+ clean_rpmdb ();
+ autorelabel ();
+ Convert_linux_common.augeas_init verbose g;
+ let grub = get_grub () in
+
+ unconfigure_xen ();
+ unconfigure_vbox ();
+ unconfigure_vmware ();
+ unconfigure_citrix ();
+
+ let virtio = install_virtio () in
+ let kernel_version = configure_kernel virtio grub in (*XXX*) ignore kernel_version;
+ if keep_serial_console then (
+ configure_console ();
+ grub#configure_console ()
+ ) else (
+ remove_console ();
+ grub#remove_console ()
+ );
+
+
+
+
+
+
+
+
+
+ let guestcaps = {
+ gcaps_block_bus = if virtio then "virtio" else "ide";
+ gcaps_net_bus = if virtio then "virtio" else "e1000";
+ (* XXX display *)
+ } in
+
+ guestcaps
diff --git a/v2v/convert_linux_enterprise.mli b/v2v/convert_linux_enterprise.mli
new file mode 100644
index 0000000..f55ce15
--- /dev/null
+++ b/v2v/convert_linux_enterprise.mli
@@ -0,0 +1,19 @@
+(* 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.
+ *)
+
+val convert : ?keep_serial_console:bool -> bool -> Guestfs.guestfs -> Types.inspect -> Types.source -> Types.guestcaps
diff --git a/v2v/convert_linux_grub.ml b/v2v/convert_linux_grub.ml
new file mode 100644
index 0000000..59dd4f2
--- /dev/null
+++ b/v2v/convert_linux_grub.ml
@@ -0,0 +1,330 @@
+(* 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.
+ *)
+
+module G = Guestfs
+
+open Printf
+
+open Common_gettext.Gettext
+
+open Utils
+open Types
+
+(* Helper function for SUSE: remove (hdX,X) prefix from a path. *)
+let remove_hd_prefix =
+ let rex = Str.regexp "^(hd.*)\\(.*\\)" in
+ Str.replace_first rex "\\1"
+
+(* Helper function to check if guest is EFI. *)
+let check_efi g =
+ if Array.length (g#glob_expand "/boot/efi/EFI/*/grub.cfg") < 1 then
+ raise Not_found;
+
+ (* Check the first partition of each device looking for an EFI
+ * boot partition. We can't be sure which device is the boot
+ * device, so we just check them all.
+ *)
+ let devs = g#list_devices () in
+ let devs = Array.to_list devs in
+ List.find (
+ fun dev ->
+ try g#part_get_gpt_type dev 1 = "C12A7328-F81F-11D2-BA4B-00A0C93EC93B"
+ with G.Error _ -> false
+ ) devs
+
+(* Virtual grub superclass. *)
+class virtual grub verbose (g : Guestfs.guestfs) inspect config_file =
+object
+ method virtual list_kernels : unit -> string list
+
+ method virtual configure_console : unit -> unit
+ method virtual remove_console : unit -> unit
+
+ method private get_default_image () =
+ let cmd =
+ if g#exists "/sbin/grubby" then
+ [| "grubby"; "--default-kernel" |]
+ else
+ [| "/usr/bin/perl"; "-MBootloader::Tools"; "-e"; "
+ InitLibrary();
+ my $default = Bootloader::Tools::GetDefaultSection();
+ print $default->{image};
+ " |] in
+ match g#command cmd with
+ | "" -> None
+ | k ->
+ let len = String.length k in
+ let k =
+ if len > 0 && k.[len-1] = '\n' then String.sub k 0 (len-1) else k in
+ Some (remove_hd_prefix k)
+end
+
+(* Concrete implementation for grub1. *)
+class grub1 verbose g inspect config_file grub_fs =
+object (self)
+ inherit grub verbose g inspect config_file
+
+ method private grub_fs = grub_fs (* grub filesystem prefix *)
+
+ method list_kernels () =
+ let paths =
+ let expr = sprintf "/files%s/title/kernel" config_file in
+ let paths = g#aug_match expr in
+ let paths = Array.to_list paths in
+
+ (* Get the default kernel from grub if it's set. *)
+ let default =
+ let expr = sprintf "/files%s/default" config_file in
+ try
+ let idx = g#aug_get expr in
+ let idx = int_of_string idx in
+ (* Grub indices are zero-based, augeas is 1-based. *)
+ let expr = sprintf "/files%s/title[%d]/kernel" config_file (idx+1) in
+ Some expr
+ with Not_found -> None in
+
+ (* If a default kernel was set, put it at the beginning of the paths
+ * list.
+ *)
+ match default with
+ | None -> paths
+ | Some p -> p :: List.filter ((<>) p) paths in
+
+ (* Remove duplicates. *)
+ let paths =
+ let checked = Hashtbl.create 13 in
+ let rec loop = function
+ | [] -> []
+ | p :: ps when Hashtbl.mem checked p -> ps
+ | p :: ps -> Hashtbl.add checked p true; p :: loop ps
+ in
+ loop paths in
+
+ (* Resolve the Augeas paths to kernel filenames. *)
+ let kernels = List.map g#aug_get paths in
+
+ (* Make sure kernel does not begin with (hdX,X). *)
+ let kernels = List.map remove_hd_prefix kernels in
+
+ (* Prepend grub filesystem. *)
+ let kernels = List.map ((^) grub_fs) kernels in
+
+ (* Check the actual file exists. *)
+ let kernels = List.filter (g#is_file ~followsymlinks:true) kernels in
+
+ kernels
+
+ method configure_console () =
+ let rex = Str.regexp "\\(.*\\)\\b\\([xh]vc0\\)\\b\\(.*\\)" in
+ let expr = sprintf "/files%s/title/kernel/console" config_file in
+
+ let paths = g#aug_match expr in
+ let paths = Array.to_list paths in
+ List.iter (
+ fun path ->
+ let console = g#aug_get path in
+ if Str.string_match rex console 0 then (
+ let console = Str.global_replace rex "\\1ttyS0\\3" console in
+ g#aug_set path console
+ )
+ ) paths;
+
+ g#aug_save ()
+
+ method remove_console () =
+ let rex = Str.regexp "\\(.*\\)\\b\\([xh]vc0\\)\\b\\(.*\\)" in
+ let expr = sprintf "/files%s/title/kernel/console" config_file in
+
+ let rec loop = function
+ | [] -> ()
+ | path :: paths ->
+ let console = g#aug_get path in
+ if Str.string_match rex console 0 then (
+ ignore (g#aug_rm path);
+ (* All the paths are invalid, restart the loop. *)
+ let paths = g#aug_match expr in
+ let paths = Array.to_list paths in
+ loop paths
+ )
+ else
+ loop paths
+ in
+ let paths = g#aug_match expr in
+ let paths = Array.to_list paths in
+ loop paths;
+
+ g#aug_save ()
+
+end
+
+(* Create a grub1 object. *)
+let rec grub1 verbose (g : Guestfs.guestfs) inspect =
+ let root = inspect.i_root in
+
+ (* Look for a grub configuration file. *)
+ let config_file =
+ try
+ List.find (
+ fun file -> g#is_file ~followsymlinks:true file
+ ) ["/boot/grub/menu.lst"; "/boot/grub/grub.conf"]
+ with
+ Not_found ->
+ failwith (s_"no grub/grub1/grub-legacy configuration file was found") in
+
+ (* Check for EFI and convert if found. *)
+ (try let dev = check_efi g in grub1_convert_from_efi verbose g dev
+ with Not_found -> ()
+ );
+
+ (* Find the path that has to be prepended to filenames in grub.conf
+ * in order to make them absolute.
+ *)
+ let grub_fs =
+ let mounts = g#inspect_get_mountpoints root in
+ try
+ List.find (
+ fun path -> List.mem_assoc path mounts
+ ) [ "/boot/grub"; "/boot" ]
+ with Not_found -> "" in
+
+ (* Ensure Augeas is reading the grub configuration file, and if not
+ * then add it.
+ *)
+ let () =
+ let incls = g#aug_match "/augeas/load/Grub/incl" in
+ let incls = Array.to_list incls in
+ let incls_contains_conf =
+ List.exists (fun incl -> g#aug_get incl = config_file) incls in
+ if not incls_contains_conf then (
+ g#aug_set "/augeas/load/Grub/incl[last()+1]" config_file;
+ Convert_linux_common.augeas_reload verbose g;
+ ) in
+
+ new grub1 verbose g inspect config_file grub_fs
+
+(* Reinstall grub. *)
+and grub1_convert_from_efi verbose g dev =
+ g#cp "/etc/grub.conf" "/boot/grub/grub.conf";
+ g#ln_sf "/boot/grub/grub.conf" "/etc/grub.conf";
+
+ (* Reload Augeas to pick up new location of grub.conf. *)
+ Convert_linux_common.augeas_reload verbose g;
+
+ ignore (g#command [| "grub-install"; dev |])
+
+(* Concrete implementation for grub2. *)
+class grub2 verbose g inspect config_file =
+object (self)
+ inherit grub verbose g inspect config_file
+
+ method list_kernels () =
+ let files =
+ (match self#get_default_image () with
+ | None -> []
+ | Some k -> [k]) @
+ (* This is how the grub2 config generator enumerates kernels. *)
+ Array.to_list (g#glob_expand "/boot/kernel-*") @
+ Array.to_list (g#glob_expand "/boot/vmlinuz-*") @
+ Array.to_list (g#glob_expand "/vmlinuz-*") in
+ let rex = Str.regexp ".*\\.\\(dpkg-.*|rpmsave|rpmnew\\)$" in
+ let files = List.filter (
+ fun file -> not (Str.string_match rex file 0)
+ ) files in
+ files
+
+ method private update_console ~remove =
+ let rex = Str.regexp "\\(.*\\)\\bconsole=[xh]vc0\\b\\(.*\\)" in
+
+ let grub_cmdline_expr =
+ if g#exists "/etc/sysconfig/grub" then
+ "/files/etc/sysconfig/grub/GRUB_CMDLINE_LINUX"
+ else
+ "/files/etc/default/grub/GRUB_CMDLINE_LINUX_DEFAULT" in
+
+ (try
+ let grub_cmdline = g#aug_get grub_cmdline_expr in
+ let grub_cmdline =
+ if Str.string_match rex grub_cmdline 0 then (
+ if remove then
+ Str.global_replace rex "\\1\\3" grub_cmdline
+ else
+ Str.global_replace rex "\\1console=ttyS0\\3" grub_cmdline
+ )
+ else grub_cmdline in
+ g#aug_set grub_cmdline_expr grub_cmdline;
+ g#aug_save ();
+
+ ignore (g#command [| "grub2-mkconfig"; "-o"; config_file |])
+ with
+ G.Error msg ->
+ eprintf (f_"%s: warning: could not update grub2 console: %s (ignored)\n")
+ prog msg
+ )
+
+ method configure_console () = self#update_console ~remove:false
+ method remove_console () = self#update_console ~remove:true
+end
+
+let rec grub2 verbose (g : Guestfs.guestfs) inspect =
+ (* Look for a grub2 configuration file. *)
+ let config_file = "/boot/grub2/grub.cfg" in
+ if not (g#is_file ~followsymlinks:true config_file) then (
+ let msg =
+ sprintf (f_"no grub2 configuration file was found (expecting %s)")
+ config_file in
+ failwith msg
+ );
+
+ (* Check for EFI and convert if found. *)
+ (try
+ let dev = check_efi g in
+ grub2_convert_from_efi verbose g inspect dev
+ with Not_found -> ()
+ );
+
+ new grub2 verbose g inspect config_file
+
+(* For grub2:
+ * - Turn the EFI partition into a BIOS Boot Partition
+ * - Remove the former EFI partition from fstab
+ * - Install the non-EFI version of grub
+ * - Install grub2 in the BIOS Boot Partition
+ * - Regenerate grub.cfg
+ *)
+and grub2_convert_from_efi verbose g inspect dev =
+ (* EFI systems boot using grub2-efi, and probably don't have the
+ * base grub2 package installed.
+ *)
+ Convert_linux_common.install verbose g inspect ["grub2"];
+
+ (* Relabel the EFI boot partition as a BIOS boot partition. *)
+ g#part_set_gpt_type dev 1 "21686148-6449-6E6F-744E-656564454649";
+
+ (* Delete the fstab entry for the EFI boot partition. *)
+ let nodes = g#aug_match "/files/etc/fstab/*[file = '/boot/efi']" in
+ let nodes = Array.to_list nodes in
+ List.iter (fun node -> ignore (g#aug_rm node)) nodes;
+ g#aug_save ();
+
+ (* Install grub2 in the BIOS boot partition. This overwrites the
+ * previous contents of the EFI boot partition.
+ *)
+ ignore (g#command [| "grub2-install"; dev |]);
+
+ (* Re-generate the grub2 config, and put it in the correct place *)
+ ignore (g#command [| "grub2-mkconfig"; "-o"; "/boot/grub2/grub.cfg" |])
diff --git a/v2v/convert_linux_grub.mli b/v2v/convert_linux_grub.mli
new file mode 100644
index 0000000..324a333
--- /dev/null
+++ b/v2v/convert_linux_grub.mli
@@ -0,0 +1,43 @@
+(* 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.
+ *)
+
+(** Common code handling grub1 (grub-legacy) and grub2 operations. *)
+
+class type virtual grub = object
+ method virtual list_kernels : unit -> string list
+ (** Return a list of kernels from the grub configuration. The
+ returned list is a list of filenames. *)
+ method virtual configure_console : unit -> unit
+ (** Reconfigure the grub console. *)
+ method virtual remove_console : unit -> unit
+ (** Remove the grub console configuration. *)
+end
+
+val grub1 : bool -> Guestfs.guestfs -> Types.inspect -> grub
+(** Detect if grub1/grub-legacy is used by this guest and return a
+ grub object if so.
+
+ This raises [Failure] if grub1 is not used by this guest or some
+ other problem happens. *)
+
+val grub2 : bool -> Guestfs.guestfs -> Types.inspect -> grub
+(** Detect if grub2 is used by this guest and return a grub object
+ if so.
+
+ This raises [Failure] if grub2 is not used by this guest or some
+ other problem happens. *)
diff --git a/v2v/convert_windows.ml b/v2v/convert_windows.ml
new file mode 100644
index 0000000..e5d1ea8
--- /dev/null
+++ b/v2v/convert_windows.ml
@@ -0,0 +1,22 @@
+(* 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.
+ *)
+
+(* Convert Windows guests. *)
+
+let convert verbose g inspect =
+ assert false
diff --git a/v2v/convert_windows.mli b/v2v/convert_windows.mli
new file mode 100644
index 0000000..d1e60fe
--- /dev/null
+++ b/v2v/convert_windows.mli
@@ -0,0 +1,19 @@
+(* 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.
+ *)
+
+val convert : bool -> Guestfs.guestfs -> Types.inspect -> Types.guestcaps
diff --git a/v2v/link.sh.in b/v2v/link.sh.in
new file mode 100644
index 0000000..9e5684b
--- /dev/null
+++ b/v2v/link.sh.in
@@ -0,0 +1,22 @@
+# libguestfs Makefile.am
+# @configure_input@
+# (C) Copyright 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., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+# Hack automake to link binary properly. There is no other way to add
+# the -cclib parameter to the end of the command line.
+
+exec "$@" -linkpkg -cclib '-lutils -lncurses @LIBXML2_LIBS@ -lgnu'
diff --git a/v2v/source_libvirt.ml b/v2v/source_libvirt.ml
new file mode 100644
index 0000000..bdea8d4
--- /dev/null
+++ b/v2v/source_libvirt.ml
@@ -0,0 +1,118 @@
+(* 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
+
+ (* XXX Much more metadata needs to be collected here:
+ * - graphics
+ * - cdroms
+ * - floppies
+ * - network interfaces
+ * See: lib/Sys/VirtConvert/Connection/LibVirt.pm
+ *)
+
+ {
+ 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/target_local.ml b/v2v/target_local.ml
new file mode 100644
index 0000000..ed4e5e3
--- /dev/null
+++ b/v2v/target_local.ml
@@ -0,0 +1,86 @@
+(* 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 initialize dir overlays =
+ List.map (
+ fun ov ->
+ let target_file = dir // "disk-" ^ ov.ov_sd in
+ { ov with ov_target_file = target_file; ov_target_file_tmp = target_file }
+ ) overlays
+
+let create_metadata dir source overlays guestcaps =
+ let name = source.s_name in
+ let file = dir // name ^ ".xml" in
+
+ let chan = open_out file in
+ let p fs = fprintf chan fs in
+
+ p "<domain type='%s'>\n" "kvm"; (* Always assume target is kvm? *)
+ p " <name>%s</name>\n" name;
+ let memory_k = source.s_memory /^ 1024L in
+ p " <memory unit='KiB'>%Ld</memory>\n" memory_k;
+ p " <currentMemory unit='KiB'>%Ld</currentMemory>\n" memory_k;
+ p " <vcpu>%d</vcpu>\n" source.s_vcpu;
+ p " <os>\n";
+ p " <type arch='%s'>hvm</type>\n" source.s_arch;
+ p " </os>\n";
+ p " <features>\n";
+ List.iter (p " <%s/>\n") source.s_features;
+ p " </features>\n";
+
+ p " <on_poweroff>destroy</on_poweroff>\n";
+ p " <on_reboot>restart</on_reboot>\n";
+ p " <on_crash>restart</on_crash>\n";
+ p " <devices>\n";
+
+ let block_prefix =
+ if guestcaps.gcaps_block_bus = "virtio" then "vd" else "hd" in
+ iteri (
+ fun i ov ->
+ p " <disk type='file' device='disk'>\n";
+ p " <driver name='qemu' type='%s' cache='none'/>\n"
+ ov.ov_target_format;
+ p " <source file='%s'/>\n" (xml_quote_attr ov.ov_target_file);
+ p " <target dev='%s%s' bus='%s'/>\n"
+ block_prefix (drive_name i) guestcaps.gcaps_block_bus;
+ p " </disk>\n";
+ ) overlays;
+
+ p " <input type='tablet' bus='usb'/>\n";
+ p " <input type='mouse' bus='ps2'/>\n";
+ p " <console type='pty'/>\n";
+
+ (* XXX Missing here from old virt-v2v:
+ <video/>
+ <graphics/>
+ cdroms and floppies
+ network interfaces
+ See: lib/Sys/VirtConvert/Connection/LibVirtTarget.pm
+ *)
+
+ p "</domain>\n";
+
+ close_out chan
diff --git a/v2v/target_local.mli b/v2v/target_local.mli
new file mode 100644
index 0000000..1833ecb
--- /dev/null
+++ b/v2v/target_local.mli
@@ -0,0 +1,21 @@
+(* 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.
+ *)
+
+val initialize : string -> Types.overlay list -> Types.overlay list
+
+val create_metadata : string -> Types.source -> Types.overlay list -> Types.guestcaps -> unit
diff --git a/v2v/types.ml b/v2v/types.ml
new file mode 100644
index 0000000..0f5ae86
--- /dev/null
+++ b/v2v/types.ml
@@ -0,0 +1,84 @@
+(* 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
+
+(* Types. See types.mli for documentation. *)
+
+type input =
+| InputLibvirt of string option * string
+| InputLibvirtXML of string
+
+type output =
+| OutputLibvirt of string option
+| OutputLocal of string
+| OutputRHEV 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
+
+type overlay = {
+ ov_overlay : string;
+ ov_target_file : string;
+ ov_target_file_tmp : string;
+ ov_target_format : string;
+ ov_sd : string;
+ ov_virtual_size : int64;
+ ov_preallocation : string option;
+ ov_source_file : string;
+ ov_source_format : string option;
+}
+
+let string_of_overlay ov =
+ sprintf "\
+ov_overlay = %s
+ov_target_file = %s
+ov_target_file_tmp = %s
+ov_target_format = %s
+ov_sd = %s
+ov_virtual_size = %Ld
+ov_preallocation = %s
+ov_source_file = %s
+ov_source_format = %s
+"
+ ov.ov_overlay
+ ov.ov_target_file ov.ov_target_file_tmp
+ ov.ov_target_format
+ ov.ov_sd
+ ov.ov_virtual_size
+ (match ov.ov_preallocation with None -> "None" | Some s -> s)
+ ov.ov_source_file
+ (match ov.ov_source_format with None -> "None" | Some s -> s)
+
+type inspect = {
+ i_root : string;
+ i_apps : Guestfs.application2 list;
+}
+
+type guestcaps = {
+ gcaps_block_bus : string;
+ gcaps_net_bus : string;
+}
diff --git a/v2v/types.mli b/v2v/types.mli
new file mode 100644
index 0000000..e7e72e0
--- /dev/null
+++ b/v2v/types.mli
@@ -0,0 +1,77 @@
+(* 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 =
+| InputLibvirt of string option * string (* -i libvirt: -ic + guest name *)
+| InputLibvirtXML of string (* -i libvirtxml: XML file name *)
+(** The input arguments as specified on the command line. *)
+
+type output =
+| OutputLibvirt of string option (* -o libvirt: -oc *)
+| OutputLocal of string (* -o local: directory *)
+| OutputRHEV of string (* -o rhev: output storage *)
+(** The output 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. *)
+
+type overlay = {
+ ov_overlay : string; (** Local overlay file (qcow2 format). *)
+ ov_target_file : string; (** Destination file (real). *)
+ ov_target_file_tmp : string; (** Destination file (temporary). *)
+ ov_target_format : string; (** Destination format (eg. -of option). *)
+ ov_sd : string; (** sdX libguestfs name of disk. *)
+ ov_virtual_size : int64; (** Virtual disk size in bytes. *)
+ ov_preallocation : string option; (** ?preallocation option. *)
+
+ (* Note: the next two fields are for information only and must not
+ * be opened/copied/etc.
+ *)
+ ov_source_file : string; (** qemu URI for source file. *)
+ ov_source_format : string option; (** Source file format, if known. *)
+}
+(** Disk overlays and destination disks. *)
+
+val string_of_overlay : overlay -> string
+
+type inspect = {
+ i_root : string; (** Root device. *)
+ i_apps : Guestfs.application2 list; (** Packages installed. *)
+}
+(** Inspection information. Only the applications list is stored here
+ as that is the only one which is slow/inconvenient to fetch. *)
+
+type guestcaps = {
+ gcaps_block_bus : string; (** "virtio", "ide", possibly others *)
+ gcaps_net_bus : string; (** "virtio", "e1000", possibly others *)
+ (* XXX acpi, display *)
+}
+(** Guest capabilities after conversion. eg. Was virtio found or installed? *)
diff --git a/v2v/utils-c.c b/v2v/utils-c.c
new file mode 100644
index 0000000..f6a5d74
--- /dev/null
+++ b/v2v/utils-c.c
@@ -0,0 +1,43 @@
+/* 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.
+ */
+
+#include <config.h>
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
+
+#include "guestfs.h"
+#include "guestfs-internal-frontend.h"
+
+value
+v2v_utils_drive_name (value indexv)
+{
+ CAMLparam1 (indexv);
+ CAMLlocal1 (namev);
+ char name[64];
+
+ guestfs___drive_name (Int_val (indexv), name);
+ namev = caml_copy_string (name);
+
+ CAMLreturn (namev);
+}
diff --git a/v2v/utils.ml b/v2v/utils.ml
new file mode 100644
index 0000000..6155f9a
--- /dev/null
+++ b/v2v/utils.ml
@@ -0,0 +1,44 @@
+(* 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
+
+(* Quote XML <element attr='...'> content. Note you must use single
+ * quotes around the attribute.
+ *)
+let xml_quote_attr str =
+ let str = Common_utils.replace_str str "&" "&" in
+ let str = Common_utils.replace_str str "'" "'" in
+ let str = Common_utils.replace_str str "<" "<" in
+ let str = Common_utils.replace_str str ">" ">" in
+ str
+
+external drive_name : int -> string = "v2v_utils_drive_name"
+
diff --git a/v2v/v2v.ml b/v2v/v2v.ml
new file mode 100644
index 0000000..e21cb79
--- /dev/null
+++ b/v2v/v2v.ml
@@ -0,0 +1,353 @@
+(* 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 input, output,
+ debug_gc, output_alloc, output_format, output_name,
+ quiet, root_choice, trace, verbose =
+ Cmdline.parse_cmdline () in
+
+ let msg fs = make_message_function ~quiet fs in
+
+ let source =
+ match input with
+ | InputLibvirt (libvirt_uri, guest) ->
+ Source_libvirt.create libvirt_uri guest
+ | InputLibvirtXML 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
+ unlink_on_exit overlay;
+
+ 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, qemu_uri, format
+ ) source.s_disks in
+
+ (* Open the guestfs handle. *)
+ msg (f_"Opening the overlay");
+ let g = new G.guestfs () in
+ g#set_trace trace;
+ g#set_verbose verbose;
+ g#set_network true;
+ List.iter (
+ fun (overlay, _, _) ->
+ g#add_drive_opts overlay
+ ~format:"qcow2" ~cachemode:"unsafe" ~discard:"besteffort"
+ ) overlays;
+
+ g#launch ();
+
+ (* Work out where we will write the final output. Do this early
+ * just so we can display errors to the user before doing too much
+ * work.
+ *)
+ let overlays =
+ initialize_target g output output_alloc output_format overlays in
+
+ (* Inspection - this also mounts up the filesystems. *)
+ msg (f_"Inspecting the overlay");
+ let inspect = inspect_source g root_choice in
+
+ (* Conversion. *)
+ let guestcaps =
+ let root = inspect.i_root in
+
+ (match g#inspect_get_product_name root with
+ | "unknown" ->
+ msg (f_"Converting the guest to run on KVM")
+ | prod ->
+ msg (f_"Converting %s to run on KVM") prod
+ );
+
+ match g#inspect_get_type root with
+ | "linux" ->
+ (match g#inspect_get_distro root with
+ | "fedora"
+ | "rhel" | "centos" | "scientificlinux" | "redhat-based"
+ | "sles" | "suse-based" | "opensuse" ->
+
+ (* RHEV doesn't support serial console so remove any on conversion. *)
+ let keep_serial_console =
+ match output with
+ | OutputRHEV _ -> Some false
+ | OutputLibvirt _ | OutputLocal _ -> None in
+
+ Convert_linux_enterprise.convert ?keep_serial_console
+ verbose g inspect source
+
+ | distro ->
+ error (f_"virt-v2v is unable to convert this guest type (linux/distro=%s)") distro
+ );
+
+ | "windows" -> Convert_windows.convert verbose g inspect
+
+ | typ ->
+ error (f_"virt-v2v is unable to convert this guest type (type=%s)") typ in
+
+ (* Trim the filesystems to reduce transfer size. *)
+ msg (f_"Trimming filesystems to reduce amount of data to copy");
+ let () =
+ let mps = g#mountpoints () in
+ List.iter (
+ fun (_, mp) ->
+ try g#fstrim mp
+ with G.Error msg -> eprintf "%s: %s (ignored)\n" mp msg
+ ) mps in
+
+ msg (f_"Closing the overlay");
+ g#umount_all ();
+ g#shutdown ();
+ g#close ();
+
+ (* Copy the source to the output. *)
+ let delete_target_on_exit = ref true in
+ at_exit (fun () ->
+ if !delete_target_on_exit then (
+ List.iter (
+ fun ov -> try Unix.unlink ov.ov_target_file_tmp with _ -> ()
+ ) overlays
+ )
+ );
+ let nr_overlays = List.length overlays in
+ iteri (
+ fun i ov ->
+ msg (f_"Copying disk %d/%d to %s (%s)")
+ (i+1) nr_overlays ov.ov_target_file ov.ov_target_format;
+ if verbose then printf "%s\n%!" (string_of_overlay ov);
+
+ (* It turns out that libguestfs's disk creation code is
+ * considerably more flexible and easier to use than qemu-img, so
+ * create the disk explicitly using libguestfs then pass the
+ * 'qemu-img convert -n' option so qemu reuses the disk.
+ *)
+ let preallocation = ov.ov_preallocation in
+ let compat =
+ match ov.ov_target_format with "qcow2" -> Some "1.1" | _ -> None in
+ (new G.guestfs ())#disk_create ov.ov_target_file_tmp
+ ov.ov_target_format ov.ov_virtual_size ?preallocation ?compat;
+
+ let cmd =
+ sprintf "qemu-img convert -n -f qcow2 -O %s %s %s"
+ (quote ov.ov_target_format) (quote ov.ov_overlay)
+ (quote ov.ov_target_file_tmp) in
+ if verbose then printf "%s\n%!" cmd;
+ if Sys.command cmd <> 0 then
+ error (f_"qemu-img command failed, see earlier errors");
+ ) overlays;
+
+ (* Create output metadata. *)
+ msg (f_"Creating output metadata");
+ let () =
+ (* Are we going to rename the guest? *)
+ let renamed_source =
+ match output_name with
+ | None -> source
+ | Some name -> { source with s_name = name } in
+ match output with
+ | OutputLibvirt oc -> assert false
+ | OutputLocal dir ->
+ Target_local.create_metadata dir renamed_source overlays guestcaps
+ | OutputRHEV os -> assert false in
+
+ (* If we wrote to a temporary file, rename to the real file. *)
+ List.iter (
+ fun ov ->
+ if ov.ov_target_file_tmp <> ov.ov_target_file then
+ rename ov.ov_target_file_tmp ov.ov_target_file
+ ) overlays;
+
+ delete_target_on_exit := false;
+
+ msg (f_"Finishing off");
+
+ if debug_gc then
+ Gc.compact ()
+
+and initialize_target g output output_alloc output_format overlays =
+ let overlays =
+ mapi (
+ fun i (overlay, qemu_uri, backing_format) ->
+ (* Grab the virtual size of each disk. *)
+ let sd = "sd" ^ drive_name i in
+ let dev = "/dev/" ^ sd in
+ let vsize = g#blockdev_getsize64 dev in
+
+ (* What output format should we use? *)
+ let format =
+ match output_format, backing_format with
+ | Some format, _ -> format (* -of overrides everything *)
+ | None, Some format -> format (* same as backing format *)
+ | None, None ->
+ error (f_"disk %s (%s) has no defined format, you have to either define the original format in the source metadata, or use the '-of' option to force the output format") sd qemu_uri in
+
+ (* What output preallocation mode should we use? *)
+ let preallocation =
+ match format, output_alloc with
+ | "raw", `Sparse -> Some "sparse"
+ | "raw", `Preallocated -> Some "full"
+ | "qcow2", `Sparse -> Some "off" (* ? *)
+ | "qcow2", `Preallocated -> Some "metadata"
+ | _ -> None (* ignore -oa flag for other formats *) in
+
+ { ov_overlay = overlay;
+ ov_target_file = ""; ov_target_file_tmp = "";
+ ov_target_format = format;
+ ov_sd = sd; ov_virtual_size = vsize; ov_preallocation = preallocation;
+ ov_source_file = qemu_uri; ov_source_format = backing_format; }
+ ) overlays in
+ let overlays =
+ match output with
+ | OutputLibvirt oc -> assert false
+ | OutputLocal dir -> Target_local.initialize dir overlays
+ | OutputRHEV os -> assert false in
+ overlays
+
+and inspect_source g root_choice =
+ let roots = g#inspect_os () in
+ let roots = Array.to_list roots in
+
+ let root =
+ 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) in
+
+ (* Reject this OS if it doesn't look like an installed image. *)
+ let () =
+ let fmt = g#inspect_get_format root in
+ if fmt <> "installed" then
+ error (f_"libguestfs thinks this is not an installed operating system (it might be, for example, an installer disk or live CD). If this is wrong, it is probably a bug in libguestfs. root=%s fmt=%s") root fmt in
+
+ (* Mount up the filesystems. *)
+ 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 dev mp
+ with G.Error msg -> eprintf "%s (ignored)\n" msg
+ ) mps;
+
+ (* Get list of applications/packages installed. *)
+ let apps = g#inspect_list_applications2 root in
+ let apps = Array.to_list apps in
+
+ { i_root = root; i_apps = apps; }
+
+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..138e73b
--- /dev/null
+++ b/v2v/virt-v2v.pod
@@ -0,0 +1,301 @@
+=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 -o local -os /tmp 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<-i libvirt>
+
+Set the input method to I<libvirt>. This is the default.
+
+In this mode you have to specify a libvirt guest name on the command
+line. You may also specify a libvirt connection URI (see I<-ic>).
+
+=item B<-i libvirtxml>
+
+Set the input method to I<libvirtxml>.
+
+In this mode you have to pass a libvirt XML file on the command line.
+This file is read in order to get metadata about the source guest
+(such as its name, amount of memory), and also to locate the input
+disks.
+
+=item B<-ic> libvirtURI
+
+Specify a libvirt connection URI to use when reading the guest. This
+is only used when S<I<-i libvirt>>.
+
+Only local libvirt connections and ESX connections can be used.
+Remote libvirt connections will not work in general.
+
+=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<-o libvirt>
+
+Set the output method to I<libvirt>. This is the default.
+
+In this mode, the converted guest is created as a libvirt guest. You
+may also specify a libvirt connection URI (see I<-oc>).
+
+=item B<-o local>
+
+Set the output method to I<local>.
+
+In this mode, the converted guest is written to a local directory
+specified by I<-os /dir> (the directory must exist). The converted
+guest's disks are written as:
+
+ /dir/disk-sda
+ /dir/disk-sdb
+ [etc]
+
+and a libvirt XML file is created containing guest metadata
+(C</dir/name.xml>, where C<name> is the guest name).
+
+=item B<-o rhev>
+
+Set the output method to I<rhev>.
+
+The converted guest is written to a RHEV Export Storage Domain. The
+I<-os> parameter must also be used to specify the location of the
+Export Storage Domain. Note this does not actually import the guest
+into RHEV. You have to do that manually later using the UI.
+
+=item B<-oa sparse>
+
+=item B<-oa preallocated>
+
+Set the output file allocation mode. The default is C<sparse>.
+
+=item B<-oc> libvirtURI
+
+Specify a libvirt connection to use when writing the converted guest.
+This is only used when S<I<-o libvirt>>.
+
+Only local libvirt connections can be used. Remote libvirt
+connections will not work.
+
+=item B<-of> format
+
+When converting the guest, convert the disks to the given format.
+
+If not specified, then the input format is used.
+
+=item B<-on> name
+
+Rename the guest when converting it. If this option is not used then
+the output name is the same as the input name.
+
+=item B<-os> storage
+
+The location of the storage for the converted guest.
+
+For I<-o libvirt>, this is a libvirt pool (see S<C<virsh pool-list>>).
+
+For I<-o local>, this is a directory name. The directory must exist.
+
+For I<-o rhev>, this is an NFS path of the form
+C<E<lt>hostE<gt>:E<lt>pathE<gt>>, eg:
+
+ rhev-storage.example.com:/rhev/export
+
+The NFS export must be mountable and writable by the user and host
+running virt-v2v, since the virt-v2v program has to actually mount it
+when it runs.
+
+=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
10 years, 7 months