+(* Dialog functions.
+ *
+ * Each function takes some common parameters (eg. ~title) and some
+ * dialog-specific parameters.
+ *
+ * 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
+