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 (* Parse the output of 'lvs' to get list of LV names, sizes,
 135  * corresponding PVs, etc.  Returns a list of (lvname, PVs, lvsize).
 136  *)
 137 let get_lvs () =
 138   let whitespace = Str.regexp "[ \t]+" in
 139   let comma = Str.regexp "," in
 140   let devname = Str.regexp "^/dev/\\(.+\\)(.+)$" in
 141
 142   match
 143   shget "lvs --noheadings -o vg_name,lv_name,devices,lv_size"
 144   with
 145   | None -> []
 146   | Some lines ->
 147       let lines = List.map (Str.split whitespace) lines in
 148       List.map (
 149         function
 150         | [vg; lv; pvs; lvsize] ->
 151             let pvs = Str.split comma pvs in
 152             let pvs = List.map (
 153               fun pv ->
 154                 if Str.string_match devname pv then
 155                   Str.matched_group 0
 156                 else
 157                   failwith ("lvs: unexpected device name: " ^ pv)
 158             ) pvs in
 159             vg ^ "/" ^ lv, pvs, lvsize
 160         | _ ->
 161             failwith "lvs: unexpected output"
 162       ) lines
 163
 164 (* Get the partitions on a block device.  eg. "sda" -> ["sda1";"sda2"] *)
 165 let get_partitions dev =
 166   let parts = Sys.readdir ("/sys/block/" ^ dev) in
 167   let parts = List.filter is_dir parts in
 168   let regexp = Str.regexp ("^" ^ dev) in
 169   let parts = List.filter (Str.string_match regexp) parts in
 170   parts
 171
 172 (* Main entry point. *)
 173 let rec main ttyname =
 174   (* Running from an init script.  We don't have much of a
 175    * login environment, so set one up.
 176    *)
 177   putenv "PATH"
 178     (String.concat ":"
 179        ["/usr/sbin"; "/sbin"; "/usr/local/bin"; "/usr/kerberos/bin";
 180         "/usr/bin"; "/bin"]);
 181   putenv "HOME" "/root";
 182   putenv "LOGNAME" "root";
 183
 184   (* We can safely write in /tmp (it's a synthetic live CD directory). *)
 185   chdir "/tmp";
 186
 187   (* Set up logging to /tmp/virt-p2v.log. *)
 188   let fd = openfile "virt-p2v.log" [ O_WRONLY; O_APPEND; O_CREAT ] 0o644 in
 189   dup2 fd stderr;
 190   close fd;
 191
 192   (* Log the start up time. *)
 193   eprintf "\n\n**************************************************\n\n";
 194   let tm = localtime (time ()) in
 195   eprintf "virt-p2v-ng starting up at %04d-%02d-%02d %02d:%02d:%02d\n%!"
 196     (tm.tm_year+1900) (tm.tm_mon+1) tm.tm_mday tm.tm_hour tm.tm_min tm.tm_sec;
 197
 198   (* Connect stdin/stdout to the tty. *)
 199   (match ttyname with
 200    | None -> ()
 201    | Some ttyname ->
 202        let fd = openfile ("/dev/" ^ ttyname) [ O_RDWR ] 0 in
 203        dup2 fd stdin;
 204        dup2 fd stdout;
 205        close fd);
 206
 207   (* Search for all non-removable block devices.  Do this early and bail
 208    * if we can't find anything.
 209    *)
 210   let all_block_devices =
 211     let regexp = Str.regexp "^[hs]d" in
 212     let devices = Array.to_list (Sys.readdir "/sys/block") in
 213     let devices = List.sort compare devices in
 214     let devices = List.filter (fun d -> Str.string_match regexp d 0) devices in
 215     eprintf "all_block_devices: block devices: %s\n%!"
 216       (String.concat "; " devices);
 217     (* Run blockdev --getsize on each, and reject any where this fails
 218      * (probably removable devices).
 219      *)
 220     let devices = List.map (
 221       fun d ->
 222         let cmd = "blockdev --getsize /dev/" ^ Filename.quote d in
 223         let lines = shget cmd in
 224         match lines with
 225         | Some (blksize::_) -> d, Int64.of_string blksize
 226         | Some [] | None -> d, 0L
 227     ) devices in
 228     let devices = List.filter (fun (_, blksize) -> blksize > 0L) devices in
 229     eprintf "all_block_devices: non-removable block devices: %s\n%!"
 230       (String.concat "; "
 231          (List.map (fun (d, b) -> sprintf "%s [%Ld]" d b) devices));
 232     if devices = [] then
 233       fail_dialog "No non-removable block devices (hard disks, etc.) could be found on this machine.";
 234     devices in
 235
 236   (* For each device that we identified above, search for partitions on
 237    * the device.  These are returned as strings like "hda1" or for
 238    * LVs "VolGroup00/LogVol00".  This creates a StringMap of block device
 239    * name -> list of partitions on the device.
 240    *)
 241   let partition_map =
 242     let lvs = get_lvs () in             (* Logical volumes. *)
 243     eprintf "partition_map: LVs: %s\n%!"
 244       (String.concat "; " (List.map (fun (lvname, _, _) -> lvname));
 245
 246     let all_partitions = List.map get_partitions all_block_devices in
 247     let all_partitions = List.concat all_partitions in
 248     eprintf "partition_map: all parts: %s\n%!"
 249       (String.concat "; " all_partitions);
 250
 251     (* Ignore any partitions which are used as PVs in the first list. *)
 252     let all_partitions =
 253
 254 in
 255
 256
 257
 258   (* Dialogs. *)
 259   let ask_greeting state =
 260     ignore (
 261       dialog [
 262         title "virt-p2v" ();
 263         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
 264       ]
 265     );
 266     Next state
 267   in
 268
 269   let ask_transport state =
 270     match
 271     dialog [
 272       title "Connection type" ~backbutton:false ();
 273       radiolist "Connection type" 10 50 2 [
 274         "ssh", "SSH (secure shell - recommended)",
 275           state.remote_transport = Some SSH;
 276         "tcp", "TCP socket",
 277           state.remote_transport = Some TCP
 278       ]
 279     ]
 280     with
 281     | Yes ("ssh"::_) -> Next { state with remote_transport = Some SSH }
 282     | Yes ("tcp"::_) -> Next { state with remote_transport = Some TCP }
 283     | Yes _ | No | Help | Error -> Ask_again
 284     | Back -> Prev
 285   in
 286
 287   let ask_hostname state =
 288     match
 289     dialog [
 290       title "Remote host" ();
 291       inputbox "Remote host" 10 50 (default "" state.remote_host)
 292     ]
 293     with
 294     | Yes [] -> Ask_again
 295     | Yes (hostname::_) -> Next { state with remote_host = Some hostname }
 296     | No | Help | Error -> Ask_again
 297     | Back -> Prev
 298   in
 299
 300   let ask_port state =
 301     match
 302     dialog [
 303       title "Remote port" ();
 304       inputbox "Remote port" 10 50 (default "" state.remote_port)
 305     ]
 306     with
 307     | Yes [] ->
 308         if state.remote_transport = Some TCP then
 309           Next { state with remote_port = Some "16211" }
 310         else
 311           Next { state with remote_port = Some "22" }
 312     | Yes (port::_) -> Next { state with remote_port = Some port }
 313     | No | Help | Error -> Ask_again
 314     | Back -> Prev
 315   in
 316
 317   let ask_directory state =
 318     match
 319     dialog [
 320       title "Remote directory" ();
 321       inputbox "Remote directory" 10 50 (default "" state.remote_directory)
 322     ]
 323     with
 324     | Yes [] ->
 325         Next { state with remote_directory = Some "/var/lib/xen/images" }
 326     | Yes (dir::_) -> Next { state with remote_directory = Some dir }
 327     | No | Help | Error -> Ask_again
 328     | Back -> Prev
 329   in
 330
 331   let ask_network state =
 332     match
 333     dialog [
 334       title "Network configuration" ();
 335       radiolist "Network configuration" 10 50 2 [
 336         "auto", "Automatic configuration", state.network = Some Auto;
 337         "sh", "Configure from the shell", state.network = Some Shell;
 338       ]
 339     ]
 340     with
 341     | Yes ("auto"::_) -> Next { state with network = Some Auto }
 342     | Yes ("sh"::_) -> Next { state with network = Some Shell }
 343     | Yes _ | No | Help | Error -> Ask_again
 344     | Back -> Prev
 345   in
 346
 347   let ask_devices state =
 348     let selected_devices = default [] state.devices_to_send in
 349     let devices = List.map (
 350       fun (dev, blksize) ->
 351         (dev,
 352          sprintf "/dev/%s (%g GB)" dev ((Int64.to_float blksize) /. 2_097_152.),
 353          List.mem dev selected_devices)
 354     ) all_block_devices in
 355     match
 356     dialog [
 357       title "Devices" ();
 358       checklist "Pick devices to send" 15 50 8 devices
 359     ]
 360     with
 361     | Yes [] | No | Help | Error -> Ask_again
 362     | Yes devices -> Next { state with devices_to_send = Some devices }
 363     | Back -> Prev
 364   in
 365
 366   (* This is the list of dialogs, in order.  The user can go forwards or
 367    * backwards through them.  The second parameter in each pair is
 368    * false if we need to skip this dialog (info already supplied in
 369    * 'defaults' above).
 370    *)
 371   let dlgs = [|
 372     ask_greeting,                       (* Initial greeting. *)
 373       defaults.greeting;
 374     ask_transport,                      (* Transport (ssh, tcp) *)
 375       defaults.remote_transport = None;
 376     ask_hostname,                       (* Hostname. *)
 377       defaults.remote_host = None;
 378     ask_port,                           (* Port number. *)
 379       defaults.remote_port = None;
 380     ask_directory,                      (* Remote directory. *)
 381       defaults.remote_directory = None;
 382     ask_network,                        (* Network configuration. *)
 383       defaults.network = None;
 384     ask_devices,                        (* Block devices to send. *)
 385       defaults.devices_to_send = None;
 386 (*    ask_root,                         (* Root filesystem. *)
 387       defaults.root_filesystem = None;
 388     ask_verify,                         (* Verify settings. *)
 389       defaults.greeting*)
 390   |] in
 391
 392   (* Loop through the dialogs until we reach the end. *)
 393   let rec loop posn state =
 394     eprintf "dialog loop: posn = %d\n%!" posn;
 395     if posn >= Array.length dlgs then state (* Finished all dialogs. *)
 396     else (
 397       let dlg, no_skip = dlgs.(posn) in
 398       let skip = not no_skip in
 399       if skip then
 400         (* Skip this dialog and move straight to the next one. *)
 401         loop (posn+1) state
 402       else (
 403         (* Run dialog. *)
 404         match dlg state with
 405         | Next new_state -> loop (posn+1) new_state (* Forwards. *)
 406         | Prev -> loop (posn-1) state       (* Backwards / back button. *)
 407         | Ask_again -> loop posn state      (* Repeat the question. *)
 408       )
 409     )
 410   in
 411   let state = loop 0 defaults in
 412
 413   eprintf "finished dialog loop\nstate = %s\n%!" (string_of_state state);
 414
 415
 416
 417
 418
 419
 420   ()
 421
 422 (* Run the external 'dialog' command with the given list of parameters.
 423  * Actually it's a list-of-list-of-parameters because you would normally
 424  * use this function like this:
 425  *   dialog [
 426  *     title (* title and other common parameters *) ();
 427  *     dialogtype (* specific parameter *)
 428  *   ]
 429  * where 'dialogtype' is a function such as 'msgbox' (see below)
 430  * representing a specific subfunction of dialog.
 431  *
 432  * The functions 'title' and 'dialogtype' return partially-constructed
 433  * lists of shell parameters.  See the dialog manpage.
 434  *
 435  * Returns the exit status (Yes lines | No | Help | Back | Error).
 436  *)
 437 and dialog params =
 438   let params = List.concat params in    (* list-of-list to flat list *)
 439   eprintf "dialog [%s]\n%!"
 440     (String.concat "; " (List.map (sprintf "%S") params));
 441
 442   (* 'dialog' writes its output/result to stderr, so we need to take
 443    * special steps to capture that - in other words, manual pipe/fork.
 444    *)
 445   let rfd, wfd = pipe () in
 446   match fork () with
 447   | 0 ->                                (* child, runs dialog *)
 448       close rfd;
 449       dup2 wfd stderr;                  (* capture stderr to pipe *)
 450       execvp "dialog" (Array.of_list ("dialog" :: params))
 451   | pid ->                              (* parent *)
 452       close wfd;
 453       let chan = in_channel_of_descr rfd in
 454       let result = input_all_lines chan in
 455       close rfd;
 456       eprintf "dialog result: %S\n%!" (String.concat "\n" result);
 457       match snd (wait ()) with
 458       | WEXITED 0 -> Yes result         (* something selected / entered *)
 459       | WEXITED 1 -> No                 (* cancel / no button *)
 460       | WEXITED 2 -> Help               (* help pressed *)
 461       | WEXITED 3 -> Back               (* back button *)
 462       | WEXITED _ -> Error              (* error or Esc *)
 463       | WSIGNALED i -> failwith (sprintf "dialog: killed by signal %d" i)
 464       | WSTOPPED i -> failwith (sprintf "dialog: stopped by signal %d" i)
 465
 466 (* Title and common dialog options. *)
 467 and title title ?(cancel=false) ?(backbutton=true) () =
 468   let params = ["--title"; title] in
 469   let params = if not cancel then "--nocancel" :: params else params in
 470   let params =
 471     if backbutton then "--extra-button" :: "--extra-label" :: "Back" :: params
 472     else params in
 473   params
 474
 475 (* Message box. *)
 476 and msgbox text height width =
 477   [ "--msgbox"; text; string_of_int height; string_of_int width ]
 478
 479 (* Simple input box. *)
 480 and inputbox text height width default =
 481   [ "--inputbox"; text; string_of_int height; string_of_int width; default ]
 482
 483 (* Radio list and check list. *)
 484 and radiolist text height width listheight items =
 485   let items = List.map (
 486     function
 487     | tag, item, true -> [ tag; item; "on" ]
 488     | tag, item, false -> [ tag; item; "off" ]
 489   ) items in
 490   let items = List.concat items in
 491   "--single-quoted" ::
 492     "--radiolist" :: text :: string_of_int height :: string_of_int width ::
 493     string_of_int listheight :: items
 494
 495 and checklist text height width listheight items =
 496   let items = List.map (
 497     function
 498     | tag, item, true -> [ tag; item; "on" ]
 499     | tag, item, false -> [ tag; item; "off" ]
 500   ) items in
 501   let items = List.concat items in
 502   "--separate-output" ::
 503     "--checklist" :: text :: string_of_int height :: string_of_int width ::
 504     string_of_int listheight :: items
 505
 506 (* Print failure dialog and exit. *)
 507 and fail_dialog text =
 508   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
 509   ignore (
 510     dialog [
 511       title "Error" ();
 512       msgbox text 17 50
 513     ]
 514   );
 515   exit 1
 516
 517 let usage () =
 518   eprintf "usage: virt-p2v [ttyname]\n%!";
 519   exit 2
 520
 521 (* Test harness for the Makefile.  The Makefile invokes this script as
 522  * 'virt-p2v.ml --test' just to check it compiles.  When it is running
 523  * from the actual live CD, there is a single parameter which is the
 524  * tty name (so usually 'virt-p2v.ml tty1').
 525  *)
 526 let () =
 527   match Array.to_list Sys.argv with
 528   | [ _; "--test" ] -> ()            (* Makefile test - do nothing. *)
 529   | [ _; ("--help"|"-help"|"-?"|"-h") ] -> usage ();
 530   | [ _; ttyname ] -> main (Some ttyname) (* Run main with ttyname. *)
 531   | [ _ ] -> main None                 (* Interactive - no ttyname. *)
 532   | _ -> usage ()