* 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. *)
| 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. *)
(* 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. *)
| "" -> UnknownArch
| str -> OtherArch str
+type wordsize =
+ | W32 | W64 | WUnknown
+
let wordsize_of_architecture = function
| I386 -> W32
| X86_64 -> W64
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).
*)
(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
(* 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. *)
in
List.map (
- fun part ->
+ fun (part, size) ->
let dev = dev_of_partition part in (* Get /dev device. *)
let nature =
eprintf "partition detection: %s is %s\n%!"
dev (string_of_nature nature);
- (part, nature)
+ (part, (size, nature))
) all_partitions
in
*)
let rec loop = function
| [] -> ()
- | (partition, LinuxRoot (_, ((RHEL _|Fedora _) as distro)))
+ | (partition, (_, LinuxRoot (_, ((RHEL _|Fedora _) as distro))))
:: parts ->
let label =
sprintf "%s (%s)"
| 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
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