X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=virt-p2v;h=4e27c778af5b9ecc6a0e0ae361504fd77bec2a7c;hb=b16a2c25233749983e1ba95122aa2036b6b67cbe;hp=dcd7af0ff4d967c5a165126e62ea5b763e7865f9;hpb=5ff38db3fb35cc8c58c8dd9e0b2e37680592a7a3;p=virt-p2v.git

diff --git a/virt-p2v b/virt-p2v
index dcd7af0..4e27c77 100755
--- a/virt-p2v
+++ b/virt-p2v
@@ -35,6 +35,14 @@ 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 : string;			(* Remote port. *)
+  ssh_directory : string;		(* Remote directory. *)
+  ssh_username : string;		(* Remote username. *)
+  ssh_compression : bool;		(* If true, use SSH compression. *)
+  ssh_check : bool;			(* If true, check SSH is working. *)
+}
 type hypervisor =
   | Xen
   | QEMU
@@ -43,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.
@@ -72,25 +88,14 @@ 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
 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
+let config_target = ref None
 
 (* The name of the program as displayed in various places. *)
 let program_name = "virt-p2v"
@@ -223,8 +228,7 @@ let message_box title text =
       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.form_add_components form [textbox; ok];
 
       Newt.component_takes_focus ok true;
 
@@ -239,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 (width-12) 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
 
@@ -319,7 +418,7 @@ type block_device = string * int64	(* "hda" & size in bytes *)
 let get_lvs =
   let devname = Pcre.regexp "^/dev/(.+)\\(.+\\)$" in
 
-  function () ->
+  fun () ->
     match
     shget "lvs --noheadings -o vg_name,lv_name,devices,lv_size"
     with
@@ -403,6 +502,7 @@ let auto_network () =
 
   (* NB. Lazy unmount is required because dhclient keeps its current
    * directory open on /etc/sysconfig/network-scripts/
+   * (Fixed in dhcp >= 4.0.0 but be generous anyway).
    *)
   sh "mount -o bind /mnt/root/etc /etc";
   let status = shwithstatus "/etc/init.d/network start" in
@@ -453,8 +553,60 @@ let remote_of_origin_dev =
   fun dev ->
     Pcre.replace ~rex:devsd ~itempl:devsd_subst dev
 
+(* Make an SSH connection to the remote machine, execute command.
+ * The connection remains open until you call ssh_disconnect, it
+ * times out or there is some error.
+ *
+ * NB. The command is NOT quoted.
+ *
+ * Returns a pair (file descriptor, channel), both referring to the
+ * same thing.  Use whichever is more convenient.
+ *)
+let ssh_connect config cmd =
+  let cmd = sprintf "ssh%s -l %s -p %s %s %s"
+    (if config.ssh_compression then " -C" else "")
+    (quote config.ssh_username) (quote config.ssh_port) (quote config.ssh_host)
+    cmd in
+  eprintf "ssh_connect: %s\n%!" cmd;
+  let chan = open_process_out cmd in
+  descr_of_out_channel chan, chan
+
+let ssh_disconnect (_, chan) =
+  eprintf "ssh_disconnect\n%!";
+  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)
+
+(* Use these functions to upload a file. *)
+let ssh_start_upload config filename =
+  let cmd =
+    sprintf "cat \\> %s/%s" (quote config.ssh_directory) (quote filename) in
+  ssh_connect config cmd
+
+let ssh_finish_upload = ssh_disconnect
+
+(* Test SSH connection. *)
+let test_ssh config =
+  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
+  ssh_disconnect conn;
+
+  if !config_greeting then (
+    printf "\n\nDid SSH work?\n";
+    printf "Hint: If not sure, there is a shell on console [ALT] [F2]\n";
+    printf "    (y/n) %!";
+    let line = read_line () in
+    String.length line > 0 && (line.[0] = 'y' || line.[0] = 'Y')
+  )
+  else
+    true
+
 (* Rewrite /mnt/root/etc/fstab. *)
-let rewrite_fstab state devices_to_send =
+let rewrite_fstab devices_to_send =
   let filename = "/mnt/root/etc/fstab" in
   if is_file filename = Some true then (
     sh ("cp " ^ quote filename ^ " " ^ quote (filename ^ ".p2vsaved"));
@@ -585,8 +737,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".
@@ -781,7 +932,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 =
@@ -813,181 +964,162 @@ 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 items = [
+		"Physical to Virtual (P2V)", P2V;
+		"Virtual to Virtual (V2V)", V2V;
+	      ] 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
+	      select_single ~stage:"Transfer type" 40
+		"Transfer type"
+		items 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 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
+		    ignore (Newt.listbox_append_entry autolist label partition);
+		    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 = Newt.listbox_item_count autolist = 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
+		  (Newt.component_of_listbox 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
+		  (Newt.component_of_listbox autolist) true
 	      in
-	      loop () in
+	      let disable_autolist () =
+		Newt.component_takes_focus
+		  (Newt.component_of_listbox 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_components form [auto;
+					     Newt.component_of_listbox autolist;
+					     shell;qemu;nonet;static;
+					     label1;label2;label3;label4;label5;
+					     entry1;entry2;entry3;entry4;entry5;
+					     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 part -> Auto part
+		  )
+		  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
@@ -1036,306 +1168,205 @@ 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
-
-  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 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 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 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 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 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 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
+  (* 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
+	    (*
+	      There's no sensible way to support this for SSH:
+	    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 ok = Newt.button 48 16 "  OK  " 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
 
-  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 ();
+	    c
+    ) in
 
-  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
+  (* If asked, check the SSH connection. *)
+  if config_ssh.ssh_check then
+    if not (test_ssh config_ssh) then
+      failwith "SSH configuration failed";
 
-  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
-
-  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
+  (* 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
 
-  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
+	      Newt.pop_window ();
 
-  (* 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
+	      c in
 
-  eprintf "finished dialog loop\n%!";
+	config_devices_to_send, config_root_filesystem, config_target
+    ) in
 
-  (* In test mode, exit here before we do bad things to the developer's
+  (* In test mode, exit here before we do Bad Things to the developer's
    * hard disk.
    *)
   if test_dialog_stages then exit 1;
@@ -1347,28 +1378,26 @@ Compression:  %b"
   sh "rm -f /etc/lvm.new/cache/.cache";
 
   (* Snapshot the block devices to send. *)
-  let devices_to_send = Option.get state.devices_to_send in
-  let devices_to_send =
+  let config_devices_to_send =
     List.map (
       fun origin_dev ->
 	let snapshot_dev = snapshot_name origin_dev in
 	snapshot origin_dev snapshot_dev;
 	(origin_dev, snapshot_dev)
-    ) devices_to_send in
+    ) config_devices_to_send in
 
   (* Run kpartx on the snapshots. *)
   List.iter (
     fun (origin, snapshot) ->
       shfailok ("kpartx -a " ^ quote ("/dev/mapper/" ^ snapshot))
-  ) devices_to_send;
+  ) config_devices_to_send;
 
   (* Rescan for LVs. *)
   sh "vgscan";
   sh "vgchange -a y";
 
   (* Mount the root filesystem under /mnt/root. *)
-  let root_filesystem = Option.get state.root_filesystem in
-  (match root_filesystem with
+  (match config_root_filesystem with
    | Part (dev, partnum) ->
        let dev = dev ^ partnum in
        let snapshot_dev = snapshot_name dev in
@@ -1382,59 +1411,35 @@ Compression:  %b"
   );
 
   (* Work out what devices will be called at the remote end. *)
-  let devices_to_send = List.map (
+  let config_devices_to_send = List.map (
     fun (origin_dev, snapshot_dev) ->
       let remote_dev = remote_of_origin_dev origin_dev in
       (origin_dev, snapshot_dev, remote_dev)
-  ) devices_to_send in
+  ) config_devices_to_send in
 
   (* Modify files on the root filesystem. *)
-  rewrite_fstab state devices_to_send;
+  rewrite_fstab config_devices_to_send;
   (* XXX Other files to rewrite? *)
 
   (* Unmount the root filesystem and sync disks. *)
   sh "umount /mnt/root";
   sh "sync";				(* Ugh, should be in stdlib. *)
 
-  (* Get architecture of root filesystem, detected previously. *)
-  let system_architecture =
-    try
-      (match List.assoc root_filesystem all_partitions with
-       | LinuxRoot (arch, _) -> arch
-       | _ -> raise Not_found
-      )
-    with
-      Not_found ->
-	(* None was detected before, so assume same as live CD. *)
+  (* If architecture is set to UnknownArch, then assume the same
+   * architecture as the live CD.
+   *)
+  let config_target =
+    match config_target.tgt_architecture with
+    | UnknownArch ->
 	let arch = shget "uname -m" in
-	match arch with
-	| Some (("i386"|"i486"|"i586"|"i686")::_) -> I386
-	| Some ("x86_64"::_) -> X86_64
-	| Some ("ia64"::_) -> IA64
-	| _ -> I386 (* probably wrong XXX *) 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
-  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
+	let arch =
+	  match arch with
+	  | Some (("i386"|"i486"|"i586"|"i686")::_) -> I386
+	  | Some ("x86_64"::_) -> X86_64
+	  | Some ("ia64"::_) -> IA64
+	  | _ -> I386 (* probably wrong XXX *) in
+	{ config_target with tgt_architecture = arch }
+    | _ -> config_target in
 
   (* XXX This is using the hostname derived from network configuration
    * above.  We might want to ask the user to choose.
@@ -1446,11 +1451,11 @@ Compression:  %b"
     "p2v-" ^ hostname ^ "-" ^ date in
 
   (* Work out what the image filenames will be at the remote end. *)
-  let devices_to_send = List.map (
+  let config_devices_to_send = List.map (
     fun (origin_dev, snapshot_dev, remote_dev) ->
       let remote_name = basename ^ "-" ^ remote_dev ^ ".img" in
       (origin_dev, snapshot_dev, remote_dev, remote_name)
-  ) devices_to_send in
+  ) config_devices_to_send in
 
   (* Write a configuration file.  Not sure if this is any better than
    * just 'sprintf-ing' bits of XML text together, but at least we will
@@ -1465,23 +1470,6 @@ Compression:  %b"
    *)
   let conf_filename = basename ^ ".conf" in
 
-  let architecture =
-    match state.architecture with
-    | Some UnknownArch | None -> system_architecture
-    | Some arch -> arch in
-  let memory =
-    match state.memory with
-    | Some 0 | None -> system_memory
-    | Some memory -> memory in
-  let vcpus =
-    match state.vcpus with
-    | Some 0 | None -> system_nr_cpus
-    | Some n -> n in
-  let mac_address =
-    match state.mac_address with
-    | Some "" | None -> random_mac_address ()
-    | Some mac -> mac in
-
   let xml =
     (* Shortcut to make "<name>value</name>". *)
     let leaf name value = Xml.Element (name, [], [Xml.PCData value]) in
@@ -1491,15 +1479,17 @@ Compression:  %b"
     (* Standard stuff for every domain. *)
     let name = leaf "name" hostname in
     let uuid = leaf "uuid" (random_uuid ()) in
-    let maxmem = leaf "maxmem" (string_of_int (memory * 1024)) in
-    let memory = leaf "memory" (string_of_int (memory * 1024)) in
-    let vcpu = leaf "vcpu" (string_of_int vcpus) in
+    let maxmem, memory =
+      let m =
+	leaf "maxmem" (string_of_int (config_target.tgt_memory * 1024)) in
+      m, m in
+    let vcpu = leaf "vcpu" (string_of_int config_target.tgt_vcpus) in
 
     (* Top-level stuff which differs for each HV type (isn't this supposed
      * to be portable ...)
      *)
     let extras =
-      match state.hypervisor with
+      match config_target.tgt_hypervisor with
       | Some Xen ->
 	  [Xml.Element ("os", [],
 			[leaf "type" "hvm";
@@ -1517,7 +1507,8 @@ Compression:  %b"
 	  [Xml.Element ("os", [],
 			[Xml.Element ("type",
 				      ["arch",
-				       string_of_architecture architecture;
+				       string_of_architecture
+					 config_target.tgt_architecture;
 				       "machine","pc"],
 				      [Xml.PCData "hvm"]);
 			 tleaf "boot" ["dev", "hd"]])]
@@ -1527,7 +1518,7 @@ Compression:  %b"
     (* <devices> section. *)
     let devices =
       let emulator =
-	match state.hypervisor with
+	match config_target.tgt_hypervisor with
 	| Some Xen ->
 	    [leaf "emulator" "/usr/lib64/xen/bin/qemu-dm"] (* XXX lib64? *)
 	| Some QEMU ->
@@ -1538,7 +1529,8 @@ Compression:  %b"
 	    [] in
       let interface =
 	Xml.Element ("interface", ["type", "user"],
-		     [tleaf "mac" ["address", mac_address]]) in
+		     [tleaf "mac" ["address",
+				   config_target.tgt_mac_address]]) in
       (* XXX should have an option for Xen bridging:
 	Xml.Element (
 	"interface", ["type","bridge"],
@@ -1552,10 +1544,11 @@ Compression:  %b"
 	  Xml.Element (
 	    "disk", ["type", "file";
 		     "device", "disk"],
-	    [tleaf "source" ["file", remote_directory ^ "/" ^ remote_name];
+	    [tleaf "source" ["file",
+			     config_ssh.ssh_directory ^ "/" ^ remote_name];
 	     tleaf "target" ["dev", remote_dev]]
 	  )
-      ) devices_to_send in
+      ) config_devices_to_send in
 
       Xml.Element (
 	"devices", [],
@@ -1565,7 +1558,7 @@ Compression:  %b"
     (* Put it all together in <domain type='foo'>. *)
     Xml.Element (
       "domain",
-      (match state.hypervisor with
+      (match config_target.tgt_hypervisor with
        | Some Xen -> ["type", "xen"]
        | Some QEMU -> ["type", "qemu"]
        | Some KVM -> ["type", "kvm"]
@@ -1580,7 +1573,7 @@ Compression:  %b"
     let xml = Xml.to_string_fmt xml in
 
     let conn_arg =
-      match state.hypervisor with
+      match config_target.tgt_hypervisor with
       | Some Xen | None -> ""
       | Some QEMU | Some KVM -> " -c qemu:///system" in
     let xml = sprintf "\
@@ -1595,10 +1588,10 @@ Compression:  %b"
     let xml_len = String.length xml in
     eprintf "length of configuration file is %d bytes\n%!" xml_len;
 
-    let (sock,_) as conn = do_connect conf_filename (Int64.of_int xml_len) in
+    let (sock,_) as conn = ssh_start_upload config_ssh conf_filename in
     (* In OCaml this actually loops calling write(2) *)
     ignore (write sock xml 0 xml_len);
-    do_disconnect conn in
+    ssh_finish_upload conn in
 
   (* Send the device snapshots to the remote host. *)
   (* XXX This code should be made more robust against both network
@@ -1620,7 +1613,7 @@ Compression:  %b"
       let fd = openfile ("/dev/mapper/" ^ snapshot_dev) [O_RDONLY] 0 in
 
       (* Now connect. *)
-      let (sock,_) as conn = do_connect remote_name size in
+      let (sock,_) as conn = ssh_start_upload config_ssh remote_name in
 
       (* Copy the data. *)
       let spinners = "|/-\\" (* "Oo" *) in
@@ -1667,22 +1660,21 @@ Compression:  %b"
       printf "\n\n%!"; (* because of the messages printed above *)
 
       (* Disconnect. *)
-      do_disconnect conn
-  ) devices_to_send;
+      ssh_finish_upload conn
+  ) config_devices_to_send;
 
   (*printf "\n\nPress any key ...\n%!"; ignore (read_line ());*)
 
   (* Clean up and reboot. *)
   ignore (
-    msgbox (sprintf "%s completed" program_name)
+    message_box (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
+	 config_ssh.ssh_directory conf_filename)
   );
 
   shfailok "eject";
   shfailok "reboot";
-*)
+
   exit 0
 
 (*----------------------------------------------------------------------*)