1 #!/usr/bin/ocamlrun /usr/bin/ocaml
3 (* virt-p2v.ml is a script which performs a physical to
4 * virtual conversion of local disks.
6 * Copyright (C) 2007-2008 Red Hat Inc.
7 * Written by Richard W.M. Jones <rjones@redhat.com>
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.
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.
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
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
36 type dialog_status = Yes | No | Help | Extra | Error
38 let default d = function None -> d | Some p -> p
40 (*----------------------------------------------------------------------*)
41 (* TO MAKE A CUSTOM virt-p2v SCRIPT, adjust the defaults in this section.
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.
48 * Note that 'None' means 'no default' (ie. ask the user) whereas
49 * 'Some foo' means use 'foo' as the answer.
52 (* If greeting is true, wait for keypress after boot and during
53 * final verification. Set to 'false' for less interactions.
57 (* Transport: Set to 'Some SSH' or 'Some TCP' to assume SSH or TCP
60 remote_transport = None;
62 (* Remote host and port. Set to 'Some "host"' and 'Some "port"',
68 (* Remote directory (only for SSH transport). Set to 'Some "path"'
69 * to set up a directory path, else ask the user.
71 remote_directory = None;
73 (* List of devices to send. Set to 'Some ["sda"; "sdb"]' for
74 * example to select /dev/sda and /dev/sdb.
76 devices_to_send = None;
78 (* The root filesystem containing /etc/fstab. Set to 'Some "sda3"'
79 * or 'Some "VolGroup00/LogVol00"' for example, else ask user.
81 root_filesystem = None;
83 (* Network configuration: Set to 'Some Auto' (try to set it up
84 * automatically, or 'Some Shell' (give the user a shell).
89 (* END OF CUSTOM virt-p2v SCRIPT SECTION. *)
90 (*----------------------------------------------------------------------*)
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.
99 ["/usr/sbin"; "/sbin"; "/usr/local/bin"; "/usr/kerberos/bin";
100 "/usr/bin"; "/bin"]);
101 putenv "HOME" "/root";
102 putenv "LOGNAME" "root";
104 (* We can safely write in /tmp (it's a synthetic live CD directory). *)
107 (* Set up logging to /tmp/virt-p2v.log. *)
108 let fd = openfile "virt-p2v.log" [ O_WRONLY; O_APPEND; O_CREAT ] 0o644 in
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;
118 (* Connect stdin/stdout to the tty. *)
122 let fd = openfile ("/dev/" ^ ttyname) [ O_RDWR ] 0 in
128 let rec ask_greeting state =
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
137 and ask_transport state =
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;
145 state.remote_transport = Some TCP
151 and ask_hostname state =
154 title "Remote host" ~cancel:false ~backbutton:true ();
155 inputbox "Remote host" 10 50 (default "" state.remote_host)
163 title "Remote port" ~cancel:false ~backbutton:true ();
164 inputbox "Remote port" 10 50 (default "" state.remote_port)
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
177 ask_greeting, (* Initial 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. *)
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. *)
202 let dlg, no_skip = dlgs.(posn) in
203 let skip = not no_skip in
205 (* Skip this dialog and move straight to the next one. *)
208 (* Run dialog. Either the state is updated or 'None' is
209 * returned, which indicates that the user hit the back button.
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. *)
218 let state = loop 0 defaults in
220 eprintf "finished dialog loop\n%!";
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:
233 * title (* title and other common parameters *) ();
234 * dialogtype (* specific parameter *)
236 * where 'dialogtype' is a function such as 'msgbox' (see below)
237 * representing a specific subfunction of dialog.
239 * The functions 'title' and 'dialogtype' return partially-constructed
240 * lists of shell parameters. See the dialog manpage.
242 * Returns the exit status (Yes | No | Help | Extra | Error).
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
251 | 0 -> Yes | 1 -> No | 2 -> Help | 3 -> Extra | _ -> Error
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
258 if backbutton then "--extra-button" :: "--extra-label" :: "Back" :: params
263 and msgbox text height width =
264 [ "--msgbox"; text; string_of_int height; string_of_int width ]
266 and inputbox text height width default =
267 [ "--inputbox"; text; string_of_int height; string_of_int width; default ]
269 and radiolist text height width listheight items =
270 let items = List.map (
272 | tag, item, true -> [ tag; item; "on" ]
273 | tag, item, false -> [ tag; item; "off" ]
275 let items = List.concat items in
276 "--radiolist" :: text :: string_of_int height :: string_of_int width ::
277 string_of_int listheight :: items
280 eprintf "usage: virt-p2v [ttyname]\n%!";
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').
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. *)