virt-p2v.ml

   1 #!/usr/bin/ocamlrun /usr/bin/ocaml
   2 #load "unix.cma";;
   3 #load "str.cma";;
   4
   5 (* virt-p2v.ml is a script which performs a physical to
   6  * virtual conversion of local disks.
   7  *
   8  * Copyright (C) 2007-2008 Red Hat Inc.
   9  * Written by Richard W.M. Jones <rjones@redhat.com>
  10  *
  11  * This program is free software; you can redistribute it and/or modify
  12  * it under the terms of the GNU General Public License as published by
  13  * the Free Software Foundation; either version 2 of the License, or
  14  * (at your option) any later version.
  15  *
  16  * This program is distributed in the hope that it will be useful,
  17  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  18  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19  * GNU General Public License for more details.
  20  *
  21  * You should have received a copy of the GNU General Public License
  22  * along with this program; if not, write to the Free Software
  23  * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  24  *)
  25
  26 open Unix
  27 open Printf
  28
  29 type state = { greeting : bool;
  30                remote_host : string option; remote_port : string option;
  31                remote_transport : transport option;
  32                remote_directory : string option;
  33                network : network option;
  34                devices_to_send : string list option;
  35                root_filesystem : string option }
  36 and transport = SSH | TCP
  37 and network = Auto | Shell
  38
  39 (*----------------------------------------------------------------------*)
  40 (* TO MAKE A CUSTOM virt-p2v SCRIPT, adjust the defaults in this section.
  41  *
  42  * If left as they are, then this will create a generic virt-p2v script
  43  * which asks the user for each question.  If you set the defaults here
  44  * then you will get a custom virt-p2v which is partially or even fully
  45  * automated and won't ask the user any questions.
  46  *
  47  * Note that 'None' means 'no default' (ie. ask the user) whereas
  48  * 'Some foo' means use 'foo' as the answer.
  49  *)
  50 let defaults = {
  51   (* If greeting is true, wait for keypress after boot and during
  52    * final verification.  Set to 'false' for less interactions.
  53    *)
  54   greeting = true;
  55
  56   (* Transport: Set to 'Some SSH' or 'Some TCP' to assume SSH or TCP
  57    * respectively.
  58    *)
  59   remote_transport = None;
  60
  61   (* Remote host and port.  Set to 'Some "host"' and 'Some "port"',
  62    * else ask the user.
  63    *)
  64   remote_host = None;
  65   remote_port = None;
  66
  67   (* Remote directory (only for SSH transport).  Set to 'Some "path"'
  68    * to set up a directory path, else ask the user.
  69    *)
  70   remote_directory = None;
  71
  72   (* List of devices to send.  Set to 'Some ["sda"; "sdb"]' for
  73    * example to select /dev/sda and /dev/sdb.
  74    *)
  75   devices_to_send = None;
  76
  77   (* The root filesystem containing /etc/fstab.  Set to 'Some "sda3"'
  78    * or 'Some "VolGroup00/LogVol00"' for example, else ask user.
  79    *)
  80   root_filesystem = None;
  81
  82   (* Network configuration: Set to 'Some Auto' (try to set it up
  83    * automatically, or 'Some Shell' (give the user a shell).
  84    *)
  85   network = None;
  86
  87 }
  88 (* END OF CUSTOM virt-p2v SCRIPT SECTION.                               *)
  89 (*----------------------------------------------------------------------*)
  90
  91 (* String map type. *)
  92 module StringMap = Map.Make (String)
  93
  94 (* General helper functions. *)
  95
  96 let default d = function None -> d | Some p -> p
  97
  98 let string_of_state state =
  99   sprintf
 100     "greeting: %b  remote: %s:%s%s%s  network: %s  devices: [%s]  root: %s"
 101     state.greeting
 102     (default "" state.remote_host)
 103     (default "" state.remote_port)
 104     (match state.remote_transport with
 105      | None -> "" | Some SSH -> " (ssh)" | Some TCP -> " (tcp)")
 106     (match state.remote_directory with
 107      | None -> "" | Some dir -> " " ^ dir)
 108     (match state.network with
 109      | None -> "none" | Some Auto -> "auto" | Some Shell -> "shell")
 110     (String.concat "; " (default [] state.devices_to_send))
 111     (default "" state.root_filesystem)
 112
 113 type dialog_status = Yes of string list | No | Help | Back | Error
 114
 115 type ask_result = Next of state | Prev | Ask_again
 116
 117 let input_all_lines chan =
 118   let lines = ref [] in
 119   try
 120     while true do lines := input_line chan :: !lines done; []
 121   with
 122     End_of_file -> List.rev !lines
 123
 124 (* Same as `cmd` in shell.  Any error message will be in the logfile. *)
 125 let shget cmd =
 126   let chan = open_process_in cmd in
 127   let lines = input_all_lines chan in
 128   match close_process_in chan with
 129   | WEXITED 0 -> Some lines             (* command succeeded *)
 130   | WEXITED _ -> None                   (* command failed *)
 131   | WSIGNALED i -> failwith (sprintf "shget: command killed by signal %d" i)
 132   | WSTOPPED i -> failwith (sprintf "shget: command stopped by signal %d" i)
 133
 134 (*
 135 (* Parse the output of 'lvs' to get list of LV names, sizes,
 136  * corresponding PVs, etc.  Returns a list of (lvname, PVs, lvsize).
 137  *)
 138 let get_lvs () =
 139   let whitespace = Str.regexp "[ \t]+" in
 140   let comma = Str.regexp "," in
 141   let devname = Str.regexp "^/dev/\\(.+\\)(.+)$" in
 142
 143   match
 144   shget "lvs --noheadings -o vg_name,lv_name,devices,lv_size"
 145   with
 146   | None -> []
 147   | Some lines ->
 148       let lines = List.map (Str.split whitespace) lines in
 149       List.map (
 150         function
 151         | [vg; lv; pvs; lvsize] ->
 152             let pvs = Str.split comma pvs in
 153             let pvs = List.map (
 154               fun pv ->
 155                 if Str.string_match devname pv then
 156                   Str.matched_group 0
 157                 else
 158                   failwith ("lvs: unexpected device name: " ^ pv)
 159             ) pvs in
 160             vg ^ "/" ^ lv, pvs, lvsize
 161         | _ ->
 162             failwith "lvs: unexpected output"
 163       ) lines
 164 *)
 165
 166 (*
 167 (* Get the partitions on a block device.  eg. "sda" -> ["sda1";"sda2"] *)
 168 let get_partitions dev =
 169   let parts = Sys.readdir ("/sys/block/" ^ dev) in
 170   let parts = List.filter is_dir parts in
 171   let regexp = Str.regexp ("^" ^ dev) in
 172   let parts = List.filter (Str.string_match regexp) parts in
 173   parts
 174 *)
 175
 176 (* Dialog functions.
 177  *
 178  * Each function takes some common parameters (eg. ~title) and some
 179  * dialog-specific functions.
 180  *
 181  * Returns the exit status (Yes lines | No | Help | Back | Error).
 182  *)
 183 let msgbox, inputbox, radiolist, checklist =
 184   (* Internal function to actually run the "dialog" shell command. *)
 185   let run_dialog cparams params =
 186     let params = cparams @ params in
 187     eprintf "dialog [%s]\n%!"
 188       (String.concat "; " (List.map (sprintf "%S") params));
 189
 190     (* 'dialog' writes its output/result to stderr, so we need to take
 191      * special steps to capture that - in other words, manual pipe/fork.
 192      *)
 193     let rfd, wfd = pipe () in
 194     match fork () with
 195     | 0 ->                              (* child, runs dialog *)
 196         close rfd;
 197         dup2 wfd stderr;                (* capture stderr to pipe *)
 198         execvp "dialog" (Array.of_list ("dialog" :: params))
 199     | pid ->                            (* parent *)
 200         close wfd;
 201         let chan = in_channel_of_descr rfd in
 202         let result = input_all_lines chan in
 203         close rfd;
 204         eprintf "dialog result: %S\n%!" (String.concat "\n" result);
 205         match snd (wait ()) with
 206         | WEXITED 0 -> Yes result       (* something selected / entered *)
 207         | WEXITED 1 -> No               (* cancel / no button *)
 208         | WEXITED 2 -> Help             (* help pressed *)
 209         | WEXITED 3 -> Back             (* back button *)
 210         | WEXITED _ -> Error            (* error or Esc *)
 211         | WSIGNALED i -> failwith (sprintf "dialog: killed by signal %d" i)
 212         | WSTOPPED i -> failwith (sprintf "dialog: stopped by signal %d" i)
 213   in
 214
 215   (* Handle the common parameters.  Note Continuation Passing Style. *)
 216   let with_common cont ?(cancel=false) ?(backbutton=true) title =
 217     let params = ["--title"; title] in
 218     let params = if not cancel then "--nocancel" :: params else params in
 219     let params =
 220       if backbutton then "--extra-button" :: "--extra-label" :: "Back" :: params
 221       else params in
 222     cont params
 223   in
 224
 225   (* Message box. *)
 226   let msgbox =
 227     with_common (
 228       fun cparams text height width ->
 229         run_dialog cparams
 230           [ "--msgbox"; text; string_of_int height; string_of_int width ]
 231     )
 232   in
 233
 234   (* Simple input box. *)
 235   let inputbox =
 236     with_common (
 237       fun cparams text height width default ->
 238         run_dialog cparams
 239           [ "--inputbox"; text; string_of_int height; string_of_int width;
 240             default ]
 241     )
 242   in
 243
 244   (* Radio list and check list. *)
 245   let radiolist =
 246     with_common (
 247       fun cparams text height width listheight items ->
 248         let items = List.map (
 249           function
 250           | tag, item, true -> [ tag; item; "on" ]
 251           | tag, item, false -> [ tag; item; "off" ]
 252         ) items in
 253         let items = List.concat items in
 254         let items = "--single-quoted" ::
 255           "--radiolist" :: text ::
 256           string_of_int height :: string_of_int width ::
 257           string_of_int listheight :: items in
 258         run_dialog cparams items
 259     )
 260   in
 261
 262   let checklist =
 263     with_common (
 264       fun cparams text height width listheight items ->
 265         let items = List.map (
 266           function
 267           | tag, item, true -> [ tag; item; "on" ]
 268           | tag, item, false -> [ tag; item; "off" ]
 269         ) items in
 270         let items = List.concat items in
 271         let items = "--separate-output" ::
 272           "--checklist" :: text ::
 273           string_of_int height :: string_of_int width ::
 274           string_of_int listheight :: items in
 275         run_dialog cparams items
 276     )
 277   in
 278   msgbox, inputbox, radiolist, checklist
 279
 280 (* Print failure dialog and exit. *)
 281 let fail_dialog text =
 282   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
 283   ignore (msgbox "Error" text 17 50);
 284   exit 1
 285
 286 (* Main entry point. *)
 287 let rec main ttyname =
 288   (* Running from an init script.  We don't have much of a
 289    * login environment, so set one up.
 290    *)
 291   putenv "PATH"
 292     (String.concat ":"
 293        ["/usr/sbin"; "/sbin"; "/usr/local/bin"; "/usr/kerberos/bin";
 294         "/usr/bin"; "/bin"]);
 295   putenv "HOME" "/root";
 296   putenv "LOGNAME" "root";
 297
 298   (* We can safely write in /tmp (it's a synthetic live CD directory). *)
 299   chdir "/tmp";
 300
 301   (* Set up logging to /tmp/virt-p2v.log. *)
 302   let fd = openfile "virt-p2v.log" [ O_WRONLY; O_APPEND; O_CREAT ] 0o644 in
 303   dup2 fd stderr;
 304   close fd;
 305
 306   (* Log the start up time. *)
 307   eprintf "\n\n**************************************************\n\n";
 308   let tm = localtime (time ()) in
 309   eprintf "virt-p2v-ng starting up at %04d-%02d-%02d %02d:%02d:%02d\n%!"
 310     (tm.tm_year+1900) (tm.tm_mon+1) tm.tm_mday tm.tm_hour tm.tm_min tm.tm_sec;
 311
 312   (* Connect stdin/stdout to the tty. *)
 313   (match ttyname with
 314    | None -> ()
 315    | Some ttyname ->
 316        let fd = openfile ("/dev/" ^ ttyname) [ O_RDWR ] 0 in
 317        dup2 fd stdin;
 318        dup2 fd stdout;
 319        close fd);
 320
 321   (* Search for all non-removable block devices.  Do this early and bail
 322    * if we can't find anything.
 323    *)
 324   let all_block_devices =
 325     let regexp = Str.regexp "^[hs]d" in
 326     let devices = Array.to_list (Sys.readdir "/sys/block") in
 327     let devices = List.sort compare devices in
 328     let devices = List.filter (fun d -> Str.string_match regexp d 0) devices in
 329     eprintf "all_block_devices: block devices: %s\n%!"
 330       (String.concat "; " devices);
 331     (* Run blockdev --getsize on each, and reject any where this fails
 332      * (probably removable devices).
 333      *)
 334     let devices = List.map (
 335       fun d ->
 336         let cmd = "blockdev --getsize /dev/" ^ Filename.quote d in
 337         let lines = shget cmd in
 338         match lines with
 339         | Some (blksize::_) -> d, Int64.of_string blksize
 340         | Some [] | None -> d, 0L
 341     ) devices in
 342     let devices = List.filter (fun (_, blksize) -> blksize > 0L) devices in
 343     eprintf "all_block_devices: non-removable block devices: %s\n%!"
 344       (String.concat "; "
 345          (List.map (fun (d, b) -> sprintf "%s [%Ld]" d b) devices));
 346     if devices = [] then
 347       fail_dialog "No non-removable block devices (hard disks, etc.) could be found on this machine.";
 348     devices in
 349
 350 (*
 351   (* For each device that we identified above, search for partitions on
 352    * the device.  These are returned as strings like "hda1" or for
 353    * LVs "VolGroup00/LogVol00".  This creates a StringMap of block device
 354    * name -> list of partitions on the device.
 355    *)
 356   let partition_map =
 357     let lvs = get_lvs () in             (* Logical volumes. *)
 358     eprintf "partition_map: LVs: %s\n%!"
 359       (String.concat "; " (List.map (fun (lvname, _, _) -> lvname));
 360
 361     let all_partitions = List.map get_partitions all_block_devices in
 362     let all_partitions = List.concat all_partitions in
 363     eprintf "partition_map: all parts: %s\n%!"
 364       (String.concat "; " all_partitions);
 365
 366     (* Ignore any partitions which are used as PVs in the first list. *)
 367     let all_partitions =
 368
 369 in
 370 *)
 371
 372
 373   (* Dialogs. *)
 374   let ask_greeting state =
 375     ignore (msgbox "virt-p2v" "\nWelcome to virt-p2v, a live CD for migrating a physical machine to a virtualized host.\n\nTo continue press the Return key.\n\nTo get a shell you can use [ALT] [F2] and log in as root with no password." 17 50);
 376     Next state
 377   in
 378
 379   let ask_transport state =
 380     match
 381     radiolist "Connection type" ~backbutton:false
 382       "Connection type" 10 50 2 [
 383         "ssh", "SSH (secure shell - recommended)",
 384           state.remote_transport = Some SSH;
 385         "tcp", "TCP socket",
 386           state.remote_transport = Some TCP
 387       ]
 388     with
 389     | Yes ("ssh"::_) -> Next { state with remote_transport = Some SSH }
 390     | Yes ("tcp"::_) -> Next { state with remote_transport = Some TCP }
 391     | Yes _ | No | Help | Error -> Ask_again
 392     | Back -> Prev
 393   in
 394
 395   let ask_hostname state =
 396     match
 397     inputbox "Remote host" "Remote host" 10 50 (default "" state.remote_host)
 398     with
 399     | Yes [] -> Ask_again
 400     | Yes (hostname::_) -> Next { state with remote_host = Some hostname }
 401     | No | Help | Error -> Ask_again
 402     | Back -> Prev
 403   in
 404
 405   let ask_port state =
 406     match
 407     inputbox "Remote port" "Remote port" 10 50 (default "" state.remote_port)
 408     with
 409     | Yes [] ->
 410         if state.remote_transport = Some TCP then
 411           Next { state with remote_port = Some "16211" }
 412         else
 413           Next { state with remote_port = Some "22" }
 414     | Yes (port::_) -> Next { state with remote_port = Some port }
 415     | No | Help | Error -> Ask_again
 416     | Back -> Prev
 417   in
 418
 419   let ask_directory state =
 420     match
 421     inputbox "Remote directory" "Remote directory" 10 50
 422       (default "" state.remote_directory)
 423     with
 424     | Yes [] ->
 425         Next { state with remote_directory = Some "/var/lib/xen/images" }
 426     | Yes (dir::_) -> Next { state with remote_directory = Some dir }
 427     | No | Help | Error -> Ask_again
 428     | Back -> Prev
 429   in
 430
 431   let ask_network state =
 432     match
 433     radiolist "Network configuration" "Network configuration" 10 50 2 [
 434       "auto", "Automatic configuration", state.network = Some Auto;
 435       "sh", "Configure from the shell", state.network = Some Shell;
 436     ]
 437     with
 438     | Yes ("auto"::_) -> Next { state with network = Some Auto }
 439     | Yes ("sh"::_) -> Next { state with network = Some Shell }
 440     | Yes _ | No | Help | Error -> Ask_again
 441     | Back -> Prev
 442   in
 443
 444   let ask_devices state =
 445     let selected_devices = default [] state.devices_to_send in
 446     let devices = List.map (
 447       fun (dev, blksize) ->
 448         (dev,
 449          sprintf "/dev/%s (%g GB)" dev ((Int64.to_float blksize) /. 2_097_152.),
 450          List.mem dev selected_devices)
 451     ) all_block_devices in
 452     match
 453     checklist "Devices" "Pick devices to send" 15 50 8 devices
 454     with
 455     | Yes [] | No | Help | Error -> Ask_again
 456     | Yes devices -> Next { state with devices_to_send = Some devices }
 457     | Back -> Prev
 458   in
 459
 460   (* This is the list of dialogs, in order.  The user can go forwards or
 461    * backwards through them.  The second parameter in each pair is
 462    * false if we need to skip this dialog (info already supplied in
 463    * 'defaults' above).
 464    *)
 465   let dlgs = [|
 466     ask_greeting,                       (* Initial greeting. *)
 467       defaults.greeting;
 468     ask_transport,                      (* Transport (ssh, tcp) *)
 469       defaults.remote_transport = None;
 470     ask_hostname,                       (* Hostname. *)
 471       defaults.remote_host = None;
 472     ask_port,                           (* Port number. *)
 473       defaults.remote_port = None;
 474     ask_directory,                      (* Remote directory. *)
 475       defaults.remote_directory = None;
 476     ask_network,                        (* Network configuration. *)
 477       defaults.network = None;
 478     ask_devices,                        (* Block devices to send. *)
 479       defaults.devices_to_send = None;
 480 (*    ask_root,                         (* Root filesystem. *)
 481       defaults.root_filesystem = None;
 482     ask_verify,                         (* Verify settings. *)
 483       defaults.greeting*)
 484   |] in
 485
 486   (* Loop through the dialogs until we reach the end. *)
 487   let rec loop posn state =
 488     eprintf "dialog loop: posn = %d\n%!" posn;
 489     if posn >= Array.length dlgs then state (* Finished all dialogs. *)
 490     else (
 491       let dlg, no_skip = dlgs.(posn) in
 492       let skip = not no_skip in
 493       if skip then
 494         (* Skip this dialog and move straight to the next one. *)
 495         loop (posn+1) state
 496       else (
 497         (* Run dialog. *)
 498         match dlg state with
 499         | Next new_state -> loop (posn+1) new_state (* Forwards. *)
 500         | Prev -> loop (posn-1) state       (* Backwards / back button. *)
 501         | Ask_again -> loop posn state      (* Repeat the question. *)
 502       )
 503     )
 504   in
 505   let state = loop 0 defaults in
 506
 507   eprintf "finished dialog loop\nstate = %s\n%!" (string_of_state state);
 508
 509
 510
 511
 512
 513
 514   ()
 515
 516 let usage () =
 517   eprintf "usage: virt-p2v [ttyname]\n%!";
 518   exit 2
 519
 520 (* Test harness for the Makefile.  The Makefile invokes this script as
 521  * 'virt-p2v.ml --test' just to check it compiles.  When it is running
 522  * from the actual live CD, there is a single parameter which is the
 523  * tty name (so usually 'virt-p2v.ml tty1').
 524  *)
 525 let () =
 526   match Array.to_list Sys.argv with
 527   | [ _; "--test" ] -> ()            (* Makefile test - do nothing. *)
 528   | [ _; ("--help"|"-help"|"-?"|"-h") ] -> usage ();
 529   | [ _; ttyname ] -> main (Some ttyname) (* Run main with ttyname. *)
 530   | [ _ ] -> main None                 (* Interactive - no ttyname. *)
 531   | _ -> usage ()