From: Richard W.M. Jones <"Richard W.M. Jones "> Date: Wed, 23 Jan 2008 18:03:15 +0000 (+0000) Subject: First attempt to translate virt-p2v into a modern language. X-Git-Url: http://git.annexia.org/?a=commitdiff_plain;h=29ee4297592dcde61dd3dacd304ee4f4b38c5182;p=virt-p2v.git First attempt to translate virt-p2v into a modern language. --- diff --git a/virt-p2v.ml b/virt-p2v.ml new file mode 100755 index 0000000..6c9a35a --- /dev/null +++ b/virt-p2v.ml @@ -0,0 +1,294 @@ +#!/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 + * + * 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 ()