| 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
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_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. *)
(*----------------------------------------------------------------------*)
#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";;
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
"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".
) all_partitions
in
- printf "finished detecting hard drives\n%!";
+ printf "Finished detecting hard drives.\n%!";
(* Autodetect system memory. *)
let system_memory =
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
| 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
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.
*)
git.annexia.org / virt-p2v.git / blobdiff