#!/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. * * 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 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 } and transport = SSH | TCP and network = Auto | Shell (*----------------------------------------------------------------------*) (* 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 SSH' or 'Some TCP' to assume SSH or TCP * respectively. *) remote_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 "sda3"' * or 'Some "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. *) (*----------------------------------------------------------------------*) (* 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 * 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%!" (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); (* 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 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 ] ); 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; "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 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 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; ] ] 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 * 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.remote_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\nstate = %s\n%!" (string_of_state state); () (* 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)); (* '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=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 (* 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 (* 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. *) | [ _; ("--help"|"-help"|"-?"|"-h") ] -> usage (); | [ _; ttyname ] -> main (Some ttyname) (* Run main with ttyname. *) | [ _ ] -> main None (* Interactive - no ttyname. *) | _ -> usage ()