--- /dev/null
+#!/usr/bin/ocamlrun /usr/bin/ocaml
+#load "unix.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 <rjones@redhat.com>
+ *
+ * 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;
+ devices_to_send : string list option;
+ root_filesystem : string option; network : network option }
+and transport = SSH | TCP
+and network = Auto | Shell
+
+type dialog_status = Yes | No | Help | Extra | Error
+
+let default d = function None -> d | Some p -> p
+
+(*----------------------------------------------------------------------*)
+(* 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. *)
+(*----------------------------------------------------------------------*)
+
+(* 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);
+
+ (* Dialogs. *)
+ let rec 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
+ ]
+ );
+ Some state
+
+ and ask_transport state =
+ ignore ( (* XXX *)
+ dialog [
+ title "Connection type" ~cancel: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
+ ]
+ ]
+ );
+ Some state
+
+ and ask_hostname state =
+ ignore ( (* XXX *)
+ dialog [
+ title "Remote host" ~cancel:false ~backbutton:true ();
+ inputbox "Remote host" 10 50 (default "" state.remote_host)
+ ]
+ );
+ Some state
+
+ and ask_port state =
+ ignore ( (* XXX *)
+ dialog [
+ title "Remote port" ~cancel:false ~backbutton:true ();
+ inputbox "Remote port" 10 50 (default "" state.remote_port)
+ ]
+ );
+ Some state
+
+ 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_devices, (* Block devices to send. *)
+ defaults.devices_to_send = None;
+ ask_root, (* Root filesystem. *)
+ defaults.root_filesystem = None;
+ ask_network, (* Network configuration. *)
+ defaults.network = 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. Either the state is updated or 'None' is
+ * returned, which indicates that the user hit the back button.
+ *)
+ let next_state = dlg state in
+ match next_state with
+ | Some state -> loop (posn+1) state (* Forwards. *)
+ | None -> loop (posn-1) state (* Backwards. *)
+ )
+ )
+ in
+ let state = loop 0 defaults in
+
+ eprintf "finished dialog loop\n%!";
+
+
+
+
+
+
+ ()
+
+(* 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 | No | Help | Extra | Error).
+ *)
+and dialog params =
+ let params = List.concat params in (* list-of-list to flat list *)
+ let params = List.map Filename.quote params in (* shell quoting *)
+ let cmd = String.concat " " ("dialog" :: params) in
+ eprintf "%s\n%!" cmd; (* log the full command *)
+ let r = Sys.command cmd in
+ match r with
+ | 0 -> Yes | 1 -> No | 2 -> Help | 3 -> Extra | _ -> Error
+
+(* Title and common dialog options. *)
+and title title ?(cancel=true) ?(backbutton=false) () =
+ 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 ]
+
+and inputbox text height width default =
+ [ "--inputbox"; text; string_of_int height; string_of_int width; default ]
+
+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
+ "--radiolist" :: text :: string_of_int height :: string_of_int width ::
+ string_of_int listheight :: items
+
+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 ()
git.annexia.org / virt-p2v.git / commitdiff