- let ask_verify state =
- match
- yesno "Verify and proceed"
- (sprintf "\nPlease verify the settings below and click [OK] to proceed, or the [Back] button to return to a previous step.
-
-Host:port: %s : %s
-Directory: %s
-Network: %s
-Send devices: %s
-Root (/) dev: %s
-Hypervisor: %s
-Architecture: %s
-Memory: %s
-VCPUs: %s
-MAC address: %s"
- (Option.default "" state.remote_host)
- (Option.default "" state.remote_port)
- (Option.default "" state.remote_directory)
- (match state.network with
- | Some Auto -> "Auto-configure" | Some Shell -> "Shell"
- | None -> "")
- (String.concat "," (Option.default [] state.devices_to_send))
- (Option.map_default dev_of_partition "" state.root_filesystem)
- (match state.hypervisor with
- | Some Xen -> "Xen" | Some QEMU -> "QEMU" | Some KVM -> "KVM"
- | None -> "Other / not set")
- (match state.architecture with
- | 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 -> "")
- (match state.vcpus with
- | Some 0 -> "Same as physical"
- | Some vcpus -> string_of_int vcpus | None -> "")
- (match state.mac_address with
- | Some "" -> "Random" | Some mac -> mac | None -> "")
- )
- 21 50
- with
- | Yes _ -> Next state
- | Back -> Prev
- | No | Help | Error -> Ask_again
- in
+ (* SSH configuration phase. *)
+ let config_ssh =
+ with_newt (
+ fun () ->
+ match !config_ssh with
+ | Some c -> c
+ | None ->
+ (* Query the user for SSH configuration. *)
+ open_centered_window ~stage:(s_ "SSH configuration")
+ 60 20 (s_ "SSH configuration");
+
+ let label1 = Newt.label 1 1 (s_ "Remote host") in
+ let host = Newt.entry 20 1 None 36 [] in
+ let label2 = Newt.label 1 2 (s_ "Remote port") in
+ let port = Newt.entry 20 2 (Some "22") 6 [] in
+ let label3 = Newt.label 1 3 (s_ "Remote directory") in
+ let dir = Newt.entry 20 3 (Some "/var/lib/xen/images") 36 [] in
+ let label4 = Newt.label 1 4 (s_ "SSH username") in
+ let user = Newt.entry 20 4 (Some "root") 16 [] in
+ (*
+ There's no sensible way to support this for SSH:
+ let label5 = Newt.label 1 5 (s_ "SSH password") in
+ let pass = Newt.entry 20 5 None 16 [Newt.PASSWORD] in
+ *)
+
+ let compr =
+ Newt.checkbox 16 7 (s_ "Use SSH compression (not good for LANs)")
+ ' ' None in
+
+ let check =
+ Newt.checkbox 16 9 (s_ "Test SSH connection") '*' None in
+
+ let ok = Newt.button 48 16 ok_button in
+
+ let form = Newt.form None None [] in
+ Newt.form_add_components form [label1;label2;label3;label4;
+ host;port;dir;user;
+ compr;check;
+ ok];
+
+ let c =
+ let rec loop () =
+ ignore (Newt.run_form form);
+ let host = Newt.entry_get_value host in
+ let port = Newt.entry_get_value port in
+ let dir = Newt.entry_get_value dir in
+ let user = Newt.entry_get_value user in
+ let compr = Newt.checkbox_get_value compr = '*' in
+ let check = Newt.checkbox_get_value check = '*' in
+ if host <> "" && port <> "" && user <> "" then
+ { ssh_host = host; ssh_port = port; ssh_directory = dir;
+ ssh_username = user;
+ ssh_compression = compr;
+ ssh_check = check; }
+ else
+ loop ()
+ in
+ loop () in
+
+ Newt.pop_window ();
+ c
+ ) in
+
+ (* If asked, check the SSH connection. *)
+ if config_ssh.ssh_check then
+ if not (test_ssh config_ssh) then
+ failwith (s_ "SSH configuration failed");
+
+ (* Devices and root partition and target configuration selection stage. *)
+ let config_devices_to_send, config_root_filesystem, config_target =
+ with_newt (
+ fun () ->
+ let config_devices_to_send =
+ match !config_devices_to_send with
+ | Some ds -> ds
+ | None ->
+ let items = List.map (
+ fun (dev, size) ->
+ let label =
+ sprintf "/dev/%s (%.3f GB)" dev
+ ((Int64.to_float size) /. (1024.*.1024.*.1024.)) in
+ (label, dev, true)
+ ) all_block_devices in
+
+ select_multiple ~stage:(s_ "Block devices")
+ ~force_one:true 60
+ (s_ "Select block devices to send")
+ items in
+
+ let config_root_filesystem =
+ match !config_root_filesystem with
+ | Some fs -> fs
+ | None ->
+ let items = List.map (
+ fun (part, nature) ->
+ let label =
+ sprintf "%s %s" (dev_of_partition part)
+ (string_of_nature nature) in
+ (label, part)
+ ) all_partitions in
+
+ select_single ~stage:(s_ "Root filesystem") 60
+ (s_ "Select root filesystem")
+ items in
+
+ let config_target =
+ match !config_target with
+ | Some t -> t
+ | None ->
+ open_centered_window ~stage:(s_ "Target system") 40 20
+ (s_ "Configure target system");
+
+ let hvlabel = Newt.label 1 1 (s_ "Hypervisor:") in
+ let hvlistbox = Newt.listbox 16 1 4 [Newt.SCROLL] in
+ Newt.listbox_append_entry hvlistbox "Xen" (Some Xen);
+ Newt.listbox_append_entry hvlistbox "QEMU" (Some QEMU);
+ Newt.listbox_append_entry hvlistbox "KVM" (Some KVM);
+ Newt.listbox_append_entry hvlistbox "Other" None;
+
+ let archlabel = Newt.label 1 5 (s_ "Architecture:") in
+ let archlistbox = Newt.listbox 16 5 4 [Newt.SCROLL] in
+ Newt.listbox_append_entry archlistbox "i386" I386;
+ Newt.listbox_append_entry archlistbox
+ "x86-64 (64-bit x86)" X86_64;
+ Newt.listbox_append_entry archlistbox "IA64 (Itanium)" IA64;
+ Newt.listbox_append_entry archlistbox "PowerPC 32-bit" PPC;
+ Newt.listbox_append_entry archlistbox "PowerPC 64-bit" PPC64;
+ Newt.listbox_append_entry archlistbox "SPARC 32-bit" SPARC;
+ Newt.listbox_append_entry archlistbox "SPARC 64-bit" SPARC64;
+ Newt.listbox_append_entry archlistbox "Unknown/other" UnknownArch;
+
+ (* Get the architecture of the selected root filesystem.
+ * If not known, default to UnknownArch.
+ *)
+ Newt.listbox_set_current_by_key archlistbox UnknownArch;
+ (try
+ match List.assoc config_root_filesystem all_partitions with
+ | LinuxRoot (arch, _) ->
+ Newt.listbox_set_current_by_key archlistbox arch
+ | _ -> ()
+ with
+ Not_found -> ());
+
+ let memlabel = Newt.label 1 9 (s_ "Memory (MB):") in
+ let mementry = Newt.entry 16 9
+ (Some (string_of_int system_memory)) 8 [] in
+ let cpulabel = Newt.label 1 10 (s_ "CPUs:") in
+ let cpuentry = Newt.entry 16 10
+ (Some (string_of_int system_nr_cpus)) 4 [] in
+ let maclabel = Newt.label 1 11 (s_ "MAC addr:") in
+ let macentry = Newt.entry 16 11 None 20 [] in
+ let maclabel2 =
+ Newt.label 1 12 (s_ "(leave MAC blank for random)") in
+
+ let libvirtd =
+ Newt.checkbox 12 14 (s_ "Use remote libvirtd") '*' None in
+
+ let ok = Newt.button 28 16 ok_button in
+
+ let form = Newt.form None None [] in
+ Newt.form_add_components form
+ [hvlabel; Newt.component_of_listbox hvlistbox;
+ archlabel; Newt.component_of_listbox archlistbox;
+ memlabel; mementry;
+ cpulabel; cpuentry;
+ maclabel; macentry; maclabel2;
+ libvirtd;
+ ok];
+
+ let c =
+ let rec loop () =
+ ignore (Newt.run_form form);
+ try
+ let hv = Newt.listbox_get_current hvlistbox in
+ let arch = Newt.listbox_get_current archlistbox in
+ let mem = int_of_string (Newt.entry_get_value mementry) in
+ let cpus = int_of_string (Newt.entry_get_value cpuentry) in
+ let mac = Newt.entry_get_value macentry in
+ let libvirtd = Newt.checkbox_get_value libvirtd = '*' in
+ if hv <> None && arch <> None && mem >= 0 && cpus >= 0
+ then
+ { tgt_hypervisor = Option.get hv;
+ tgt_architecture = Option.get arch;
+ tgt_memory = mem; tgt_vcpus = cpus;
+ tgt_mac_address =
+ if mac <> "" then mac else random_mac_address ();
+ tgt_libvirtd = libvirtd }
+ else
+ loop ()
+ with
+ Not_found | Failure "int_of_string" -> loop ()
+ in
+ loop () in