X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;ds=sidebyside;f=virt-p2v.ml;h=a9f23d5c6669c7390edefcbde588884624ce6cb1;hb=09eaf293724cc1ed6100f5a8a97cecf8cc007956;hp=e678d5bf91bb1be4005e6b2cee8d1bd97a944120;hpb=24199bac240adc5f5fe66df06143ea5a8e4327a3;p=virt-p2v.git diff --git a/virt-p2v.ml b/virt-p2v.ml index e678d5b..a9f23d5 100755 --- a/virt-p2v.ml +++ b/virt-p2v.ml @@ -1,6 +1,9 @@ #!/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. @@ -25,6 +28,8 @@ open Unix open Printf +open ExtList +open ExtString type state = { greeting : bool; remote_host : string option; remote_port : string option; @@ -32,9 +37,11 @@ type state = { greeting : bool; 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. @@ -74,8 +81,9 @@ let defaults = { *) 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; @@ -88,27 +96,35 @@ let defaults = { (* 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 @@ -131,52 +147,66 @@ let shget cmd = | 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 functions. + * dialog-specific parameters. * * Returns the exit status (Yes lines | No | Help | Back | Error). *) @@ -306,7 +336,7 @@ let rec main ttyname = (* 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. *) @@ -319,27 +349,26 @@ let rec main ttyname = 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)); @@ -347,32 +376,47 @@ 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 - * 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 (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); + 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 @@ -394,7 +438,8 @@ in let ask_hostname state = match - inputbox "Remote host" "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 } @@ -404,7 +449,8 @@ in let ask_port state = match - inputbox "Remote port" "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 @@ -419,7 +465,7 @@ in let ask_directory state = match inputbox "Remote directory" "Remote directory" 10 50 - (default "" state.remote_directory) + (Option.default "" state.remote_directory) with | Yes [] -> Next { state with remote_directory = Some "/var/lib/xen/images" } @@ -442,11 +488,12 @@ in 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 @@ -457,6 +504,24 @@ in | 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 @@ -477,9 +542,9 @@ 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