#!/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. * * Copyright (C) 2007-2008 Red Hat Inc. * Written by Richard W.M. Jones * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Unix open Printf open ExtList open ExtString type state = { greeting : bool; remote_host : string option; remote_port : string option; transport : transport option; remote_directory : string option; network : network option; devices_to_send : string list option; 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. * * If left as they are, then this will create a generic virt-p2v script * which asks the user for each question. If you set the defaults here * then you will get a custom virt-p2v which is partially or even fully * automated and won't ask the user any questions. * * Note that 'None' means 'no default' (ie. ask the user) whereas * 'Some foo' means use 'foo' as the answer. *) let defaults = { (* If greeting is true, wait for keypress after boot and during * final verification. Set to 'false' for less interactions. *) greeting = true; (* Transport: Set to 'Some Server' or 'Some SSH' or 'Some TCP' to * assume Server, SSH or TCP transports respectively. *) transport = None; (* Remote host and port. Set to 'Some "host"' and 'Some "port"', * else ask the user. *) remote_host = None; remote_port = None; (* Remote directory (only for SSH transport). Set to 'Some "path"' * to set up a directory path, else ask the user. *) remote_directory = None; (* List of devices to send. Set to 'Some ["sda"; "sdb"]' for * example to select /dev/sda and /dev/sdb. *) devices_to_send = None; (* 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; (* Network configuration: Set to 'Some Auto' (try to set it up * automatically, or 'Some Shell' (give the user a shell). *) network = None; } (* 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 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 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.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 "; " (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 (* 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 | 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) (* 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 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 = 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 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 * login environment, so set one up. *) putenv "PATH" (String.concat ":" ["/usr/sbin"; "/sbin"; "/usr/local/bin"; "/usr/kerberos/bin"; "/usr/bin"; "/bin"]); putenv "HOME" "/root"; putenv "LOGNAME" "root"; (* We can safely write in /tmp (it's a synthetic live CD directory). *) chdir "/tmp"; (* Set up logging to /tmp/virt-p2v.log. *) let fd = openfile "virt-p2v.log" [ O_WRONLY; O_APPEND; O_CREAT ] 0o644 in dup2 fd stderr; close fd; (* 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\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. *) (match ttyname with | None -> () | Some ttyname -> let fd = openfile ("/dev/" ^ ttyname) [ O_RDWR ] 0 in 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. 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 " ^ quote ("/dev/" ^ 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 ask_greeting state = 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 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.transport = Some TCP ] with | 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 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 [] -> (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 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; ] 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 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 * 'defaults' above). *) let dlgs = [| ask_greeting, (* Initial greeting. *) defaults.greeting; ask_transport, (* Transport (ssh, tcp) *) defaults.transport = None; ask_hostname, (* Hostname. *) defaults.remote_host = None; ask_port, (* Port number. *) defaults.remote_port = None; 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_verify, (* Verify settings. *) defaults.greeting |] in (* Loop through the dialogs until we reach the end. *) let rec loop posn state = eprintf "dialog loop: posn = %d\n%!" posn; if posn >= Array.length dlgs then state (* Finished all dialogs. *) else ( let dlg, no_skip = dlgs.(posn) in let skip = not no_skip in if skip then (* Skip this dialog and move straight to the next one. *) loop (posn+1) state else ( (* 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\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") | 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 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 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 (* 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 ( 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 ); 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 * tty name (so usually 'virt-p2v.ml tty1'). *) let () = match Array.to_list Sys.argv with | [ _; "--test" ] -> () (* Makefile test - do nothing. *) | [ _; "--update"; ttyname ] -> (* Test for update and run. *) update ttyname | [ _; ("--help"|"-help"|"-?"|"-h") ] -> usage (); | [ _; 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 *)