~$
\.orig$
+\.iso$
+\.img$
+^virt-p2v-.*\.tar\.gz$
+^livecd\.ks$
+^livecd-test\.ks$
+^livecd-post\.sh$
MANIFEST
README
README.developers
+virt-p2v.ml
virt-p2v.sh
virt-p2v-unpack
# General configuration
PACKAGE := virt-p2v
-VERSION := 0.7
+VERSION := 0.8
# i386 images also work on x86-64, so best to stick with i386.
ARCH := i386
+# Base repository.
+BASE := 8
+BASEURL := http://download.fedora.redhat.com/pub/fedora/linux/releases/$(BASE)/Everything/$(ARCH)/os/
+
LANG := en_US.UTF-8
KEYBOARD := us
TIMEZONE := US/Eastern
-BASEREPO := http://download.fedora.redhat.com/pub/fedora/linux/releases/8/Fedora/$(ARCH)/os/
-
# Select a suitable HTTP proxy.
# The default assumes a local squid proxy.
-#export http_proxy := http://127.0.0.1:3128/
-#export ftp_proxy := http://127.0.0.1:3128/
+export http_proxy := http://127.0.0.1:3128/
+export ftp_proxy := http://127.0.0.1:3128/
LABEL := $(PACKAGE)-$(VERSION)
+ISO := $(LABEL).iso
+
#----------------------------------------------------------------------
all:
@echo "make build Build the live CD ISO"
@echo "make boot [HDA=hda.img] [HDB=hdb.img] [ISO=livecd.iso]"
- @echo " Boot built/named ISO (uses qemu)"
+ @echo " Boot built/named ISO (uses qemu)"
+ @echo "make update Update an existing live CD ISO with new"
+ @echo " virt-p2v script, without doing full rebuild"
# Build live CD.
-build: checkroot livecd.ks
- rm -f $(LABEL).iso
+build: checkroot checkscript livecd.ks
+ rm -f $(ISO)
livecd-creator --config=livecd.ks --fslabel=$(LABEL)
ls -lhtr *.iso
livecd.ks: livecd.ks.in livecd-post.sh Makefile
rm -f $@
sed \
- -e 's|@BASEREPO@|$(BASEREPO)|g' \
+ -e 's|@ARCH@|$(ARCH)|g' \
+ -e 's|@BASE@|$(BASE)|g' \
+ -e 's|@BASEURL@|$(BASEURL)|g' \
-e 's|@LANG@|$(LANG)|g' \
-e 's|@KEYBOARD@|$(KEYBOARD)|g' \
-e 's|@TIMEZONE@|$(TIMEZONE)|g' \
< $< | cat - livecd-post.sh > $@
-livecd-post.sh: livecd-post.sh.in virt-p2v.sh inittab lvm.conf Makefile
+livecd-post.sh: livecd-post.sh.in virt-p2v.ml inittab lvm.conf Makefile
rm -f $@
sed \
- -e '/@VIRT-P2V.SH@/ r virt-p2v.sh' \
- -e '/@VIRT-P2V.SH@/ d' \
+ -e '/@VIRT-P2V.ML@/ r virt-p2v.ml' \
+ -e '/@VIRT-P2V.ML@/ d' \
-e '/@INITTAB@/ r inittab' \
-e '/@INITTAB@/ d' \
-e '/@LVM.CONF@/ r lvm.conf' \
# Run live CD under qemu.
QEMU := qemu
-ISO := $(LABEL).iso
HDA :=
HDB :=
boot:
$(QEMU) $(QEMU_ARGS)
-# Standard rules.
+# Update an existing ISO.
+
+update: checkroot
+ -./update-iso.ml delete $(ISO)
+ ./update-iso.ml add $(ISO) virt-p2v.ml
+
+# Check that we are root.
checkroot:
@if [ `id -u` -ne 0 ]; then \
exit 1; \
fi
+# Check that the script compiles.
+
+checkscript:
+ ./virt-p2v.ml --test
+
+# Clean.
+
clean:
rm -f *~ core livecd.ks livecd-post.sh
This is installed on the live CD as /etc/init.d/p2v, and it causes the
live CD to boot into the P2V configuration tool (see next).
-virt-p2v.sh
+virt-p2v.ml
- This is the virt-p2v.sh P2V configuration tool itself. It is
- installed on the live CD as /usr/bin/virt-p2v.sh and runs after the
+ This is the virt-p2v.ml P2V configuration tool itself. It is
+ installed on the live CD as /usr/bin/virt-p2v.ml and runs after the
live CD has booted. All the P2V stuff happens from this script. It
uses the 'dialog' program to ask questions.
For (b) we can simply use 'dd' and 'ssh'. The general plan is to do
this:
- dd if=/dev/disk | gzip | ssh xenhost 'zcat > /var/lib/xen/images/disk.img'
+ dd if=/dev/disk | ssh -C xenhost 'cat > /var/lib/xen/images/disk.img'
If the user doesn't have sshd installed on the Xen host, then they can
also opt for a pure TCP transport:
- dd if=/dev/disk | gzip | nc xenhost port
+ dd if=/dev/disk | nc xenhost port
and on the remote host they do:
nc -kl port > /var/lib/xen/images/disks
For (c) we can use device-mapper snapshots to mount a ramdisk above
the disks themselves. This allows us to make non-destructive changes
to files, and still see the "modified" block device (d). A hairy
-shell script looks for candidate files to modify.
+script looks for candidate files to modify.
Non-generic virt-p2v
----------------------------------------------------------------------
# If power was restored before the shutdown kicked in, cancel it.
pr:12345:powerokwait:/sbin/shutdown -c "Power Restored; Shutdown Cancelled"
-# Run virt-p2v.sh on tty1
-1:3:once:/usr/bin/virt-p2v.sh tty1
+# Run virt-p2v.ml on tty1
+1:3:once:/usr/bin/virt-p2v.ml --update tty1
# Run gettys but not on tty1 which is where virt-p2v runs.
2:2345:respawn:/sbin/mingetty tty2
#
# $Id$
-# This is the virt-p2v shell script.
+# This is the virt-p2v script.
-cat > /usr/bin/virt-p2v.sh << '__EOF1234__'
-@VIRT-P2V.SH@
+cat > /usr/bin/virt-p2v.ml << '__EOF1234__'
+@VIRT-P2V.ML@
__EOF1234__
-chmod 0755 /usr/bin/virt-p2v.sh
-/sbin/restorecon /usr/bin/virt-p2v.sh
+chmod 0755 /usr/bin/virt-p2v.ml
+/sbin/restorecon /usr/bin/virt-p2v.ml
# Install custom inittab.
cat > /etc/inittab << '__EOF4123__'
@INITTAB@
__EOF4123__
-# Install custom lvm.conf.new (the shell script will rename to
-# lvm.conf when the time comes).
-cat > /etc/lvm/lvm.conf.new << '__EOF4312__'
+# Install custom lvm.conf. The script selects this by adjusting
+# $LVM_SYSTEM_DIR environment variable at the right time.
+cp -a /etc/lvm /etc/lvm.new
+cat > /etc/lvm.new/lvm.conf << '__EOF4312__'
@LVM.CONF@
__EOF4312__
selinux --enforcing
firewall --disabled
-repo --name=a-dev --baseurl=@BASEREPO@
+repo --name=released --baseurl=@BASEURL@
+#repo --name=released --mirrorlist=http://mirrors.fedoraproject.org/mirrorlist?repo=fedora-@BASE@&arch=@ARCH@
%packages
bash
gawk
findutils
+# For OCaml
+ocaml
+ocaml-runtime
+ocaml-pcre
+ocaml-extlib
+ocaml-libvirt
+
# For network configuration
dhclient
--- /dev/null
+#!/usr/bin/ocamlrun /usr/bin/ocaml
+#load "unix.cma";;
+
+(* update-iso.ml attaches an updated 'virt-p2v.ml' file to the end of
+ * an ISO image. This is just for quick developer builds because it
+ * takes ages to rebuild a full ISO.
+ *
+ * Copyright (C) 2007-2008 Red Hat Inc.
+ * Written by Richard W.M. Jones <rjones@redhat.com>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *)
+
+open Printf
+open Unix
+
+(* CD-ROM format has 2048 byte "sectors" and the final ISO image
+ * must be a multiple of 2048 bytes in size.
+ *
+ * The basic plan is that we will use store the file followed by a
+ * trailer, all rounded up to 2048 bytes:
+ *
+ * +------ - - - - - - - -----+------------+----------------+
+ * | file | padding | trailer |
+ * | | | magic | .... |
+ * +------ - - - - - - - -----+------------+----------------+
+ * |<---- total size is a multiple of 2048 bytes ---->|
+ *
+ * The magic string is used to identify that there is an
+ * attachment, and is followed by a few extra fields which
+ * identify the file start and true file size. (Note the
+ * original filename is not stored because it is not needed).
+ *
+ * Attachments can be stacked. This script only deals with the
+ * top-most attachment (ie. the one at the very end of the file).
+ * If you want to attach lots of files, a better way is to
+ * stuff them into a tarball or ZIP file and attach that.
+ *)
+
+let magic = "ISOATTACHMENT002"
+let magiclen = String.length magic (* = 16 bytes *)
+let trailerlen = magiclen + 8 + 8 (* magic + file start + true size *)
+
+(* Ugh, would be really nice to have 64 bit pack/unpack functions
+ * in the stdlib, instead of this ugliness ...
+ *)
+let string_of_int64 i =
+ let str = String.create 8 in
+ let shift_mask i shift =
+ Char.chr (Int64.to_int (Int64.shift_right_logical i shift) land 0xff)
+ in
+ str.[0] <- shift_mask i 56; str.[1] <- shift_mask i 48;
+ str.[2] <- shift_mask i 40; str.[3] <- shift_mask i 32;
+ str.[4] <- shift_mask i 24; str.[5] <- shift_mask i 16;
+ str.[6] <- shift_mask i 8; str.[7] <- shift_mask i 0;
+ str
+let int64_of_string str =
+ let i = ref 0L in
+ let add offs shift =
+ i :=
+ Int64.logor
+ (Int64.shift_left (Int64.of_int (Char.code str.[offs])) shift) !i
+ in
+ add 0 56; add 1 48; add 2 40; add 3 32;
+ add 4 24; add 5 16; add 6 8; add 7 0;
+ !i
+
+let rec main () =
+ let args = Array.to_list Sys.argv in
+ match args with
+ | [ _; "add"; isoname; attachment ] -> (* add an attachment *)
+ do_add isoname attachment
+ | [ _; "delete"; isoname ] -> (* delete any attachment *)
+ do_delete isoname
+ | [ _; "get"; isoname; output ] -> (* get attachment *)
+ do_get isoname output
+ | [ _; "has"; isoname ] -> (* is there an attachment? *)
+ do_has isoname
+ | _ ->
+ eprintf "\
+update-iso.ml add foo.iso file
+ Attach 'file' to 'foo.iso'.
+
+update-iso.ml delete foo.iso
+ Remove attachment (if any) from 'foo.iso'.
+
+update-iso.ml get foo.iso file
+ Get attachment from 'foo.iso' and save it as 'file'.
+
+update-iso.ml has foo.iso
+ Exit with 0 (true) if there is an attachment.
+ Exit with 1 (false) if there is no attachment.
+ Exit with 2 if there was some other error, eg. file not found.
+
+Note that attachments are stacked, so you can add more than one
+attachment. In this case 'get' operation returns the most recently
+added and 'delete' operation deletes only the most recently added.
+";
+ exit 1
+
+and do_has isoname =
+ let fd =
+ try openfile isoname [O_RDONLY] 0
+ with Unix_error (err, syscall, param) ->
+ eprintf "%s:%s: %s\n" syscall param (error_message err);
+ exit 2 in
+ try
+ ignore (LargeFile.lseek fd (Int64.of_int ~-trailerlen) SEEK_END);
+ let buf = String.create magiclen in
+ if read fd buf 0 magiclen <> magiclen then exit 1;
+ if buf <> magic then exit 1;
+ exit 0
+ with
+ Unix_error (err, syscall, param) ->
+ eprintf "%s:%s: %s\n" syscall param (error_message err);
+ exit 1
+
+and do_add isoname attachment =
+ let fd = openfile isoname [O_APPEND; O_WRONLY] 0 in
+
+ let iso_size = (LargeFile.fstat fd).LargeFile.st_size in
+ if Int64.logand iso_size 2047L <> 0L then
+ failwith "ISO image is not a multiple of 2048 bytes in size";
+
+ (* Copy the attachment itself to the end of the file. *)
+ let fd2 = openfile attachment [O_RDONLY] 0 in
+ let bufsize = 4 * 1024 in
+ let buffer = String.create bufsize in
+ let rec copy size =
+ let n = read fd2 buffer 0 bufsize in
+ if n > 0 then (
+ ignore (write fd buffer 0 n);
+ copy (size + n)
+ )
+ else size
+ in
+ let file_size = copy 0 in
+ close fd2;
+
+ (* How much padding to use so that file_size + trailer + padding
+ * = 2048 bytes multiple?
+ *)
+ let padding_size =
+ let size = file_size + trailerlen in
+ let over = size land 2047 in
+ if over > 0 then 2048-over else 0 in
+ assert ((padding_size + file_size + trailerlen) land 2047 = 0);
+
+ (* Write the padding. *)
+ ignore (write fd (String.make padding_size 'x') 0 padding_size);
+
+ (* Write the magic. *)
+ ignore (write fd magic 0 magiclen);
+
+ (* Write the file start and true size. *)
+ let buffer = string_of_int64 iso_size in
+ ignore (write fd buffer 0 8);
+ let buffer = string_of_int64 (Int64.of_int file_size) in
+ ignore (write fd buffer 0 8);
+
+ close fd
+
+and do_delete isoname =
+ let fd = openfile isoname [O_RDWR] 0 in
+ ignore (LargeFile.lseek fd (Int64.of_int ~-trailerlen) SEEK_END);
+ let buf = String.create magiclen in
+ if read fd buf 0 magiclen <> magiclen || buf <> magic then
+ failwith "no attachment found";
+
+ (* Read the start offset of the file. *)
+ let buf = String.create 8 in
+ if read fd buf 0 8 <> 8 then
+ failwith "cannot read attachment size";
+ let offset = int64_of_string buf in
+
+ (* Truncate to start of the file. *)
+ LargeFile.ftruncate fd offset;
+
+ close fd
+
+and do_get isoname output =
+ let fd = openfile isoname [O_RDONLY] 0 in
+ ignore (LargeFile.lseek fd (Int64.of_int ~-trailerlen) SEEK_END);
+ let buf = String.create magiclen in
+ if read fd buf 0 magiclen <> magiclen || buf <> magic then
+ failwith "no attachment found";
+
+ (* Read the start and size. *)
+ let buf = String.create 8 in
+ if read fd buf 0 8 <> 8 then
+ failwith "cannot read attachment offset";
+ let offset = int64_of_string buf in
+ let buf = String.create 8 in
+ if read fd buf 0 8 <> 8 then
+ failwith "cannot read attachment size";
+ let size = Int64.to_int (int64_of_string buf) in
+
+ (* Seek to beginning of the attachment. *)
+ ignore (LargeFile.lseek fd offset SEEK_SET);
+
+ (* Copy out the attachment. *)
+ let fd2 = openfile output [O_WRONLY; O_CREAT; O_TRUNC] 0o644 in
+ let bufsize = 4 * 1024 in
+ let buffer = String.create bufsize in
+ let rec copy remaining =
+ if remaining > 0 then (
+ let n = min remaining bufsize in
+ let n = read fd buffer 0 n in
+ if n = 0 then failwith "corrupted or partial attachment";
+ ignore (write fd2 buffer 0 n);
+ copy (remaining - n)
+ )
+ in
+ copy size;
+ close fd2;
+
+ close fd
+
+let () = main ()
use Getopt::Long;
use Pod::Usage;
+XXX This needs a rewrite
+
my $outputdir = ".";
my $force = 0;
my $noninteractive = 0;
ignore (Sys.command cmd)
let shwithstatus cmd =
- eprintf "shfailok: %s\n%!" cmd;
+ eprintf "shwithstatus: %s\n%!" cmd;
Sys.command cmd
(* Same as `cmd` in shell. Any error message will be in the logfile. *)
function
| [vg; lv; pvs; lvsize]
| [_; vg; lv; pvs; lvsize] ->
- let pvs = String.nsplit "," pvs in
- let pvs = List.map (
+ let pvs = String.nsplit pvs "," in
+ let pvs = List.filter_map (
fun pv ->
try
let subs = Pcre.exec ~rex:devname pv in
- Pcre.get_substring subs 1
+ Some (Pcre.get_substring subs 1)
with
- Not_found -> failwith ("lvs: unexpected device name: " ^ pv)
+ Not_found ->
+ eprintf "lvs: unexpected device name: %s\n%!" pv;
+ None
) pvs in
LV (vg, lv), pvs, lvsize
| line ->
chdir "/tmp";
(* Try to ping the remote host to see if this worked. *)
- sh ("ping -c 3 " ^ Option.map_default quote "" state.remote_host);
+ shfailok ("ping -c 3 " ^ Option.map_default quote "" state.remote_host);
if state.greeting then (
printf "\n\nDid automatic network configuration work?\n";
* future, lots of complex possibilities.
*)
let remote_of_origin_dev =
- let devsd = Pcre.regexp "^sd([[:alpha:]]+[[:digit:]]+)$" in
+ let devsd = Pcre.regexp "^sd([[:alpha:]]+[[:digit:]]*)$" in
let devsd_subst = Pcre.subst "hd$1" in
fun dev ->
Pcre.replace ~rex:devsd ~itempl:devsd_subst dev
dup2 fd stdin;
dup2 fd stdout;
close fd);
+ printf "virt-p2v.ml starting up ...\n%!";
(* 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".
(* Dialogs. *)
let ask_greeting state =
- 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);
+ ignore (msgbox "virt-p2v" "\nUPDATED! Welcome 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);
Next state
in
match
radiolist "Connection type" ~backbutton:false
"Connection type. If possible, select 'server' and run P2V server on the remote host"
- 10 50 2 [
+ 11 50 3 [
"server", "P2V server on remote host",
state.transport = Some Server;
"ssh", "SSH (secure shell)",
eprintf "finished dialog loop\nfinal state = %s\n%!" (string_of_state state);
(* Check that the environment is a sane-looking live CD. If not, bail. *)
- if is_dir "/mnt/root" <> Some true ||
- is_file "/etc/lvm/lvm.conf.new" <> Some true then
+ if is_dir "/mnt/root" <> Some true then
fail_dialog "You should only run this script from the live CD or a USB key.";
(* Switch LVM config. *)
sh "vgchange -a n";
- sh "mv /etc/lvm/lvm.conf /etc/lvm/lvm.conf.old";
- sh "mv /etc/lvm/lvm.conf.new /etc/lvm/lvm.conf";
+ putenv "LVM_SYSTEM_DIR" "/etc/lvm.new"; (* see lvm(8) *)
sh "rm -f /etc/lvm/cache/.cache";
+ sh "rm -f /etc/lvm.new/cache/.cache";
(* Snapshot the block devices to send. *)
let devices_to_send = Option.get state.devices_to_send in
sh ("mount " ^ quote ("/dev/mapper/" ^ snapshot_dev) ^ " /mnt/root")
| LV (vg, lv) ->
- (* The LV will be backed by a snapshot device, so just mount directly. *)
+ (* The LV will be backed by a snapshot device, so just mount
+ * directly.
+ *)
sh ("mount " ^ quote ("/dev/" ^ vg ^ "/" ^ lv) ^ " /mnt/root")
);
| 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";
+ printf "When you have finished, exit the shell with ^D or exit.\n\n%!";
shell ()
| Auto ->
- printf "Trying network auto-configuration from root filesystem ...\n\n";
+ printf
+ "Trying network auto-configuration from root filesystem ...\n\n%!";
if not (auto_network state) then (
printf "\nAuto-configuration failed. Starting a shell.\n\n";
printf "Please configure the network from this shell.\n\n";
(origin_dev, snapshot_dev, remote_dev)
) devices_to_send in
+ (* Modify files on the root filesystem. *)
rewrite_fstab state devices_to_send;
(* XXX Other files to rewrite? *)
sh "umount /mnt/root";
sh "sync"; (* Ugh, should be in stdlib. *)
+ (* Disable screen blanking on console. *)
+ sh "setterm -blank 0";
+
(* For Server and TCP type connections, we connect just once. *)
let remote_host = Option.get state.remote_host in
let remote_port = Option.get state.remote_port in
fd, chan in
(* Copy the data. *)
- let bufsize = 128 * 1024 in
+ let bufsize = 1024 * 1024 in
let buffer = String.create bufsize in
+ let start = gettimeofday () in
- let rec copy () =
+ 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);
- copy ()
+
+ 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 (
+ let elapsed = Int64.to_float bytes_sent /. Int64.to_float size in
+ let secs_elapsed = now -. start in
+ printf "%.0f%%" (100. *. elapsed);
+ (* 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.)
+ else
+ printf " (about %.0f seconds remaining) "
+ secs_remaining
+ );
+ printf "\r%!";
+ now
+ )
+ else last_printed_at in
+
+ copy bytes_sent last_printed_at
)
in
- copy ();
+ copy 0L start;
(* For SSH disconnect, for Server/TCP send a newline. *)
match transport with
try f arg
with exn -> print_endline (Printexc.to_string exn); raise exn
+(* If the ISO image has an attachment then it could be a new version
+ * of virt-p2v.ml (this script). Get the attachment and run it
+ * instead. Useful mainly for testing, in conjunction with the
+ * 'make update' target in the virt-p2v Makefile.
+ *)
+let magic = "ISOATTACHMENT002"
+let magiclen = String.length magic (* = 16 bytes *)
+let trailerlen = magiclen + 8 + 8 (* magic + file start + true size *)
+
+let int64_of_string str =
+ let i = ref 0L in
+ let add offs shift =
+ i :=
+ Int64.logor
+ (Int64.shift_left (Int64.of_int (Char.code str.[offs])) shift) !i
+ in
+ add 0 56; add 1 48; add 2 40; add 3 32;
+ add 4 24; add 5 16; add 6 8; add 7 0;
+ !i
+
+let update ttyname =
+ let cdrom = "/dev/cdrom" in
+ let output = "/tmp/virt-p2v.ml" in
+
+ try
+ let fd = openfile cdrom [O_RDONLY] 0 in
+ ignore (LargeFile.lseek fd (Int64.of_int ~-trailerlen) SEEK_END);
+ let buf = String.create magiclen in
+ if read fd buf 0 magiclen <> magiclen || buf <> magic then (
+ close fd;
+ raise Exit
+ );
+
+ (* Read the size. *)
+ let buf = String.create 8 in
+ if read fd buf 0 8 <> 8 then
+ failwith "cannot read attachment offset";
+ let offset = int64_of_string buf in
+ let buf = String.create 8 in
+ if read fd buf 0 8 <> 8 then
+ failwith "cannot read attachment size";
+ let size = Int64.to_int (int64_of_string buf) in
+
+ (* Seek to beginning of the attachment. *)
+ ignore (LargeFile.lseek fd offset SEEK_SET);
+
+ (* Copy out the attachment. *)
+ let fd2 = openfile output [O_WRONLY; O_CREAT; O_TRUNC] 0o755 in
+ let bufsize = 4 * 1024 in
+ let buffer = String.create bufsize in
+ let rec copy remaining =
+ if remaining > 0 then (
+ let n = min remaining bufsize in
+ let n = read fd buffer 0 n in
+ if n = 0 then failwith "corrupted or partial attachment";
+ ignore (write fd2 buffer 0 n);
+ copy (remaining - n)
+ )
+ in
+ copy size;
+ close fd2;
+
+ close fd;
+
+ (* Run updated virt-p2v script. *)
+ execv output [| output; ttyname |]
+ with
+ Unix_error _ | Exit ->
+ (* Some error, or no attachment, so keep running this script. *)
+ handle_exn main (Some ttyname)
+
(* Test harness for the Makefile. The Makefile invokes this script as
* 'virt-p2v.ml --test' just to check it compiles. When it is running
* from the actual live CD, there is a single parameter which is the
let () =
match Array.to_list Sys.argv with
| [ _; "--test" ] -> () (* Makefile test - do nothing. *)
+ | [ _; "--update"; ttyname ] -> (* Test for update and run. *)
+ update ttyname
| [ _; ("--help"|"-help"|"-?"|"-h") ] -> usage ();
- | [ _; ttyname ] ->
- handle_exn main (Some ttyname) (* Run main with ttyname. *)
- | [ _ ] ->
- handle_exn main None (* Interactive - no ttyname. *)
+ | [ _; ttyname ] -> (* Run main with ttyname. *)
+ handle_exn main (Some ttyname)
+ | [ _ ] -> (* Interactive - no ttyname. *)
+ handle_exn main None
| _ -> usage ()
+
+(* This file must end with a newline *)