- (* This is the list of dialogs, in order. The user can go forwards or
- * backwards through them.
- *
- * The second parameter in each tuple is true if we need to skip
- * this dialog statically (info already supplied in 'defaults' above).
- *
- * The third parameter in each tuple is a function that tests whether
- * this dialog should be skipped, given other parts of the current state.
- *)
- let dlgs =
- let dont_skip _ = false in
- [|
- ask_greeting, not defaults.greeting, dont_skip;
- ask_hostname, defaults.remote_host <> None, dont_skip;
- ask_port, defaults.remote_port <> None, dont_skip;
- ask_directory, defaults.remote_directory <> None, dont_skip;
- ask_username, defaults.remote_username <> None, dont_skip;
- ask_network, defaults.network <> None, dont_skip;
- ask_static_network_config,
- defaults.static_network_config <> None,
- (function { network = Some Static } -> false | _ -> true);
- ask_devices, defaults.devices_to_send <> None, dont_skip;
- ask_root, defaults.root_filesystem <> None, dont_skip;
- ask_hypervisor, defaults.hypervisor <> None, dont_skip;
- ask_architecture, defaults.architecture <> None, dont_skip;
- ask_memory, defaults.memory <> None, dont_skip;
- ask_vcpus, defaults.vcpus <> None, dont_skip;
- ask_mac_address, defaults.mac_address <> None, dont_skip;
- ask_verify, not defaults.greeting, dont_skip;
- |] in
-
- (* Loop through the dialogs until we reach the end. *)
- let rec loop ?(back=false) posn state =
- eprintf "dialog loop: posn = %d, back = %b\n%!" posn back;
- if posn >= Array.length dlgs then state (* Finished all dialogs. *)
- else if posn < 0 then loop 0 state
- else (
- let dlg, skip_static, skip_dynamic = dlgs.(posn) in
- if skip_static || skip_dynamic state then
- (* Skip this dialog. *)
- loop ~back (if back then posn-1 else posn+1) state
- else (
- (* Run dialog. *)
- match dlg state with
- | Next new_state -> loop (posn+1) new_state (* Forwards. *)
- | Ask_again -> loop posn state (* Repeat the question. *)
- | Prev -> loop ~back:true (posn-1) state (* Backwards / back button. *)
- )
- )
- in
- let state = loop 0 defaults in
+ (* If asked, check the SSH connection. *)
+ if config_ssh.ssh_check then
+ if not (test_ssh config_ssh) then
+ failwith "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:"Block devices" ~force_one:true 60
+ "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:"Root filesystem" 60
+ "Select root filesystem"
+ items in
+
+ let config_target =
+ match !config_target with
+ | Some t -> t
+ | None ->
+ open_centered_window ~stage:"Target system" 40 20
+ "Configure target system";
+
+ let hvlabel = Newt.label 1 1 "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 "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 "Memory (MB):" in
+ let mementry = Newt.entry 16 9
+ (Some (string_of_int system_memory)) 8 [] in
+ let cpulabel = Newt.label 1 10 "CPUs:" in
+ let cpuentry = Newt.entry 16 10
+ (Some (string_of_int system_nr_cpus)) 4 [] in
+ let maclabel = Newt.label 1 11 "MAC addr:" in
+ let macentry = Newt.entry 16 11 None 20 [] in
+ let maclabel2 = Newt.label 1 12 "(leave MAC blank for random)" in
+
+ let libvirtd =
+ Newt.checkbox 12 14 "Use remote libvirtd" '*' None in
+
+ let ok = Newt.button 28 16 " OK " 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
+
+ Newt.pop_window ();
+
+ c in
+
+ config_devices_to_send, config_root_filesystem, config_target
+ ) in
git.annexia.org / virt-p2v.git / blobdiff