X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=virt-p2v;h=dcd7af0ff4d967c5a165126e62ea5b763e7865f9;hb=5ff38db3fb35cc8c58c8dd9e0b2e37680592a7a3;hp=133cee1b9af51101a517f7cbc81946da8257d41b;hpb=7d4f5476b3a7e286e36c6bf6bf06727c56a3f58f;p=virt-p2v.git diff --git a/virt-p2v b/virt-p2v index 133cee1..dcd7af0 100755 --- a/virt-p2v +++ b/virt-p2v @@ -21,46 +21,31 @@ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) -#load "unix.cma";; -#directory "+extlib";; -#load "extLib.cma";; -#directory "+pcre";; -#load "pcre.cma";; -#directory "+xml-light";; -#load "xml-light.cma";; - -open Unix -open Printf -open ExtList -open ExtString - -type state = { greeting : bool; - remote_host : string option; remote_port : string option; - remote_directory : string option; - remote_username : string option; - network : network option; - static_network_config : static_network_config option; - devices_to_send : string list option; - root_filesystem : partition option; - hypervisor : hypervisor option; - architecture : architecture option; - memory : int option; vcpus : int option; - mac_address : string option; - } -and network = Auto - | Shell - | QEMUUserNet - | Static -and partition = Part of string * string (* eg. "hda", "1" *) - | LV of string * string (* eg. "VolGroup00", "LogVol00" *) -and hypervisor = Xen | QEMU | KVM -and architecture = I386 | X86_64 | IA64 | PPC | PPC64 | SPARC | SPARC64 - | OtherArch of string | UnknownArch -and static_network_config = string * string * string * string * string - (* interface, address, netmask, gateway, nameserver *) +type partition = + | Part of string * string (* eg. "hda", "1" *) + | LV of string * string (* eg. "VolGroup00", "LogVol00" *) +type transfer = + | P2V (* physical to virtual *) + | V2V (* virtual to virtual *) + (*| V2P*) (* virtual to physical - not impl *) +type network = + | Auto of partition (* Automatic network configuration. *) + | Shell (* Start a shell. *) + | QEMUUserNet (* Assume we're running under qemu. *) + | Static of string * string * string * string * string + (* interface, address, netmask, gateway, nameserver *) + | NoNetwork +type hypervisor = + | Xen + | QEMU + | KVM +type architecture = + | I386 | X86_64 | IA64 | PPC | PPC64 | SPARC | SPARC64 + | OtherArch of string + | UnknownArch (*----------------------------------------------------------------------*) -(* TO MAKE A CUSTOM virt-p2v SCRIPT, adjust the defaults in this section. +(* TO MAKE A CUSTOM VIRT-P2V SCRIPT, adjust the defaults in this section. * * If left as they are, then this will create a generic virt-p2v script * which asks the user for each question. If you set the defaults here @@ -69,34 +54,71 @@ and static_network_config = string * string * string * string * string * * Note that 'None' means 'no default' (ie. ask the user) whereas * 'Some foo' means use 'foo' as the answer. + * + * These are documented in the virt-p2v(1) manual page. + * + * After changing them, run './virt-p2v --test' to check syntax. *) -let defaults = { - (* If greeting is true, wait for keypress after boot and during - * final verification. Set to 'false' for less interactions. - *) - greeting = true; - (* These are now documented in the man page virt-p2v(1). - * 'None' means ask the user. - * After changing them, run './virt-p2v --test' to check syntax. - *) - remote_host = None; - remote_port = None; - remote_directory = None; - remote_username = None; - devices_to_send = None; - root_filesystem = None; - network = None; - static_network_config = None; - hypervisor = None; - architecture = None; - memory = None; - vcpus = None; - mac_address = None; -} +(* If greeting is true, wait for keypress after boot and during + * final verification. Set to 'false' for less interactions. + *) +let config_greeting = ref true + +(* General type of transfer. *) +let config_transfer_type = ref None + +(* Network configuration. *) +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 + +(* What to transfer. *) +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_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 + (* END OF CUSTOM virt-p2v SCRIPT SECTION. *) (*----------------------------------------------------------------------*) +(* Load external libraries. *) +;; +#load "unix.cma";; +#directory "+extlib";; +#load "extLib.cma";; +#directory "+pcre";; +#load "pcre.cma";; +#directory "+newt";; +#load "mlnewt.cma";; +#directory "+xml-light";; +#load "xml-light.cma";; + +open Unix +open Printf +open ExtList +open ExtString + +(*----------------------------------------------------------------------*) (* General helper functions. *) let sort_uniq ?(cmp = compare) xs = (* sort and uniq a list *) @@ -130,10 +152,6 @@ let string_of_architecture = function | OtherArch arch -> arch | UnknownArch -> "" -type dialog_status = Yes of string list | No | Help | Back | Error - -type ask_result = Next of state | Prev | Ask_again - type nature = LinuxSwap | LinuxRoot of architecture * linux_distro | WindowsRoot (* Windows C: *) @@ -159,133 +177,66 @@ and string_of_linux_distro = function | Debian (a,b) -> sprintf "Debian %d.%d" a b | OtherLinux -> "Linux" -(* Dialog functions. - * - * Each function takes some common parameters (eg. ~title) and some - * dialog-specific parameters. +type ('a, 'b) either = Either of 'a | Or of 'b + +(* We go into and out of newt mode at various stages, but we might + * also need to put up a message at any time. This keeps track of + * whether we are in newt mode or not. * - * Returns the exit status (Yes lines | No | Help | Back | Error). + * General tip: Try to do any complex operations like setting up the + * network or probing disks outside newt mode, and try not to throw + * exceptions in newt mode. *) -let msgbox, yesno, inputbox, radiolist, checklist, form = - (* Internal function to actually run the "dialog" shell command. *) - let run_dialog cparams params = - let params = cparams @ params in - eprintf "dialog %s\n%!" - (String.concat " " (List.map (sprintf "%S") params)); - - (* 'dialog' writes its output/result to stderr, so we need to take - * special steps to capture that - in other words, manual pipe/fork. - *) - let rfd, wfd = pipe () in - match fork () with - | 0 -> (* child, runs dialog *) - close rfd; - dup2 wfd stderr; (* capture stderr to pipe *) - execvp "dialog" (Array.of_list ("dialog" :: params)) - | pid -> (* parent *) - close wfd; - let chan = in_channel_of_descr rfd in - let result = input_all_lines chan in - close rfd; - eprintf "dialog result: %S\n%!" (String.concat "\n" result); - match snd (wait ()) with - | WEXITED 0 -> Yes result (* something selected / entered *) - | WEXITED 1 -> No (* cancel / no button *) - | WEXITED 2 -> Help (* help pressed *) - | WEXITED 3 -> Back (* back button *) - | WEXITED _ -> Error (* error or Esc *) - | WSIGNALED i -> failwith (sprintf "dialog: killed by signal %d" i) - | WSTOPPED i -> failwith (sprintf "dialog: stopped by signal %d" i) - in - - (* Handle the common parameters. Note Continuation Passing Style. *) - let with_common cont ?(cancel=false) ?(backbutton=true) title = - let params = ["--title"; title] in - let params = if not cancel then "--nocancel" :: params else params in - let params = - if backbutton then "--extra-button" :: "--extra-label" :: "Back" :: params - else params in - cont params - in - - (* Message box and yes/no box. *) - let rec msgbox = - with_common ( - fun cparams text height width -> - run_dialog cparams - [ "--msgbox"; text; string_of_int height; string_of_int width ] - ) - and yesno = - with_common ( - fun cparams text height width -> - run_dialog cparams - [ "--yesno"; text; string_of_int height; string_of_int width ] - ) - - (* Simple input box. *) - and inputbox = - with_common ( - fun cparams text height width default -> - run_dialog cparams - [ "--inputbox"; text; string_of_int height; string_of_int width; - default ] - ) - - (* Radio list and check list. *) - and radiolist = - with_common ( - fun cparams text height width listheight items -> - let items = List.map ( - function - | tag, item, true -> [ tag; item; "on" ] - | tag, item, false -> [ tag; item; "off" ] - ) items in - let items = List.concat items in - let items = "--single-quoted" :: - "--radiolist" :: text :: - string_of_int height :: string_of_int width :: - string_of_int listheight :: items in - run_dialog cparams items - ) - and checklist = - with_common ( - fun cparams text height width listheight items -> - let items = List.map ( - function - | tag, item, true -> [ tag; item; "on" ] - | tag, item, false -> [ tag; item; "off" ] - ) items in - let items = List.concat items in - let items = "--separate-output" :: - "--checklist" :: text :: - string_of_int height :: string_of_int width :: - string_of_int listheight :: items in - run_dialog cparams items - ) +let in_newt = ref false +let with_newt f = + if !in_newt then f () + else ( + in_newt := true; + let r = + try Either (Newt.init_and_finish f) + with exn -> Or exn in + in_newt := false; + match r with Either r -> r | Or exn -> raise exn + ) - (* Form. *) - and form = - with_common ( - fun cparams text height width formheight items -> - let items = List.map ( - fun (label, y, x, item, y', x', flen, ilen) -> - [ label; string_of_int y; string_of_int x; item; - string_of_int y'; string_of_int x'; - string_of_int flen; string_of_int ilen ] - ) items in - let items = List.concat items in - let items = "--form" :: text :: - string_of_int height :: string_of_int width :: - string_of_int formheight :: items in - run_dialog cparams items - ) - in - msgbox, yesno, inputbox, radiolist, checklist, form +(* Clear the screen, open a new centered window, make sure the background + * and help messages are consistent. + *) +let open_centered_window ?stage width height title = + if not !in_newt then failwith "open_centered_window: not in newt mode"; + Newt.cls (); + Newt.centered_window width height title; + let root_text = + program_name ^ (match stage with + | None -> "" + | Some stage -> " - " ^ stage) in + Newt.draw_root_text 0 0 root_text; + Newt.push_help_line "F12 for next screen | [ALT] [F2] root / no password for shell" + +(* Some general dialog boxes. *) +let message_box title text = + with_newt ( + fun () -> + open_centered_window 40 20 title; + + let textbox = Newt.textbox 1 1 36 14 [Newt.WRAP; Newt.SCROLL] in + Newt.textbox_set_text textbox text; + let ok = Newt.button 28 16 " OK " in + let form = Newt.form None None [] in + Newt.form_add_component form textbox; + Newt.form_add_component form ok; + + Newt.component_takes_focus ok true; + + ignore (Newt.run_form form); + Newt.pop_window () + ) -(* Print failure dialog and exit. *) -let fail_dialog text = +(* Fail and exit with error. *) +let failwith text = + prerr_endline text; let text = "\n" ^ text ^ "\n\nIf you want to report this error, there is a shell on [ALT] [F2], log in as root with no password.\n\nPlease provide the contents of /tmp/virt-p2v.log and output of the 'dmesg' command." in - ignore (msgbox "Error" text 17 50); + message_box "Error" text; exit 1 (* Shell-safe quoting function. In fact there's one in stdlib so use it. *) @@ -294,7 +245,7 @@ let quote = Filename.quote (* Run a shell command and check it returns 0. *) let sh cmd = eprintf "sh: %s\n%!" cmd; - if Sys.command cmd <> 0 then fail_dialog (sprintf "Command failed:\n\n%s" cmd) + if Sys.command cmd <> 0 then failwith (sprintf "Command failed:\n\n%s" cmd) let shfailok cmd = eprintf "shfailok: %s\n%!" cmd; @@ -339,8 +290,8 @@ let is_file path = try Some ((stat path).st_kind = S_REG) with Unix_error (ENOENT, "stat", _) -> None -(* Useful regular expression. *) -let whitespace = Pcre.regexp "[ \t]+" +(*----------------------------------------------------------------------*) +(* P2V-specific helper functions. *) (* Generate a predictable safe name containing only letters, numbers * and underscores. If passed a string with no letters or numbers, @@ -374,7 +325,7 @@ let get_lvs = with | None -> [] | Some lines -> - let lines = List.map (Pcre.split ~rex:whitespace) lines in + let lines = List.map Pcre.split lines in List.map ( function | [vg; lv; pvs; lvsize] @@ -434,7 +385,7 @@ let snapshot = match lines with | Some (sectors::_) -> Int64.of_string sectors | Some [] | None -> - fail_dialog (sprintf "Snapshot failed - unable to read the size in sectors of block device %s" origin_dev) in + failwith (sprintf "Snapshot failed - unable to read the size in sectors of block device %s" origin_dev) in (* Create the snapshot origin device. Called, eg. snap_sda1_org *) sh (sprintf "dmsetup create %s_org --table='0 %Ld snapshot-origin /dev/%s'" @@ -446,48 +397,21 @@ let snapshot = (* Try to perform automatic network configuration, assuming a Fedora or * RHEL-like root filesystem mounted on /mnt/root. *) -let auto_network state = +let auto_network () = (* Fedora gives an error if this file doesn't exist. *) sh "touch /etc/resolv.conf"; -(* - (* We can run /mnt/root/etc/init.d/network in a chroot environment, - * however this won't work directly because the architecture of the - * binaries under /mnt/root (eg. /mnt/root/sbin/ip) might not match - * the architecture of the live CD kernel. In particular, a 32 bit - * live CD cannot run 64 bit binaries. So we also have to bind-mount - * the live CD's /bin, /sbin, /lib etc. over the equivalents in - * /mnt/root. - *) - let bind dir = - if is_dir dir = Some true then - sh ("mount -o bind " ^ quote dir ^ " " ^ quote ("/mnt/root" ^ dir)) - in - let unbind dir = - if is_dir dir = Some true then sh ("umount -l " ^ quote ("/mnt/root" ^ dir)) - in - let dirs = [ - "/bin"; "/sbin"; "/lib"; "/lib64"; - "/usr/bin"; "/usr/sbin"; "/usr/lib"; "/usr/lib64"; - "/proc"; "/sys" - ] in - List.iter bind dirs; - let status = shwithstatus "chroot /mnt/root /etc/init.d/network start" in - List.iter unbind dirs; -*) - - (* Simpler way to do the above. - * NB. Lazy unmount is required because dhclient keeps its current + (* NB. Lazy unmount is required because dhclient keeps its current * directory open on /etc/sysconfig/network-scripts/ *) sh "mount -o bind /mnt/root/etc /etc"; let status = shwithstatus "/etc/init.d/network start" in sh "umount -l /etc"; - (* Try to ping the remote host to see if this worked. *) - shfailok ("ping -c 3 " ^ Option.map_default quote "" state.remote_host); + (* Try to ping the default gateway to see if this worked. *) + shfailok "ping -c3 `/sbin/ip route list match 0.0.0.0 | head -1 | awk '{print $3}'`"; - if state.greeting then ( + if !config_greeting then ( printf "\n\nDid automatic network configuration work?\n"; printf "Hint: If not sure, there is a shell on console [ALT] [F2]\n"; printf " (y/n) %!"; @@ -499,23 +423,21 @@ let auto_network state = status = 0 (* Configure the network statically. *) -let static_network state = - match state.static_network_config with - | None -> false (* failed *) - | Some (interface, address, netmask, gateway, nameserver) -> - let do_cmd_or_exit cmd = if shwithstatus cmd <> 0 then raise Exit in - try - do_cmd_or_exit (sprintf "ifconfig %s %s netmask %s" - (quote interface) (quote address) (quote netmask)); - do_cmd_or_exit (sprintf "route add default gw %s %s" - (quote gateway) (quote interface)); - if nameserver <> "" then - do_cmd_or_exit (sprintf "echo nameserver %s > /etc/resolv.conf" - (quote nameserver)); - true (* succeeded *) - with - Exit -> false (* failed *) +let static_network (interface, address, netmask, gateway, nameserver) = + let do_cmd_or_exit cmd = if shwithstatus cmd <> 0 then raise Exit in + try + do_cmd_or_exit (sprintf "ifconfig %s %s netmask %s" + (quote interface) (quote address) (quote netmask)); + do_cmd_or_exit (sprintf "route add default gw %s %s" + (quote gateway) (quote interface)); + if nameserver <> "" then + do_cmd_or_exit (sprintf "echo nameserver %s > /etc/resolv.conf" + (quote nameserver)); + true (* succeeded *) + with + Exit -> false (* failed *) +(* http://fabrice.bellard.free.fr/qemu/qemu-doc.html#SEC30 *) let qemu_network () = sh "ifconfig eth0 10.0.2.10 netmask 255.255.255.0"; sh "route add default gw 10.0.2.2 eth0"; @@ -540,7 +462,7 @@ let rewrite_fstab state devices_to_send = let chan = open_in filename in let lines = input_all_lines chan in close_in chan; - let lines = List.map (Pcre.split ~rex:whitespace) lines in + let lines = List.map Pcre.split lines in let lines = List.map ( function | dev :: rest when String.starts_with dev "/dev/" -> @@ -558,13 +480,13 @@ let rewrite_fstab state devices_to_send = fprintf chan "%-23s %-23s %-7s %-15s %s %s\n" dev mountpoint fstype options freq passno | line -> - output_string chan (String.concat " " line) + output_string chan (String.concat " " line); + output_char chan '\n' ) lines; close_out chan ) -let () = Random.self_init () - +(* Generate a random MAC address in the Xen-reserved space. *) let random_mac_address () = let random = List.map (sprintf "%02x") ( @@ -572,6 +494,7 @@ let random_mac_address () = ) in String.concat ":" ("00"::"16"::"3e"::random) +(* Generate a random UUID. *) let random_uuid = let hex = "0123456789abcdef" in fun () -> @@ -579,8 +502,45 @@ let random_uuid = for i = 0 to 31 do str.[i] <- hex.[Random.int 16] done; str +(*----------------------------------------------------------------------*) (* Main entry point. *) + +(* The general plan for the main function is to operate in stages: + * + * Start-up + * | + * V + * Information gathering about the system + * | (eg. block devices, number of CPUs, etc.) + * V + * Greeting and type of transfer question + * | + * V + * Set up the network + * | (after this point we have a working network) + * V + * Set up SSH + * | (after this point we have a working SSH connection) + * V + * Questions about what to transfer (block devs, root fs) <--. + * | | + * V | + * Questions about hypervisor configuration | + * | | + * V | + * Verify information -------- user wants to change info ----/ + * | + * V + * Perform transfer + * + * Prior versions of virt-p2v (the ones which used 'dialog') had support + * for a back button so they could go back through dialogs. I removed + * this because it was hard to support and not particularly useful. + *) + let rec main ttyname = + Random.self_init (); + (* Running from an init script. We don't have much of a * login environment, so set one up. *) @@ -602,7 +562,8 @@ let rec main ttyname = (* Log the start up time. *) eprintf "\n\n**************************************************\n\n"; let tm = localtime (time ()) in - eprintf "virt-p2v-ng starting up at %04d-%02d-%02d %02d:%02d:%02d\n\n%!" + eprintf "%s starting up at %04d-%02d-%02d %02d:%02d:%02d\n\n%!" + program_name (tm.tm_year+1900) (tm.tm_mon+1) tm.tm_mday tm.tm_hour tm.tm_min tm.tm_sec; (* Connect stdin/stdout to the tty. *) @@ -613,17 +574,19 @@ let rec main ttyname = dup2 fd stdin; dup2 fd stdout; close fd); - printf "virt-p2v starting up ...\n%!"; + printf "%s starting up ...\n%!" program_name; (* Disable screen blanking on tty. *) sh "setterm -blank 0"; (* Check that the environment is a sane-looking live CD. If not, bail. *) - if is_dir "/mnt/root" <> Some true then - fail_dialog + if not test_dialog_stages && is_dir "/mnt/root" <> Some true then + failwith "You should only run this script from the live CD or a USB key."; - printf "virt-p2v detecting hard drives (this may take some time) ...\n%!"; + (* Start of the information gathering phase. *) + printf "%s detecting hard drives (this may take some time) ...\n%!" + program_name; (* 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". @@ -650,7 +613,7 @@ let rec main ttyname = (String.concat "; " (List.map (fun (d, b) -> sprintf "%s [%Ld]" d b) devices)); if devices = [] then - fail_dialog "No non-removable block devices (hard disks, etc.) could be found on this machine."; + failwith "No non-removable block devices (hard disks, etc.) could be found on this machine."; devices in (* Search for partitions and LVs (anything that could contain a @@ -818,14 +781,262 @@ let rec main ttyname = ) all_partitions in - printf "virt-p2v finished detecting hard drives\n%!"; + printf "finished detecting hard drives\n%!"; - (* Dialogs. *) - let ask_greeting state = - ignore (msgbox "virt-p2v" "\nWelcome to virt-p2v, 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." 18 50); - Next state - in + (* 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 + (* Try to bring up the network. *) + (match config_network with + | Shell -> + printf "Network configuration.\n\n"; + printf "Please configure the network from this shell.\n\n"; + printf "When you have finished, exit the shell with ^D or exit.\n\n%!"; + shell () + + | Static (interface, address, netmask, gateway, nameserver) -> + printf "Trying static network configuration.\n\n%!"; + if not (static_network + (interface, address, netmask, gateway, nameserver)) then ( + printf "\nAuto-configuration failed. Starting a shell.\n\n"; + printf "Please configure the network from this shell.\n\n"; + printf "When you have finished, exit the shell with ^D or exit.\n\n"; + shell () + ) + + | Auto rootfs -> + printf + "Trying network auto-configuration from root filesystem ...\n\n%!"; + + (* Mount the root filesystem read-only under /mnt/root. *) + sh ("mount -o ro " ^ quote (dev_of_partition rootfs) ^ " /mnt/root"); + + if not (auto_network ()) then ( + printf "\nAuto-configuration failed. Starting a shell.\n\n"; + printf "Please configure the network from this shell.\n\n"; + printf "When you have finished, exit the shell with ^D or exit.\n\n"; + shell () + ); + + (* NB. Lazy unmount is required because dhclient keeps its current + * directory open on /etc/sysconfig/network-scripts/ + *) + sh ("umount -l /mnt/root"); + + | QEMUUserNet -> + printf "Trying QEMU network configuration.\n\n%!"; + qemu_network () + + | NoNetwork -> (* this is easy ... *) () + ); + +(* let ask_hostname state = match inputbox "Remote host" "Remote host" 10 50 @@ -873,48 +1084,6 @@ let rec main ttyname = | Back -> Prev in - let ask_network state = - match - radiolist "Network configuration" "Network configuration" 12 50 4 [ - "auto", "Automatic configuration", state.network = Some Auto; - "ask", "Ask for fixed IP address and gateway", - state.network = Some Static; - "sh", "Configure from the shell", state.network = Some Shell; - "qemu", "QEMU user network (for developers only)", - state.network = Some QEMUUserNet - ] - with - | Yes ("auto"::_) -> Next { state with network = Some Auto } - | Yes ("ask"::_) -> Next { state with network = Some Static } - | Yes ("sh"::_) -> Next { state with network = Some Shell } - | Yes ("qemu"::_) -> Next { state with network = Some QEMUUserNet } - | Yes _ | No | Help | Error -> Ask_again - | Back -> Prev - in - - let ask_static_network_config state = - let interface, address, netmask, gateway, nameserver = - match state.static_network_config with - | Some (a,b,c,d,e) -> a,b,c,d,e - | None -> "eth0","","","","" in - match - form "Static network configuration" "Static network configuration" - 13 50 5 [ - "Interface", 1, 0, interface, 1, 12, 8, 0; - "Address", 2, 0, address, 2, 12, 16, 0; - "Netmask", 3, 0, netmask, 3, 12, 16, 0; - "Gateway", 4, 0, gateway, 4, 12, 16, 0; - "Nameserver", 5, 0, nameserver, 5, 12, 16, 0; - ] - with - | Yes (interface::address::netmask::gateway::nameserver::_) -> - Next { state with - static_network_config = Some (interface, address, netmask, - gateway, nameserver) } - | Yes _ | No | Help | Error -> Ask_again - | Back -> Prev - in - let ask_devices state = let selected_devices = Option.default [] state.devices_to_send in let devices = List.map ( @@ -1050,6 +1219,19 @@ let rec main ttyname = | Back -> Prev 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" @@ -1064,7 +1246,8 @@ Hypervisor: %s Architecture: %s Memory: %s VCPUs: %s -MAC address: %s" +MAC address: %s +Compression: %b" (Option.default "" state.remote_host) (Option.default "" state.remote_port) (Option.default "" state.remote_directory) @@ -1088,6 +1271,7 @@ MAC address: %s" | 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 @@ -1124,6 +1308,7 @@ MAC address: %s" 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 @@ -1150,6 +1335,11 @@ MAC address: %s" eprintf "finished dialog loop\n%!"; + (* In test mode, exit here before we do bad things to the developer's + * hard disk. + *) + if test_dialog_stages then exit 1; + (* Switch LVM config. *) sh "vgchange -a n"; putenv "LVM_SYSTEM_DIR" "/etc/lvm.new"; (* see lvm(8) *) @@ -1191,38 +1381,6 @@ MAC address: %s" sh ("mount " ^ quote ("/dev/" ^ vg ^ "/" ^ lv) ^ " /mnt/root") ); - (* See if we can do network configuration. *) - let network = Option.get state.network in - (match network with - | Shell -> - printf "Network configuration.\n\n"; - printf "Please configure the network from this shell.\n\n"; - printf "When you have finished, exit the shell with ^D or exit.\n\n%!"; - shell () - - | Static -> - printf "Trying static network configuration.\n\n%!"; - if not (static_network state) then ( - printf "\nAuto-configuration failed. Starting a shell.\n\n"; - printf "Please configure the network from this shell.\n\n"; - printf "When you have finished, exit the shell with ^D or exit.\n\n"; - shell () - ) - - | Auto -> - printf - "Trying network auto-configuration from root filesystem ...\n\n%!"; - if not (auto_network state) then ( - printf "\nAuto-configuration failed. Starting a shell.\n\n"; - printf "Please configure the network from this shell.\n\n"; - printf "When you have finished, exit the shell with ^D or exit.\n\n"; - shell () - ) - | QEMUUserNet -> - printf "Trying QEMU network configuration.\n\n%!"; - qemu_network () - ); - (* Work out what devices will be called at the remote end. *) let devices_to_send = List.map ( fun (origin_dev, snapshot_dev) -> @@ -1255,21 +1413,6 @@ MAC address: %s" | Some ("ia64"::_) -> IA64 | _ -> I386 (* probably wrong XXX *) in - (* 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 - let remote_host = Option.get state.remote_host in let remote_port = Option.get state.remote_port in let remote_directory = Option.get state.remote_directory in @@ -1277,7 +1420,8 @@ MAC address: %s" (* Functions to connect and disconnect from the remote system. *) let do_connect remote_name _ = - let cmd = sprintf "ssh -C -l %s -p %s %s \"cat > %s/%s\"" + 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; @@ -1479,51 +1623,58 @@ MAC address: %s" let (sock,_) as conn = do_connect remote_name size in (* Copy the data. *) + let spinners = "|/-\\" (* "Oo" *) in let bufsize = 1024 * 1024 in let buffer = String.create bufsize in let start = gettimeofday () in - let rec copy bytes_sent last_printed_at = + let rec copy bytes_sent last_printed_at spinner = let n = read fd buffer 0 bufsize in if n > 0 then ( - ignore (write sock buffer 0 n); + let n' = write sock buffer 0 n in + if n <> n' then assert false; (* never, according to the manual *) let bytes_sent = Int64.add bytes_sent (Int64.of_int n) in - let last_printed_at = + let last_printed_at, spinner = let now = gettimeofday () in (* Print progress every few seconds. *) - if now -. last_printed_at > 5. then ( + if now -. last_printed_at > 2. then ( let elapsed = Int64.to_float bytes_sent /. Int64.to_float size in let secs_elapsed = now -. start in - printf "%.0f%%" (100. *. elapsed); + printf "%.0f%% %c %.1f Mbps" + (100. *. elapsed) spinners.[spinner] + (Int64.to_float bytes_sent/.secs_elapsed/.1_000_000. *. 8.); (* After 60 seconds has elapsed, start printing estimates. *) if secs_elapsed >= 60. then ( let remaining = 1. -. elapsed in let secs_remaining = (remaining /. elapsed) *. secs_elapsed in if secs_remaining > 120. then - printf " (about %.0f minutes remaining) " - (secs_remaining /. 60.) + printf " (about %.0f minutes remaining)" (secs_remaining/.60.) else - printf " (about %.0f seconds remaining) " + printf " (about %.0f seconds remaining)" secs_remaining ); - printf "\r%!"; - now + printf " \r%!"; + let spinner = (spinner + 1) mod String.length spinners in + now, spinner ) - else last_printed_at in + else last_printed_at, spinner in - copy bytes_sent last_printed_at + copy bytes_sent last_printed_at spinner ) in - copy 0L start; + copy 0L start 0; + printf "\n\n%!"; (* because of the messages printed above *) (* Disconnect. *) do_disconnect conn ) devices_to_send; + (*printf "\n\nPress any key ...\n%!"; ignore (read_line ());*) + (* Clean up and reboot. *) ignore ( - msgbox "virt-p2v completed" + msgbox (sprintf "%s completed" program_name) (sprintf "\nThe physical to virtual migration is complete.\n\nPlease verify the disk image(s) and configuration file on the remote host, and then start up the virtual machine by doing:\n\ncd %s\nvirsh define %s\n\nWhen you press [OK] this machine will reboot." remote_directory conf_filename) 17 50 @@ -1531,8 +1682,11 @@ MAC address: %s" shfailok "eject"; shfailok "reboot"; +*) exit 0 +(*----------------------------------------------------------------------*) + let usage () = eprintf "usage: virt-p2v [--test] [ttyname]\n%!"; exit 2 @@ -1543,7 +1697,9 @@ let usage () = *) let handle_exn f arg = try f arg - with exn -> print_endline (Printexc.to_string exn); raise exn + with exn -> + print_endline (Printexc.to_string exn); + raise exn (* Test harness for the Makefile. The Makefile invokes this script as * 'virt-p2v --test' just to check it compiles. When it is running