X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=virt-p2v;h=269bbe268700bd2803b29e8711f064c5d031f87e;hb=4b59a9e67994b88c9ff8e2db7ec81ef49d5124ef;hp=805d7ab7bf95ab7f1822edf1644433207f60f02e;hpb=4a5fdb0a695840f635281a0169167c204401dd56;p=virt-p2v.git diff --git a/virt-p2v b/virt-p2v index 805d7ab..269bbe2 100755 --- a/virt-p2v +++ b/virt-p2v @@ -35,6 +35,16 @@ type network = | Static of string * string * string * string * string (* interface, address, netmask, gateway, nameserver *) | NoNetwork +type ssh_config = { + ssh_host : string; (* Remote host for SSH. *) + ssh_port : int; (* Remote port. *) + ssh_directory : string; (* Remote directory. *) + ssh_username : string; (* Remote username. *) + ssh_password : string; (* Remote password/passphrase. *) + ssh_compression : bool; (* If true, use SSH compression. *) + ssh_check : bool; (* If true, check SSH is working. *) + ssh_libvirtd : bool; (* If true, contact remote libvirtd. *) +} type hypervisor = | Xen | QEMU @@ -72,13 +82,7 @@ let config_transfer_type = ref None let config_network = ref None (* SSH configuration. *) -let config_remote_host = ref None -let config_remote_port = ref None -let config_remote_directory = ref None -let config_remote_username = ref None -let config_remote_password = ref None -let config_ssh_check = ref None -let config_libvirtd_check = ref None +let config_ssh = ref None (* What to transfer. *) let config_devices_to_send = ref None @@ -90,13 +94,12 @@ let config_architecture = ref None let config_memory = ref None let config_vcpus = ref None let config_mac_address = ref None -let config_compression = ref None (* The name of the program as displayed in various places. *) let program_name = "virt-p2v" (* If you want to test the dialog stages, set this to true. *) -let test_dialog_stages = false +let test_dialog_stages = true (* END OF CUSTOM virt-p2v SCRIPT SECTION. *) (*----------------------------------------------------------------------*) @@ -108,8 +111,7 @@ let test_dialog_stages = false #load "extLib.cma";; #directory "+pcre";; #load "pcre.cma";; -(*#directory "+newt";;*) -#directory "/home/rjones/d/redhat/newt";; +#directory "+newt";; #load "mlnewt.cma";; #directory "+xml-light";; #load "xml-light.cma";; @@ -454,6 +456,25 @@ let remote_of_origin_dev = fun dev -> Pcre.replace ~rex:devsd ~itempl:devsd_subst dev +(* Make an SSH connection to the remote machine. *) +(* +let ssh_connect config = + let cmd = sprintf "ssh%s -l %s -p %s %s" XXXXX + (if config.ssh_compression then " -C" else "") + (quote config.ssh_username) + (quote config.ssh_port) + (quote config.ssh_host) in + eprintf "ssh_connect: %s\n%!" cmd; + let chan = open_process_out cmd in + descr_of_out_channel chan, chan + +let ssh_disconnect (_, chan) = + match close_process_out chan with + | WEXITED 0 -> () (* OK *) + | WEXITED i -> failwith (sprintf "ssh: exited with error code %d" i) + | WSIGNALED i -> failwith (sprintf "ssh: killed by signal %d" i) + | WSTOPPED i -> failwith (sprintf "ssh: stopped by signal %d" i)*) + (* Rewrite /mnt/root/etc/fstab. *) let rewrite_fstab state devices_to_send = let filename = "/mnt/root/etc/fstab" in @@ -586,8 +607,7 @@ let rec main ttyname = "You should only run this script from the live CD or a USB key."; (* Start of the information gathering phase. *) - printf "%s detecting hard drives (this may take some time) ...\n%!" - program_name; + printf "Detecting hard drives (this may take some time) ...\n%!"; (* 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". @@ -782,7 +802,7 @@ let rec main ttyname = ) all_partitions in - printf "finished detecting hard drives\n%!"; + printf "Finished detecting hard drives.\n%!"; (* Autodetect system memory. *) let system_memory = @@ -814,181 +834,188 @@ let rec main ttyname = 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; + 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; + + 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 - ignore (Newt.run_form form); - Newt.pop_window (); + 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 + t 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 + 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 loop = 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; + loop parts + | _ :: parts -> loop parts + in + loop 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 enable_autolist () = - Newt.component_takes_focus autolist true - in - let disable_autolist () = - Newt.component_takes_focus autolist false - in + 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 - 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; + 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 - 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 () + let enable_autolist () = + Newt.component_takes_focus autolist true in - loop () 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 48 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; + + let n = + let rec loop () = + ignore (Newt.run_form form); + + 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 + Newt.pop_window (); + + n in config_transfer_type, config_network ) in @@ -1037,53 +1064,97 @@ let rec main ttyname = | NoNetwork -> (* this is easy ... *) () ); -(* - let ask_hostname state = - match - inputbox "Remote host" "Remote host" 10 50 - (Option.default "" state.remote_host) - with - | Yes [] -> Ask_again - | Yes (hostname::_) -> Next { state with remote_host = Some hostname } - | No | Help | Error -> Ask_again - | Back -> Prev - 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:"SSH configuration" + 60 20 "SSH configuration"; + + let label1 = Newt.label 1 1 "Remote host" in + let host = Newt.entry 20 1 None 36 [] in + let label2 = Newt.label 1 2 "Remote port" in + let port = Newt.entry 20 2 (Some "22") 6 [] in + let label3 = Newt.label 1 3 "Remote directory" in + let dir = Newt.entry 20 3 (Some "/var/lib/xen/images") 36 [] in + let label4 = Newt.label 1 4 "SSH username" in + let user = Newt.entry 20 4 (Some "root") 16 [] in + let label5 = Newt.label 1 5 "SSH password" in + let pass = Newt.entry 20 5 None 16 [Newt.PASSWORD] in + + let compr = + Newt.checkbox 16 7 "Use SSH compression (not good for LANs)" + ' ' None in + + let check = Newt.checkbox 16 9 "Test SSH connection" '*' None in + let libvirtd = + Newt.checkbox 16 10 "libvirtd is running on host" '*' None in + + Newt.component_add_callback check + (fun () -> + if Newt.checkbox_get_value check = '*' then + Newt.component_takes_focus libvirtd true + else ( + Newt.component_takes_focus libvirtd false; + Newt.checkbox_set_value libvirtd ' ' + ) + ); - let ask_port state = - match - inputbox "Remote port" "Remote port" 10 50 - (Option.default "22" state.remote_port) - with - | Yes ([]|""::_) -> Next { state with remote_port = Some "22" } - | Yes (port::_) -> Next { state with remote_port = Some port } - | No | Help | Error -> Ask_again - | Back -> Prev - in + let ok = Newt.button 48 16 " OK " in - let ask_directory state = - let default_dir = "/var/lib/xen/images" in - match - inputbox "Remote directory" "Remote directory" 10 50 - (Option.default default_dir state.remote_directory) - with - | Yes ([]|""::_) -> Next { state with remote_directory = Some default_dir } - | Yes (dir::_) -> Next { state with remote_directory = Some dir } - | No | Help | Error -> Ask_again - | Back -> Prev - in + let form = Newt.form None None [] in + Newt.form_add_components form [label1;label2;label3;label4;label5]; + Newt.form_add_components form [host;port;dir;user;pass]; + Newt.form_add_components form [compr;check;libvirtd]; + Newt.form_add_component form ok; - let ask_username state = - let default_username = "root" in - match - inputbox "Remote username" "Remote username for ssh access to server" 10 50 - (Option.default default_username state.remote_username) - with - | Yes ([]|""::_) -> - Next { state with remote_username = Some default_username } - | Yes (user::_) -> Next { state with remote_username = Some user } - | No | Help | Error -> Ask_again - | Back -> Prev - in + let c = + let rec loop () = + ignore (Newt.run_form form); + try + let host = Newt.entry_get_value host in + let port = int_of_string (Newt.entry_get_value port) in + let dir = Newt.entry_get_value dir in + let user = Newt.entry_get_value user in + let pass = Newt.entry_get_value pass in + let compr = Newt.checkbox_get_value compr = '*' in + let check = Newt.checkbox_get_value check = '*' in + let libvirtd = Newt.checkbox_get_value libvirtd = '*' in + if host <> "" && port > 0 && port < 65536 && + user <> "" then + { ssh_host = host; ssh_port = port; ssh_directory = dir; + ssh_username = user; ssh_password = pass; + ssh_compression = compr; + ssh_check = check; ssh_libvirtd = libvirtd } + else + loop () + with + Failure "int_of_string" -> loop () + in + loop () in + + Newt.pop_window (); + c + ) in + + (* If asked, check the SSH connection. At the same time + * grab the capabilities from the remote host. + *) + let capabilities = + if config_ssh.ssh_check then ( + printf "Testing SSH connection.\n\n"; + + Some "foo" + + + ) + else None in + +(* let ask_devices state = let selected_devices = Option.default [] state.devices_to_send in @@ -1419,24 +1490,6 @@ Compression: %b" let remote_directory = Option.get state.remote_directory in let remote_username = Option.get state.remote_username in - (* Functions to connect and disconnect from the remote system. *) - let do_connect remote_name _ = - let cmd = sprintf "ssh%s -l %s -p %s %s \"cat > %s/%s\"" - (if state.compression = Some false then "" else " -C") - (quote remote_username) (quote remote_port) (quote remote_host) - (quote remote_directory) (quote remote_name) in - eprintf "connect: %s\n%!" cmd; - let chan = open_process_out cmd in - descr_of_out_channel chan, chan - in - let do_disconnect (_, chan) = - match close_process_out chan with - | WEXITED 0 -> () (* OK *) - | WEXITED i -> failwith (sprintf "ssh: exited with error code %d" i) - | WSIGNALED i -> failwith (sprintf "ssh: killed by signal %d" i) - | WSTOPPED i -> failwith (sprintf "ssh: stopped by signal %d" i) - in - (* XXX This is using the hostname derived from network configuration * above. We might want to ask the user to choose. *)