virt-p2v.ml

   1 #!/usr/bin/ocamlrun /usr/bin/ocaml
   2 #load "unix.cma";;
   3 (* virt-p2v.ml is a script which performs a physical to
   4  * virtual conversion of local disks.
   5  *
   6  * Copyright (C) 2007-2008 Red Hat Inc.
   7  * Written by Richard W.M. Jones <rjones@redhat.com>
   8  *
   9  * This program is free software; you can redistribute it and/or modify
  10  * it under the terms of the GNU General Public License as published by
  11  * the Free Software Foundation; either version 2 of the License, or
  12  * (at your option) any later version.
  13  *
  14  * This program is distributed in the hope that it will be useful,
  15  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  16  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17  * GNU General Public License for more details.
  18  *
  19  * You should have received a copy of the GNU General Public License
  20  * along with this program; if not, write to the Free Software
  21  * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  22  *)
  23
  24 open Unix
  25 open Printf
  26
  27 type state = { greeting : bool;
  28                remote_host : string option; remote_port : string option;
  29                remote_transport : transport option;
  30                remote_directory : string option;
  31                devices_to_send : string list option;
  32                root_filesystem : string option; network : network option }
  33 and transport = SSH | TCP
  34 and network = Auto | Shell
  35
  36 type dialog_status = Yes | No | Help | Extra | Error
  37
  38 let default d = function None -> d | Some p -> p
  39
  40 (*----------------------------------------------------------------------*)
  41 (* TO MAKE A CUSTOM virt-p2v SCRIPT, adjust the defaults in this section.
  42  *
  43  * If left as they are, then this will create a generic virt-p2v script
  44  * which asks the user for each question.  If you set the defaults here
  45  * then you will get a custom virt-p2v which is partially or even fully
  46  * automated and won't ask the user any questions.
  47  *
  48  * Note that 'None' means 'no default' (ie. ask the user) whereas
  49  * 'Some foo' means use 'foo' as the answer.
  50  *)
  51 let defaults = {
  52   (* If greeting is true, wait for keypress after boot and during
  53    * final verification.  Set to 'false' for less interactions.
  54    *)
  55   greeting = true;
  56
  57   (* Transport: Set to 'Some SSH' or 'Some TCP' to assume SSH or TCP
  58    * respectively.
  59    *)
  60   remote_transport = None;
  61
  62   (* Remote host and port.  Set to 'Some "host"' and 'Some "port"',
  63    * else ask the user.
  64    *)
  65   remote_host = None;
  66   remote_port = None;
  67
  68   (* Remote directory (only for SSH transport).  Set to 'Some "path"'
  69    * to set up a directory path, else ask the user.
  70    *)
  71   remote_directory = None;
  72
  73   (* List of devices to send.  Set to 'Some ["sda"; "sdb"]' for
  74    * example to select /dev/sda and /dev/sdb.
  75    *)
  76   devices_to_send = None;
  77
  78   (* The root filesystem containing /etc/fstab.  Set to 'Some "sda3"'
  79    * or 'Some "VolGroup00/LogVol00"' for example, else ask user.
  80    *)
  81   root_filesystem = None;
  82
  83   (* Network configuration: Set to 'Some Auto' (try to set it up
  84    * automatically, or 'Some Shell' (give the user a shell).
  85    *)
  86   network = None;
  87
  88 }
  89 (* END OF CUSTOM virt-p2v SCRIPT SECTION.                               *)
  90 (*----------------------------------------------------------------------*)
  91
  92 (* Main entry point. *)
  93 let rec main ttyname =
  94   (* Running from an init script.  We don't have much of a
  95    * login environment, so set one up.
  96    *)
  97   putenv "PATH"
  98     (String.concat ":"
  99        ["/usr/sbin"; "/sbin"; "/usr/local/bin"; "/usr/kerberos/bin";
 100         "/usr/bin"; "/bin"]);
 101   putenv "HOME" "/root";
 102   putenv "LOGNAME" "root";
 103
 104   (* We can safely write in /tmp (it's a synthetic live CD directory). *)
 105   chdir "/tmp";
 106
 107   (* Set up logging to /tmp/virt-p2v.log. *)
 108   let fd = openfile "virt-p2v.log" [ O_WRONLY; O_APPEND; O_CREAT ] 0o644 in
 109   dup2 fd stderr;
 110   close fd;
 111
 112   (* Log the start up time. *)
 113   eprintf "\n\n**************************************************\n\n";
 114   let tm = localtime (time ()) in
 115   eprintf "virt-p2v-ng starting up at %04d-%02d-%02d %02d:%02d:%02d\n%!"
 116     (tm.tm_year+1900) (tm.tm_mon+1) tm.tm_mday tm.tm_hour tm.tm_min tm.tm_sec;
 117
 118   (* Connect stdin/stdout to the tty. *)
 119   (match ttyname with
 120    | None -> ()
 121    | Some ttyname ->
 122        let fd = openfile ("/dev/" ^ ttyname) [ O_RDWR ] 0 in
 123        dup2 fd stdin;
 124        dup2 fd stdout;
 125        close fd);
 126
 127   (* Dialogs. *)
 128   let rec ask_greeting state =
 129     ignore (
 130       dialog [
 131         title "virt-p2v" ();
 132         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
 133       ]
 134     );
 135     Some state
 136
 137   and ask_transport state =
 138     ignore ( (* XXX *)
 139     dialog [
 140       title "Connection type" ~cancel:false ();
 141       radiolist "Connection type" 10 50 2 [
 142         "ssh", "SSH (secure shell - recommended)",
 143           state.remote_transport = Some SSH;
 144         "tcp", "TCP socket",
 145           state.remote_transport = Some TCP
 146       ]
 147     ]
 148     );
 149     Some state
 150
 151   and ask_hostname state =
 152     ignore ( (* XXX *)
 153       dialog [
 154         title "Remote host" ~cancel:false ~backbutton:true ();
 155         inputbox "Remote host" 10 50 (default "" state.remote_host)
 156       ]
 157     );
 158     Some state
 159
 160   and ask_port state =
 161     ignore ( (* XXX *)
 162       dialog [
 163         title "Remote port" ~cancel:false ~backbutton:true ();
 164         inputbox "Remote port" 10 50 (default "" state.remote_port)
 165       ]
 166     );
 167     Some state
 168
 169   in
 170
 171   (* This is the list of dialogs, in order.  The user can go forwards or
 172    * backwards through them.  The second parameter in each pair is
 173    * false if we need to skip this dialog (info already supplied in
 174    * 'defaults' above).
 175    *)
 176   let dlgs = [|
 177     ask_greeting,                       (* Initial greeting. *)
 178       defaults.greeting;
 179     ask_transport,                      (* Transport (ssh, tcp) *)
 180       defaults.remote_transport = None;
 181     ask_hostname,                       (* Hostname. *)
 182       defaults.remote_host = None;
 183     ask_port,                           (* Port number. *)
 184       defaults.remote_port = None;
 185 (*    ask_directory,                    (* Remote directory. *)
 186       defaults.remote_directory = None;
 187     ask_devices,                        (* Block devices to send. *)
 188       defaults.devices_to_send = None;
 189     ask_root,                           (* Root filesystem. *)
 190       defaults.root_filesystem = None;
 191     ask_network,                        (* Network configuration. *)
 192       defaults.network = None;
 193     ask_verify,                         (* Verify settings. *)
 194       defaults.greeting*)
 195   |] in
 196
 197   (* Loop through the dialogs until we reach the end. *)
 198   let rec loop posn state =
 199     eprintf "dialog loop: posn = %d\n%!" posn;
 200     if posn >= Array.length dlgs then state (* Finished all dialogs. *)
 201     else (
 202       let dlg, no_skip = dlgs.(posn) in
 203       let skip = not no_skip in
 204       if skip then
 205         (* Skip this dialog and move straight to the next one. *)
 206         loop (posn+1) state
 207       else (
 208         (* Run dialog.  Either the state is updated or 'None' is
 209          * returned, which indicates that the user hit the back button.
 210          *)
 211         let next_state = dlg state in
 212         match next_state with
 213         | Some state -> loop (posn+1) state (* Forwards. *)
 214         | None -> loop (posn-1) state       (* Backwards. *)
 215       )
 216     )
 217   in
 218   let state = loop 0 defaults in
 219
 220   eprintf "finished dialog loop\n%!";
 221
 222
 223
 224
 225
 226
 227   ()
 228
 229 (* Run the external 'dialog' command with the given list of parameters.
 230  * Actually it's a list-of-list-of-parameters because you would normally
 231  * use this function like this:
 232  *   dialog [
 233  *     title (* title and other common parameters *) ();
 234  *     dialogtype (* specific parameter *)
 235  *   ]
 236  * where 'dialogtype' is a function such as 'msgbox' (see below)
 237  * representing a specific subfunction of dialog.
 238  *
 239  * The functions 'title' and 'dialogtype' return partially-constructed
 240  * lists of shell parameters.  See the dialog manpage.
 241  *
 242  * Returns the exit status (Yes | No | Help | Extra | Error).
 243  *)
 244 and dialog params =
 245   let params = List.concat params in    (* list-of-list to flat list *)
 246   let params = List.map Filename.quote params in (* shell quoting *)
 247   let cmd = String.concat " " ("dialog" :: params) in
 248   eprintf "%s\n%!" cmd;                 (* log the full command *)
 249   let r = Sys.command cmd in
 250   match r with
 251   | 0 -> Yes | 1 -> No | 2 -> Help | 3 -> Extra | _ -> Error
 252
 253 (* Title and common dialog options. *)
 254 and title title ?(cancel=true) ?(backbutton=false) () =
 255   let params = ["--title"; title] in
 256   let params = if not cancel then "--nocancel" :: params else params in
 257   let params =
 258     if backbutton then "--extra-button" :: "--extra-label" :: "Back" :: params
 259     else params in
 260   params
 261
 262 (* Message box. *)
 263 and msgbox text height width =
 264   [ "--msgbox"; text; string_of_int height; string_of_int width ]
 265
 266 and inputbox text height width default =
 267   [ "--inputbox"; text; string_of_int height; string_of_int width; default ]
 268
 269 and radiolist text height width listheight items =
 270   let items = List.map (
 271     function
 272     | tag, item, true -> [ tag; item; "on" ]
 273     | tag, item, false -> [ tag; item; "off" ]
 274   ) items in
 275   let items = List.concat items in
 276   "--radiolist" :: text :: string_of_int height :: string_of_int width ::
 277     string_of_int listheight :: items
 278
 279 let usage () =
 280   eprintf "usage: virt-p2v [ttyname]\n%!";
 281   exit 2
 282
 283 (* Test harness for the Makefile.  The Makefile invokes this script as
 284  * 'virt-p2v.ml --test' just to check it compiles.  When it is running
 285  * from the actual live CD, there is a single parameter which is the
 286  * tty name (so usually 'virt-p2v.ml tty1').
 287  *)
 288 let () =
 289   match Array.to_list Sys.argv with
 290   | [ _; "--test" ] -> ()            (* Makefile test - do nothing. *)
 291   | [ _; ("--help"|"-help"|"-?"|"-h") ] -> usage ();
 292   | [ _; ttyname ] -> main (Some ttyname) (* Run main with ttyname. *)
 293   | [ _ ] -> main None                 (* Interactive - no ttyname. *)
 294   | _ -> usage ()