X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=virt-p2v.ml;h=1640eede0c334854b2099d8aa6aa34ceec99d3b8;hb=3bbcbfe8c8a210aab420a97e1b0d2c9d75b0fd39;hp=28650f1fe7f3fb717c23222b4e540cd27eb4c400;hpb=5f6d8b293055d9fd80a083b48c91ce40cf884cd4;p=virt-p2v.git diff --git a/virt-p2v.ml b/virt-p2v.ml index 28650f1..1640eed 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,16 +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; + transport : transport option; remote_directory : string option; network : network option; devices_to_send : string list option; - root_filesystem : string option } -and transport = SSH | TCP + root_filesystem : partition option } +and transport = Server | 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. @@ -53,10 +60,10 @@ let defaults = { *) greeting = true; - (* Transport: Set to 'Some SSH' or 'Some TCP' to assume SSH or TCP - * respectively. + (* Transport: Set to 'Some Server' or 'Some SSH' or 'Some TCP' to + * assume Server, SSH or TCP transports respectively. *) - remote_transport = None; + transport = None; (* Remote host and port. Set to 'Some "host"' and 'Some "port"', * else ask the user. @@ -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; @@ -83,46 +91,183 @@ let defaults = { * automatically, or 'Some Shell' (give the user a shell). *) network = 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 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 -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) - (match state.remote_transport with - | None -> "" | Some SSH -> " (ssh)" | Some TCP -> " (tcp)") + (Option.default "" state.remote_host) + (Option.default "" state.remote_port) + (match state.transport with + | None -> "" + | Some Server -> " (server)" | 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 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 +(* 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, yesno, 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 and yes/no box. *) + let rec msgbox = + with_common ( + fun cparams text height width -> + run_dialog cparams + [ "--msgbox"; text; string_of_int height; string_of_int width ] + ) + and yesno = + with_common ( + fun cparams text height width -> + run_dialog cparams + [ "--yesno"; text; string_of_int height; string_of_int width ] + ) + + (* Simple input box. *) + and inputbox = + with_common ( + fun cparams text height width default -> + run_dialog cparams + [ "--inputbox"; text; string_of_int height; string_of_int width; + default ] + ) + + (* Radio list and check list. *) + and 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 + ) + and 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, yesno, inputbox, radiolist, checklist + +(* Print failure dialog and exit. *) +let fail_dialog text = + let text = "\n" ^ 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 + +(* Shell-safe quoting function. In fact there's one in stdlib so use it. *) +let quote = Filename.quote + +(* Run a shell command and check it returns 0. *) +let sh cmd = + eprintf "sh: %s\n%!" cmd; + if Sys.command cmd <> 0 then fail_dialog (sprintf "Command failed:\n\n%s" cmd) + +let shfailok cmd = + eprintf "shfailok: %s\n%!" cmd; + ignore (Sys.command cmd) + +let shwithstatus cmd = + eprintf "shwithstatus: %s\n%!" cmd; + Sys.command cmd (* Same as `cmd` in shell. Any error message will be in the logfile. *) let shget cmd = + eprintf "shget: %s\n%!" cmd; let chan = open_process_in cmd in let lines = input_all_lines chan in match close_process_in chan with @@ -131,44 +276,208 @@ 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) +(* Start an interactive shell. *) +let shell () = + shfailok "PS1='\\u@\\h:\\w\\$ ' bash" + +(* Some true if is dir/file, Some false if not, None if not found. *) +let is_dir path = + try Some ((stat path).st_kind = S_DIR) + with Unix_error (ENOENT, "stat", _) -> None +let is_file path = + try Some ((stat path).st_kind = S_REG) + with Unix_error (ENOENT, "stat", _) -> None + +(* Useful regular expression. *) +let whitespace = Pcre.regexp "[ \t]+" + +(* Generate a predictable safe name containing only letters, numbers + * and underscores. If passed a string with no letters or numbers, + * generates "_1", "_2", etc. + *) +let safe_name = + let next_anon = + let i = ref 0 in + fun () -> incr i; "_" ^ string_of_int !i + in + fun name -> + let is_safe = function 'a'..'z'|'A'..'Z'|'0'..'9' -> true | _ -> false in + let name = String.copy name in + let have_safe = ref false in + for i = 0 to String.length name - 1 do + if not (is_safe name.[i]) then name.[i] <- '_' else have_safe := true + done; + if !have_safe then name else next_anon () + +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 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 = String.nsplit pvs "," in + let pvs = List.filter_map ( + fun pv -> + try + let subs = Pcre.exec ~rex:devname pv in + Some (Pcre.get_substring subs 1) + with + Not_found -> + eprintf "lvs: unexpected device name: %s\n%!" pv; + None + ) 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 -> Some true = 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 +(* Generate snapshot device name from device name. *) +let snapshot_name dev = + "snap" ^ (safe_name dev) + +(* Perform a device-mapper snapshot with ramdisk overlay. *) +let snapshot = + let next_free_ram_disk = + let i = ref 0 in + fun () -> incr i; "/dev/ram" ^ string_of_int !i + in + fun origin_dev snapshot_dev -> + let ramdisk = next_free_ram_disk () in + let sectors = + let cmd = "blockdev --getsz " ^ quote ("/dev/" ^ origin_dev) in + let lines = shget cmd in + match lines with + | Some (sectors::_) -> Int64.of_string sectors + | Some [] | None -> + fail_dialog (sprintf "Snapshot failed - unable to read the size in sectors of block device %s" origin_dev) in + + (* Create the snapshot origin device. Called, eg. snap_sda1_org *) + sh (sprintf "dmsetup create %s_org --table='0 %Ld snapshot-origin /dev/%s'" + snapshot_dev sectors origin_dev); + (* Create the snapshot. *) + sh (sprintf "dmsetup create %s --table='0 %Ld snapshot /dev/mapper/%s_org %s n 64'" + snapshot_dev sectors snapshot_dev ramdisk) + +(* Try to perform automatic network configuration, assuming a Fedora or RHEL- + * like root filesystem mounted on /mnt/root. + *) +let auto_network state = + (* Fedora gives an error if this file doesn't exist. *) + sh "touch /etc/resolv.conf"; + + chdir "/etc/sysconfig"; + + sh "mv network network.saved"; + sh "mv networking networking.saved"; + sh "mv network-scripts network-scripts.saved"; + + (* Originally I symlinked these, but that causes dhclient to + * keep open /mnt/root (as its cwd is in network-scripts subdir). + * So now we will copy them recursively instead. + *) + sh "cp -r /mnt/root/etc/sysconfig/network ."; + sh "cp -r /mnt/root/etc/sysconfig/networking ."; + sh "cp -r /mnt/root/etc/sysconfig/network-scripts ."; + + let status = shwithstatus "/etc/init.d/network start" in + + sh "rm -rf network networking network-scripts"; + sh "mv network.saved network"; + sh "mv networking.saved networking"; + sh "mv network-scripts.saved network-scripts"; + + chdir "/tmp"; + + (* Try to ping the remote host to see if this worked. *) + shfailok ("ping -c 3 " ^ Option.map_default quote "" state.remote_host); + + if state.greeting then ( + printf "\n\nDid automatic network configuration work?\n"; + printf "Hint: If not sure, there is a shell on console [ALT] [F2]\n"; + printf " (y/n) %!"; + let line = read_line () in + String.length line > 0 && (line.[0] = 'y' || line.[0] = 'Y') + ) + else + (* Non-interactive: return the status of /etc/init.d/network start. *) + status = 0 + +(* Map local device names to remote devices names. At the moment we + * just change sd* to hd* (as device names appear under fullvirt). In + * future, lots of complex possibilities. + *) +let remote_of_origin_dev = + let devsd = Pcre.regexp "^sd([[:alpha:]]+[[:digit:]]*)$" in + let devsd_subst = Pcre.subst "hd$1" in + fun dev -> + Pcre.replace ~rex:devsd ~itempl:devsd_subst dev + +(* Rewrite /mnt/root/etc/fstab. *) +let rewrite_fstab state devices_to_send = + let filename = "/mnt/root/etc/fstab" in + if is_file filename = Some true then ( + sh ("cp " ^ quote filename ^ " " ^ quote (filename ^ ".p2vsaved")); + + let chan = open_in filename in + let lines = input_all_lines chan in + close_in chan; + let lines = List.map (Pcre.split ~rex:whitespace) lines in + let lines = List.map ( + function + | dev :: rest when String.starts_with dev "/dev/" -> + let dev = String.sub dev 5 (String.length dev - 5) in + let dev = remote_of_origin_dev dev in + let dev = "/dev/" ^ dev in + dev :: rest + | line -> line + ) lines in + + let chan = open_out filename in + List.iter ( + function + | [dev; mountpoint; fstype; options; freq; passno] -> + fprintf chan "%-23s %-23s %-7s %-15s %s %s\n" + dev mountpoint fstype options freq passno + | line -> + output_string chan (String.concat " " line) + ) lines; + close_out chan + ) + (* Main entry point. *) let rec main ttyname = (* Running from an init script. We don't have much of a @@ -192,7 +501,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. *) @@ -203,29 +512,29 @@ let rec main ttyname = dup2 fd stdin; dup2 fd stdout; close fd); + printf "virt-p2v.ml starting up ...\n%!"; (* 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 " ^ quote ("/dev/" ^ 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)); @@ -233,63 +542,74 @@ 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 = + 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 -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" "\nUPDATED! Welcome 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 [ - "ssh", "SSH (secure shell - recommended)", - state.remote_transport = Some SSH; + radiolist "Connection type" ~backbutton:false + "Connection type. If possible, select 'server' and run P2V server on the remote host" + 11 50 3 [ + "server", "P2V server on remote host", + state.transport = Some Server; + "ssh", "SSH (secure shell)", + state.transport = Some SSH; "tcp", "TCP socket", - state.remote_transport = Some TCP + state.transport = Some TCP ] - ] with - | Yes ("ssh"::_) -> Next { state with remote_transport = Some SSH } - | Yes ("tcp"::_) -> Next { state with remote_transport = Some TCP } + | Yes ("server"::_) -> Next { state with transport = Some Server } + | Yes ("ssh"::_) -> Next { state with transport = Some SSH } + | Yes ("tcp"::_) -> Next { state with transport = Some TCP } | Yes _ | No | Help | Error -> Ask_again | Back -> Prev in 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 } @@ -299,16 +619,14 @@ in 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 - Next { state with remote_port = Some "16211" } - else - Next { state with remote_port = Some "22" } + (match state.transport with + | Some SSH -> Next { state with remote_port = Some "22" } + | _ -> Next { state with remote_port = Some "16211" } + ) | Yes (port::_) -> Next { state with remote_port = Some port } | No | Help | Error -> Ask_again | Back -> Prev @@ -316,10 +634,8 @@ in 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" } @@ -330,12 +646,9 @@ 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; - ] + 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 } @@ -345,24 +658,71 @@ 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 - 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 + + let ask_verify state = + match + yesno "Verify and proceed" + (sprintf "\nPlease verify the settings below and click [OK] to proceed, or the [Back] button to return to a previous step. + +Connection: %s +Remote host: %s +Remote port: %s +Directory: %s +Network: %s +Send devices: %s +Root (/) dev: %s" + (match state.transport with + | Some Server -> "Server" + | Some SSH -> "SSH" | Some TCP -> "TCP socket" + | None -> "") + (Option.default "" state.remote_host) + (Option.default "" state.remote_port) + (Option.default "" state.remote_directory) + (match state.network with + | Some Auto -> "Auto-configure" | Some Shell -> "Shell" + | None -> "") + (String.concat "," (Option.default [] state.devices_to_send)) + (Option.map_default dev_of_partition "" state.root_filesystem)) + 18 50 + with + | Yes _ -> Next state + | Back -> Prev + | No | Help | Error -> Ask_again + 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 @@ -372,7 +732,7 @@ in ask_greeting, (* Initial greeting. *) defaults.greeting; ask_transport, (* Transport (ssh, tcp) *) - defaults.remote_transport = None; + defaults.transport = None; ask_hostname, (* Hostname. *) defaults.remote_host = None; ask_port, (* Port number. *) @@ -383,10 +743,10 @@ 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. *) - defaults.greeting*) + defaults.greeting |] in (* Loop through the dialogs until we reach the end. *) @@ -410,114 +770,321 @@ in in let state = loop 0 defaults in - eprintf "finished dialog loop\nstate = %s\n%!" (string_of_state state); + eprintf "finished dialog loop\nfinal state = %s\n%!" (string_of_state state); + (* Check that the environment is a sane-looking live CD. If not, bail. *) + if is_dir "/mnt/root" <> Some true then + fail_dialog "You should only run this script from the live CD or a USB key."; + (* Switch LVM config. *) + sh "vgchange -a n"; + putenv "LVM_SYSTEM_DIR" "/etc/lvm.new"; (* see lvm(8) *) + sh "rm -f /etc/lvm/cache/.cache"; + sh "rm -f /etc/lvm.new/cache/.cache"; + (* Snapshot the block devices to send. *) + let devices_to_send = Option.get state.devices_to_send in + let devices_to_send = + List.map ( + fun origin_dev -> + let snapshot_dev = snapshot_name origin_dev in + snapshot origin_dev snapshot_dev; + (origin_dev, snapshot_dev) + ) devices_to_send in + (* Run kpartx on the snapshots. *) + List.iter ( + fun (origin, snapshot) -> + shfailok ("kpartx -a " ^ quote ("/dev/mapper/" ^ snapshot)) + ) devices_to_send; + (* Rescan for LVs. *) + sh "vgscan"; + sh "vgchange -a y"; - () + (* Mount the root filesystem under /mnt/root. *) + let root_filesystem = Option.get state.root_filesystem in + (match root_filesystem with + | Part (dev, partnum) -> + let dev = dev ^ partnum in + let snapshot_dev = snapshot_name dev in + sh ("mount " ^ quote ("/dev/mapper/" ^ snapshot_dev) ^ " /mnt/root") -(* 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)); + | LV (vg, lv) -> + (* The LV will be backed by a snapshot device, so just mount + * directly. + *) + sh ("mount " ^ quote ("/dev/" ^ vg ^ "/" ^ lv) ^ " /mnt/root") + ); + + (* See if we can do network configuration. *) + let network = Option.get state.network in + (match network with + | Shell -> + printf "Network configuration.\n\n"; + printf "Please configure the network from this shell.\n\n"; + printf "When you have finished, exit the shell with ^D or exit.\n\n%!"; + shell () + + | Auto -> + printf + "Trying network auto-configuration from root filesystem ...\n\n%!"; + if not (auto_network state) then ( + printf "\nAuto-configuration failed. Starting a shell.\n\n"; + printf "Please configure the network from this shell.\n\n"; + printf "When you have finished, exit the shell with ^D or exit.\n\n"; + shell () + ) + ); + + (* Work out what devices will be called at the remote end. *) + let devices_to_send = List.map ( + fun (origin_dev, snapshot_dev) -> + let remote_dev = remote_of_origin_dev origin_dev in + (origin_dev, snapshot_dev, remote_dev) + ) devices_to_send in + + (* Modify files on the root filesystem. *) + rewrite_fstab state devices_to_send; + (* XXX Other files to rewrite? *) + + (* Unmount the root filesystem and sync disks. *) + sh "umount /mnt/root"; + sh "sync"; (* Ugh, should be in stdlib. *) + + (* Disable screen blanking on console. *) + sh "setterm -blank 0"; + + (* For Server and TCP type connections, we connect just once. *) + let remote_host = Option.get state.remote_host in + let remote_port = Option.get state.remote_port in + let remote_directory = Option.get state.remote_directory in + let transport = Option.get state.transport in - (* 'dialog' writes its output/result to stderr, so we need to take - * special steps to capture that - in other words, manual pipe/fork. + let sock = + match transport with + | Server | TCP -> + let addrs = + getaddrinfo remote_host remote_port [AI_SOCKTYPE SOCK_STREAM] in + let rec loop = function + | [] -> + fail_dialog + (sprintf "Unable to connect to %s:%s" remote_host remote_port) + | addr :: addrs -> + try + let sock = + socket addr.ai_family addr.ai_socktype addr.ai_protocol in + connect sock addr.ai_addr; + sock + with Unix_error (err, syscall, extra) -> + (* Log the error message, but continue around the loop. *) + eprintf "%s:%s: %s\n%!" syscall extra (error_message err); + loop addrs + in + loop addrs + | SSH -> + (* Just dummy socket for SSH for now ... *) stdin in + + (* Send the device snapshots to the remote host. *) + (* XXX This is using the hostname derived from network configuration + * above. We might want to ask the user to choose. *) - 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 + let basename = + let hostname = safe_name (gethostname ()) in + let date = sprintf "%04d%02d%02d%02d%02d" + (tm.tm_year+1900) (tm.tm_mon+1) tm.tm_mday tm.tm_hour tm.tm_min in + "p2v-" ^ hostname ^ "-" ^ date in -(* 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 + (* XXX This code should be made more robust against both network + * errors and local I/O errors. Also should allow the user several + * attempts to connect, or let them go back to the dialog stage. + *) + List.iter ( + fun (origin_dev, snapshot_dev, remote_dev) -> + let remote_name = basename ^ "-" ^ remote_dev ^ ".img" in + eprintf "sending %s as %s\n%!" origin_dev remote_name; + + let size = + try List.assoc origin_dev all_block_devices + with Not_found -> assert false (* internal error *) in + + printf "Sending /dev/%s (%.3f GB) to remote machine\n%!" origin_dev + ((Int64.to_float size) /. (1024.*.1024.*.1024.)); + + (* Open the snapshot device. *) + let fd = openfile ("/dev/mapper/" ^ snapshot_dev) [O_RDONLY] 0 in + + (* Now connect (for SSH) or send the header (for Server/TCP). *) + let sock, chan = + match transport with + | Server | TCP -> + let header = sprintf "p2v2 %s %Ld\n%!" remote_name size in + let len = String.length header in + assert (len = write sock header 0 len); + sock, Pervasives.stdout + | SSH -> + let cmd = sprintf "ssh -C -p %s %s \"cat > %s/%s\"" + (quote remote_port) (quote remote_host) + (quote remote_directory) (quote remote_name) in + let chan = open_process_out cmd in + let fd = descr_of_out_channel chan in + fd, chan in + + (* Copy the data. *) + let bufsize = 1024 * 1024 in + let buffer = String.create bufsize in + let start = gettimeofday () in + + let rec copy bytes_sent last_printed_at = + let n = read fd buffer 0 bufsize in + if n > 0 then ( + ignore (write sock buffer 0 n); + + let bytes_sent = Int64.add bytes_sent (Int64.of_int n) in + let last_printed_at = + let now = gettimeofday () in + (* Print progress once per second. *) + if now -. last_printed_at > 1. then ( + let elapsed = Int64.to_float bytes_sent /. Int64.to_float size in + let secs_elapsed = now -. start in + printf "%.0f%%" (100. *. elapsed); + (* After 60 seconds has elapsed, start printing estimates. *) + if secs_elapsed >= 60. then ( + let remaining = 1. -. elapsed in + let secs_remaining = (remaining /. elapsed) *. secs_elapsed in + if secs_remaining > 120. then + printf " (about %.0f minutes remaining) " + (secs_remaining /. 60.) + else + printf " (about %.0f seconds remaining) " + secs_remaining + ); + printf "\r%!"; + now + ) + else last_printed_at in + + copy bytes_sent last_printed_at + ) + in + copy 0L start; + + (* For SSH disconnect, for Server/TCP send a newline. *) + match transport with + | Server | TCP -> + ignore (write sock "\n" 0 1) + | SSH -> + match close_process_out chan with + | WEXITED 0 -> () (* OK *) + | WEXITED i -> failwith (sprintf "ssh: exited with error code %d" i) + | WSIGNALED i -> failwith (sprintf "ssh: killed by signal %d" i) + | WSTOPPED i -> failwith (sprintf "ssh: stopped by signal %d" i) + ) devices_to_send; + + (* Disconnect. *) + (match transport with + | Server | TCP -> close sock + | SSH -> () + ); + + (* XXX Write a configuration file. *) + let conf_filename = basename ^ ".conf" in + + (* Clean up and reboot. *) ignore ( - dialog [ - title "Error" (); - msgbox text 17 50 - ] + msgbox "virt-p2v completed" + (sprintf "\nThe physical to virtual migration is complete.\n\nPlease verify the disk image(s) and configuration file on the remote host, and then start up the virtual machine by doing:\n\nvirsh define %s/%s\n\nWhen you press [OK] this machine will reboot." + (Option.default "" state.remote_directory) conf_filename) + 17 50 ); - exit 1 + + shfailok "eject"; + shfailok "reboot"; + exit 0 let usage () = eprintf "usage: virt-p2v [ttyname]\n%!"; exit 2 +(* Make sure that exceptions from 'main' get printed out on stdout + * as well as stderr, since stderr is probably redirected to the + * logfile, and so not visible to the user. + *) +let handle_exn f arg = + try f arg + with exn -> print_endline (Printexc.to_string exn); raise exn + +(* If the ISO image has an attachment then it could be a new version + * of virt-p2v.ml (this script). Get the attachment and run it + * instead. Useful mainly for testing, in conjunction with the + * 'make update' target in the virt-p2v Makefile. + *) +let magic = "ISOATTACHMENT002" +let magiclen = String.length magic (* = 16 bytes *) +let trailerlen = magiclen + 8 + 8 (* magic + file start + true size *) + +let int64_of_string str = + let i = ref 0L in + let add offs shift = + i := + Int64.logor + (Int64.shift_left (Int64.of_int (Char.code str.[offs])) shift) !i + in + add 0 56; add 1 48; add 2 40; add 3 32; + add 4 24; add 5 16; add 6 8; add 7 0; + !i + +let update ttyname = + let cdrom = "/dev/cdrom" in + let output = "/tmp/virt-p2v.ml" in + + try + let fd = openfile cdrom [O_RDONLY] 0 in + ignore (LargeFile.lseek fd (Int64.of_int ~-trailerlen) SEEK_END); + let buf = String.create magiclen in + if read fd buf 0 magiclen <> magiclen || buf <> magic then ( + close fd; + raise Exit + ); + + (* Read the size. *) + let buf = String.create 8 in + if read fd buf 0 8 <> 8 then + failwith "cannot read attachment offset"; + let offset = int64_of_string buf in + let buf = String.create 8 in + if read fd buf 0 8 <> 8 then + failwith "cannot read attachment size"; + let size = Int64.to_int (int64_of_string buf) in + + (* Seek to beginning of the attachment. *) + ignore (LargeFile.lseek fd offset SEEK_SET); + + (* Copy out the attachment. *) + let fd2 = openfile output [O_WRONLY; O_CREAT; O_TRUNC] 0o755 in + let bufsize = 4 * 1024 in + let buffer = String.create bufsize in + let rec copy remaining = + if remaining > 0 then ( + let n = min remaining bufsize in + let n = read fd buffer 0 n in + if n = 0 then failwith "corrupted or partial attachment"; + ignore (write fd2 buffer 0 n); + copy (remaining - n) + ) + in + copy size; + close fd2; + + close fd; + + (* Run updated virt-p2v script. *) + execv output [| output; ttyname |] + with + Unix_error _ | Exit -> + (* Some error, or no attachment, so keep running this script. *) + handle_exn main (Some ttyname) + (* Test harness for the Makefile. The Makefile invokes this script as * 'virt-p2v.ml --test' just to check it compiles. When it is running * from the actual live CD, there is a single parameter which is the @@ -525,8 +1092,14 @@ let usage () = *) let () = match Array.to_list Sys.argv with - | [ _; "--test" ] -> () (* Makefile test - do nothing. *) + | [ _; "--test" ] -> () (* Makefile test - do nothing. *) + | [ _; "--update"; ttyname ] -> (* Test for update and run. *) + update ttyname | [ _; ("--help"|"-help"|"-?"|"-h") ] -> usage (); - | [ _; ttyname ] -> main (Some ttyname) (* Run main with ttyname. *) - | [ _ ] -> main None (* Interactive - no ttyname. *) + | [ _; ttyname ] -> (* Run main with ttyname. *) + handle_exn main (Some ttyname) + | [ _ ] -> (* Interactive - no ttyname. *) + handle_exn main None | _ -> usage () + +(* This file must end with a newline *)