architecture : architecture option;
memory : int option; vcpus : int option;
mac_address : string option;
+ compression : bool option;
}
and network = Auto
| Shell
memory = None;
vcpus = None;
mac_address = None;
+ compression = None;
}
(* END OF CUSTOM virt-p2v SCRIPT SECTION. *)
(*----------------------------------------------------------------------*)
in
(* Handle the common parameters. Note Continuation Passing Style. *)
- let with_common cont ?(cancel=false) ?(backbutton=true) title =
+ let with_common cont
+ ?(cancel=false)
+ ?(backbutton=true) ?(backbutton_label="Back")
+ title =
let params = ["--title"; title] in
let params = if not cancel then "--nocancel" :: params else params in
let params =
- if backbutton then "--extra-button" :: "--extra-label" :: "Back" :: params
+ if backbutton then
+ "--extra-button" :: "--extra-label" :: backbutton_label :: params
else params in
cont params
in
(* Fedora gives an error if this file doesn't exist. *)
sh "touch /etc/resolv.conf";
-(*
- (* We can run /mnt/root/etc/init.d/network in a chroot environment,
- * however this won't work directly because the architecture of the
- * binaries under /mnt/root (eg. /mnt/root/sbin/ip) might not match
- * the architecture of the live CD kernel. In particular, a 32 bit
- * live CD cannot run 64 bit binaries. So we also have to bind-mount
- * the live CD's /bin, /sbin, /lib etc. over the equivalents in
- * /mnt/root.
- *)
- let bind dir =
- if is_dir dir = Some true then
- sh ("mount -o bind " ^ quote dir ^ " " ^ quote ("/mnt/root" ^ dir))
- in
- let unbind dir =
- if is_dir dir = Some true then sh ("umount -l " ^ quote ("/mnt/root" ^ dir))
- in
- let dirs = [
- "/bin"; "/sbin"; "/lib"; "/lib64";
- "/usr/bin"; "/usr/sbin"; "/usr/lib"; "/usr/lib64";
- "/proc"; "/sys"
- ] in
- List.iter bind dirs;
- let status = shwithstatus "chroot /mnt/root /etc/init.d/network start" in
- List.iter unbind dirs;
-*)
-
- (* Simpler way to do the above.
- * NB. Lazy unmount is required because dhclient keeps its current
+ (* NB. Lazy unmount is required because dhclient keeps its current
* directory open on /etc/sysconfig/network-scripts/
*)
sh "mount -o bind /mnt/root/etc /etc";
close_out chan
)
+let () = Random.self_init ()
+
+let random_mac_address () =
+ let random =
+ List.map (sprintf "%02x") (
+ List.map (fun _ -> Random.int 256) [0;0;0]
+ ) in
+ String.concat ":" ("00"::"16"::"3e"::random)
+
+let random_uuid =
+ let hex = "0123456789abcdef" in
+ fun () ->
+ let str = String.create 32 in
+ for i = 0 to 31 do str.[i] <- hex.[Random.int 16] done;
+ str
+
(* Main entry point. *)
let rec main ttyname =
(* Running from an init script. We don't have much of a
| Back -> Prev
in
+ let ask_compression state =
+ match
+ radiolist "Network compression" "Enable network compression" 10 50 2 [
+ "yes", "Yes, compress network traffic", state.compression <> Some false;
+ "no", "No, don't compress", state.compression = Some false
+ ]
+ with
+ | Yes ("no"::_) -> Next { state with compression = Some false }
+ | Yes _ -> Next { state with compression = Some true }
+ | No | Help | Error -> Ask_again
+ | Back -> Prev
+ in
+
let ask_verify state =
match
yesno "Verify and proceed"
Architecture: %s
Memory: %s
VCPUs: %s
-MAC address: %s"
+MAC address: %s
+Compression: %b"
(Option.default "" state.remote_host)
(Option.default "" state.remote_port)
(Option.default "" state.remote_directory)
| Some vcpus -> string_of_int vcpus | None -> "")
(match state.mac_address with
| Some "" -> "Random" | Some mac -> mac | None -> "")
+ (Option.default true state.compression)
)
21 50
with
ask_memory, defaults.memory <> None, dont_skip;
ask_vcpus, defaults.vcpus <> None, dont_skip;
ask_mac_address, defaults.mac_address <> None, dont_skip;
+ ask_compression, defaults.compression <> None, dont_skip;
ask_verify, not defaults.greeting, dont_skip;
|] in
(* Functions to connect and disconnect from the remote system. *)
let do_connect remote_name _ =
- let cmd = sprintf "ssh -C -l %s -p %s %s \"cat > %s/%s\""
+ let cmd = sprintf "ssh%s -l %s -p %s %s \"cat > %s/%s\""
+ (if state.compression = Some false then "" else " -C")
(quote remote_username) (quote remote_port) (quote remote_host)
(quote remote_directory) (quote remote_name) in
eprintf "connect: %s\n%!" cmd;
| Some n -> n in
let mac_address =
match state.mac_address with
- | Some "" | None ->
- let random =
- List.map (sprintf "%02x") (
- List.map (fun _ -> Random.int 256) [0;0;0]
- ) in
- String.concat ":" ("00"::"16"::"3e"::random)
+ | Some "" | None -> random_mac_address ()
| Some mac -> mac in
let xml =
(* Standard stuff for every domain. *)
let name = leaf "name" hostname in
+ let uuid = leaf "uuid" (random_uuid ()) in
+ let maxmem = leaf "maxmem" (string_of_int (memory * 1024)) in
let memory = leaf "memory" (string_of_int (memory * 1024)) in
let vcpu = leaf "vcpu" (string_of_int vcpus) in
| Some QEMU -> ["type", "qemu"]
| Some KVM -> ["type", "kvm"]
| None -> []),
- name :: memory :: vcpu :: extras @ [devices]
+ name :: uuid :: memory :: maxmem :: vcpu :: extras @ [devices]
) in
(* Convert XML configuration file to a string, then send it to the
let rec copy bytes_sent last_printed_at =
let n = read fd buffer 0 bufsize in
if n > 0 then (
- ignore (write sock buffer 0 n);
+ let n' = write sock buffer 0 n in
+ if n <> n' then assert false; (* never, according to the manual *)
let bytes_sent = Int64.add bytes_sent (Int64.of_int n) in
let last_printed_at =
let now = gettimeofday () in
- (* Print progress once per second. *)
- if now -. last_printed_at > 1. then (
+ (* Print progress every few seconds. *)
+ if now -. last_printed_at > 5. then (
let elapsed = Int64.to_float bytes_sent /. Int64.to_float size in
let secs_elapsed = now -. start in
- printf "%.0f%%" (100. *. elapsed);
+ printf "%.0f%% @ %.1f Mbps"
+ (100. *. elapsed)
+ (Int64.to_float bytes_sent/.secs_elapsed/.1_000_000. *. 8.);
(* After 60 seconds has elapsed, start printing estimates. *)
if secs_elapsed >= 60. then (
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 " (about %.0f minutes remaining)" (secs_remaining/.60.)
else
- printf " (about %.0f seconds remaining) "
+ printf " (about %.0f seconds remaining)"
secs_remaining
);
- printf "\r%!";
+ printf " \r%!";
now
)
else last_printed_at in
)
in
copy 0L start;
+ printf "\n\n%!"; (* because of the messages printed above *)
(* Disconnect. *)
do_disconnect conn
) devices_to_send;
+ (*printf "\n\nPress any key ...\n%!"; ignore (read_line ());*)
+
(* Clean up and reboot. *)
ignore (
msgbox "virt-p2v completed"
git.annexia.org / virt-p2v.git / blobdiff