| WSIGNALED i -> failwith (sprintf "shget: command killed by signal %d" i)
| WSTOPPED i -> failwith (sprintf "shget: command stopped by signal %d" i)
+(*
(* Parse the output of 'lvs' to get list of LV names, sizes,
* corresponding PVs, etc. Returns a list of (lvname, PVs, lvsize).
*)
| _ ->
failwith "lvs: unexpected output"
) lines
+*)
+(*
(* Get the partitions on a block device. eg. "sda" -> ["sda1";"sda2"] *)
let get_partitions dev =
let parts = Sys.readdir ("/sys/block/" ^ dev) in
let regexp = Str.regexp ("^" ^ dev) in
let parts = List.filter (Str.string_match regexp) parts in
parts
+*)
+
+(* Dialog functions.
+ *
+ * Each function takes some common parameters (eg. ~title) and some
+ * dialog-specific functions.
+ *
+ * Returns the exit status (Yes lines | No | Help | Back | Error).
+ *)
+let msgbox, inputbox, radiolist, checklist =
+ (* 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. *)
+ let msgbox =
+ with_common (
+ fun cparams text height width ->
+ run_dialog cparams
+ [ "--msgbox"; text; string_of_int height; string_of_int width ]
+ )
+ in
+
+ (* Simple input box. *)
+ let inputbox =
+ with_common (
+ fun cparams text height width default ->
+ run_dialog cparams
+ [ "--inputbox"; text; string_of_int height; string_of_int width;
+ default ]
+ )
+ in
+
+ (* Radio list and check list. *)
+ let 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
+ )
+ in
+
+ let 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
+ )
+ in
+ msgbox, inputbox, radiolist, checklist
+
+(* Print failure dialog and exit. *)
+let fail_dialog text =
+ let text = 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);
+ exit 1
(* Main entry point. *)
let rec main ttyname =
fail_dialog "No non-removable block devices (hard disks, etc.) could be found on this machine.";
devices in
+(*
(* For each device that we identified above, search for partitions on
* the device. These are returned as strings like "hda1" or for
* LVs "VolGroup00/LogVol00". This creates a StringMap of block device
let all_partitions =
in
-
+*)
(* Dialogs. *)
let ask_greeting state =
- ignore (
- dialog [
- title "virt-p2v" ();
- msgbox "\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." 17 50
- ]
- );
+ 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." 17 50);
Next state
in
let ask_transport state =
match
- dialog [
- title "Connection type" ~backbutton:false ();
- radiolist "Connection type" 10 50 2 [
+ radiolist "Connection type" ~backbutton:false
+ "Connection type" 10 50 2 [
"ssh", "SSH (secure shell - recommended)",
state.remote_transport = Some SSH;
"tcp", "TCP socket",
state.remote_transport = Some TCP
]
- ]
with
| Yes ("ssh"::_) -> Next { state with remote_transport = Some SSH }
| Yes ("tcp"::_) -> Next { state with remote_transport = Some TCP }
let ask_hostname state =
match
- dialog [
- title "Remote host" ();
- inputbox "Remote host" 10 50 (default "" state.remote_host)
- ]
+ inputbox "Remote host" "Remote host" 10 50 (default "" state.remote_host)
with
| Yes [] -> Ask_again
| Yes (hostname::_) -> Next { state with remote_host = Some hostname }
let ask_port state =
match
- dialog [
- title "Remote port" ();
- inputbox "Remote port" 10 50 (default "" state.remote_port)
- ]
+ inputbox "Remote port" "Remote port" 10 50 (default "" state.remote_port)
with
| Yes [] ->
if state.remote_transport = Some TCP then
let ask_directory state =
match
- dialog [
- title "Remote directory" ();
- inputbox "Remote directory" 10 50 (default "" state.remote_directory)
- ]
+ inputbox "Remote directory" "Remote directory" 10 50
+ (default "" state.remote_directory)
with
| Yes [] ->
Next { state with remote_directory = Some "/var/lib/xen/images" }
let ask_network state =
match
- dialog [
- title "Network configuration" ();
- radiolist "Network configuration" 10 50 2 [
- "auto", "Automatic configuration", state.network = Some Auto;
- "sh", "Configure from the shell", state.network = Some Shell;
- ]
+ radiolist "Network configuration" "Network configuration" 10 50 2 [
+ "auto", "Automatic configuration", state.network = Some Auto;
+ "sh", "Configure from the shell", state.network = Some Shell;
]
with
| Yes ("auto"::_) -> Next { state with network = Some Auto }
List.mem dev selected_devices)
) all_block_devices in
match
- dialog [
- title "Devices" ();
- checklist "Pick devices to send" 15 50 8 devices
- ]
+ 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 }
()
-(* Run the external 'dialog' command with the given list of parameters.
- * Actually it's a list-of-list-of-parameters because you would normally
- * use this function like this:
- * dialog [
- * title (* title and other common parameters *) ();
- * dialogtype (* specific parameter *)
- * ]
- * where 'dialogtype' is a function such as 'msgbox' (see below)
- * representing a specific subfunction of dialog.
- *
- * The functions 'title' and 'dialogtype' return partially-constructed
- * lists of shell parameters. See the dialog manpage.
- *
- * Returns the exit status (Yes lines | No | Help | Back | Error).
- *)
-and dialog params =
- let params = List.concat params in (* list-of-list to flat list *)
- 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)
-
-(* Title and common dialog options. *)
-and title title ?(cancel=false) ?(backbutton=true) () =
- 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
- params
-
-(* Message box. *)
-and msgbox text height width =
- [ "--msgbox"; text; string_of_int height; string_of_int width ]
-
-(* Simple input box. *)
-and inputbox text height width default =
- [ "--inputbox"; text; string_of_int height; string_of_int width; default ]
-
-(* Radio list and check list. *)
-and radiolist 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
- "--single-quoted" ::
- "--radiolist" :: text :: string_of_int height :: string_of_int width ::
- string_of_int listheight :: items
-
-and checklist 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
- "--separate-output" ::
- "--checklist" :: text :: string_of_int height :: string_of_int width ::
- string_of_int listheight :: items
-
-(* Print failure dialog and exit. *)
-and fail_dialog text =
- let text = 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 (
- dialog [
- title "Error" ();
- msgbox text 17 50
- ]
- );
- exit 1
-
let usage () =
eprintf "usage: virt-p2v [ttyname]\n%!";
exit 2
git.annexia.org / virt-p2v.git / commitdiff