Pull in non-essential parts of the V2P patch.
authorRichard W.M. Jones <rjones@redhat.com>
Mon, 8 Sep 2008 12:26:01 +0000 (13:26 +0100)
committerRichard W.M. Jones <rjones@redhat.com>
Mon, 8 Sep 2008 12:26:01 +0000 (13:26 +0100)
virt-p2v

index b257bc4..ffaf824 100755 (executable)
--- a/virt-p2v
+++ b/virt-p2v
  * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  *)
 
-type partition =
-  | Part of string * string            (* eg. "hda", "1" *)
-  | LV of string * string              (* eg. "VolGroup00", "LogVol00" *)
 type transfer =
   | P2V                                        (* physical to virtual *)
   | V2V                                        (* virtual to virtual *)
   (*| V2P*)                             (* virtual to physical - not impl *)
+type partition =
+  | Part of string * string            (* eg. "hda", "1" *)
+  | LV of string * string              (* eg. "VolGroup00", "LogVol00" *)
 type network =
   | Auto of partition                  (* Automatic network configuration. *)
   | Shell                              (* Start a shell. *)
@@ -51,8 +51,6 @@ type architecture =
   | I386 | X86_64 | IA64 | PPC | PPC64 | SPARC | SPARC64
   | OtherArch of string
   | UnknownArch
-type wordsize =
-  | W32 | W64 | WUnknown
 type target_config = {
   tgt_hypervisor : hypervisor option;  (* Remote hypervisor. *)
   tgt_architecture : architecture;     (* Remote architecture. *)
@@ -94,6 +92,8 @@ let config_ssh = ref None
 
 (* What to transfer. *)
 let config_devices_to_send = ref None
+
+(* The root filesystem - parts of this get modified after migration. *)
 let config_root_filesystem = ref None
 
 (* Configuration of the target. *)
@@ -207,6 +207,9 @@ let architecture_of_string = function
   | "" -> UnknownArch
   | str -> OtherArch str
 
+type wordsize =
+  | W32 | W64 | WUnknown
+
 let wordsize_of_architecture = function
   | I386 -> W32
   | X86_64 -> W64
@@ -518,8 +521,6 @@ let safe_name =
     done;
     if !have_safe then name else next_anon ()
 
-type block_device = string * int64     (* "hda" & size in bytes *)
-
 (* Parse the output of 'lvs' to get list of LV names, sizes,
  * corresponding PVs, etc.  Returns a list of (lvname, PVs, lvsize).
  *)
@@ -864,9 +865,11 @@ let rec main ttyname =
     (s_ "Detecting hard drives (this may take some time) ...");
 
   (* 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".
+   * if we can't find anything.
+   *
+   * This is a list of strings, like "hda" and size in bytes.
    *)
-  let all_block_devices : block_device list =
+  let all_block_devices : (string * int64) list =
     let rex = Pcre.regexp "^[hs]d" in
     let devices = Array.to_list (Sys.readdir "/sys/block") in
     let devices = List.sort devices in
@@ -930,10 +933,24 @@ let rec main ttyname =
     (* Concatenate LVs & Parts *)
     lvs @ parts in
 
+  (* Run blockdev --getsize64 on each partition to get its size.
+   *
+   * Returns a list of partitions and their size in bytes.
+   *)
+  let all_partitions : (partition * int64) list =
+    List.filter_map (
+      fun part ->
+       let cmd = "blockdev --getsize64 " ^ quote (dev_of_partition part) in
+       let lines = shget cmd in
+       match lines with
+       | Some (blksize::_) -> Some (part, Int64.of_string blksize)
+       | Some [] | None -> None
+    ) all_partitions in
+
   (* Try to determine the nature of each partition.
    * Root? Swap? Architecture? etc.
    *)
-  let all_partitions : (partition * nature) list =
+  let all_partitions : (partition * (int64 * nature)) list =
     (* Output of 'file' command for Linux swap file. *)
     let swap = Pcre.regexp "Linux.*swap.*file" in
     (* Contents of /etc/redhat-release. *)
@@ -1023,7 +1040,7 @@ let rec main ttyname =
     in
 
     List.map (
-      fun part ->
+      fun (part, size) ->
        let dev = dev_of_partition part in (* Get /dev device. *)
 
        let nature =
@@ -1053,7 +1070,7 @@ let rec main ttyname =
        eprintf "partition detection: %s is %s\n%!"
          dev (string_of_nature nature);
 
-       (part, nature)
+       (part, (size, nature))
     ) all_partitions
   in
 
@@ -1137,7 +1154,7 @@ let rec main ttyname =
               *)
              let rec loop = function
                | [] -> ()
-               | (partition, LinuxRoot (_, ((RHEL _|Fedora _) as distro)))
+               | (partition, (_, LinuxRoot (_, ((RHEL _|Fedora _) as distro))))
                  :: parts ->
                    let label =
                      sprintf "%s (%s)"
@@ -1402,7 +1419,7 @@ let rec main ttyname =
          | Some fs -> fs
          | None ->
              let items = List.map (
-               fun (part, nature) ->
+               fun (part, (_, nature)) ->
                  let label =
                    sprintf "%s %s" (dev_of_partition part)
                      (string_of_nature nature) in
@@ -1445,7 +1462,7 @@ let rec main ttyname =
              Newt.listbox_set_current_by_key archlistbox UnknownArch;
              (try
                 match List.assoc config_root_filesystem all_partitions with
-                | LinuxRoot (arch, _) ->
+                | _, LinuxRoot (arch, _) ->
                     Newt.listbox_set_current_by_key archlistbox arch
                 | _ -> ()
                with