X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=virt-p2v.ml;h=f2db82845f86eeef9dd3fe4997f73b5d804153e1;hb=7402bb415d0c7633a920ba81c21bc2dc5464987a;hp=d735cee17cca21092201ca739f114bd2fa72fd38;hpb=12d18571a32a78dec42f481d78d62250608a0bb8;p=virt-p2v.git

diff --git a/virt-p2v.ml b/virt-p2v.ml
index d735cee..f2db828 100755
--- a/virt-p2v.ml
+++ b/virt-p2v.ml
@@ -40,7 +40,7 @@ type state = { greeting : bool;
 	       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;
 	     }
@@ -48,6 +48,8 @@ and network = Auto | Shell
 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.
@@ -96,8 +98,9 @@ let defaults = {
   (* 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;
 
@@ -143,10 +146,46 @@ let dev_of_partition = function
   | 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
@@ -286,9 +325,21 @@ let shget cmd =
   | WSIGNALED i -> failwith (sprintf "shget: command killed by signal %d" i)
   | WSTOPPED i -> failwith (sprintf "shget: command stopped by signal %d" i)
 
-(* Start an interactive shell. *)
+(* Start an interactive shell.  Need to juggle file descriptors a bit
+ * because bash write PS1 to stderr (currently directed to the logfile).
+ *)
 let shell () =
-  shfailok "PS1='\\u@\\h:\\w\\$ ' bash"
+  match fork () with
+  | 0 ->				(* child, runs bash *)
+      close stderr;
+      dup2 stdout stderr;
+      (* Sys.command runs 'sh -c' which blows away PS1, so set it late. *)
+      ignore (
+	Sys.command "PS1='\\u@\\h:\\w\\$ ' /bin/bash --norc --noprofile -i"
+      )
+  | _ ->				(* parent, waits *)
+      eprintf "waiting for subshell to exit\n%!";
+      ignore (wait ())
 
 (* Some true if is dir/file, Some false if not, None if not found. *)
 let is_dir path =
@@ -402,33 +453,51 @@ let snapshot =
     sh (sprintf "dmsetup create %s --table='0 %Ld snapshot /dev/mapper/%s_org %s n 64'"
 	  snapshot_dev sectors snapshot_dev ramdisk)
 
-(* Try to perform automatic network configuration, assuming a Fedora or RHEL-
- * like root filesystem mounted on /mnt/root.
+(* Try to perform automatic network configuration, assuming a Fedora or
+ * RHEL-like root filesystem mounted on /mnt/root.
  *)
 let auto_network state =
   (* Fedora gives an error if this file doesn't exist. *)
   sh "touch /etc/resolv.conf";
 
+  (* It's tempting to do a 'chroot ...' and run the original
+   * '/etc/init.d/network start' script.  However this will not
+   * always work, in particular in the case where the root is
+   * a 64 bit machine and the live CD kernel is 32 bit, and so
+   * cannot run binaries such as /sbin/ifconfig from the root.
+   * Do it the hard way instead ...
+   *)
   chdir "/etc/sysconfig";
-
   sh "mv network network.saved";
   sh "mv networking networking.saved";
   sh "mv network-scripts network-scripts.saved";
+  chdir "/etc/init.d";
+  sh "mv network network.saved";
+  sh "mv functions functions.saved";
 
   (* Originally I symlinked these, but that causes dhclient to
    * keep open /mnt/root (as its cwd is in network-scripts subdir).
    * So now we will copy them recursively instead.
    *)
-  sh "cp -r /mnt/root/etc/sysconfig/network .";
-  sh "cp -r /mnt/root/etc/sysconfig/networking .";
-  sh "cp -r /mnt/root/etc/sysconfig/network-scripts .";
+  chdir "/etc/sysconfig";
+  sh "cp -a /mnt/root/etc/sysconfig/network .";
+  sh "cp -a /mnt/root/etc/sysconfig/networking .";
+  sh "cp -a /mnt/root/etc/sysconfig/network-scripts .";
+  chdir "/etc/init.d";
+  sh "cp /mnt/root/etc/init.d/network .";
+  sh "cp /mnt/root/etc/init.d/functions .";
 
   let status = shwithstatus "/etc/init.d/network start" in
 
+  chdir "/etc/sysconfig";
   sh "rm -rf network networking network-scripts";
   sh "mv network.saved network";
   sh "mv networking.saved networking";
   sh "mv network-scripts.saved network-scripts";
+  chdir "/etc/init.d";
+  sh "rm -f network functions";
+  sh "mv network.saved network";
+  sh "mv functions.saved functions";
 
   chdir "/tmp";
 
@@ -524,6 +593,13 @@ let rec main ttyname =
        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".
    *)
@@ -590,6 +666,135 @@ let rec main ttyname =
     (* 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+)" 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 to detect OS from /etc/redhat-release *)
+		try
+		  let subs = Pcre.exec ~rex:rhel line in
+		  let major = int_of_string (Pcre.get_substring subs 1) in
+		  let minor =
+		    try int_of_string (Pcre.get_substring subs 2)
+		    with Not_found -> 0 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 to detect version from /etc/debian_version *)
+		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);
@@ -610,7 +815,7 @@ let rec main ttyname =
   let ask_port state =
     match
     inputbox "Remote port" "Remote port" 10 50
-      (Option.default "" state.remote_port)
+      (Option.default "22" state.remote_port)
     with
     | Yes ([]|""::_) -> Next { state with remote_port = Some "22" }
     | Yes (port::_) -> Next { state with remote_port = Some port }
@@ -619,12 +824,12 @@ let rec main ttyname =
   in
 
   let ask_directory state =
+    let default_dir = "/var/lib/xen/images" in
     match
     inputbox "Remote directory" "Remote directory" 10 50
-      (Option.default "" state.remote_directory)
+      (Option.default default_dir state.remote_directory)
     with
-    | Yes [] ->
-	Next { state with remote_directory = Some "/var/lib/xen/images" }
+    | Yes ([]|""::_) -> Next { state with remote_directory = Some default_dir }
     | Yes (dir::_) -> Next { state with remote_directory = Some dir }
     | No | Help | Error -> Ask_again
     | Back -> Prev
@@ -662,17 +867,29 @@ let rec main ttyname =
 
   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
@@ -700,19 +917,25 @@ let rec main ttyname =
   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
@@ -787,7 +1010,8 @@ MAC address:  %s"
 	  | 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 -> "")
@@ -861,10 +1085,6 @@ MAC address:  %s"
 
   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) *)
@@ -938,7 +1158,7 @@ MAC address:  %s"
   (* 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
@@ -1005,7 +1225,7 @@ MAC address:  %s"
 
   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
@@ -1056,8 +1276,10 @@ MAC address:  %s"
 	   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 ->