From dda0f801d4c3254c0e5a1d03d2f7020acdc150f8 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Thu, 1 Jan 1970 00:00:00 +0000 Subject: [PATCH] Block devices, root fs, target configuration dialogs. --- virt-p2v | 531 +++++++++++++++++++++++++++++---------------------------------- 1 file changed, 243 insertions(+), 288 deletions(-) diff --git a/virt-p2v b/virt-p2v index 3df66f3..8c4498c 100755 --- a/virt-p2v +++ b/virt-p2v @@ -51,6 +51,14 @@ type architecture = | I386 | X86_64 | IA64 | PPC | PPC64 | SPARC | SPARC64 | OtherArch of string | UnknownArch +type target_config = { + tgt_hypervisor : hypervisor option; (* Remote hypervisor. *) + tgt_architecture : architecture; (* Remote architecture. *) + tgt_memory : int; (* Memory (megabytes). *) + tgt_vcpus : int; (* Number of virtual CPUs. *) + tgt_mac_address : string; (* MAC address. *) + tgt_libvirtd : bool; (* True if libvirtd on remote. *) +} (*----------------------------------------------------------------------*) (* TO MAKE A CUSTOM VIRT-P2V SCRIPT, adjust the defaults in this section. @@ -87,12 +95,7 @@ let config_devices_to_send = ref None let config_root_filesystem = ref None (* Configuration of the target. *) -let config_hypervisor = ref None -let config_architecture = ref None -let config_memory = ref None -let config_vcpus = ref None -let config_mac_address = ref None -let config_libvirtd = ref None +let config_target = ref None (* The name of the program as displayed in various places. *) let program_name = "virt-p2v" @@ -240,6 +243,101 @@ let failwith text = message_box "Error" text; exit 1 +(* Display a dialog with checkboxes, return the multiple selected items. *) +let select_multiple ?stage ?(force_one = false) width title items = + with_newt ( + fun () -> + open_centered_window ?stage width 20 title; + + let entries = + List.mapi ( + fun i (label, handle, selected) -> + let cb = + Newt.checkbox 1 (i+1) label + (if selected then '*' else ' ') None in + (handle, cb) + ) items in + + let ok = Newt.button 48 16 " OK " in + + let vb = + if List.length entries > 10 then + Some (Newt.vertical_scrollbar 58 1 10 + Newt_int.NEWT_COLORSET_WINDOW + Newt_int.NEWT_COLORSET_ACTCHECKBOX) + else + None in + let form = Newt.form vb None [] in + Newt.form_add_components form (List.map snd entries); + Newt.form_add_component form ok; + + let selected = + let rec loop () = + ignore (Newt.run_form form); + let selected = List.filter_map ( + fun (handle, cb) -> + if Newt.checkbox_get_value cb = '*' then Some handle else None + ) entries in + if force_one && selected = [] then loop () + else selected + in + loop () in + + Newt.pop_window (); + + selected + ) + +(* Display a dialog with radio buttons, return the single selected item. *) +let select_single ?stage width title items = + if items = [] then failwith "select_single: no items"; + + with_newt ( + fun () -> + open_centered_window ?stage width 20 title; + + let prev = ref None in + let entries = + List.mapi ( + fun i (label, handle) -> + let rb = Newt.radio_button 1 (i+1) label (!prev = None) !prev in + prev := Some rb; + (handle, rb) + ) items in + + let ok = Newt.button 48 16 " OK " in + + let vb = + if List.length entries > 10 then + Some (Newt.vertical_scrollbar 58 1 10 + Newt_int.NEWT_COLORSET_WINDOW + Newt_int.NEWT_COLORSET_ACTCHECKBOX) + else + None in + let form = Newt.form vb None [] in + Newt.form_add_components form (List.map snd entries); + Newt.form_add_component form ok; + + let (selected, _) = + let rec loop () = + ignore (Newt.run_form form); + let r = Option.get !prev in + let r = Newt.radio_get_current r in + (* Now we compare 'r' to all the 'rb's in the list + * to see which one is selected. + *) + try + List.find (fun (_, rb) -> Newt.component_equals r rb) entries + with + Not_found -> loop () + in + loop () in + + Newt.pop_window (); + + selected + ) + (* Shell-safe quoting function. In fact there's one in stdlib so use it. *) let quote = Filename.quote @@ -482,7 +580,7 @@ let ssh_disconnect (_, chan) = (* Test SSH connection. *) let test_ssh config = - printf "Testing SSH connection.\n\n%!"; + printf "Testing SSH connection by listing files in remote directory ...\n\n%!"; let cmd = sprintf "/bin/ls %s" (quote config.ssh_directory) in let conn = ssh_connect config cmd in @@ -857,34 +955,14 @@ let rec main ttyname = match !config_transfer_type with | Some t -> t | None -> - open_centered_window ~stage:"Transfer type" - 40 10 "Transfer type"; + let items = [ + "Physical to Virtual (P2V)", P2V; + "Virtual to Virtual (V2V)", V2V; + ] in - 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; ok]; - - let t = - let rec loop () = - ignore (Newt.run_form form); - - 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 - - Newt.pop_window (); - - t in + select_single ~stage:"Transfer type" 40 + "Transfer type" + items in (* Network configuration. *) let config_network = @@ -901,8 +979,6 @@ let rec main ttyname = * 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 loop = function | [] -> () | (partition, LinuxRoot (_, ((RHEL _|Fedora _) as distro))) @@ -911,11 +987,7 @@ let rec main ttyname = 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; + ignore (Newt.listbox_append_entry autolist label partition); loop parts | _ :: parts -> loop parts in @@ -924,7 +996,7 @@ let rec main ttyname = (* 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 no_auto = Newt.listbox_item_count autolist = 0 in let auto = Newt.radio_button 1 1 @@ -935,7 +1007,8 @@ let rec main ttyname = if no_auto then ( Newt.component_takes_focus auto false; - Newt.component_takes_focus autolist false + Newt.component_takes_focus + (Newt.component_of_listbox autolist) false ); let qemu = @@ -977,10 +1050,12 @@ let rec main ttyname = in let enable_autolist () = - Newt.component_takes_focus autolist true + Newt.component_takes_focus + (Newt.component_of_listbox autolist) true in let disable_autolist () = - Newt.component_takes_focus autolist false + Newt.component_takes_focus + (Newt.component_of_listbox autolist) false in disable_static (); @@ -998,7 +1073,8 @@ let rec main ttyname = let ok = Newt.button 48 16 " OK " in let form = Newt.form None None [] in - Newt.form_add_components form [auto; autolist; + Newt.form_add_components form [auto; + Newt.component_of_listbox autolist; shell;qemu;nonet;static; label1;label2;label3;label4;label5; entry1;entry2;entry3;entry4;entry5; @@ -1012,7 +1088,7 @@ let rec main ttyname = if Newt.component_equals r auto then ( match Newt.listbox_get_current autolist with | None -> loop () - | Some i -> Auto (Hashtbl.find partition_map i) + | Some part -> Auto part ) else if Newt.component_equals r shell then Shell else if Newt.component_equals r qemu then QEMUUserNet @@ -1150,259 +1226,138 @@ let rec main ttyname = 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. *) + (try + match List.assoc config_root_filesystem all_partitions with + | LinuxRoot (arch, _) -> + Newt.listbox_set_current_by_key archlistbox arch + | _ -> () + with + Not_found -> ()); - let ask_devices state = - let selected_devices = Option.default [] state.devices_to_send in - let devices = List.map ( - fun (dev, blksize) -> - (dev, - sprintf "/dev/%s (%.3f GB)" dev - ((Int64.to_float blksize) /. (1024.*.1024.*.1024.)), - List.mem dev selected_devices) - ) all_block_devices in - match - checklist "Devices" "Pick devices to send" 15 50 8 devices - with - | Yes [] | No | Help | Error -> Ask_again - | Yes devices -> Next { state with devices_to_send = Some devices } - | Back -> Prev - in + 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 ask_root state = - let parts = List.mapi ( - fun i (part, nature) -> - let descr = - match nature with - | LinuxSwap -> " (Linux swap)" - | LinuxRoot (_, RHEL (a,b)) -> sprintf " (RHEL %d.%d root)" a b - | LinuxRoot (_, Fedora v) -> sprintf " (Fedora %d root)" v - | LinuxRoot (_, Debian (a,b)) -> sprintf " (Debian %d.%d root)" a b - | LinuxRoot (_, OtherLinux) -> sprintf " (Linux root)" - | WindowsRoot -> " (Windows C:)" - | LinuxBoot -> " (Linux /boot)" - | NotRoot -> " (filesystem)" - | UnknownNature -> "" in - (string_of_int i, - dev_of_partition part ^ descr, - Some part = state.root_filesystem) - ) all_partitions in - match - radiolist "Root device" - "Pick partition containing the root (/) filesystem" 18 70 9 - parts - with - | Yes (i::_) -> - let (part, _) = List.nth all_partitions (int_of_string i) in - Next { state with root_filesystem = Some part } - | Yes [] | No | Help | Error -> Ask_again - | Back -> Prev - in + let libvirtd = + Newt.checkbox 12 14 "Use remote libvirtd" '*' None in - let ask_hypervisor state = - match - radiolist "Hypervisor" - "Choose hypervisor / virtualization system" - 11 50 4 [ - "xen", "Xen", state.hypervisor = Some Xen; - "qemu", "QEMU", state.hypervisor = Some QEMU; - "kvm", "KVM", state.hypervisor = Some KVM; - "other", "Other", state.hypervisor = None - ] - with - | Yes ("xen"::_) -> Next { state with hypervisor = Some Xen } - | Yes ("qemu"::_) -> Next { state with hypervisor = Some QEMU } - | Yes ("kvm"::_) -> Next { state with hypervisor = Some KVM } - | Yes _ -> Next { state with hypervisor = None } - | No | Help | Error -> Ask_again - | Back -> Prev - in + let ok = Newt.button 28 16 " OK " in - let ask_architecture state = - match - radiolist "Architecture" "Machine architecture" 16 50 8 [ - "i386", "i386 and up (32 bit)", state.architecture = Some I386; - "x86_64", "x86-64 (64 bit)", state.architecture = Some X86_64; - "ia64", "Itanium IA64", state.architecture = Some IA64; - "ppc", "PowerPC (32 bit)", state.architecture = Some PPC; - "ppc64", "PowerPC (64 bit)", state.architecture = Some PPC64; - "sparc", "SPARC (32 bit)", state.architecture = Some SPARC; - "sparc64", "SPARC (64 bit)", state.architecture = Some SPARC64; - "auto", "Auto-detect", - state.architecture = None || state.architecture = Some UnknownArch; - ] - with - | Yes ("i386" :: _) -> Next { state with architecture = Some I386 } - | Yes ("x86_64" :: _) -> Next { state with architecture = Some X86_64 } - | Yes ("ia64" :: _) -> Next { state with architecture = Some IA64 } - | Yes ("ppc" :: _) -> Next { state with architecture = Some PPC } - | Yes ("ppc64" :: _) -> Next { state with architecture = Some PPC64 } - | Yes ("sparc" :: _) -> Next { state with architecture = Some SPARC } - | Yes ("sparc64" :: _) -> Next { state with architecture = Some SPARC64 } - | Yes _ -> Next { state with architecture = Some UnknownArch } - | No | Help | Error -> Ask_again - | Back -> Prev - 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 = mac; + tgt_libvirtd = libvirtd } + else + loop () + with + Not_found | Failure "int_of_string" -> loop () + in + loop () in - let ask_memory state = - match - inputbox "Memory" "Memory (MB). Leave blank to use same as physical server." - 10 50 - (Option.map_default string_of_int "" state.memory) - with - | Yes (""::_ | []) -> Next { state with memory = Some 0 } - | Yes (mem::_) -> - let mem = try int_of_string mem with Failure "int_of_string" -> -1 in - if mem < 0 || (mem > 0 && mem < 64) then Ask_again - else Next { state with memory = Some mem } - | No | Help | Error -> Ask_again - | Back -> Prev - in + Newt.pop_window (); - let ask_vcpus state = - match - inputbox "VCPUs" "Virtual CPUs. Leave blank to use same as physical server." - 10 50 - (Option.map_default string_of_int "" state.vcpus) - with - | Yes (""::_ | []) -> Next { state with vcpus = Some 0 } - | Yes (vcpus::_) -> - let vcpus = - try int_of_string vcpus with Failure "int_of_string" -> -1 in - if vcpus < 0 then Ask_again - else Next { state with vcpus = Some vcpus } - | No | Help | Error -> Ask_again - | Back -> Prev - in + c in - let ask_mac_address state = - match - inputbox "MAC address" - "Network MAC address. Leave blank to use a random address." 10 50 - (Option.default "" state.mac_address) - with - | Yes (""::_ | []) -> Next { state with mac_address = Some "" } - | Yes (mac :: _) -> Next { state with mac_address = Some mac } - | No | Help | Error -> Ask_again - | Back -> Prev - in + config_devices_to_send, config_root_filesystem, config_target + ) in - let ask_compression state = - match - radiolist "Network compression" "Enable network compression" 10 50 2 [ - "yes", "Yes, compress network traffic", state.compression <> Some false; - "no", "No, don't compress", state.compression = Some false - ] - with - | Yes ("no"::_) -> Next { state with compression = Some false } - | Yes _ -> Next { state with compression = Some true } - | No | Help | Error -> Ask_again - | Back -> Prev - in - 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 -Compression: %b" - (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" - | Some Static -> "Static" | Some QEMUUserNet -> "QEMU user net" - | 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 -> "") - (Option.default true state.compression) - ) - 21 50 - with - | Yes _ -> Next state - | Back -> Prev - | No | Help | Error -> Ask_again - in - (* 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_compression, defaults.compression <> 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 - eprintf "finished dialog loop\n%!"; +(* (* In test mode, exit here before we do bad things to the developer's * hard disk. *) -- 1.8.3.1