devices_to_send : string list option;
root_filesystem : partition option;
hypervisor : hypervisor option;
- architecture : string option;
+ architecture : architecture option;
memory : int option; vcpus : int option;
mac_address : string option;
}
and partition = Part of string * string (* eg. "hda", "1" *)
| LV of string * string (* eg. "VolGroup00", "LogVol00" *)
and hypervisor = Xen | QEMU | KVM
+and architecture = I386 | X86_64 | IA64 | PPC | PPC64 | SPARC | SPARC64
+ | OtherArch of string | UnknownArch
(*----------------------------------------------------------------------*)
(* TO MAKE A CUSTOM virt-p2v SCRIPT, adjust the defaults in this section.
(* Hypervisor: Set to 'Some Xen', 'Some QEMU' or 'Some KVM'. *)
hypervisor = None;
- (* Architecture: Set to 'Some "x86_64"' (or another architecture).
- * If set to 'Some ""' then we try to autodetect the right architecture.
+ (* Architecture: Set to 'Some X86_64' (or another architecture).
+ * If set to 'Some UnknownArch' then we try to autodetect the
+ * right architecture.
*)
architecture = None;
| Part (dev, partnum) -> sprintf "/dev/%s%s" dev partnum
| LV (vg, lv) -> sprintf "/dev/%s/%s" vg lv
+let string_of_architecture = function
+ | I386 -> "i386"
+ | X86_64 -> "x86_64"
+ | IA64 -> "ia64"
+ | PPC -> "ppc"
+ | PPC64 -> "ppc64"
+ | SPARC -> "sparc"
+ | SPARC64 -> "sparc64"
+ | OtherArch arch -> arch
+ | UnknownArch -> ""
+
type dialog_status = Yes of string list | No | Help | Back | Error
type ask_result = Next of state | Prev | Ask_again
+type nature = LinuxSwap
+ | LinuxRoot of architecture * linux_distro
+ | WindowsRoot (* Windows C: *)
+ | LinuxBoot (* Linux /boot *)
+ | NotRoot (* mountable, but not / or /boot *)
+ | UnknownNature
+and linux_distro = RHEL of int * int
+ | Fedora of int
+ | Debian of int * int
+ | OtherLinux
+
+let rec string_of_nature = function
+ | LinuxSwap -> "Linux swap"
+ | LinuxRoot (architecture, distro) ->
+ string_of_linux_distro distro ^ " " ^ string_of_architecture architecture
+ | WindowsRoot -> "Windows root"
+ | LinuxBoot -> "Linux /boot"
+ | NotRoot -> "Mountable non-root"
+ | UnknownNature -> "Unknown"
+and string_of_linux_distro = function
+ | RHEL (a,b) -> sprintf "RHEL %d.%d" a b
+ | Fedora v -> sprintf "Fedora %d" v
+ | Debian (a,b) -> sprintf "Debian %d.%d" a b
+ | OtherLinux -> "Linux"
+
(* Dialog functions.
*
* Each function takes some common parameters (eg. ~title) and some
close fd);
printf "virt-p2v.ml starting up ...\n%!";
+ (* Check that the environment is a sane-looking live CD. If not, bail. *)
+ if is_dir "/mnt/root" <> Some true then
+ fail_dialog
+ "You should only run this script from the live CD or a USB key.";
+
+ printf "virt-p2v.ml detecting hard drives (this may take some time) ...\n%!";
+
(* Search for all non-removable block devices. Do this early and bail
* if we can't find anything. This is a list of strings, like "hda".
*)
(* Concatenate LVs & Parts *)
lvs @ parts in
+ (* Try to determine the nature of each partition.
+ * Root? Swap? Architecture? etc.
+ *)
+ let all_partitions : (partition * nature) list =
+ (* Output of 'file' command for Linux swap file. *)
+ let swap = Pcre.regexp "Linux.*swap.*file" in
+ (* Contents of /etc/redhat-release. *)
+ let rhel = Pcre.regexp "(?:Red Hat Enterprise Linux|CentOS|Scientific Linux).*release (\\d+)\\.(\\d+)" in
+ let fedora = Pcre.regexp "Fedora.*release (\\d+)\\.(\\d+)" in
+ (* Contents of /etc/debian_version. *)
+ let debian = Pcre.regexp "^(\\d+)\\.(\\d+)" in
+ (* Output of 'file' on certain executables. *)
+ let i386 = Pcre.regexp ", Intel 80386," in
+ let x86_64 = Pcre.regexp ", x86-64," in
+ let itanic = Pcre.regexp ", IA-64," in
+
+ (* Examine the filesystem mounted on 'mnt' to determine the
+ * operating system, and, if Linux, the distro.
+ *)
+ let detect_os mnt =
+ if is_dir (mnt ^ "/Windows") = Some true &&
+ is_file (mnt ^ "/autoexec.bat") = Some true then
+ WindowsRoot
+ else if is_dir (mnt ^ "/etc") = Some true &&
+ is_dir (mnt ^ "/sbin") = Some true &&
+ is_dir (mnt ^ "/var") = Some true then (
+ if is_file (mnt ^ "/etc/redhat-release") = Some true then (
+ let chan = open_in (mnt ^ "/etc/redhat-release") in
+ let lines = input_all_lines chan in
+ close_in chan;
+
+ match lines with
+ | [] -> (* empty /etc/redhat-release ...? *)
+ LinuxRoot (UnknownArch, OtherLinux)
+ | line::_ ->
+ try
+ let subs = Pcre.exec ~rex:rhel line in
+ let major = int_of_string (Pcre.get_substring subs 1) in
+ let minor = int_of_string (Pcre.get_substring subs 2) in
+ LinuxRoot (UnknownArch, RHEL (major, minor))
+ with
+ Not_found | Failure "int_of_string" ->
+ try
+ let subs = Pcre.exec ~rex:fedora line in
+ let version = int_of_string (Pcre.get_substring subs 1) in
+ LinuxRoot (UnknownArch, Fedora version)
+ with
+ Not_found | Failure "int_of_string" ->
+ LinuxRoot (UnknownArch, OtherLinux)
+ )
+ else if is_file (mnt ^ "/etc/debian_version") = Some true then (
+ let chan = open_in (mnt ^ "/etc/debian_version") in
+ let lines = input_all_lines chan in
+ close_in chan;
+
+ match lines with
+ | [] -> (* empty /etc/debian_version ...? *)
+ LinuxRoot (UnknownArch, OtherLinux)
+ | line::_ ->
+ try
+ let subs = Pcre.exec ~rex:debian line in
+ let major = int_of_string (Pcre.get_substring subs 1) in
+ let minor = int_of_string (Pcre.get_substring subs 2) in
+ LinuxRoot (UnknownArch, Debian (major, minor))
+ with
+ Not_found | Failure "int_of_string" ->
+ LinuxRoot (UnknownArch, OtherLinux)
+ )
+ else
+ LinuxRoot (UnknownArch, OtherLinux)
+ ) else if is_dir (mnt ^ "/grub") = Some true &&
+ is_file (mnt ^ "/grub/stage1") = Some true then (
+ LinuxBoot
+ ) else
+ NotRoot (* mountable, but not a root filesystem *)
+ in
+
+ (* Examine the Linux root filesystem mounted on 'mnt' to
+ * determine the architecture. We do this by looking at some
+ * well-known binaries that we expect to be there.
+ *)
+ let detect_architecture mnt =
+ let cmd = "file -bL " ^ quote (mnt ^ "/sbin/init") in
+ match shget cmd with
+ | Some (str::_) when Pcre.pmatch ~rex:i386 str -> I386
+ | Some (str::_) when Pcre.pmatch ~rex:x86_64 str -> X86_64
+ | Some (str::_) when Pcre.pmatch ~rex:itanic str -> IA64
+ | _ -> UnknownArch
+ in
+
+ List.map (
+ fun part ->
+ let dev = dev_of_partition part in (* Get /dev device. *)
+
+ let nature =
+ (* Use 'file' command to detect if it is swap. *)
+ let cmd = "file -sbL " ^ quote dev in
+ match shget cmd with
+ | Some (str::_) when Pcre.pmatch ~rex:swap str -> LinuxSwap
+ | _ ->
+ (* Blindly try to mount the device. *)
+ let cmd = "mount -o ro " ^ quote dev ^ " /mnt/root" in
+ match shwithstatus cmd with
+ | 0 ->
+ let os = detect_os "/mnt/root" in
+ let nature =
+ match os with
+ | LinuxRoot (UnknownArch, distro) ->
+ let architecture = detect_architecture "/mnt/root" in
+ LinuxRoot (architecture, distro)
+ | os -> os in
+ sh "umount /mnt/root";
+ nature
+
+ | _ -> UnknownNature (* not mountable *)
+
+ in
+
+ eprintf "partition detection: %s is %s\n%!"
+ dev (string_of_nature nature);
+
+ (part, nature)
+ ) all_partitions
+ in
+
+ printf "virt-p2v.ml finished detecting hard drives\n%!";
+
(* Dialogs. *)
let ask_greeting state =
ignore (msgbox "virt-p2v" "\nWelcome to virt-p2v, a live CD for migrating a physical machine to a virtualized host.\n\nTo continue press the Return key.\n\nTo get a shell you can use [ALT] [F2] and log in as root with no password.\n\nExtra information is logged in /tmp/virt-p2v.log but this file disappears when the machine reboots." 18 50);
let ask_root state =
let parts = List.mapi (
- fun i part ->
- (string_of_int i, dev_of_partition part,
+ fun i (part, nature) ->
+ let descr =
+ match nature with
+ | LinuxSwap -> " (Linux swap)"
+ | LinuxRoot (_, RHEL (a,b)) -> sprintf " (RHEL %d.%d root)" a b
+ | LinuxRoot (_, Fedora v) -> sprintf " (Fedora %d root)" v
+ | LinuxRoot (_, Debian (a,b)) -> sprintf " (Debian %d.%d root)" a b
+ | LinuxRoot (_, OtherLinux) -> sprintf " (Linux root)"
+ | WindowsRoot -> " (Windows C:)"
+ | LinuxBoot -> " (Linux /boot)"
+ | NotRoot -> " (filesystem)"
+ | UnknownNature -> "" in
+ (string_of_int i,
+ dev_of_partition part ^ descr,
Some part = state.root_filesystem)
) all_partitions in
match
radiolist "Root device"
- "Pick partition containing the root (/) filesystem" 15 50 6
+ "Pick partition containing the root (/) filesystem" 18 70 9
parts
with
| Yes (i::_) ->
- let part = List.nth all_partitions (int_of_string i) in
+ let (part, _) = List.nth all_partitions (int_of_string i) in
Next { state with root_filesystem = Some part }
| Yes [] | No | Help | Error -> Ask_again
| Back -> Prev
let ask_architecture state =
match
radiolist "Architecture" "Machine architecture" 16 50 8 [
- "i386", "i386 and up (32 bit)", state.architecture = Some "i386";
- "x86_64", "x86-64 (64 bit)", state.architecture = Some "x86_64";
- "ia64", "Itanium IA64", state.architecture = Some "ia64";
- "ppc", "PowerPC (32 bit)", state.architecture = Some "ppc";
- "ppc64", "PowerPC (64 bit)", state.architecture = Some "ppc64";
- "sparc", "SPARC (32 bit)", state.architecture = Some "sparc";
- "sparc64", "SPARC (64 bit)", state.architecture = Some "sparc64";
-(* "auto", "Other or auto-detect",
- state.architecture = None || state.architecture = Some "";*)
+ "i386", "i386 and up (32 bit)", state.architecture = Some I386;
+ "x86_64", "x86-64 (64 bit)", state.architecture = Some X86_64;
+ "ia64", "Itanium IA64", state.architecture = Some IA64;
+ "ppc", "PowerPC (32 bit)", state.architecture = Some PPC;
+ "ppc64", "PowerPC (64 bit)", state.architecture = Some PPC64;
+ "sparc", "SPARC (32 bit)", state.architecture = Some SPARC;
+ "sparc64", "SPARC (64 bit)", state.architecture = Some SPARC64;
+ "auto", "Auto-detect",
+ state.architecture = None || state.architecture = Some UnknownArch;
]
with
- | Yes (("auto"|"")::_ | []) -> Next { state with architecture = Some "" }
- | Yes (arch :: _) -> Next { state with architecture = Some arch }
+ | Yes ("i386" :: _) -> Next { state with architecture = Some I386 }
+ | Yes ("x86_64" :: _) -> Next { state with architecture = Some X86_64 }
+ | Yes ("ia64" :: _) -> Next { state with architecture = Some IA64 }
+ | Yes ("ppc" :: _) -> Next { state with architecture = Some PPC }
+ | Yes ("ppc64" :: _) -> Next { state with architecture = Some PPC64 }
+ | Yes ("sparc" :: _) -> Next { state with architecture = Some SPARC }
+ | Yes ("sparc64" :: _) -> Next { state with architecture = Some SPARC64 }
+ | Yes _ -> Next { state with architecture = Some UnknownArch }
| No | Help | Error -> Ask_again
| Back -> Prev
in
| Some Xen -> "Xen" | Some QEMU -> "QEMU" | Some KVM -> "KVM"
| None -> "Other / not set")
(match state.architecture with
- | Some "" -> "Guess" | Some arch -> arch | None -> "")
+ | Some UnknownArch -> "Auto-detect"
+ | Some arch -> string_of_architecture arch | None -> "")
(match state.memory with
| Some 0 -> "Same as physical"
| Some mem -> string_of_int mem ^ " MB" | None -> "")
eprintf "finished dialog loop\n%!";
- (* Check that the environment is a sane-looking live CD. If not, bail. *)
- if is_dir "/mnt/root" <> Some true then
- fail_dialog "You should only run this script from the live CD or a USB key.";
-
(* Switch LVM config. *)
sh "vgchange -a n";
putenv "LVM_SYSTEM_DIR" "/etc/lvm.new"; (* see lvm(8) *)
(* XXX Other files to rewrite? *)
(* XXX Autodetect architecture of root filesystem by looking for /bin/ls. *)
- let system_architecture = "x86_64" in
+ let system_architecture = X86_64 in
(* XXX Autodetect system memory. *)
let system_memory = 256 in
let architecture =
match state.architecture with
- | Some "" | None -> system_architecture
+ | Some UnknownArch | None -> system_architecture
| Some arch -> arch in
let memory =
match state.memory with
tleaf "clock" ["sync", "localtime"]]
| Some QEMU ->
[Xml.Element ("os", [],
- [Xml.Element ("type", ["arch",architecture;
- "machine","pc"],
+ [Xml.Element ("type",
+ ["arch",
+ string_of_architecture architecture;
+ "machine","pc"],
[Xml.PCData "hvm"]);
tleaf "boot" ["dev", "hd"]])]
| None ->
git.annexia.org / virt-p2v.git / commitdiff