X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=virt-p2v.ml;h=a9f23d5c6669c7390edefcbde588884624ce6cb1;hb=09eaf293724cc1ed6100f5a8a97cecf8cc007956;hp=6c9a35ab388f757aff76cf1f55ff21484fc84a54;hpb=29ee4297592dcde61dd3dacd304ee4f4b38c5182;p=virt-p2v.git diff --git a/virt-p2v.ml b/virt-p2v.ml index 6c9a35a..a9f23d5 100755 --- a/virt-p2v.ml +++ b/virt-p2v.ml @@ -1,5 +1,10 @@ #!/usr/bin/ocamlrun /usr/bin/ocaml #load "unix.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. * @@ -23,19 +28,20 @@ open Unix open Printf +open ExtList +open ExtString type state = { greeting : bool; 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 : partition 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 +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. @@ -75,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; @@ -89,6 +96,223 @@ let defaults = { (* END OF CUSTOM virt-p2v SCRIPT SECTION. *) (*----------------------------------------------------------------------*) +(* General helper functions. *) + +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 rec string_of_state state = + sprintf + "greeting: %b remote: %s:%s%s%s network: %s devices: [%s] root: %s" + state.greeting + (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 "; " (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 + +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) + +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 = Pcre.regexp "[ \t]+" in + let comma = Pcre.regexp "," in + let devname = Pcre.regexp "^/dev/(.+)\\(.+\\)$" in + + 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 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 @@ -112,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. *) @@ -124,48 +348,178 @@ let rec main ttyname = dup2 fd stdout; close fd); + (* Search for all non-removable block devices. Do this early and bail + * if we can't find anything. This is a list of strings, like "hda". + *) + 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 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 --getsize64 on each, and reject any where this fails + * (probably removable devices). + *) + let devices = List.filter_map ( + fun d -> + let cmd = "blockdev --getsize64 /dev/" ^ Filename.quote d in + let lines = shget cmd in + match lines with + | Some (blksize::_) -> Some (d, Int64.of_string blksize) + | Some [] | None -> None + ) 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 + + (* Search for partitions and LVs (anything that could contain a + * filesystem directly). We refer to these generically as + * "partitions". + *) + 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 rec 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 - - and ask_transport state = - ignore ( (* XXX *) - dialog [ - title "Connection type" ~cancel:false (); - radiolist "Connection type" 10 50 2 [ + 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.\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 + 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 } + | Yes _ | No | Help | Error -> Ask_again + | Back -> Prev + in + + let ask_hostname state = + match + 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 } + | No | Help | Error -> Ask_again + | Back -> Prev + in + + let ask_port state = + match + inputbox "Remote port" "Remote port" 10 50 + (Option.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 + inputbox "Remote directory" "Remote directory" 10 50 + (Option.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 + radiolist "Network configuration" "Network configuration" 10 50 2 [ + "auto", "Automatic configuration", state.network = Some Auto; + "sh", "Configure from the shell", state.network = Some Shell; ] - ); - Some state - - 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 - - and ask_port state = - ignore ( (* XXX *) - dialog [ - title "Remote port" ~cancel:false ~backbutton:true (); - inputbox "Remote port" 10 50 (default "" state.remote_port) - ] - ); - 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 = Option.default [] state.devices_to_send in + let devices = List.map ( + fun (dev, blksize) -> + (dev, + sprintf "/dev/%s (%.3f GB)" dev + ((Int64.to_float blksize) /. (1024.*.1024.*.1024.)), + List.mem dev selected_devices) + ) all_block_devices in + match + 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 @@ -182,15 +536,15 @@ let rec main ttyname = 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. *) defaults.root_filesystem = None; - ask_network, (* Network configuration. *) - defaults.network = None; - ask_verify, (* Verify settings. *) +(* ask_verify, (* Verify settings. *) defaults.greeting*) |] in @@ -205,19 +559,17 @@ let rec main ttyname = (* 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); @@ -226,56 +578,6 @@ let rec main ttyname = () -(* 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 | No | Help | Extra | 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 - -(* Title and common dialog options. *) -and title title ?(cancel=true) ?(backbutton=false) () = - 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 ] - -and inputbox text height width default = - [ "--inputbox"; text; string_of_int height; string_of_int width; default ] - -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 - "--radiolist" :: text :: string_of_int height :: string_of_int width :: - string_of_int listheight :: items - let usage () = eprintf "usage: virt-p2v [ttyname]\n%!"; exit 2