1 #!/usr/bin/ocamlrun /usr/bin/ocaml
8 (* virt-p2v.ml is a script which performs a physical to
9 * virtual conversion of local disks.
11 * Copyright (C) 2007-2008 Red Hat Inc.
12 * Written by Richard W.M. Jones <rjones@redhat.com>
14 * This program is free software; you can redistribute it and/or modify
15 * it under the terms of the GNU General Public License as published by
16 * the Free Software Foundation; either version 2 of the License, or
17 * (at your option) any later version.
19 * This program is distributed in the hope that it will be useful,
20 * but WITHOUT ANY WARRANTY; without even the implied warranty of
21 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 * GNU General Public License for more details.
24 * You should have received a copy of the GNU General Public License
25 * along with this program; if not, write to the Free Software
26 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
34 type state = { greeting : bool;
35 remote_host : string option; remote_port : string option;
36 transport : transport option;
37 remote_directory : string option;
38 network : network option;
39 devices_to_send : string list option;
40 root_filesystem : partition option }
41 and transport = Server | SSH | TCP
42 and network = Auto | Shell
43 and partition = Part of string * string (* eg. "hda", "1" *)
44 | LV of string * string (* eg. "VolGroup00", "LogVol00" *)
46 (*----------------------------------------------------------------------*)
47 (* TO MAKE A CUSTOM virt-p2v SCRIPT, adjust the defaults in this section.
49 * If left as they are, then this will create a generic virt-p2v script
50 * which asks the user for each question. If you set the defaults here
51 * then you will get a custom virt-p2v which is partially or even fully
52 * automated and won't ask the user any questions.
54 * Note that 'None' means 'no default' (ie. ask the user) whereas
55 * 'Some foo' means use 'foo' as the answer.
58 (* If greeting is true, wait for keypress after boot and during
59 * final verification. Set to 'false' for less interactions.
63 (* Transport: Set to 'Some Server' or 'Some SSH' or 'Some TCP' to
64 * assume Server, SSH or TCP transports respectively.
68 (* Remote host and port. Set to 'Some "host"' and 'Some "port"',
74 (* Remote directory (only for SSH transport). Set to 'Some "path"'
75 * to set up a directory path, else ask the user.
77 remote_directory = None;
79 (* List of devices to send. Set to 'Some ["sda"; "sdb"]' for
80 * example to select /dev/sda and /dev/sdb.
82 devices_to_send = None;
84 (* The root filesystem containing /etc/fstab. Set to
85 * 'Some (Part ("sda", "3"))' or 'Some (LV ("VolGroup00", "LogVol00"))'
86 * for example, else ask user.
88 root_filesystem = None;
90 (* Network configuration: Set to 'Some Auto' (try to set it up
91 * automatically, or 'Some Shell' (give the user a shell).
95 (* END OF CUSTOM virt-p2v SCRIPT SECTION. *)
96 (*----------------------------------------------------------------------*)
98 (* General helper functions. *)
100 let sort_uniq ?(cmp = compare) xs = (* sort and uniq a list *)
101 let xs = List.sort ~cmp xs in
102 let rec loop = function
103 | [] -> [] | [x] -> [x]
104 | x1 :: x2 :: xs when x1 = x2 -> loop (x1 :: xs)
105 | x :: xs -> x :: loop xs
109 let input_all_lines chan =
110 let lines = ref [] in
112 while true do lines := input_line chan :: !lines done; []
114 End_of_file -> List.rev !lines
116 let rec string_of_state state =
118 "greeting: %b remote: %s:%s%s%s network: %s devices: [%s] root: %s"
120 (Option.default "" state.remote_host)
121 (Option.default "" state.remote_port)
122 (match state.transport with
124 | Some Server -> " (server)" | Some SSH -> " (ssh)" | Some TCP -> " (tcp)")
125 (match state.remote_directory with
126 | None -> "" | Some dir -> " " ^ dir)
127 (match state.network with
128 | None -> "none" | Some Auto -> "auto" | Some Shell -> "shell")
129 (String.concat "; " (Option.default [] state.devices_to_send))
130 (Option.map_default dev_of_partition "" state.root_filesystem)
132 and dev_of_partition = function
133 | Part (dev, partnum) -> sprintf "/dev/%s%s" dev partnum
134 | LV (vg, lv) -> sprintf "/dev/%s/%s" vg lv
136 type dialog_status = Yes of string list | No | Help | Back | Error
138 type ask_result = Next of state | Prev | Ask_again
142 * Each function takes some common parameters (eg. ~title) and some
143 * dialog-specific parameters.
145 * Returns the exit status (Yes lines | No | Help | Back | Error).
147 let msgbox, yesno, inputbox, radiolist, checklist =
148 (* Internal function to actually run the "dialog" shell command. *)
149 let run_dialog cparams params =
150 let params = cparams @ params in
151 eprintf "dialog %s\n%!"
152 (String.concat " " (List.map (sprintf "%S") params));
154 (* 'dialog' writes its output/result to stderr, so we need to take
155 * special steps to capture that - in other words, manual pipe/fork.
157 let rfd, wfd = pipe () in
159 | 0 -> (* child, runs dialog *)
161 dup2 wfd stderr; (* capture stderr to pipe *)
162 execvp "dialog" (Array.of_list ("dialog" :: params))
163 | pid -> (* parent *)
165 let chan = in_channel_of_descr rfd in
166 let result = input_all_lines chan in
168 eprintf "dialog result: %S\n%!" (String.concat "\n" result);
169 match snd (wait ()) with
170 | WEXITED 0 -> Yes result (* something selected / entered *)
171 | WEXITED 1 -> No (* cancel / no button *)
172 | WEXITED 2 -> Help (* help pressed *)
173 | WEXITED 3 -> Back (* back button *)
174 | WEXITED _ -> Error (* error or Esc *)
175 | WSIGNALED i -> failwith (sprintf "dialog: killed by signal %d" i)
176 | WSTOPPED i -> failwith (sprintf "dialog: stopped by signal %d" i)
179 (* Handle the common parameters. Note Continuation Passing Style. *)
180 let with_common cont ?(cancel=false) ?(backbutton=true) title =
181 let params = ["--title"; title] in
182 let params = if not cancel then "--nocancel" :: params else params in
184 if backbutton then "--extra-button" :: "--extra-label" :: "Back" :: params
189 (* Message box and yes/no box. *)
192 fun cparams text height width ->
194 [ "--msgbox"; text; string_of_int height; string_of_int width ]
198 fun cparams text height width ->
200 [ "--yesno"; text; string_of_int height; string_of_int width ]
203 (* Simple input box. *)
206 fun cparams text height width default ->
208 [ "--inputbox"; text; string_of_int height; string_of_int width;
212 (* Radio list and check list. *)
215 fun cparams text height width listheight items ->
216 let items = List.map (
218 | tag, item, true -> [ tag; item; "on" ]
219 | tag, item, false -> [ tag; item; "off" ]
221 let items = List.concat items in
222 let items = "--single-quoted" ::
223 "--radiolist" :: text ::
224 string_of_int height :: string_of_int width ::
225 string_of_int listheight :: items in
226 run_dialog cparams items
230 fun cparams text height width listheight items ->
231 let items = List.map (
233 | tag, item, true -> [ tag; item; "on" ]
234 | tag, item, false -> [ tag; item; "off" ]
236 let items = List.concat items in
237 let items = "--separate-output" ::
238 "--checklist" :: text ::
239 string_of_int height :: string_of_int width ::
240 string_of_int listheight :: items in
241 run_dialog cparams items
244 msgbox, yesno, inputbox, radiolist, checklist
246 (* Print failure dialog and exit. *)
247 let fail_dialog text =
248 let text = "\n" ^ 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
249 ignore (msgbox "Error" text 17 50);
252 (* Shell-safe quoting function. In fact there's one in stdlib so use it. *)
253 let quote = Filename.quote
255 (* Run a shell command and check it returns 0. *)
257 eprintf "sh: %s\n%!" cmd;
258 if Sys.command cmd <> 0 then fail_dialog (sprintf "Command failed:\n\n%s" cmd)
261 eprintf "shfailok: %s\n%!" cmd;
262 ignore (Sys.command cmd)
264 let shwithstatus cmd =
265 eprintf "shfailok: %s\n%!" cmd;
268 (* Same as `cmd` in shell. Any error message will be in the logfile. *)
270 eprintf "shget: %s\n%!" cmd;
271 let chan = open_process_in cmd in
272 let lines = input_all_lines chan in
273 match close_process_in chan with
274 | WEXITED 0 -> Some lines (* command succeeded *)
275 | WEXITED _ -> None (* command failed *)
276 | WSIGNALED i -> failwith (sprintf "shget: command killed by signal %d" i)
277 | WSTOPPED i -> failwith (sprintf "shget: command stopped by signal %d" i)
279 (* Start an interactive shell. *)
281 shfailok "PS1='\\u@\\h:\\w\\$ ' bash"
283 (* Some true if is dir/file, Some false if not, None if not found. *)
285 try Some ((stat path).st_kind = S_DIR)
286 with Unix_error (ENOENT, "stat", _) -> None
288 try Some ((stat path).st_kind = S_REG)
289 with Unix_error (ENOENT, "stat", _) -> None
291 (* Useful regular expression. *)
292 let whitespace = Pcre.regexp "[ \t]+"
294 (* Generate a predictable safe name containing only letters, numbers
295 * and underscores. If passed a string with no letters or numbers,
296 * generates "_1", "_2", etc.
301 fun () -> incr i; "_" ^ string_of_int !i
304 let is_safe = function 'a'..'z'|'A'..'Z'|'0'..'9' -> true | _ -> false in
305 let name = String.copy name in
306 let have_safe = ref false in
307 for i = 0 to String.length name - 1 do
308 if not (is_safe name.[i]) then name.[i] <- '_' else have_safe := true
310 if !have_safe then name else next_anon ()
312 type block_device = string * int64 (* "hda" & size in bytes *)
314 (* Parse the output of 'lvs' to get list of LV names, sizes,
315 * corresponding PVs, etc. Returns a list of (lvname, PVs, lvsize).
318 let devname = Pcre.regexp "^/dev/(.+)\\(.+\\)$" in
322 shget "lvs --noheadings -o vg_name,lv_name,devices,lv_size"
326 let lines = List.map (Pcre.split ~rex:whitespace) lines in
329 | [vg; lv; pvs; lvsize]
330 | [_; vg; lv; pvs; lvsize] ->
331 let pvs = String.nsplit "," pvs in
335 let subs = Pcre.exec ~rex:devname pv in
336 Pcre.get_substring subs 1
338 Not_found -> failwith ("lvs: unexpected device name: " ^ pv)
340 LV (vg, lv), pvs, lvsize
342 failwith ("lvs: unexpected output: " ^ String.concat "," line)
345 (* Get the partitions on a block device.
346 * eg. "sda" -> [Part ("sda","1"); Part ("sda", "2")]
348 let get_partitions dev =
349 let rex = Pcre.regexp ("^" ^ dev ^ "(.+)$") in
350 let devdir = "/sys/block/" ^ dev in
351 let parts = Sys.readdir devdir in
352 let parts = Array.to_list parts in
353 let parts = List.filter (
354 fun name -> Some true = is_dir (devdir ^ "/" ^ name)
356 let parts = List.filter_map (
359 let subs = Pcre.exec ~rex part in
360 Some (Part (dev, Pcre.get_substring subs 1))
366 (* Generate snapshot device name from device name. *)
367 let snapshot_name dev =
368 "snap" ^ (safe_name dev)
370 (* Perform a device-mapper snapshot with ramdisk overlay. *)
372 let next_free_ram_disk =
374 fun () -> incr i; "/dev/ram" ^ string_of_int !i
376 fun origin_dev snapshot_dev ->
377 let ramdisk = next_free_ram_disk () in
379 let cmd = "blockdev --getsz " ^ quote ("/dev/" ^ origin_dev) in
380 let lines = shget cmd in
382 | Some (sectors::_) -> Int64.of_string sectors
384 fail_dialog (sprintf "Snapshot failed - unable to read the size in sectors of block device %s" origin_dev) in
386 (* Create the snapshot origin device. Called, eg. snap_sda1_org *)
387 sh (sprintf "dmsetup create %s_org --table='0 %Ld snapshot-origin /dev/%s'"
388 snapshot_dev sectors origin_dev);
389 (* Create the snapshot. *)
390 sh (sprintf "dmsetup create %s --table='0 %Ld snapshot /dev/mapper/%s_org %s n 64'"
391 snapshot_dev sectors snapshot_dev ramdisk)
393 (* Try to perform automatic network configuration, assuming a Fedora or RHEL-
394 * like root filesystem mounted on /mnt/root.
396 let auto_network state =
397 (* Fedora gives an error if this file doesn't exist. *)
398 sh "touch /etc/resolv.conf";
400 chdir "/etc/sysconfig";
402 sh "mv network network.saved";
403 sh "mv networking networking.saved";
404 sh "mv network-scripts network-scripts.saved";
406 (* Originally I symlinked these, but that causes dhclient to
407 * keep open /mnt/root (as its cwd is in network-scripts subdir).
408 * So now we will copy them recursively instead.
410 sh "cp -r /mnt/root/etc/sysconfig/network .";
411 sh "cp -r /mnt/root/etc/sysconfig/networking .";
412 sh "cp -r /mnt/root/etc/sysconfig/network-scripts .";
414 let status = shwithstatus "/etc/init.d/network start" in
416 sh "rm -rf network networking network-scripts";
417 sh "mv network.saved network";
418 sh "mv networking.saved networking";
419 sh "mv network-scripts.saved network-scripts";
423 (* Try to ping the remote host to see if this worked. *)
424 sh ("ping -c 3 " ^ Option.map_default quote "" state.remote_host);
426 if state.greeting then (
427 printf "\n\nDid automatic network configuration work?\n";
428 printf "Hint: If not sure, there is a shell on console [ALT] [F2]\n";
430 let line = read_line () in
431 String.length line > 0 && (line.[0] = 'y' || line.[0] = 'Y')
434 (* Non-interactive: return the status of /etc/init.d/network start. *)
437 (* Map local device names to remote devices names. At the moment we
438 * just change sd* to hd* (as device names appear under fullvirt). In
439 * future, lots of complex possibilities.
441 let remote_of_origin_dev =
442 let devsd = Pcre.regexp "^sd([[:alpha:]]+[[:digit:]]+)$" in
443 let devsd_subst = Pcre.subst "hd$1" in
445 Pcre.replace ~rex:devsd ~itempl:devsd_subst dev
447 (* Rewrite /mnt/root/etc/fstab. *)
448 let rewrite_fstab state devices_to_send =
449 let filename = "/mnt/root/etc/fstab" in
450 if is_file filename = Some true then (
451 sh ("cp " ^ quote filename ^ " " ^ quote (filename ^ ".p2vsaved"));
453 let chan = open_in filename in
454 let lines = input_all_lines chan in
456 let lines = List.map (Pcre.split ~rex:whitespace) lines in
457 let lines = List.map (
459 | dev :: rest when String.starts_with dev "/dev/" ->
460 let dev = String.sub dev 5 (String.length dev - 5) in
461 let dev = remote_of_origin_dev dev in
462 let dev = "/dev/" ^ dev in
467 let chan = open_out filename in
470 | [dev; mountpoint; fstype; options; freq; passno] ->
471 fprintf chan "%-23s %-23s %-7s %-15s %s %s\n"
472 dev mountpoint fstype options freq passno
474 output_string chan (String.concat " " line)
479 (* Main entry point. *)
480 let rec main ttyname =
481 (* Running from an init script. We don't have much of a
482 * login environment, so set one up.
486 ["/usr/sbin"; "/sbin"; "/usr/local/bin"; "/usr/kerberos/bin";
487 "/usr/bin"; "/bin"]);
488 putenv "HOME" "/root";
489 putenv "LOGNAME" "root";
491 (* We can safely write in /tmp (it's a synthetic live CD directory). *)
494 (* Set up logging to /tmp/virt-p2v.log. *)
495 let fd = openfile "virt-p2v.log" [ O_WRONLY; O_APPEND; O_CREAT ] 0o644 in
499 (* Log the start up time. *)
500 eprintf "\n\n**************************************************\n\n";
501 let tm = localtime (time ()) in
502 eprintf "virt-p2v-ng starting up at %04d-%02d-%02d %02d:%02d:%02d\n\n%!"
503 (tm.tm_year+1900) (tm.tm_mon+1) tm.tm_mday tm.tm_hour tm.tm_min tm.tm_sec;
505 (* Connect stdin/stdout to the tty. *)
509 let fd = openfile ("/dev/" ^ ttyname) [ O_RDWR ] 0 in
514 (* Search for all non-removable block devices. Do this early and bail
515 * if we can't find anything. This is a list of strings, like "hda".
517 let all_block_devices : block_device list =
518 let rex = Pcre.regexp "^[hs]d" in
519 let devices = Array.to_list (Sys.readdir "/sys/block") in
520 let devices = List.sort devices in
521 let devices = List.filter (fun d -> Pcre.pmatch ~rex d) devices in
522 eprintf "all_block_devices: block devices: %s\n%!"
523 (String.concat "; " devices);
524 (* Run blockdev --getsize64 on each, and reject any where this fails
525 * (probably removable devices).
527 let devices = List.filter_map (
529 let cmd = "blockdev --getsize64 " ^ quote ("/dev/" ^ d) in
530 let lines = shget cmd in
532 | Some (blksize::_) -> Some (d, Int64.of_string blksize)
533 | Some [] | None -> None
535 eprintf "all_block_devices: non-removable block devices: %s\n%!"
537 (List.map (fun (d, b) -> sprintf "%s [%Ld]" d b) devices));
539 fail_dialog "No non-removable block devices (hard disks, etc.) could be found on this machine.";
542 (* Search for partitions and LVs (anything that could contain a
543 * filesystem directly). We refer to these generically as
546 let all_partitions : partition list =
549 let lvs = get_lvs () in
550 let pvs = List.map (fun (_, pvs, _) -> pvs) lvs in
551 let pvs = List.concat pvs in
552 let pvs = sort_uniq pvs in
553 eprintf "all_partitions: PVs: %s\n%!" (String.concat "; " pvs);
554 let lvs = List.map (fun (lvname, _, _) -> lvname) lvs in
555 eprintf "all_partitions: LVs: %s\n%!"
556 (String.concat "; " (List.map dev_of_partition lvs));
559 (* Partitions (eg. "sda1", "sda2"). *)
561 let parts = List.map fst all_block_devices in
562 let parts = List.map get_partitions parts in
563 let parts = List.concat parts in
564 eprintf "all_partitions: all partitions: %s\n%!"
565 (String.concat "; " (List.map dev_of_partition parts));
567 (* Remove any partitions which are PVs. *)
568 let parts = List.filter (
570 | Part (dev, partnum) -> not (List.mem (dev ^ partnum) pvs)
571 | LV _ -> assert false
574 eprintf "all_partitions: partitions after removing PVs: %s\n%!"
575 (String.concat "; " (List.map dev_of_partition parts));
577 (* Concatenate LVs & Parts *)
581 let ask_greeting state =
582 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.\n\nExtra information is logged in /tmp/virt-p2v.log but this file disappears when the machine reboots." 18 50);
586 let ask_transport state =
588 radiolist "Connection type" ~backbutton:false
589 "Connection type. If possible, select 'server' and run P2V server on the remote host"
591 "server", "P2V server on remote host",
592 state.transport = Some Server;
593 "ssh", "SSH (secure shell)",
594 state.transport = Some SSH;
596 state.transport = Some TCP
599 | Yes ("server"::_) -> Next { state with transport = Some Server }
600 | Yes ("ssh"::_) -> Next { state with transport = Some SSH }
601 | Yes ("tcp"::_) -> Next { state with transport = Some TCP }
602 | Yes _ | No | Help | Error -> Ask_again
606 let ask_hostname state =
608 inputbox "Remote host" "Remote host" 10 50
609 (Option.default "" state.remote_host)
611 | Yes [] -> Ask_again
612 | Yes (hostname::_) -> Next { state with remote_host = Some hostname }
613 | No | Help | Error -> Ask_again
619 inputbox "Remote port" "Remote port" 10 50
620 (Option.default "" state.remote_port)
623 (match state.transport with
624 | Some SSH -> Next { state with remote_port = Some "22" }
625 | _ -> Next { state with remote_port = Some "16211" }
627 | Yes (port::_) -> Next { state with remote_port = Some port }
628 | No | Help | Error -> Ask_again
632 let ask_directory state =
634 inputbox "Remote directory" "Remote directory" 10 50
635 (Option.default "" state.remote_directory)
638 Next { state with remote_directory = Some "/var/lib/xen/images" }
639 | Yes (dir::_) -> Next { state with remote_directory = Some dir }
640 | No | Help | Error -> Ask_again
644 let ask_network state =
646 radiolist "Network configuration" "Network configuration" 10 50 2 [
647 "auto", "Automatic configuration", state.network = Some Auto;
648 "sh", "Configure from the shell", state.network = Some Shell;
651 | Yes ("auto"::_) -> Next { state with network = Some Auto }
652 | Yes ("sh"::_) -> Next { state with network = Some Shell }
653 | Yes _ | No | Help | Error -> Ask_again
657 let ask_devices state =
658 let selected_devices = Option.default [] state.devices_to_send in
659 let devices = List.map (
660 fun (dev, blksize) ->
662 sprintf "/dev/%s (%.3f GB)" dev
663 ((Int64.to_float blksize) /. (1024.*.1024.*.1024.)),
664 List.mem dev selected_devices)
665 ) all_block_devices in
667 checklist "Devices" "Pick devices to send" 15 50 8 devices
669 | Yes [] | No | Help | Error -> Ask_again
670 | Yes devices -> Next { state with devices_to_send = Some devices }
675 let parts = List.mapi (
677 (string_of_int i, dev_of_partition part,
678 Some part = state.root_filesystem)
681 radiolist "Root device"
682 "Pick partition containing the root (/) filesystem" 15 50 6
686 let part = List.nth all_partitions (int_of_string i) in
687 Next { state with root_filesystem = Some part }
688 | Yes [] | No | Help | Error -> Ask_again
692 let ask_verify state =
694 yesno "Verify and proceed"
695 (sprintf "\nPlease verify the settings below and click [OK] to proceed, or the [Back] button to return to a previous step.
704 (match state.transport with
705 | Some Server -> "Server"
706 | Some SSH -> "SSH" | Some TCP -> "TCP socket"
708 (Option.default "" state.remote_host)
709 (Option.default "" state.remote_port)
710 (Option.default "" state.remote_directory)
711 (match state.network with
712 | Some Auto -> "Auto-configure" | Some Shell -> "Shell"
714 (String.concat "," (Option.default [] state.devices_to_send))
715 (Option.map_default dev_of_partition "" state.root_filesystem))
718 | Yes _ -> Next state
720 | No | Help | Error -> Ask_again
723 (* This is the list of dialogs, in order. The user can go forwards or
724 * backwards through them. The second parameter in each pair is
725 * false if we need to skip this dialog (info already supplied in
729 ask_greeting, (* Initial greeting. *)
731 ask_transport, (* Transport (ssh, tcp) *)
732 defaults.transport = None;
733 ask_hostname, (* Hostname. *)
734 defaults.remote_host = None;
735 ask_port, (* Port number. *)
736 defaults.remote_port = None;
737 ask_directory, (* Remote directory. *)
738 defaults.remote_directory = None;
739 ask_network, (* Network configuration. *)
740 defaults.network = None;
741 ask_devices, (* Block devices to send. *)
742 defaults.devices_to_send = None;
743 ask_root, (* Root filesystem. *)
744 defaults.root_filesystem = None;
745 ask_verify, (* Verify settings. *)
749 (* Loop through the dialogs until we reach the end. *)
750 let rec loop posn state =
751 eprintf "dialog loop: posn = %d\n%!" posn;
752 if posn >= Array.length dlgs then state (* Finished all dialogs. *)
754 let dlg, no_skip = dlgs.(posn) in
755 let skip = not no_skip in
757 (* Skip this dialog and move straight to the next one. *)
762 | Next new_state -> loop (posn+1) new_state (* Forwards. *)
763 | Prev -> loop (posn-1) state (* Backwards / back button. *)
764 | Ask_again -> loop posn state (* Repeat the question. *)
768 let state = loop 0 defaults in
770 eprintf "finished dialog loop\nfinal state = %s\n%!" (string_of_state state);
772 (* Check that the environment is a sane-looking live CD. If not, bail. *)
773 if is_dir "/mnt/root" <> Some true ||
774 is_file "/etc/lvm/lvm.conf.new" <> Some true then
775 fail_dialog "You should only run this script from the live CD or a USB key.";
777 (* Switch LVM config. *)
779 sh "mv /etc/lvm/lvm.conf /etc/lvm/lvm.conf.old";
780 sh "mv /etc/lvm/lvm.conf.new /etc/lvm/lvm.conf";
781 sh "rm -f /etc/lvm/cache/.cache";
783 (* Snapshot the block devices to send. *)
784 let devices_to_send = Option.get state.devices_to_send in
785 let devices_to_send =
788 let snapshot_dev = snapshot_name origin_dev in
789 snapshot origin_dev snapshot_dev;
790 (origin_dev, snapshot_dev)
793 (* Run kpartx on the snapshots. *)
795 fun (origin, snapshot) ->
796 shfailok ("kpartx -a " ^ quote ("/dev/mapper/" ^ snapshot))
799 (* Rescan for LVs. *)
803 (* Mount the root filesystem under /mnt/root. *)
804 let root_filesystem = Option.get state.root_filesystem in
805 (match root_filesystem with
806 | Part (dev, partnum) ->
807 let dev = dev ^ partnum in
808 let snapshot_dev = snapshot_name dev in
809 sh ("mount " ^ quote ("/dev/mapper/" ^ snapshot_dev) ^ " /mnt/root")
812 (* The LV will be backed by a snapshot device, so just mount directly. *)
813 sh ("mount " ^ quote ("/dev/" ^ vg ^ "/" ^ lv) ^ " /mnt/root")
816 (* See if we can do network configuration. *)
817 let network = Option.get state.network in
820 printf "Network configuration.\n\n";
821 printf "Please configure the network from this shell.\n\n";
822 printf "When you have finished, exit the shell with ^D or exit.\n\n";
826 printf "Trying network auto-configuration from root filesystem ...\n\n";
827 if not (auto_network state) then (
828 printf "\nAuto-configuration failed. Starting a shell.\n\n";
829 printf "Please configure the network from this shell.\n\n";
830 printf "When you have finished, exit the shell with ^D or exit.\n\n";
835 (* Work out what devices will be called at the remote end. *)
836 let devices_to_send = List.map (
837 fun (origin_dev, snapshot_dev) ->
838 let remote_dev = remote_of_origin_dev origin_dev in
839 (origin_dev, snapshot_dev, remote_dev)
842 rewrite_fstab state devices_to_send;
843 (* XXX Other files to rewrite? *)
845 (* Unmount the root filesystem and sync disks. *)
846 sh "umount /mnt/root";
847 sh "sync"; (* Ugh, should be in stdlib. *)
849 (* For Server and TCP type connections, we connect just once. *)
850 let remote_host = Option.get state.remote_host in
851 let remote_port = Option.get state.remote_port in
852 let remote_directory = Option.get state.remote_directory in
853 let transport = Option.get state.transport in
859 getaddrinfo remote_host remote_port [AI_SOCKTYPE SOCK_STREAM] in
860 let rec loop = function
863 (sprintf "Unable to connect to %s:%s" remote_host remote_port)
867 socket addr.ai_family addr.ai_socktype addr.ai_protocol in
868 connect sock addr.ai_addr;
870 with Unix_error (err, syscall, extra) ->
871 (* Log the error message, but continue around the loop. *)
872 eprintf "%s:%s: %s\n%!" syscall extra (error_message err);
877 (* Just dummy socket for SSH for now ... *) stdin in
879 (* Send the device snapshots to the remote host. *)
880 (* XXX This is using the hostname derived from network configuration
881 * above. We might want to ask the user to choose.
884 let hostname = safe_name (gethostname ()) in
885 let date = sprintf "%04d%02d%02d%02d%02d"
886 (tm.tm_year+1900) (tm.tm_mon+1) tm.tm_mday tm.tm_hour tm.tm_min in
887 "p2v-" ^ hostname ^ "-" ^ date in
889 (* XXX This code should be made more robust against both network
890 * errors and local I/O errors. Also should allow the user several
891 * attempts to connect, or let them go back to the dialog stage.
894 fun (origin_dev, snapshot_dev, remote_dev) ->
895 let remote_name = basename ^ "-" ^ remote_dev ^ ".img" in
896 eprintf "sending %s as %s\n%!" origin_dev remote_name;
899 try List.assoc origin_dev all_block_devices
900 with Not_found -> assert false (* internal error *) in
902 printf "Sending /dev/%s (%.3f GB) to remote machine\n%!" origin_dev
903 ((Int64.to_float size) /. (1024.*.1024.*.1024.));
905 (* Open the snapshot device. *)
906 let fd = openfile ("/dev/mapper/" ^ snapshot_dev) [O_RDONLY] 0 in
908 (* Now connect (for SSH) or send the header (for Server/TCP). *)
912 let header = sprintf "p2v2 %s %Ld\n%!" remote_name size in
913 let len = String.length header in
914 assert (len = write sock header 0 len);
915 sock, Pervasives.stdout
917 let cmd = sprintf "ssh -C -p %s %s \"cat > %s/%s\""
918 (quote remote_port) (quote remote_host)
919 (quote remote_directory) (quote remote_name) in
920 let chan = open_process_out cmd in
921 let fd = descr_of_out_channel chan in
925 let bufsize = 128 * 1024 in
926 let buffer = String.create bufsize in
929 let n = read fd buffer 0 bufsize in
931 ignore (write sock buffer 0 n);
937 (* For SSH disconnect, for Server/TCP send a newline. *)
940 ignore (write sock "\n" 0 1)
942 match close_process_out chan with
943 | WEXITED 0 -> () (* OK *)
944 | WEXITED i -> failwith (sprintf "ssh: exited with error code %d" i)
945 | WSIGNALED i -> failwith (sprintf "ssh: killed by signal %d" i)
946 | WSTOPPED i -> failwith (sprintf "ssh: stopped by signal %d" i)
950 (match transport with
951 | Server | TCP -> close sock
955 (* XXX Write a configuration file. *)
956 let conf_filename = basename ^ ".conf" in
958 (* Clean up and reboot. *)
960 msgbox "virt-p2v completed"
961 (sprintf "\nThe physical to virtual migration is complete.\n\nPlease verify the disk image(s) and configuration file on the remote host, and then start up the virtual machine by doing:\n\nvirsh define %s/%s\n\nWhen you press [OK] this machine will reboot."
962 (Option.default "" state.remote_directory) conf_filename)
971 eprintf "usage: virt-p2v [ttyname]\n%!";
974 (* Make sure that exceptions from 'main' get printed out on stdout
975 * as well as stderr, since stderr is probably redirected to the
976 * logfile, and so not visible to the user.
978 let handle_exn f arg =
980 with exn -> print_endline (Printexc.to_string exn); raise exn
982 (* Test harness for the Makefile. The Makefile invokes this script as
983 * 'virt-p2v.ml --test' just to check it compiles. When it is running
984 * from the actual live CD, there is a single parameter which is the
985 * tty name (so usually 'virt-p2v.ml tty1').
988 match Array.to_list Sys.argv with
989 | [ _; "--test" ] -> () (* Makefile test - do nothing. *)
990 | [ _; ("--help"|"-help"|"-?"|"-h") ] -> usage ();
992 handle_exn main (Some ttyname) (* Run main with ttyname. *)
994 handle_exn main None (* Interactive - no ttyname. *)