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)
134 (* Parse the output of 'lvs' to get list of LV names, sizes,
135 * corresponding PVs, etc. Returns a list of (lvname, PVs, lvsize).
138 let whitespace = Str.regexp "[ \t]+" in
139 let comma = Str.regexp "," in
140 let devname = Str.regexp "^/dev/\\(.+\\)(.+)$" in
143 shget "lvs --noheadings -o vg_name,lv_name,devices,lv_size"
147 let lines = List.map (Str.split whitespace) lines in
150 | [vg; lv; pvs; lvsize] ->
151 let pvs = Str.split comma pvs in
154 if Str.string_match devname pv then
157 failwith ("lvs: unexpected device name: " ^ pv)
159 vg ^ "/" ^ lv, pvs, lvsize
161 failwith "lvs: unexpected output"
164 (* Get the partitions on a block device. eg. "sda" -> ["sda1";"sda2"] *)
165 let get_partitions dev =
166 let parts = Sys.readdir ("/sys/block/" ^ dev) in
167 let parts = List.filter is_dir parts in
168 let regexp = Str.regexp ("^" ^ dev) in
169 let parts = List.filter (Str.string_match regexp) parts in
172 (* Main entry point. *)
173 let rec main ttyname =
174 (* Running from an init script. We don't have much of a
175 * login environment, so set one up.
179 ["/usr/sbin"; "/sbin"; "/usr/local/bin"; "/usr/kerberos/bin";
180 "/usr/bin"; "/bin"]);
181 putenv "HOME" "/root";
182 putenv "LOGNAME" "root";
184 (* We can safely write in /tmp (it's a synthetic live CD directory). *)
187 (* Set up logging to /tmp/virt-p2v.log. *)
188 let fd = openfile "virt-p2v.log" [ O_WRONLY; O_APPEND; O_CREAT ] 0o644 in
192 (* Log the start up time. *)
193 eprintf "\n\n**************************************************\n\n";
194 let tm = localtime (time ()) in
195 eprintf "virt-p2v-ng starting up at %04d-%02d-%02d %02d:%02d:%02d\n%!"
196 (tm.tm_year+1900) (tm.tm_mon+1) tm.tm_mday tm.tm_hour tm.tm_min tm.tm_sec;
198 (* Connect stdin/stdout to the tty. *)
202 let fd = openfile ("/dev/" ^ ttyname) [ O_RDWR ] 0 in
207 (* Search for all non-removable block devices. Do this early and bail
208 * if we can't find anything.
210 let all_block_devices =
211 let regexp = Str.regexp "^[hs]d" in
212 let devices = Array.to_list (Sys.readdir "/sys/block") in
213 let devices = List.sort compare devices in
214 let devices = List.filter (fun d -> Str.string_match regexp d 0) devices in
215 eprintf "all_block_devices: block devices: %s\n%!"
216 (String.concat "; " devices);
217 (* Run blockdev --getsize on each, and reject any where this fails
218 * (probably removable devices).
220 let devices = List.map (
222 let cmd = "blockdev --getsize /dev/" ^ Filename.quote d in
223 let lines = shget cmd in
225 | Some (blksize::_) -> d, Int64.of_string blksize
226 | Some [] | None -> d, 0L
228 let devices = List.filter (fun (_, blksize) -> blksize > 0L) devices in
229 eprintf "all_block_devices: non-removable block devices: %s\n%!"
231 (List.map (fun (d, b) -> sprintf "%s [%Ld]" d b) devices));
233 fail_dialog "No non-removable block devices (hard disks, etc.) could be found on this machine.";
236 (* For each device that we identified above, search for partitions on
237 * the device. These are returned as strings like "hda1" or for
238 * LVs "VolGroup00/LogVol00". This creates a StringMap of block device
239 * name -> list of partitions on the device.
242 let lvs = get_lvs () in (* Logical volumes. *)
243 eprintf "partition_map: LVs: %s\n%!"
244 (String.concat "; " (List.map (fun (lvname, _, _) -> lvname));
246 let all_partitions = List.map get_partitions all_block_devices in
247 let all_partitions = List.concat all_partitions in
248 eprintf "partition_map: all parts: %s\n%!"
249 (String.concat "; " all_partitions);
251 (* Ignore any partitions which are used as PVs in the first list. *)
259 let ask_greeting state =
263 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
269 let ask_transport state =
272 title "Connection type" ~backbutton:false ();
273 radiolist "Connection type" 10 50 2 [
274 "ssh", "SSH (secure shell - recommended)",
275 state.remote_transport = Some SSH;
277 state.remote_transport = Some TCP
281 | Yes ("ssh"::_) -> Next { state with remote_transport = Some SSH }
282 | Yes ("tcp"::_) -> Next { state with remote_transport = Some TCP }
283 | Yes _ | No | Help | Error -> Ask_again
287 let ask_hostname state =
290 title "Remote host" ();
291 inputbox "Remote host" 10 50 (default "" state.remote_host)
294 | Yes [] -> Ask_again
295 | Yes (hostname::_) -> Next { state with remote_host = Some hostname }
296 | No | Help | Error -> Ask_again
303 title "Remote port" ();
304 inputbox "Remote port" 10 50 (default "" state.remote_port)
308 if state.remote_transport = Some TCP then
309 Next { state with remote_port = Some "16211" }
311 Next { state with remote_port = Some "22" }
312 | Yes (port::_) -> Next { state with remote_port = Some port }
313 | No | Help | Error -> Ask_again
317 let ask_directory state =
320 title "Remote directory" ();
321 inputbox "Remote directory" 10 50 (default "" state.remote_directory)
325 Next { state with remote_directory = Some "/var/lib/xen/images" }
326 | Yes (dir::_) -> Next { state with remote_directory = Some dir }
327 | No | Help | Error -> Ask_again
331 let ask_network state =
334 title "Network configuration" ();
335 radiolist "Network configuration" 10 50 2 [
336 "auto", "Automatic configuration", state.network = Some Auto;
337 "sh", "Configure from the shell", state.network = Some Shell;
341 | Yes ("auto"::_) -> Next { state with network = Some Auto }
342 | Yes ("sh"::_) -> Next { state with network = Some Shell }
343 | Yes _ | No | Help | Error -> Ask_again
347 let ask_devices state =
348 let selected_devices = default [] state.devices_to_send in
349 let devices = List.map (
350 fun (dev, blksize) ->
352 sprintf "/dev/%s (%g GB)" dev ((Int64.to_float blksize) /. 2_097_152.),
353 List.mem dev selected_devices)
354 ) all_block_devices in
358 checklist "Pick devices to send" 15 50 8 devices
361 | Yes [] | No | Help | Error -> Ask_again
362 | Yes devices -> Next { state with devices_to_send = Some devices }
366 (* This is the list of dialogs, in order. The user can go forwards or
367 * backwards through them. The second parameter in each pair is
368 * false if we need to skip this dialog (info already supplied in
372 ask_greeting, (* Initial greeting. *)
374 ask_transport, (* Transport (ssh, tcp) *)
375 defaults.remote_transport = None;
376 ask_hostname, (* Hostname. *)
377 defaults.remote_host = None;
378 ask_port, (* Port number. *)
379 defaults.remote_port = None;
380 ask_directory, (* Remote directory. *)
381 defaults.remote_directory = None;
382 ask_network, (* Network configuration. *)
383 defaults.network = None;
384 ask_devices, (* Block devices to send. *)
385 defaults.devices_to_send = None;
386 (* ask_root, (* Root filesystem. *)
387 defaults.root_filesystem = None;
388 ask_verify, (* Verify settings. *)
392 (* Loop through the dialogs until we reach the end. *)
393 let rec loop posn state =
394 eprintf "dialog loop: posn = %d\n%!" posn;
395 if posn >= Array.length dlgs then state (* Finished all dialogs. *)
397 let dlg, no_skip = dlgs.(posn) in
398 let skip = not no_skip in
400 (* Skip this dialog and move straight to the next one. *)
405 | Next new_state -> loop (posn+1) new_state (* Forwards. *)
406 | Prev -> loop (posn-1) state (* Backwards / back button. *)
407 | Ask_again -> loop posn state (* Repeat the question. *)
411 let state = loop 0 defaults in
413 eprintf "finished dialog loop\nstate = %s\n%!" (string_of_state state);
422 (* Run the external 'dialog' command with the given list of parameters.
423 * Actually it's a list-of-list-of-parameters because you would normally
424 * use this function like this:
426 * title (* title and other common parameters *) ();
427 * dialogtype (* specific parameter *)
429 * where 'dialogtype' is a function such as 'msgbox' (see below)
430 * representing a specific subfunction of dialog.
432 * The functions 'title' and 'dialogtype' return partially-constructed
433 * lists of shell parameters. See the dialog manpage.
435 * Returns the exit status (Yes lines | No | Help | Back | Error).
438 let params = List.concat params in (* list-of-list to flat list *)
439 eprintf "dialog [%s]\n%!"
440 (String.concat "; " (List.map (sprintf "%S") params));
442 (* 'dialog' writes its output/result to stderr, so we need to take
443 * special steps to capture that - in other words, manual pipe/fork.
445 let rfd, wfd = pipe () in
447 | 0 -> (* child, runs dialog *)
449 dup2 wfd stderr; (* capture stderr to pipe *)
450 execvp "dialog" (Array.of_list ("dialog" :: params))
451 | pid -> (* parent *)
453 let chan = in_channel_of_descr rfd in
454 let result = input_all_lines chan in
456 eprintf "dialog result: %S\n%!" (String.concat "\n" result);
457 match snd (wait ()) with
458 | WEXITED 0 -> Yes result (* something selected / entered *)
459 | WEXITED 1 -> No (* cancel / no button *)
460 | WEXITED 2 -> Help (* help pressed *)
461 | WEXITED 3 -> Back (* back button *)
462 | WEXITED _ -> Error (* error or Esc *)
463 | WSIGNALED i -> failwith (sprintf "dialog: killed by signal %d" i)
464 | WSTOPPED i -> failwith (sprintf "dialog: stopped by signal %d" i)
466 (* Title and common dialog options. *)
467 and title title ?(cancel=false) ?(backbutton=true) () =
468 let params = ["--title"; title] in
469 let params = if not cancel then "--nocancel" :: params else params in
471 if backbutton then "--extra-button" :: "--extra-label" :: "Back" :: params
476 and msgbox text height width =
477 [ "--msgbox"; text; string_of_int height; string_of_int width ]
479 (* Simple input box. *)
480 and inputbox text height width default =
481 [ "--inputbox"; text; string_of_int height; string_of_int width; default ]
483 (* Radio list and check list. *)
484 and radiolist text height width listheight items =
485 let items = List.map (
487 | tag, item, true -> [ tag; item; "on" ]
488 | tag, item, false -> [ tag; item; "off" ]
490 let items = List.concat items in
492 "--radiolist" :: text :: string_of_int height :: string_of_int width ::
493 string_of_int listheight :: items
495 and checklist text height width listheight items =
496 let items = List.map (
498 | tag, item, true -> [ tag; item; "on" ]
499 | tag, item, false -> [ tag; item; "off" ]
501 let items = List.concat items in
502 "--separate-output" ::
503 "--checklist" :: text :: string_of_int height :: string_of_int width ::
504 string_of_int listheight :: items
506 (* Print failure dialog and exit. *)
507 and fail_dialog text =
508 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
518 eprintf "usage: virt-p2v [ttyname]\n%!";
521 (* Test harness for the Makefile. The Makefile invokes this script as
522 * 'virt-p2v.ml --test' just to check it compiles. When it is running
523 * from the actual live CD, there is a single parameter which is the
524 * tty name (so usually 'virt-p2v.ml tty1').
527 match Array.to_list Sys.argv with
528 | [ _; "--test" ] -> () (* Makefile test - do nothing. *)
529 | [ _; ("--help"|"-help"|"-?"|"-h") ] -> usage ();
530 | [ _; ttyname ] -> main (Some ttyname) (* Run main with ttyname. *)
531 | [ _ ] -> main None (* Interactive - no ttyname. *)