#!/usr/bin/ocamlrun /usr/bin/ocaml
#load "unix.cma";;
+#load "str.cma";;
+
(* virt-p2v.ml is a script which performs a physical to
* virtual conversion of local disks.
*
remote_host : string option; remote_port : string option;
remote_transport : transport option;
remote_directory : string option;
+ network : network option;
devices_to_send : string list option;
- root_filesystem : string option; network : network option }
+ root_filesystem : string option }
and transport = SSH | TCP
and network = Auto | Shell
-type dialog_status = Yes | No | Help | Extra | Error
-
-let default d = function None -> d | Some p -> p
-
(*----------------------------------------------------------------------*)
(* TO MAKE A CUSTOM virt-p2v SCRIPT, adjust the defaults in this section.
*
(* END OF CUSTOM virt-p2v SCRIPT SECTION. *)
(*----------------------------------------------------------------------*)
+(* String map type. *)
+module StringMap = Map.Make (String)
+
+(* General helper functions. *)
+
+let default d = function None -> d | Some p -> p
+
+let string_of_state state =
+ sprintf
+ "greeting: %b remote: %s:%s%s%s network: %s devices: [%s] root: %s"
+ state.greeting
+ (default "" state.remote_host)
+ (default "" state.remote_port)
+ (match state.remote_transport with
+ | None -> "" | Some SSH -> " (ssh)" | Some TCP -> " (tcp)")
+ (match state.remote_directory with
+ | None -> "" | Some dir -> " " ^ dir)
+ (match state.network with
+ | None -> "none" | Some Auto -> "auto" | Some Shell -> "shell")
+ (String.concat "; " (default [] state.devices_to_send))
+ (default "" state.root_filesystem)
+
+type dialog_status = Yes of string list | No | Help | Back | Error
+
+type ask_result = Next of state | Prev | Ask_again
+
+let input_all_lines chan =
+ let lines = ref [] in
+ try
+ while true do lines := input_line chan :: !lines done; []
+ with
+ End_of_file -> List.rev !lines
+
+(* Same as `cmd` in shell. Any error message will be in the logfile. *)
+let shget cmd =
+ let chan = open_process_in cmd in
+ let lines = input_all_lines chan in
+ match close_process_in chan with
+ | WEXITED 0 -> Some lines (* command succeeded *)
+ | WEXITED _ -> None (* command failed *)
+ | 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).
+ *)
+let get_lvs () =
+ let whitespace = Str.regexp "[ \t]+" in
+ let comma = Str.regexp "," in
+ let devname = Str.regexp "^/dev/\\(.+\\)(.+)$" in
+
+ match
+ shget "lvs --noheadings -o vg_name,lv_name,devices,lv_size"
+ with
+ | None -> []
+ | Some lines ->
+ let lines = List.map (Str.split whitespace) lines in
+ List.map (
+ function
+ | [vg; lv; pvs; lvsize] ->
+ let pvs = Str.split comma pvs in
+ let pvs = List.map (
+ fun pv ->
+ if Str.string_match devname pv then
+ Str.matched_group 0
+ else
+ failwith ("lvs: unexpected device name: " ^ pv)
+ ) pvs in
+ vg ^ "/" ^ lv, 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 parts = List.filter is_dir parts in
+ let regexp = Str.regexp ("^" ^ dev) in
+ let parts = List.filter (Str.string_match regexp) parts in
+ parts
+
(* Main entry point. *)
let rec main ttyname =
(* Running from an init script. We don't have much of a
dup2 fd stdout;
close fd);
+ (* Search for all non-removable block devices. Do this early and bail
+ * if we can't find anything.
+ *)
+ let all_block_devices =
+ let regexp = Str.regexp "^[hs]d" in
+ let devices = Array.to_list (Sys.readdir "/sys/block") in
+ let devices = List.sort compare devices in
+ let devices = List.filter (fun d -> Str.string_match regexp d 0) devices in
+ eprintf "all_block_devices: block devices: %s\n%!"
+ (String.concat "; " devices);
+ (* Run blockdev --getsize on each, and reject any where this fails
+ * (probably removable devices).
+ *)
+ let devices = List.map (
+ fun d ->
+ let cmd = "blockdev --getsize /dev/" ^ Filename.quote d in
+ let lines = shget cmd in
+ match lines with
+ | Some (blksize::_) -> d, Int64.of_string blksize
+ | Some [] | None -> d, 0L
+ ) devices in
+ let devices = List.filter (fun (_, blksize) -> blksize > 0L) devices in
+ eprintf "all_block_devices: non-removable block devices: %s\n%!"
+ (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.";
+ 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
+ * name -> list of partitions on the device.
+ *)
+ let partition_map =
+ let lvs = get_lvs () in (* Logical volumes. *)
+ eprintf "partition_map: LVs: %s\n%!"
+ (String.concat "; " (List.map (fun (lvname, _, _) -> lvname));
+
+ let all_partitions = List.map get_partitions all_block_devices in
+ let all_partitions = List.concat all_partitions in
+ eprintf "partition_map: all parts: %s\n%!"
+ (String.concat "; " all_partitions);
+
+ (* Ignore any partitions which are used as PVs in the first list. *)
+ let all_partitions =
+
+in
+
+
+
(* Dialogs. *)
- let rec ask_greeting state =
+ 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
]
);
- Some state
+ Next state
+ in
- and ask_transport state =
- ignore ( (* XXX *)
+ let ask_transport state =
+ match
dialog [
- title "Connection type" ~cancel:false ();
+ title "Connection type" ~backbutton:false ();
radiolist "Connection type" 10 50 2 [
"ssh", "SSH (secure shell - recommended)",
state.remote_transport = Some SSH;
state.remote_transport = Some TCP
]
]
- );
- Some state
+ with
+ | Yes ("ssh"::_) -> Next { state with remote_transport = Some SSH }
+ | Yes ("tcp"::_) -> Next { state with remote_transport = Some TCP }
+ | Yes _ | No | Help | Error -> Ask_again
+ | Back -> Prev
+ in
- and ask_hostname state =
- ignore ( (* XXX *)
- dialog [
- title "Remote host" ~cancel:false ~backbutton:true ();
- inputbox "Remote host" 10 50 (default "" state.remote_host)
- ]
- );
- Some state
+ let ask_hostname state =
+ match
+ dialog [
+ title "Remote host" ();
+ inputbox "Remote host" 10 50 (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
- and ask_port state =
- ignore ( (* XXX *)
- dialog [
- title "Remote port" ~cancel:false ~backbutton:true ();
- inputbox "Remote port" 10 50 (default "" state.remote_port)
+ let ask_port state =
+ match
+ dialog [
+ title "Remote port" ();
+ inputbox "Remote port" 10 50 (default "" state.remote_port)
+ ]
+ with
+ | Yes [] ->
+ if state.remote_transport = Some TCP then
+ Next { state with remote_port = Some "16211" }
+ else
+ 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 =
+ match
+ dialog [
+ title "Remote directory" ();
+ inputbox "Remote directory" 10 50 (default "" state.remote_directory)
+ ]
+ with
+ | Yes [] ->
+ Next { state with remote_directory = Some "/var/lib/xen/images" }
+ | Yes (dir::_) -> Next { state with remote_directory = Some dir }
+ | No | Help | Error -> Ask_again
+ | Back -> Prev
+ in
+
+ 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;
]
- );
- Some state
+ ]
+ with
+ | Yes ("auto"::_) -> Next { state with network = Some Auto }
+ | Yes ("sh"::_) -> Next { state with network = Some Shell }
+ | Yes _ | No | Help | Error -> Ask_again
+ | Back -> Prev
+ in
+ let ask_devices state =
+ let selected_devices = default [] state.devices_to_send in
+ let devices = List.map (
+ fun (dev, blksize) ->
+ (dev,
+ sprintf "/dev/%s (%g GB)" dev ((Int64.to_float blksize) /. 2_097_152.),
+ List.mem dev selected_devices)
+ ) all_block_devices in
+ match
+ dialog [
+ title "Devices" ();
+ checklist "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
(* This is the list of dialogs, in order. The user can go forwards or
defaults.remote_host = None;
ask_port, (* Port number. *)
defaults.remote_port = None;
-(* ask_directory, (* Remote directory. *)
+ ask_directory, (* Remote directory. *)
defaults.remote_directory = None;
+ ask_network, (* Network configuration. *)
+ defaults.network = None;
ask_devices, (* Block devices to send. *)
defaults.devices_to_send = None;
- ask_root, (* Root filesystem. *)
+(* ask_root, (* Root filesystem. *)
defaults.root_filesystem = None;
- ask_network, (* Network configuration. *)
- defaults.network = None;
ask_verify, (* Verify settings. *)
defaults.greeting*)
|] in
(* Skip this dialog and move straight to the next one. *)
loop (posn+1) state
else (
- (* Run dialog. Either the state is updated or 'None' is
- * returned, which indicates that the user hit the back button.
- *)
- let next_state = dlg state in
- match next_state with
- | Some state -> loop (posn+1) state (* Forwards. *)
- | None -> loop (posn-1) state (* Backwards. *)
+ (* Run dialog. *)
+ match dlg state with
+ | Next new_state -> loop (posn+1) new_state (* Forwards. *)
+ | Prev -> loop (posn-1) state (* Backwards / back button. *)
+ | Ask_again -> loop posn state (* Repeat the question. *)
)
)
in
let state = loop 0 defaults in
- eprintf "finished dialog loop\n%!";
+ eprintf "finished dialog loop\nstate = %s\n%!" (string_of_state state);
* The functions 'title' and 'dialogtype' return partially-constructed
* lists of shell parameters. See the dialog manpage.
*
- * Returns the exit status (Yes | No | Help | Extra | Error).
+ * 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 *)
- let params = List.map Filename.quote params in (* shell quoting *)
- let cmd = String.concat " " ("dialog" :: params) in
- eprintf "%s\n%!" cmd; (* log the full command *)
- let r = Sys.command cmd in
- match r with
- | 0 -> Yes | 1 -> No | 2 -> Help | 3 -> Extra | _ -> Error
+ 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=true) ?(backbutton=false) () =
+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 =
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, false -> [ tag; item; "off" ]
) items in
let items = List.concat items in
- "--radiolist" :: text :: string_of_int height :: string_of_int width ::
+ "--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