+ (* Autodetect system memory. *)
+ let system_memory =
+ let mem = shget "head -1 /proc/meminfo | awk '{print $2/1024}'" in
+ match mem with
+ | Some (mem::_) -> int_of_float (float_of_string mem)
+ | _ -> 256 in
+
+ (* Autodetect system # pCPUs. *)
+ let system_nr_cpus =
+ let cpus =
+ shget "grep ^processor /proc/cpuinfo | tail -1 | awk '{print $3+1}'" in
+ match cpus with
+ | Some (cpus::_) -> int_of_string cpus
+ | _ -> 1 in
+
+ (* Greeting, type of transfer, network question stages.
+ * These are all done in newt mode.
+ *)
+ let config_transfer_type, config_network =
+ with_newt (
+ fun () ->
+ (* Greeting. *)
+ if !config_greeting then
+ message_box program_name (sprintf "Welcome to %s, 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." program_name);
+
+ (* Type of transfer. *)
+ let config_transfer_type =
+ match !config_transfer_type with
+ | Some t -> t
+ | None ->
+ let rec loop () =
+ open_centered_window ~stage:"Transfer type"
+ 40 10 "Transfer type";
+
+ let p2v =
+ Newt.radio_button 1 1 "Physical to virtual (P2V)" true
+ None in
+ let v2v =
+ Newt.radio_button 1 2 "Virtual to virtual (V2V)" false
+ (Some p2v) in
+ let ok = Newt.button 28 6 " OK " in
+
+ let form = Newt.form None None [] in
+ Newt.form_add_components form [p2v; v2v];
+ Newt.form_add_component form ok;
+
+ ignore (Newt.run_form form);
+ Newt.pop_window ();
+
+ let r = Newt.radio_get_current p2v in
+ if Newt.component_equals r p2v then P2V
+ else if Newt.component_equals r v2v then V2V
+ else loop ()
+ in
+ loop () in
+
+ (* Network configuration. *)
+ let config_network =
+ match !config_network with
+ | Some n -> n
+ | None ->
+ let rec loop () =
+ open_centered_window ~stage:"Network"
+ 60 20 "Configure network";
+
+ let autolist = Newt.listbox 4 2 4 [Newt.SCROLL] in
+ Newt.listbox_set_width autolist 52;
+
+ (* Populate the "Automatic" listbox with RHEL/Fedora
+ * root partitions found which allow us to do
+ * automatic configuration in a known way.
+ *)
+ let partition_map = Hashtbl.create 13 in
+ let maplen = ref 1 in
+ let rec iloop = function
+ | [] -> ()
+ | (partition, LinuxRoot (_, ((RHEL _|Fedora _) as distro)))
+ :: parts ->
+ let label =
+ sprintf "%s (%s)"
+ (dev_of_partition partition)
+ (string_of_linux_distro distro) in
+ Hashtbl.add partition_map (!maplen) partition;
+ ignore (
+ Newt.listbox_append_entry autolist label (!maplen)
+ );
+ incr maplen;
+ iloop parts
+ | _ :: parts -> iloop parts
+ in
+ iloop all_partitions;
+
+ (* If there is no suitable root partition (the listbox
+ * is empty) then disable the auto option and the listbox.
+ *)
+ let no_auto = Hashtbl.length partition_map = 0 in
+
+ let auto =
+ Newt.radio_button 1 1
+ "Automatic from:" (not no_auto) None in
+ let shell =
+ Newt.radio_button 1 6
+ "Start a shell" no_auto (Some auto) in
+
+ if no_auto then (
+ Newt.component_takes_focus auto false;
+ Newt.component_takes_focus autolist false
+ );
+
+ let qemu =
+ Newt.radio_button 1 7
+ "QEMU user network" false (Some shell) in
+ let nonet =
+ Newt.radio_button 1 8
+ "No network or network already configured" false
+ (Some qemu) in
+ let static =
+ Newt.radio_button 1 9
+ "Static configuration:" false (Some nonet) in
+
+ let label1 = Newt.label 4 10 "Interface" in
+ let entry1 = Newt.entry 16 10 (Some "eth0") 8 [] in
+ let label2 = Newt.label 4 11 "Address" in
+ let entry2 = Newt.entry 16 11 None 16 [] in
+ let label3 = Newt.label 4 12 "Netmask" in
+ let entry3 = Newt.entry 16 12 (Some "255.255.255.0") 16 [] in
+ let label4 = Newt.label 4 13 "Gateway" in
+ let entry4 = Newt.entry 16 13 None 16 [] in
+ let label5 = Newt.label 4 14 "Nameserver" in
+ let entry5 = Newt.entry 16 14 None 16 [] in
+
+ let enable_static () =
+ Newt.component_takes_focus entry1 true;
+ Newt.component_takes_focus entry2 true;
+ Newt.component_takes_focus entry3 true;
+ Newt.component_takes_focus entry4 true;
+ Newt.component_takes_focus entry5 true
+ in
+
+ let disable_static () =
+ Newt.component_takes_focus entry1 false;
+ Newt.component_takes_focus entry2 false;
+ Newt.component_takes_focus entry3 false;
+ Newt.component_takes_focus entry4 false;
+ Newt.component_takes_focus entry5 false
+ in
+
+ let enable_autolist () =
+ Newt.component_takes_focus autolist true
+ in
+ let disable_autolist () =
+ Newt.component_takes_focus autolist false
+ in
+
+ disable_static ();
+ Newt.component_add_callback auto
+ (fun () ->disable_static (); enable_autolist ());
+ Newt.component_add_callback shell
+ (fun () -> disable_static (); disable_autolist ());
+ Newt.component_add_callback qemu
+ (fun () -> disable_static (); disable_autolist ());
+ Newt.component_add_callback nonet
+ (fun () -> disable_static (); disable_autolist ());
+ Newt.component_add_callback static
+ (fun () -> enable_static (); disable_autolist ());
+
+ let ok = Newt.button 28 16 " OK " in
+
+ let form = Newt.form None None [] in
+ Newt.form_add_component form auto;
+ Newt.form_add_component form autolist;
+ Newt.form_add_components form [shell;qemu;nonet;static];
+ Newt.form_add_components form
+ [label1;label2;label3;label4;label5];
+ Newt.form_add_components form
+ [entry1;entry2;entry3;entry4;entry5];
+ Newt.form_add_component form ok;
+
+ ignore (Newt.run_form form);
+ Newt.pop_window ();
+
+ let r = Newt.radio_get_current auto in
+ if Newt.component_equals r auto then (
+ match Newt.listbox_get_current autolist with
+ | None -> loop ()
+ | Some i -> Auto (Hashtbl.find partition_map i)
+ )
+ else if Newt.component_equals r shell then Shell
+ else if Newt.component_equals r qemu then QEMUUserNet
+ else if Newt.component_equals r nonet then NoNetwork
+ else if Newt.component_equals r static then (
+ let interface = Newt.entry_get_value entry1 in
+ let address = Newt.entry_get_value entry2 in
+ let netmask = Newt.entry_get_value entry3 in
+ let gateway = Newt.entry_get_value entry4 in
+ let nameserver = Newt.entry_get_value entry5 in
+ if interface = "" || address = "" ||
+ netmask = "" || gateway = "" then
+ loop ()
+ else
+ Static (interface, address, netmask, gateway, nameserver)
+ )
+ else loop ()
+ in
+ loop () in
+
+ config_transfer_type, config_network
+ ) in