#!/usr/bin/ocamlrun /usr/bin/ocaml
#load "unix.cma";;
-#load "str.cma";;
+#directory "+extlib";;
+#load "extLib.cma";;
+#directory "+pcre";;
+#load "pcre.cma";;
(* virt-p2v.ml is a script which performs a physical to
* virtual conversion of local disks.
open Unix
open Printf
+open ExtList
+open ExtString
type state = { greeting : bool;
remote_host : string option; remote_port : string option;
remote_directory : string option;
network : network option;
devices_to_send : string list option;
- root_filesystem : string option }
+ root_filesystem : partition option }
and transport = SSH | TCP
and network = Auto | Shell
+and partition = Part of string * string (* eg. "hda", "1" *)
+ | LV of string * string (* eg. "VolGroup00", "LogVol00" *)
(*----------------------------------------------------------------------*)
(* TO MAKE A CUSTOM virt-p2v SCRIPT, adjust the defaults in this section.
*)
devices_to_send = None;
- (* The root filesystem containing /etc/fstab. Set to 'Some "sda3"'
- * or 'Some "VolGroup00/LogVol00"' for example, else ask user.
+ (* The root filesystem containing /etc/fstab. Set to
+ * 'Some (Part ("sda", "3"))' or 'Some (LV ("VolGroup00", "LogVol00"))'
+ * for example, else ask user.
*)
root_filesystem = None;
(* 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 sort_uniq ?(cmp = compare) xs = (* sort and uniq a list *)
+ let xs = List.sort ~cmp xs in
+ let rec loop = function
+ | [] -> [] | [x] -> [x]
+ | x1 :: x2 :: xs when x1 = x2 -> loop (x1 :: xs)
+ | x :: xs -> x :: loop xs
+ in
+ loop xs
-let string_of_state state =
+let rec 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)
+ (Option.default "" state.remote_host)
+ (Option.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)
+ (String.concat "; " (Option.default [] state.devices_to_send))
+ (Option.map_default dev_of_partition "" state.root_filesystem)
+
+and dev_of_partition = function
+ | Part (dev, partnum) -> sprintf "/dev/%s%s" dev partnum
+ | LV (vg, lv) -> sprintf "/dev/%s/%s" vg lv
type dialog_status = Yes of string list | No | Help | Back | Error
| WSIGNALED i -> failwith (sprintf "shget: command killed by signal %d" i)
| WSTOPPED i -> failwith (sprintf "shget: command stopped by signal %d" i)
+let is_dir path = (stat path).st_kind = S_DIR
+
+type block_device = string * int64 (* "hda" & size in bytes *)
+
(* 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
+let get_lvs =
+ let whitespace = Pcre.regexp "[ \t]+" in
+ let comma = Pcre.regexp "," in
+ let devname = Pcre.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"] *)
+ function () ->
+ match
+ shget "lvs --noheadings -o vg_name,lv_name,devices,lv_size"
+ with
+ | None -> []
+ | Some lines ->
+ let lines = List.map (Pcre.split ~rex:whitespace) lines in
+ List.map (
+ function
+ | [vg; lv; pvs; lvsize]
+ | [_; vg; lv; pvs; lvsize] ->
+ let pvs = Pcre.split ~rex:comma pvs in
+ let pvs = List.map (
+ fun pv ->
+ try
+ let subs = Pcre.exec ~rex:devname pv in
+ Pcre.get_substring subs 1
+ with
+ Not_found -> failwith ("lvs: unexpected device name: " ^ pv)
+ ) pvs in
+ LV (vg, lv), pvs, lvsize
+ | line ->
+ failwith ("lvs: unexpected output: " ^ String.concat "," line)
+ ) lines
+
+(* Get the partitions on a block device.
+ * eg. "sda" -> [Part ("sda","1"); Part ("sda", "2")]
+ *)
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
+ let rex = Pcre.regexp ("^" ^ dev ^ "(.+)$") in
+ let devdir = "/sys/block/" ^ dev in
+ let parts = Sys.readdir devdir in
+ let parts = Array.to_list parts in
+ let parts = List.filter (fun name -> is_dir (devdir ^ "/" ^ name)) parts in
+ let parts = List.filter_map (
+ fun part ->
+ try
+ let subs = Pcre.exec ~rex part in
+ Some (Part (dev, Pcre.get_substring subs 1))
+ with
+ Not_found -> None
+ ) parts in
parts
+(* 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
+
(* Main entry point. *)
let rec main ttyname =
(* Running from an init script. We don't have much of a
(* Log the start up time. *)
eprintf "\n\n**************************************************\n\n";
let tm = localtime (time ()) in
- eprintf "virt-p2v-ng starting up at %04d-%02d-%02d %02d:%02d:%02d\n%!"
+ eprintf "virt-p2v-ng starting up at %04d-%02d-%02d %02d:%02d:%02d\n\n%!"
(tm.tm_year+1900) (tm.tm_mon+1) tm.tm_mday tm.tm_hour tm.tm_min tm.tm_sec;
(* Connect stdin/stdout to the tty. *)
close fd);
(* Search for all non-removable block devices. Do this early and bail
- * if we can't find anything.
+ * if we can't find anything. This is a list of strings, like "hda".
*)
- let all_block_devices =
- let regexp = Str.regexp "^[hs]d" in
+ let all_block_devices : block_device list =
+ let rex = Pcre.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
+ let devices = List.sort devices in
+ let devices = List.filter (fun d -> Pcre.pmatch ~rex d) devices in
eprintf "all_block_devices: block devices: %s\n%!"
(String.concat "; " devices);
- (* Run blockdev --getsize on each, and reject any where this fails
+ (* Run blockdev --getsize64 on each, and reject any where this fails
* (probably removable devices).
*)
- let devices = List.map (
+ let devices = List.filter_map (
fun d ->
- let cmd = "blockdev --getsize /dev/" ^ Filename.quote d in
+ let cmd = "blockdev --getsize64 /dev/" ^ Filename.quote d in
let lines = shget cmd in
match lines with
- | Some (blksize::_) -> d, Int64.of_string blksize
- | Some [] | None -> d, 0L
+ | Some (blksize::_) -> Some (d, Int64.of_string blksize)
+ | Some [] | None -> None
) 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));
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.
+ (* Search for partitions and LVs (anything that could contain a
+ * filesystem directly). We refer to these generically as
+ * "partitions".
*)
- 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
-
+ let all_partitions : partition list =
+ (* LVs & PVs. *)
+ let lvs, pvs =
+ let lvs = get_lvs () in
+ let pvs = List.map (fun (_, pvs, _) -> pvs) lvs in
+ let pvs = List.concat pvs in
+ let pvs = sort_uniq pvs in
+ eprintf "all_partitions: PVs: %s\n%!" (String.concat "; " pvs);
+ let lvs = List.map (fun (lvname, _, _) -> lvname) lvs in
+ eprintf "all_partitions: LVs: %s\n%!"
+ (String.concat "; " (List.map dev_of_partition lvs));
+ lvs, pvs in
+
+ (* Partitions (eg. "sda1", "sda2"). *)
+ let parts =
+ let parts = List.map fst all_block_devices in
+ let parts = List.map get_partitions parts in
+ let parts = List.concat parts in
+ eprintf "all_partitions: all partitions: %s\n%!"
+ (String.concat "; " (List.map dev_of_partition parts));
+
+ (* Remove any partitions which are PVs. *)
+ let parts = List.filter (
+ function
+ | Part (dev, partnum) -> not (List.mem (dev ^ partnum) pvs)
+ | LV _ -> assert false
+ ) parts in
+ parts in
+ eprintf "all_partitions: partitions after removing PVs: %s\n%!"
+ (String.concat "; " (List.map dev_of_partition parts));
+ (* Concatenate LVs & Parts *)
+ lvs @ parts 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.\n\nExtra information is logged in /tmp/virt-p2v.log but this file disappears when the machine reboots." 18 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
+ (Option.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
+ (Option.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
+ (Option.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 }
in
let ask_devices state =
- let selected_devices = default [] state.devices_to_send in
+ let selected_devices = Option.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.),
+ sprintf "/dev/%s (%.3f GB)" dev
+ ((Int64.to_float blksize) /. (1024.*.1024.*.1024.)),
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 }
| Back -> Prev
in
+ let ask_root state =
+ let parts = List.mapi (
+ fun i part ->
+ (string_of_int i, dev_of_partition part,
+ Some part = state.root_filesystem)
+ ) all_partitions in
+ match
+ radiolist "Root device"
+ "Pick partition containing the root (/) filesystem" 15 50 6
+ 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
+
(* This is the list of dialogs, in order. The user can go forwards or
* backwards through them. The second parameter in each pair is
* false if we need to skip this dialog (info already supplied in
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_verify, (* Verify settings. *)
+(* ask_verify, (* Verify settings. *)
defaults.greeting*)
|] in
()
-(* 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 / blobdiff