X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=virt-p2v.ml;h=28650f1fe7f3fb717c23222b4e540cd27eb4c400;hb=5f6d8b293055d9fd80a083b48c91ce40cf884cd4;hp=6c9a35ab388f757aff76cf1f55ff21484fc84a54;hpb=29ee4297592dcde61dd3dacd304ee4f4b38c5182;p=virt-p2v.git diff --git a/virt-p2v.ml b/virt-p2v.ml index 6c9a35a..28650f1 100755 --- a/virt-p2v.ml +++ b/virt-p2v.ml @@ -1,5 +1,7 @@ #!/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. * @@ -28,15 +30,12 @@ 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 : 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. * @@ -89,6 +88,87 @@ 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 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 @@ -124,20 +204,72 @@ 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. + *) + 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; @@ -145,27 +277,90 @@ let rec main ttyname = 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 @@ -182,14 +377,14 @@ 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. *) +(* ask_root, (* Root filesystem. *) defaults.root_filesystem = None; - ask_network, (* Network configuration. *) - defaults.network = None; ask_verify, (* Verify settings. *) defaults.greeting*) |] in @@ -205,19 +400,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); @@ -239,19 +432,39 @@ let rec main ttyname = * 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 = @@ -263,9 +476,11 @@ and title title ?(cancel=true) ?(backbutton=false) () = 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 @@ -273,9 +488,32 @@ and radiolist text height width listheight items = | 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