1 #!/usr/bin/ocamlrun /usr/bin/ocaml
5 (* virt-p2v.ml is a script which performs a physical to
6 * virtual conversion of local disks.
8 * Copyright (C) 2007-2008 Red Hat Inc.
9 * Written by Richard W.M. Jones <rjones@redhat.com>
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.
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.
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
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
39 (*----------------------------------------------------------------------*)
40 (* TO MAKE A CUSTOM virt-p2v SCRIPT, adjust the defaults in this section.
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.
47 * Note that 'None' means 'no default' (ie. ask the user) whereas
48 * 'Some foo' means use 'foo' as the answer.
51 (* If greeting is true, wait for keypress after boot and during
52 * final verification. Set to 'false' for less interactions.
56 (* Transport: Set to 'Some SSH' or 'Some TCP' to assume SSH or TCP
59 remote_transport = None;
61 (* Remote host and port. Set to 'Some "host"' and 'Some "port"',
67 (* Remote directory (only for SSH transport). Set to 'Some "path"'
68 * to set up a directory path, else ask the user.
70 remote_directory = None;
72 (* List of devices to send. Set to 'Some ["sda"; "sdb"]' for
73 * example to select /dev/sda and /dev/sdb.
75 devices_to_send = None;
77 (* The root filesystem containing /etc/fstab. Set to 'Some "sda3"'
78 * or 'Some "VolGroup00/LogVol00"' for example, else ask user.
80 root_filesystem = None;
82 (* Network configuration: Set to 'Some Auto' (try to set it up
83 * automatically, or 'Some Shell' (give the user a shell).
88 (* END OF CUSTOM virt-p2v SCRIPT SECTION. *)
89 (*----------------------------------------------------------------------*)
91 (* String map type. *)
92 module StringMap = Map.Make (String)
94 (* General helper functions. *)
96 let default d = function None -> d | Some p -> p
98 let string_of_state state =
100 "greeting: %b remote: %s:%s%s%s network: %s devices: [%s] root: %s"
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)
113 type dialog_status = Yes of string list | No | Help | Back | Error
115 type ask_result = Next of state | Prev | Ask_again
117 let input_all_lines chan =
118 let lines = ref [] in
120 while true do lines := input_line chan :: !lines done; []
122 End_of_file -> List.rev !lines
124 (* Same as `cmd` in shell. Any error message will be in the logfile. *)
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)
135 (* Parse the output of 'lvs' to get list of LV names, sizes,
136 * corresponding PVs, etc. Returns a list of (lvname, PVs, lvsize).
139 let whitespace = Str.regexp "[ \t]+" in
140 let comma = Str.regexp "," in
141 let devname = Str.regexp "^/dev/\\(.+\\)(.+)$" in
144 shget "lvs --noheadings -o vg_name,lv_name,devices,lv_size"
148 let lines = List.map (Str.split whitespace) lines in
151 | [vg; lv; pvs; lvsize] ->
152 let pvs = Str.split comma pvs in
155 if Str.string_match devname pv then
158 failwith ("lvs: unexpected device name: " ^ pv)
160 vg ^ "/" ^ lv, pvs, lvsize
162 failwith "lvs: unexpected output"
167 (* Get the partitions on a block device. eg. "sda" -> ["sda1";"sda2"] *)
168 let get_partitions dev =
169 let parts = Sys.readdir ("/sys/block/" ^ dev) in
170 let parts = List.filter is_dir parts in
171 let regexp = Str.regexp ("^" ^ dev) in
172 let parts = List.filter (Str.string_match regexp) parts in
178 * Each function takes some common parameters (eg. ~title) and some
179 * dialog-specific functions.
181 * Returns the exit status (Yes lines | No | Help | Back | Error).
183 let msgbox, inputbox, radiolist, checklist =
184 (* Internal function to actually run the "dialog" shell command. *)
185 let run_dialog cparams params =
186 let params = cparams @ params in
187 eprintf "dialog [%s]\n%!"
188 (String.concat "; " (List.map (sprintf "%S") params));
190 (* 'dialog' writes its output/result to stderr, so we need to take
191 * special steps to capture that - in other words, manual pipe/fork.
193 let rfd, wfd = pipe () in
195 | 0 -> (* child, runs dialog *)
197 dup2 wfd stderr; (* capture stderr to pipe *)
198 execvp "dialog" (Array.of_list ("dialog" :: params))
199 | pid -> (* parent *)
201 let chan = in_channel_of_descr rfd in
202 let result = input_all_lines chan in
204 eprintf "dialog result: %S\n%!" (String.concat "\n" result);
205 match snd (wait ()) with
206 | WEXITED 0 -> Yes result (* something selected / entered *)
207 | WEXITED 1 -> No (* cancel / no button *)
208 | WEXITED 2 -> Help (* help pressed *)
209 | WEXITED 3 -> Back (* back button *)
210 | WEXITED _ -> Error (* error or Esc *)
211 | WSIGNALED i -> failwith (sprintf "dialog: killed by signal %d" i)
212 | WSTOPPED i -> failwith (sprintf "dialog: stopped by signal %d" i)
215 (* Handle the common parameters. Note Continuation Passing Style. *)
216 let with_common cont ?(cancel=false) ?(backbutton=true) title =
217 let params = ["--title"; title] in
218 let params = if not cancel then "--nocancel" :: params else params in
220 if backbutton then "--extra-button" :: "--extra-label" :: "Back" :: params
228 fun cparams text height width ->
230 [ "--msgbox"; text; string_of_int height; string_of_int width ]
234 (* Simple input box. *)
237 fun cparams text height width default ->
239 [ "--inputbox"; text; string_of_int height; string_of_int width;
244 (* Radio list and check list. *)
247 fun cparams text height width listheight items ->
248 let items = List.map (
250 | tag, item, true -> [ tag; item; "on" ]
251 | tag, item, false -> [ tag; item; "off" ]
253 let items = List.concat items in
254 let items = "--single-quoted" ::
255 "--radiolist" :: text ::
256 string_of_int height :: string_of_int width ::
257 string_of_int listheight :: items in
258 run_dialog cparams items
264 fun cparams text height width listheight items ->
265 let items = List.map (
267 | tag, item, true -> [ tag; item; "on" ]
268 | tag, item, false -> [ tag; item; "off" ]
270 let items = List.concat items in
271 let items = "--separate-output" ::
272 "--checklist" :: text ::
273 string_of_int height :: string_of_int width ::
274 string_of_int listheight :: items in
275 run_dialog cparams items
278 msgbox, inputbox, radiolist, checklist
280 (* Print failure dialog and exit. *)
281 let fail_dialog text =
282 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
283 ignore (msgbox "Error" text 17 50);
286 (* Main entry point. *)
287 let rec main ttyname =
288 (* Running from an init script. We don't have much of a
289 * login environment, so set one up.
293 ["/usr/sbin"; "/sbin"; "/usr/local/bin"; "/usr/kerberos/bin";
294 "/usr/bin"; "/bin"]);
295 putenv "HOME" "/root";
296 putenv "LOGNAME" "root";
298 (* We can safely write in /tmp (it's a synthetic live CD directory). *)
301 (* Set up logging to /tmp/virt-p2v.log. *)
302 let fd = openfile "virt-p2v.log" [ O_WRONLY; O_APPEND; O_CREAT ] 0o644 in
306 (* Log the start up time. *)
307 eprintf "\n\n**************************************************\n\n";
308 let tm = localtime (time ()) in
309 eprintf "virt-p2v-ng starting up at %04d-%02d-%02d %02d:%02d:%02d\n%!"
310 (tm.tm_year+1900) (tm.tm_mon+1) tm.tm_mday tm.tm_hour tm.tm_min tm.tm_sec;
312 (* Connect stdin/stdout to the tty. *)
316 let fd = openfile ("/dev/" ^ ttyname) [ O_RDWR ] 0 in
321 (* Search for all non-removable block devices. Do this early and bail
322 * if we can't find anything.
324 let all_block_devices =
325 let regexp = Str.regexp "^[hs]d" in
326 let devices = Array.to_list (Sys.readdir "/sys/block") in
327 let devices = List.sort compare devices in
328 let devices = List.filter (fun d -> Str.string_match regexp d 0) devices in
329 eprintf "all_block_devices: block devices: %s\n%!"
330 (String.concat "; " devices);
331 (* Run blockdev --getsize on each, and reject any where this fails
332 * (probably removable devices).
334 let devices = List.map (
336 let cmd = "blockdev --getsize /dev/" ^ Filename.quote d in
337 let lines = shget cmd in
339 | Some (blksize::_) -> d, Int64.of_string blksize
340 | Some [] | None -> d, 0L
342 let devices = List.filter (fun (_, blksize) -> blksize > 0L) devices in
343 eprintf "all_block_devices: non-removable block devices: %s\n%!"
345 (List.map (fun (d, b) -> sprintf "%s [%Ld]" d b) devices));
347 fail_dialog "No non-removable block devices (hard disks, etc.) could be found on this machine.";
351 (* For each device that we identified above, search for partitions on
352 * the device. These are returned as strings like "hda1" or for
353 * LVs "VolGroup00/LogVol00". This creates a StringMap of block device
354 * name -> list of partitions on the device.
357 let lvs = get_lvs () in (* Logical volumes. *)
358 eprintf "partition_map: LVs: %s\n%!"
359 (String.concat "; " (List.map (fun (lvname, _, _) -> lvname));
361 let all_partitions = List.map get_partitions all_block_devices in
362 let all_partitions = List.concat all_partitions in
363 eprintf "partition_map: all parts: %s\n%!"
364 (String.concat "; " all_partitions);
366 (* Ignore any partitions which are used as PVs in the first list. *)
374 let ask_greeting state =
375 ignore (msgbox "virt-p2v" "\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);
379 let ask_transport state =
381 radiolist "Connection type" ~backbutton:false
382 "Connection type" 10 50 2 [
383 "ssh", "SSH (secure shell - recommended)",
384 state.remote_transport = Some SSH;
386 state.remote_transport = Some TCP
389 | Yes ("ssh"::_) -> Next { state with remote_transport = Some SSH }
390 | Yes ("tcp"::_) -> Next { state with remote_transport = Some TCP }
391 | Yes _ | No | Help | Error -> Ask_again
395 let ask_hostname state =
397 inputbox "Remote host" "Remote host" 10 50 (default "" state.remote_host)
399 | Yes [] -> Ask_again
400 | Yes (hostname::_) -> Next { state with remote_host = Some hostname }
401 | No | Help | Error -> Ask_again
407 inputbox "Remote port" "Remote port" 10 50 (default "" state.remote_port)
410 if state.remote_transport = Some TCP then
411 Next { state with remote_port = Some "16211" }
413 Next { state with remote_port = Some "22" }
414 | Yes (port::_) -> Next { state with remote_port = Some port }
415 | No | Help | Error -> Ask_again
419 let ask_directory state =
421 inputbox "Remote directory" "Remote directory" 10 50
422 (default "" state.remote_directory)
425 Next { state with remote_directory = Some "/var/lib/xen/images" }
426 | Yes (dir::_) -> Next { state with remote_directory = Some dir }
427 | No | Help | Error -> Ask_again
431 let ask_network state =
433 radiolist "Network configuration" "Network configuration" 10 50 2 [
434 "auto", "Automatic configuration", state.network = Some Auto;
435 "sh", "Configure from the shell", state.network = Some Shell;
438 | Yes ("auto"::_) -> Next { state with network = Some Auto }
439 | Yes ("sh"::_) -> Next { state with network = Some Shell }
440 | Yes _ | No | Help | Error -> Ask_again
444 let ask_devices state =
445 let selected_devices = default [] state.devices_to_send in
446 let devices = List.map (
447 fun (dev, blksize) ->
449 sprintf "/dev/%s (%g GB)" dev ((Int64.to_float blksize) /. 2_097_152.),
450 List.mem dev selected_devices)
451 ) all_block_devices in
453 checklist "Devices" "Pick devices to send" 15 50 8 devices
455 | Yes [] | No | Help | Error -> Ask_again
456 | Yes devices -> Next { state with devices_to_send = Some devices }
460 (* This is the list of dialogs, in order. The user can go forwards or
461 * backwards through them. The second parameter in each pair is
462 * false if we need to skip this dialog (info already supplied in
466 ask_greeting, (* Initial greeting. *)
468 ask_transport, (* Transport (ssh, tcp) *)
469 defaults.remote_transport = None;
470 ask_hostname, (* Hostname. *)
471 defaults.remote_host = None;
472 ask_port, (* Port number. *)
473 defaults.remote_port = None;
474 ask_directory, (* Remote directory. *)
475 defaults.remote_directory = None;
476 ask_network, (* Network configuration. *)
477 defaults.network = None;
478 ask_devices, (* Block devices to send. *)
479 defaults.devices_to_send = None;
480 (* ask_root, (* Root filesystem. *)
481 defaults.root_filesystem = None;
482 ask_verify, (* Verify settings. *)
486 (* Loop through the dialogs until we reach the end. *)
487 let rec loop posn state =
488 eprintf "dialog loop: posn = %d\n%!" posn;
489 if posn >= Array.length dlgs then state (* Finished all dialogs. *)
491 let dlg, no_skip = dlgs.(posn) in
492 let skip = not no_skip in
494 (* Skip this dialog and move straight to the next one. *)
499 | Next new_state -> loop (posn+1) new_state (* Forwards. *)
500 | Prev -> loop (posn-1) state (* Backwards / back button. *)
501 | Ask_again -> loop posn state (* Repeat the question. *)
505 let state = loop 0 defaults in
507 eprintf "finished dialog loop\nstate = %s\n%!" (string_of_state state);
517 eprintf "usage: virt-p2v [ttyname]\n%!";
520 (* Test harness for the Makefile. The Makefile invokes this script as
521 * 'virt-p2v.ml --test' just to check it compiles. When it is running
522 * from the actual live CD, there is a single parameter which is the
523 * tty name (so usually 'virt-p2v.ml tty1').
526 match Array.to_list Sys.argv with
527 | [ _; "--test" ] -> () (* Makefile test - do nothing. *)
528 | [ _; ("--help"|"-help"|"-?"|"-h") ] -> usage ();
529 | [ _; ttyname ] -> main (Some ttyname) (* Run main with ttyname. *)
530 | [ _ ] -> main None (* Interactive - no ttyname. *)