X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=virt-p2v;h=4e2d9dd21cc47e438fbd1b03b949adca87d00a2a;hb=808b0435ac304f1a31063d80f6b8a6b88e578885;hp=ca75df9b4785f27e3e25b5249599bfdef7162c9b;hpb=831c069af0145b3520157bdcab4845be554c4cee;p=virt-p2v.git diff --git a/virt-p2v b/virt-p2v index ca75df9..4e2d9dd 100755 --- a/virt-p2v +++ b/virt-p2v @@ -110,17 +110,13 @@ let test_dialog_stages = false (* Load external libraries. *) ;; -#load "unix.cma";; -#directory "+extlib";; -#load "extLib.cma";; -#directory "+pcre";; -#load "pcre.cma";; -#directory "+newt";; -#load "mlnewt.cma";; -#directory "+xml-light";; -#load "xml-light.cma";; -#directory "+libvirt";; -#load "mllibvirt.cma";; +#use "topfind";; +#require "extlib";; +#require "pcre";; +#require "newt";; +#require "xml-light";; +#require "gettext-stub";; +#require "libvirt";; open Unix open Printf @@ -128,6 +124,27 @@ open ExtList open ExtString (*----------------------------------------------------------------------*) +(* Gettext support. + * + * Use s_ "string" to mark a translatable string, and f_ "string %s" + * to mark a format string (eg. for printf). There are other + * functions: see ocaml-gettext manual and GNU gettext info. + * + * Try not to mark strings which always go to the log file (eg. + * eprintf messages). + *) + +module P2VGettext = Gettext.Program ( + struct + let textdomain = "virt-p2v" + let codeset = None + let dir = None + let dependencies = [] + end +) (GettextStub.Native) +open P2VGettext + +(*----------------------------------------------------------------------*) (* General helper functions. *) let sort_uniq ?(cmp = compare) xs = (* sort and uniq a list *) @@ -199,13 +216,13 @@ and linux_distro = RHEL of int * int | OtherLinux let rec string_of_nature = function - | LinuxSwap -> "Linux swap" + | LinuxSwap -> s_ "Linux swap" | LinuxRoot (architecture, distro) -> string_of_linux_distro distro ^ " " ^ string_of_architecture architecture - | WindowsRoot -> "Windows root" - | LinuxBoot -> "Linux /boot" - | NotRoot -> "Mountable non-root" - | UnknownNature -> "Unknown" + | WindowsRoot -> s_ "Windows root" + | LinuxBoot -> s_ "Linux /boot" + | NotRoot -> s_ "Mountable non-root" + | UnknownNature -> s_ "Unknown partition type" and string_of_linux_distro = function | RHEL (a,b) -> sprintf "RHEL %d.%d" a b | Fedora v -> sprintf "Fedora %d" v @@ -277,7 +294,7 @@ let with_newt f = * and help messages are consistent. *) let open_centered_window ?stage width height title = - if not !in_newt then failwith "open_centered_window: not in newt mode"; + if not !in_newt then failwith (s_ "open_centered_window: not in newt mode"); Newt.cls (); Newt.centered_window width height title; let root_text = @@ -285,7 +302,10 @@ let open_centered_window ?stage width height title = | None -> "" | Some stage -> " - " ^ stage) in Newt.draw_root_text 0 0 root_text; - Newt.push_help_line "F12 for next screen | [ALT] [F2] root / no password for shell" + Newt.push_help_line + (s_ "F12 for next screen | [ALT] [F2] root / no password for shell") + +let ok_button = " OK " (* Some general dialog boxes. *) let message_box title text = @@ -295,7 +315,7 @@ let message_box title text = let textbox = Newt.textbox 1 1 36 14 [Newt.WRAP; Newt.SCROLL] in Newt.textbox_set_text textbox text; - let ok = Newt.button 28 16 " OK " in + let ok = Newt.button 28 16 ok_button in let form = Newt.form None None [] in Newt.form_add_components form [textbox; ok]; @@ -308,8 +328,10 @@ let message_box title text = (* Fail and exit with error. *) let failwith text = prerr_endline text; - 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 - message_box "Error" text; + let text = "\n" + ^ text + ^ s_ "\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 + message_box (s_ "Error") text; exit 1 (* Display a dialog with checkboxes, return the multiple selected items. *) @@ -327,7 +349,7 @@ let select_multiple ?stage ?(force_one = false) width title items = (handle, cb) ) items in - let ok = Newt.button 48 16 " OK " in + let ok = Newt.button 48 16 ok_button in let vb = if List.length entries > 10 then @@ -374,7 +396,7 @@ let select_single ?stage width title items = (handle, rb) ) items in - let ok = Newt.button (width-12) 16 " OK " in + let ok = Newt.button (width-12) 16 ok_button in let vb = if List.length entries > 10 then @@ -413,7 +435,8 @@ let quote = Filename.quote (* Run a shell command and check it returns 0. *) let sh cmd = eprintf "sh: %s\n%!" cmd; - if Sys.command cmd <> 0 then failwith (sprintf "Command failed:\n\n%s" cmd) + if Sys.command cmd <> 0 then + failwith (sprintf (f_ "Command failed:\n\n%s") cmd) let shfailok cmd = eprintf "shfailok: %s\n%!" cmd; @@ -431,8 +454,10 @@ let shget cmd = match close_process_in chan with | WEXITED 0 -> Some lines (* command succeeded *) | WEXITED _ -> None (* command failed *) - | WSIGNALED i -> failwith (sprintf "shget: command killed by signal %d" i) - | WSTOPPED i -> failwith (sprintf "shget: command stopped by signal %d" i) + | WSIGNALED i -> + failwith (sprintf (f_ "shget: command killed by signal %d") i) + | WSTOPPED i -> + failwith (sprintf (f_ "shget: command stopped by signal %d") i) (* Start an interactive shell. Need to juggle file descriptors a bit * because bash write PS1 to stderr (currently directed to the logfile). @@ -511,7 +536,8 @@ let get_lvs = ) pvs in LV (vg, lv), pvs, lvsize | line -> - failwith ("lvs: unexpected output: " ^ String.concat "," line) + failwith ("lvs: " ^ s_ "unexpected output: " ^ + String.concat "," line) ) lines (* Get the partitions on a block device. @@ -553,7 +579,7 @@ let snapshot = match lines with | Some (sectors::_) -> Int64.of_string sectors | Some [] | None -> - failwith (sprintf "Snapshot failed - unable to read the size in sectors of block device %s" origin_dev) in + failwith (sprintf (f_ "Disk snapshot failed: unable to read the size in sectors of block device %s") origin_dev) in (* Create the snapshot origin device. Called, eg. snap_sda1_org *) sh (sprintf "dmsetup create %s_org --table='0 %Ld snapshot-origin /dev/%s'" @@ -581,8 +607,7 @@ let auto_network () = shfailok "ping -c3 `/sbin/ip route list match 0.0.0.0 | head -1 | awk '{print $3}'`"; if !config_greeting then ( - printf "\n\nDid automatic network configuration work?\n"; - printf "Hint: If not sure, there is a shell on console [ALT] [F2]\n"; + print_endline (s_ "\n\nDid automatic network configuration work?\nHint: If not sure, there is a shell on console [ALT] [F2]"); printf " (y/n) %!"; let line = read_line () in String.length line > 0 && (line.[0] = 'y' || line.[0] = 'Y') @@ -644,9 +669,9 @@ let ssh_disconnect (_, chan) = eprintf "ssh_disconnect\n%!"; match close_process_out chan with | WEXITED 0 -> () (* OK *) - | WEXITED i -> failwith (sprintf "ssh: exited with error code %d" i) - | WSIGNALED i -> failwith (sprintf "ssh: killed by signal %d" i) - | WSTOPPED i -> failwith (sprintf "ssh: stopped by signal %d" i) + | WEXITED i -> failwith (sprintf (f_ "ssh: exited with error code %d") i) + | WSIGNALED i -> failwith (sprintf (f_ "ssh: killed by signal %d") i) + | WSTOPPED i -> failwith (sprintf (f_ "ssh: stopped by signal %d") i) (* Use these functions to upload a file. *) let ssh_start_upload config filename = @@ -658,15 +683,15 @@ let ssh_finish_upload = ssh_disconnect (* Test SSH connection. *) let test_ssh config = - printf "Testing SSH connection by listing files in remote directory ...\n\n%!"; + print_endline + (s_ "Testing SSH connection by listing files in remote directory ...\n"); let cmd = sprintf "/bin/ls %s" (quote config.ssh_directory) in let conn = ssh_connect config cmd in ssh_disconnect conn; if !config_greeting then ( - printf "\n\nDid SSH work?\n"; - printf "Hint: If not sure, there is a shell on console [ALT] [F2]\n"; + print_endline (s_ "\n\nDid SSH work?\nHint: If not sure, there is a shell on console [ALT] [F2]\n"); printf " (y/n) %!"; let line = read_line () in String.length line > 0 && (line.[0] = 'y' || line.[0] = 'Y') @@ -794,8 +819,29 @@ let rec main ttyname = let fd = openfile ("/dev/" ^ ttyname) [ O_RDWR ] 0 in dup2 fd stdin; dup2 fd stdout; - close fd); - printf "%s starting up ...\n%!" program_name; + close fd + ); + + (* Choose language early, so messages are translated. *) + if !config_greeting then ( + with_newt ( + fun () -> + (* Note these strings are NOT translated! *) + let items = [ + "English", "en_US.UTF-8"; + "\xE6\x97\xA5\xE6\x9C\xAC\xE8\xAA\x9E (Japanese)", "ja_JP.UTF-8" + ] in + + let lang = select_single ~stage:(s_ "Select language") 40 + (s_ "Select language") + items in + + putenv "LANG" lang; + ignore (GettextStubCompat.setlocale GettextStubCompat.LC_ALL lang) + ) + ); + + let () = printf (f_ "%s starting up ...\n%!") program_name in (* Disable screen blanking on tty. *) sh "setterm -blank 0"; @@ -803,10 +849,11 @@ let rec main ttyname = (* Check that the environment is a sane-looking live CD. If not, bail. *) if not test_dialog_stages && is_dir "/mnt/root" <> Some true then failwith - "You should only run this script from the live CD or a USB key."; + (s_ "You should only run this script from the live CD or a USB key."); (* Start of the information gathering phase. *) - printf "Detecting hard drives (this may take some time) ...\n%!"; + print_endline + (s_ "Detecting hard drives (this may take some time) ..."); (* Search for all non-removable block devices. Do this early and bail * if we can't find anything. This is a list of strings, like "hda". @@ -833,7 +880,8 @@ let rec main ttyname = (String.concat "; " (List.map (fun (d, b) -> sprintf "%s [%Ld]" d b) devices)); if devices = [] then - failwith "No non-removable block devices (hard disks, etc.) could be found on this machine."; + failwith + (s_ "No non-removable block devices (hard disks, etc.) could be found on this machine."); devices in (* Search for partitions and LVs (anything that could contain a @@ -1001,7 +1049,7 @@ let rec main ttyname = ) all_partitions in - printf "Finished detecting hard drives.\n%!"; + print_endline (s_ "Finished detecting hard drives."); (* Autodetect system memory. *) let system_memory = @@ -1048,7 +1096,7 @@ let rec main ttyname = fun () -> (* Greeting. *) if !config_greeting then - message_box program_name (sprintf "Welcome to %s, 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." program_name); + message_box program_name (sprintf (f_ "Welcome to %s, 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.") program_name); (* Type of transfer. *) let config_transfer_type = @@ -1056,12 +1104,12 @@ let rec main ttyname = | Some t -> t | None -> let items = [ - "Physical to Virtual (P2V)", P2V; - "Virtual to Virtual (V2V)", V2V; + s_ "Physical to Virtual (P2V)", P2V; + s_ "Virtual to Virtual (V2V)", V2V; ] in - select_single ~stage:"Transfer type" 40 - "Transfer type" + select_single ~stage:(s_ "Transfer type") 40 + (s_ "Transfer type") items in (* Network configuration. *) @@ -1069,8 +1117,8 @@ let rec main ttyname = match !config_network with | Some n -> n | None -> - open_centered_window ~stage:"Network" - 60 20 "Configure network"; + open_centered_window ~stage:(s_ "Network") + 60 20 (s_ "Configure network"); let autolist = Newt.listbox 4 2 4 [Newt.SCROLL] in Newt.listbox_set_width autolist 52; @@ -1100,10 +1148,10 @@ let rec main ttyname = let auto = Newt.radio_button 1 1 - "Automatic from:" (not no_auto) None in + (s_ "Automatic from:") (not no_auto) None in let shell = Newt.radio_button 1 6 - "Start a shell" no_auto (Some auto) in + (s_ "Start a shell") no_auto (Some auto) in if no_auto then ( Newt.component_takes_focus auto false; @@ -1113,24 +1161,23 @@ let rec main ttyname = let qemu = Newt.radio_button 1 7 - "QEMU user network" false (Some shell) in + (s_ "QEMU user network") false (Some shell) in let nonet = Newt.radio_button 1 8 - "No network or network already configured" false - (Some qemu) in + (s_ "Don't configure the network") false (Some qemu) in let static = Newt.radio_button 1 9 - "Static configuration:" false (Some nonet) in + (s_ "Static configuration:") false (Some nonet) in - let label1 = Newt.label 4 10 "Interface" in + let label1 = Newt.label 4 10 (s_ "Interface") in let entry1 = Newt.entry 16 10 (Some "eth0") 8 [] in - let label2 = Newt.label 4 11 "Address" in + let label2 = Newt.label 4 11 (s_ "IP") in let entry2 = Newt.entry 16 11 None 16 [] in - let label3 = Newt.label 4 12 "Netmask" in + let label3 = Newt.label 4 12 (s_ "Netmask") in let entry3 = Newt.entry 16 12 (Some "255.255.255.0") 16 [] in - let label4 = Newt.label 4 13 "Gateway" in + let label4 = Newt.label 4 13 (s_ "Gateway") in let entry4 = Newt.entry 16 13 None 16 [] in - let label5 = Newt.label 4 14 "Nameserver" in + let label5 = Newt.label 4 14 (s_ "Nameserver") in let entry5 = Newt.entry 16 14 None 16 [] in let enable_static () = @@ -1170,7 +1217,7 @@ let rec main ttyname = Newt.component_add_callback static (fun () -> enable_static (); disable_autolist ()); - let ok = Newt.button 48 16 " OK " in + let ok = Newt.button 48 16 ok_button in let form = Newt.form None None [] in Newt.form_add_components form [auto; @@ -1218,32 +1265,26 @@ let rec main ttyname = (* Try to bring up the network. *) (match config_network with | Shell -> - printf "Network configuration.\n\n"; - printf "Please configure the network from this shell.\n\n"; - printf "When you have finished, exit the shell with ^D or exit.\n\n%!"; + print_endline (s_ "Network configuration.\n\nPlease configure the network from this shell.\n\nWhen you have finished, exit the shell with ^D or exit.\n"); shell () | Static (interface, address, netmask, gateway, nameserver) -> - printf "Trying static network configuration.\n\n%!"; + print_endline (s_ "Trying static network configuration.\n"); if not (static_network (interface, address, netmask, gateway, nameserver)) then ( - printf "\nAuto-configuration failed. Starting a shell.\n\n"; - printf "Please configure the network from this shell.\n\n"; - printf "When you have finished, exit the shell with ^D or exit.\n\n"; + print_endline (s_ "\nAuto-configuration failed. Starting a shell.\n\nPlease configure the network from this shell.\n\nWhen you have finished, exit the shell with ^D or exit.\n"); shell () ) | Auto rootfs -> - printf - "Trying network auto-configuration from root filesystem ...\n\n%!"; + print_endline + (s_ "Trying network auto-configuration from root filesystem ...\n"); (* Mount the root filesystem read-only under /mnt/root. *) sh ("mount -o ro " ^ quote (dev_of_partition rootfs) ^ " /mnt/root"); if not (auto_network ()) then ( - printf "\nAuto-configuration failed. Starting a shell.\n\n"; - printf "Please configure the network from this shell.\n\n"; - printf "When you have finished, exit the shell with ^D or exit.\n\n"; + print_endline (s_ "\nAuto-configuration failed. Starting a shell.\n\nPlease configure the network from this shell.\n\nWhen you have finished, exit the shell with ^D or exit.\n"); shell () ); @@ -1253,7 +1294,7 @@ let rec main ttyname = sh ("umount -l /mnt/root"); | QEMUUserNet -> - printf "Trying QEMU network configuration.\n\n%!"; + print_endline (s_ "Trying QEMU network configuration.\n"); qemu_network () | NoNetwork -> (* this is easy ... *) () @@ -1267,30 +1308,31 @@ let rec main ttyname = | Some c -> c | None -> (* Query the user for SSH configuration. *) - open_centered_window ~stage:"SSH configuration" - 60 20 "SSH configuration"; + open_centered_window ~stage:(s_ "SSH configuration") + 60 20 (s_ "SSH configuration"); - let label1 = Newt.label 1 1 "Remote host" in + let label1 = Newt.label 1 1 (s_ "Remote host") in let host = Newt.entry 20 1 None 36 [] in - let label2 = Newt.label 1 2 "Remote port" in + let label2 = Newt.label 1 2 (s_ "Remote port") in let port = Newt.entry 20 2 (Some "22") 6 [] in - let label3 = Newt.label 1 3 "Remote directory" in + let label3 = Newt.label 1 3 (s_ "Remote directory") in let dir = Newt.entry 20 3 (Some "/var/lib/xen/images") 36 [] in - let label4 = Newt.label 1 4 "SSH username" in + let label4 = Newt.label 1 4 (s_ "SSH username") in let user = Newt.entry 20 4 (Some "root") 16 [] in (* There's no sensible way to support this for SSH: - let label5 = Newt.label 1 5 "SSH password" in + let label5 = Newt.label 1 5 (s_ "SSH password") in let pass = Newt.entry 20 5 None 16 [Newt.PASSWORD] in *) let compr = - Newt.checkbox 16 7 "Use SSH compression (not good for LANs)" + Newt.checkbox 16 7 (s_ "Use SSH compression (not good for LANs)") ' ' None in - let check = Newt.checkbox 16 9 "Test SSH connection" '*' None in + let check = + Newt.checkbox 16 9 (s_ "Test SSH connection") '*' None in - let ok = Newt.button 48 16 " OK " in + let ok = Newt.button 48 16 ok_button in let form = Newt.form None None [] in Newt.form_add_components form [label1;label2;label3;label4; @@ -1324,7 +1366,7 @@ let rec main ttyname = (* If asked, check the SSH connection. *) if config_ssh.ssh_check then if not (test_ssh config_ssh) then - failwith "SSH configuration failed"; + failwith (s_ "SSH configuration failed"); (* Devices and root partition and target configuration selection stage. *) let config_devices_to_send, config_root_filesystem, config_target = @@ -1342,8 +1384,9 @@ let rec main ttyname = (label, dev, true) ) all_block_devices in - select_multiple ~stage:"Block devices" ~force_one:true 60 - "Select block devices to send" + select_multiple ~stage:(s_ "Block devices") + ~force_one:true 60 + (s_ "Select block devices to send") items in let config_root_filesystem = @@ -1358,25 +1401,25 @@ let rec main ttyname = (label, part) ) all_partitions in - select_single ~stage:"Root filesystem" 60 - "Select root filesystem" + select_single ~stage:(s_ "Root filesystem") 60 + (s_ "Select root filesystem") items in let config_target = match !config_target with | Some t -> t | None -> - open_centered_window ~stage:"Target system" 40 20 - "Configure target system"; + open_centered_window ~stage:(s_ "Target system") 40 20 + (s_ "Configure target system"); - let hvlabel = Newt.label 1 1 "Hypervisor:" in + let hvlabel = Newt.label 1 1 (s_ "Hypervisor:") in let hvlistbox = Newt.listbox 16 1 4 [Newt.SCROLL] in Newt.listbox_append_entry hvlistbox "Xen" (Some Xen); Newt.listbox_append_entry hvlistbox "QEMU" (Some QEMU); Newt.listbox_append_entry hvlistbox "KVM" (Some KVM); Newt.listbox_append_entry hvlistbox "Other" None; - let archlabel = Newt.label 1 5 "Architecture:" in + let archlabel = Newt.label 1 5 (s_ "Architecture:") in let archlistbox = Newt.listbox 16 5 4 [Newt.SCROLL] in Newt.listbox_append_entry archlistbox "i386" I386; Newt.listbox_append_entry archlistbox @@ -1400,20 +1443,21 @@ let rec main ttyname = with Not_found -> ()); - let memlabel = Newt.label 1 9 "Memory (MB):" in + let memlabel = Newt.label 1 9 (s_ "Memory (MB):") in let mementry = Newt.entry 16 9 (Some (string_of_int system_memory)) 8 [] in - let cpulabel = Newt.label 1 10 "CPUs:" in + let cpulabel = Newt.label 1 10 (s_ "CPUs:") in let cpuentry = Newt.entry 16 10 (Some (string_of_int system_nr_cpus)) 4 [] in - let maclabel = Newt.label 1 11 "MAC addr:" in + let maclabel = Newt.label 1 11 (s_ "MAC addr:") in let macentry = Newt.entry 16 11 None 20 [] in - let maclabel2 = Newt.label 1 12 "(leave MAC blank for random)" in + let maclabel2 = + Newt.label 1 12 (s_ "(leave MAC blank for random)") in let libvirtd = - Newt.checkbox 12 14 "Use remote libvirtd" '*' None in + Newt.checkbox 12 14 (s_ "Use remote libvirtd") '*' None in - let ok = Newt.button 28 16 " OK " in + let ok = Newt.button 28 16 ok_button in let form = Newt.form None None [] in Newt.form_add_components form @@ -1489,7 +1533,7 @@ let rec main ttyname = config_ssh.ssh_host config_ssh.ssh_port path in eprintf "capabilities URI = %S\n%!" name; - printf "Try to fetch remote hypervisor capabilities ...\n\n%!"; + print_endline (s_ "Try to fetch remote hypervisor capabilities ...\n"); let conn = Libvirt.Connect.connect_readonly ~name () in let caps = Libvirt.Connect.get_capabilities conn in @@ -1535,14 +1579,14 @@ let rec main ttyname = *) let len = List.length guests in if len = 0 then ( - message_box "Warning" - (sprintf "Remote hypervisor claims not to support fully virtualized %s guests.\n\nContinuing anyway.\n\n%!" arch_str); + message_box (s_ "Warning") + (sprintf (f_ "Remote hypervisor claims not to support fully virtualized %s guests.\n\nContinuing anyway.\n\n%!") arch_str); raise Not_found ); if len > 1 then ( - message_box "Note" - (sprintf "Remote hypervisor supports multiple types of fully virtualized %s guests.\n\nPlease help further development of libvirt and virt-p2v by sending the file /tmp/virt-p2v.log back to the developers. See the main virt-p2v website for contact details." arch_str) + message_box (s_ "Note") + (sprintf (f_ "Remote hypervisor supports multiple types of fully virtualized %s guests.\n\nPlease help further development of libvirt and virt-p2v by sending the file /tmp/virt-p2v.log back to the developers. See the main virt-p2v website for contact details.") arch_str) ); let guest = List.hd guests in @@ -1583,6 +1627,8 @@ let rec main ttyname = *) if test_dialog_stages then exit 1; + print_endline (s_ "Performing LVM snapshots ...\n"); + (* Switch LVM config. *) sh "vgchange -a n"; putenv "LVM_SYSTEM_DIR" "/etc/lvm.new"; (* see lvm(8) *) @@ -1783,7 +1829,7 @@ let rec main ttyname = match config_target.tgt_hypervisor with | Some Xen | None -> "" | Some QEMU | Some KVM -> " -c qemu:///system" in - let xml = sprintf "\ + let xml = sprintf (f_ "\ \n\n" program_name conn_arg conf_filename conn_arg hostname +-->\n\n") program_name conn_arg conf_filename conn_arg hostname ^ xml ^ "\n" in let xml_len = String.length xml in eprintf "length of configuration file is %d bytes\n%!" xml_len; - printf "\nWriting configuration file ...\n\n%!"; + print_endline (s_ "\nWriting configuration file ...\n"); let (sock,_) as conn = ssh_start_upload config_ssh conf_filename in (* In OCaml this actually loops calling write(2) *) @@ -1821,8 +1867,9 @@ let rec main ttyname = try List.assoc origin_dev all_block_devices with Not_found -> assert false (* internal error *) in - printf "\nSending /dev/%s (%.3f GB) to remote machine\n\n%!" origin_dev - ((Int64.to_float size) /. (1024.*.1024.*.1024.)); + let () = + printf (f_ "\nSending /dev/%s (%.3f GB) to remote machine\n\n%!") + origin_dev ((Int64.to_float size) /. (1024.*.1024.*.1024.)) in (* Open the snapshot device. *) let fd = openfile ("/dev/mapper/" ^ snapshot_dev) [O_RDONLY] 0 in @@ -1857,9 +1904,10 @@ let rec main ttyname = let remaining = 1. -. elapsed in let secs_remaining = (remaining /. elapsed) *. secs_elapsed in if secs_remaining > 120. then - printf " (about %.0f minutes remaining)" (secs_remaining/.60.) + printf (f_ " (about %.0f minutes remaining)") + (secs_remaining/.60.) else - printf " (about %.0f seconds remaining)" + printf (f_ " (about %.0f seconds remaining)") secs_remaining ); printf " \r%!"; @@ -1882,8 +1930,8 @@ let rec main ttyname = (* Clean up and reboot. *) ignore ( - message_box (sprintf "%s completed" program_name) - (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\ncd %s\nvirsh define %s\n\nWhen you press [OK] this machine will reboot." + message_box (sprintf (f_ "%s has finished") program_name) + (sprintf (f_ "\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\ncd %s\nvirsh define %s\n\nWhen you press [OK] this machine will reboot.") config_ssh.ssh_directory conf_filename) ); @@ -1895,7 +1943,7 @@ let rec main ttyname = (*----------------------------------------------------------------------*) let usage () = - eprintf "usage: virt-p2v [--test] [ttyname]\n%!"; + let () = eprintf (f_ "usage: virt-p2v [--test] [ttyname]\n%!") in exit 2 (* Make sure that exceptions from 'main' get printed out on stdout