| P2V (* physical to virtual *)
| V2V (* virtual to virtual *)
(*| V2P*) (* virtual to physical - not impl *)
+type block_device =
+ | HD of string (* eg. HD "a" for /dev/hda *)
+ | SD of string (* eg. SD "b" for /dev/sdb *)
+ | CCISS of int * int (* eg. CCISS (0,0) for /dev/cciss/c0d0*)
type partition =
- | Part of string * string (* eg. "hda", "1" *)
- | LV of string * string (* eg. "VolGroup00", "LogVol00" *)
+ | Part of block_device * string (* eg. (HD "a", "1")
+ or (CCISS (0,0), "p1") *)
+ | LV of string * string (* eg. ("VolGroup00", "LogVol00") *)
type network =
| Auto of partition (* Automatic network configuration. *)
| Shell (* Start a shell. *)
with
End_of_file -> List.rev !lines
-let dev_of_partition = function
- | Part (dev, partnum) -> sprintf "/dev/%s%s" dev partnum
- | LV (vg, lv) -> sprintf "/dev/%s/%s" vg lv
+(* eg. HD "a" => "hda", or CCISS (0,1) => "cciss/c0d1" *)
+let short_dev_of_block_device = function
+ | HD n -> sprintf "hd%s" n
+ | SD n -> sprintf "sd%s" n
+ | CCISS (c, d) -> sprintf "cciss/c%dd%d" c d
+
+(* Returns the full /dev/ path to a block device. *)
+let dev_of_block_device dev = "/dev/" ^ short_dev_of_block_device dev
+
+(* Returns path to partition or LV without /dev/,
+ * eg. "hda1" or "VolGroup/LogVol"
+ *)
+let short_dev_of_partition = function
+ | Part (dev, partnum) -> short_dev_of_block_device dev ^ partnum
+ | LV (vg, lv) -> sprintf "%s/%s" vg lv
+
+(* Returns the full /dev/ path to a partition or LV. *)
+let dev_of_partition part = "/dev/" ^ short_dev_of_partition part
+
+(* A PV is loosely defined here as either a device or a partition -
+ * basically anything that could be a PV.
+ *)
+type pv = PVDev of block_device | PVPart of partition
+
+let string_of_pv = function
+ | PVDev dev -> dev_of_block_device dev
+ | PVPart p -> dev_of_partition p
+
+(* Take a device name optionally beginning with /dev/ and work
+ * out if it looks like either a device or partition that we
+ * know how to deal with. If not, returns None.
+ *
+ * For the sake of simplifying some code later on, the device
+ * name may also be followed by "(\d+)" which is just ignored.
+ *)
+let pv_of_dev =
+ let hdp = Pcre.regexp "^/dev/hd([a-z]+)(\\d+)(\\(\\d+\\))?$" in
+ let hd = Pcre.regexp "^/dev/hd([a-z]+)(\\(\\d\\))?$" in
+ let sdp = Pcre.regexp "^/dev/sd([a-z]+)(\\d+)(\\(\\d+\\))?$" in
+ let sd = Pcre.regexp "^/dev/sd([a-z]+)(\\(\\d+\\))?$" in
+ let ccissp = Pcre.regexp "^/dev/cciss/c(\\d+)d(\\d+)(p\\d+)(\\(\\d+\\))?$" in
+ let cciss = Pcre.regexp "^/dev/cciss/c(\\d+)d(\\d+)(\\(\\d+\\))?$" in
+ let lv = Pcre.regexp "^/dev/(\\w+)/(\\w+)$" in
+
+ fun name ->
+ try
+ let subs = Pcre.exec ~rex:hdp name in
+ Some (PVPart (Part (HD (Pcre.get_substring subs 1),
+ Pcre.get_substring subs 2)))
+ with Not_found ->
+ try
+ let subs = Pcre.exec ~rex:hd name in
+ Some (PVDev (HD (Pcre.get_substring subs 1)))
+ with Not_found ->
+ try
+ let subs = Pcre.exec ~rex:sdp name in
+ Some (PVPart (Part (SD (Pcre.get_substring subs 1),
+ Pcre.get_substring subs 2)))
+ with Not_found ->
+ try
+ let subs = Pcre.exec ~rex:sd name in
+ Some (PVDev (SD (Pcre.get_substring subs 1)))
+ with Not_found ->
+ try
+ let subs = Pcre.exec ~rex:ccissp name in
+ let c = int_of_string (Pcre.get_substring subs 1) in
+ let d = int_of_string (Pcre.get_substring subs 2) in
+ Some (PVPart (Part (CCISS (c, d), Pcre.get_substring subs 3)))
+ with Not_found ->
+ try
+ let subs = Pcre.exec ~rex:cciss name in
+ let c = int_of_string (Pcre.get_substring subs 1) in
+ let d = int_of_string (Pcre.get_substring subs 2) in
+ Some (PVDev (CCISS (c, d)))
+ with Not_found ->
+ try
+ let subs = Pcre.exec ~rex:lv name in
+ let vg = Pcre.get_substring subs 1 in
+ let lv = Pcre.get_substring subs 2 in
+ Some (PVPart (LV (vg, lv)))
+ with Not_found ->
+ None
let string_of_architecture = function
| I386 -> "i386"
if !have_safe then name else next_anon ()
(* Parse the output of 'lvs' to get list of LV names, sizes,
- * corresponding PVs, etc. Returns a list of (lvname, PVs, lvsize).
+ * corresponding PVs, etc.
+ *
+ * Returns a list of LVs, and a list of PVs.
*)
-let get_lvs =
- let devname = Pcre.regexp "^/dev/(.+)\\(.+\\)$" in
-
- fun () ->
- match
- shget "lvs --noheadings -o vg_name,lv_name,devices,lv_size"
- with
- | None -> []
- | Some lines ->
- let lines = List.map Pcre.split lines in
+let get_lvs () =
+ match
+ shget "lvs --noheadings -o vg_name,lv_name,devices"
+ with
+ | None -> [], []
+ | Some lines ->
+ let all_pvs = ref [] in
+ let lines = List.map Pcre.split lines in
+ let lvs =
List.map (
function
- | [vg; lv; pvs; lvsize]
- | [_; vg; lv; pvs; lvsize] ->
+ | [vg; lv; pvs] | [_; vg; lv; pvs] ->
let pvs = String.nsplit pvs "," in
- let pvs = List.filter_map (
- fun pv ->
- try
- let subs = Pcre.exec ~rex:devname pv in
- Some (Pcre.get_substring subs 1)
- with
- Not_found ->
- eprintf "lvs: unexpected device name: %s\n%!" pv;
- None
- ) pvs in
- LV (vg, lv), pvs, lvsize
+ let pvs = List.filter_map pv_of_dev pvs in
+ all_pvs := !all_pvs @ pvs;
+ LV (vg, lv)
| line ->
failwith ("lvs: " ^ s_ "unexpected output: " ^
String.concat "," line)
- ) lines
+ ) lines in
+ lvs, sort_uniq !all_pvs
+
+(* Get all block devices attached to the system. Also queries and
+ * returns the size in bytes of each. It tries to ignore any
+ * removable block devices like CD-ROMs.
+ *)
+let get_all_block_devices () =
+ let sys_block_entries =
+ List.sort (Array.to_list (Sys.readdir "/sys/block")) in
+
+ let get name filter =
+ let devices = List.filter_map filter sys_block_entries in
+ eprintf "get_all_block_devices: %s: block devices: %s\n%!"
+ name (String.concat "; " (List.map dev_of_block_device devices));
+
+ (* Run blockdev --getsize64 on each, and reject any where this
+ * fails (probably removable devices).
+ *)
+ let devices = List.filter_map (
+ fun d ->
+ let cmd = "blockdev --getsize64 " ^ (dev_of_block_device d) in
+ let lines = shget cmd in
+ match lines with
+ | Some (blksize::_) -> Some (d, Int64.of_string blksize)
+ | Some [] | None -> None
+ ) devices in
+ eprintf "all_block_devices: %s: non-removable block devices: %s\n%!"
+ name
+ (String.concat "; "
+ (List.map (fun (d, b) ->
+ sprintf "%s [%Ld]" (dev_of_block_device d) b)
+ devices));
+
+ devices
+ in
+
+ (* Search for hdX. *)
+ let rex = Pcre.regexp "^hd([a-z]+)$" in
+ let filter name =
+ try
+ let subs = Pcre.exec ~rex name in
+ Some (HD (Pcre.get_substring subs 1))
+ with
+ Not_found -> None
+ in
+ let devices = get "hd" filter in
+
+ (* Search for sdX. *)
+ let rex = Pcre.regexp "^sd([a-z]+)$" in
+ let filter name =
+ try
+ let subs = Pcre.exec ~rex name in
+ Some (SD (Pcre.get_substring subs 1))
+ with
+ Not_found -> None
+ in
+ let devices = devices @ get "sd" filter in
+
+ (* Search for cciss. *)
+ let rex = Pcre.regexp "^cciss!c(\\d)d(\\d)$" in
+ let filter name =
+ try
+ let subs = Pcre.exec ~rex name in
+ let c = int_of_string (Pcre.get_substring subs 1) in
+ let d = int_of_string (Pcre.get_substring subs 2) in
+ Some (CCISS (c, d))
+ with
+ Not_found -> None
+ in
+ let devices = devices @ get "cciss" filter in
+ devices
(* Get the partitions on a block device.
- * eg. "sda" -> [Part ("sda","1"); Part ("sda", "2")]
+ * eg. SD "a" -> [Part (SD "a","1"); Part (SD "a", "2")]
*)
let get_partitions dev =
- let rex = Pcre.regexp ("^" ^ dev ^ "(.+)$") in
- let devdir = "/sys/block/" ^ dev in
- let parts = Sys.readdir devdir in
+ (* Read the device directory, eg. /sys/block/hda, which we expect
+ * to contain partition devices like /sys/block/hda/hda1 etc.
+ *)
+ let subdir, rex =
+ match dev with
+ | HD n -> "hd" ^ n, sprintf "^hd%s(.+)$" n
+ | SD n -> "sd" ^ n, sprintf "^sd%s(.+)$" n
+ | CCISS (c,d) ->
+ sprintf "cciss!c%dd%d" c d, sprintf "^cciss!c%dd%d(p.+)$" c d in
+ let rex = Pcre.regexp rex in
+ let dir = "/sys/block/" ^ subdir in
+ let parts = Sys.readdir dir in
let parts = Array.to_list parts in
let parts = List.filter (
- fun name -> Some true = is_dir (devdir ^ "/" ^ name)
+ fun name -> is_dir (dir ^ "/" ^ name) = Some true
) parts in
let parts = List.filter_map (
fun part ->
(* Generate snapshot device name from device name. *)
let snapshot_name dev =
- "snap" ^ (safe_name dev)
+ "snap" ^ (safe_name (short_dev_of_block_device dev))
(* Perform a device-mapper snapshot with ramdisk overlay. *)
let snapshot =
in
fun origin_dev snapshot_dev ->
let ramdisk = next_free_ram_disk () in
+ let origin_dev = dev_of_block_device origin_dev in
let sectors =
- let cmd = "blockdev --getsz " ^ quote ("/dev/" ^ origin_dev) in
+ let cmd = "blockdev --getsz " ^ (quote origin_dev) in
let lines = shget cmd in
match lines with
| Some (sectors::_) -> Int64.of_string sectors
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'"
+ sh (sprintf "dmsetup create %s_org --table='0 %Ld snapshot-origin %s'"
snapshot_dev sectors origin_dev);
(* Create the snapshot. *)
sh (sprintf "dmsetup create %s --table='0 %Ld snapshot /dev/mapper/%s_org %s n 64'"
sh "route add default gw 10.0.2.2 eth0";
sh "echo nameserver 10.0.2.3 > /etc/resolv.conf"
-(* Map local device names to remote devices names. At the moment we
- * just change sd* to hd* (as device names appear under fullvirt). In
- * future, lots of complex possibilities.
- *)
-let remote_of_origin_dev =
- 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
-
(* Make an SSH connection to the remote machine, execute command.
* The connection remains open until you call ssh_disconnect, it
* times out or there is some error.
true
(* Rewrite /mnt/root/etc/fstab. *)
-let rewrite_fstab () =
+let rewrite_fstab remote_map =
let filename = "/mnt/root/etc/fstab" in
if is_file filename = Some true then (
sh ("cp " ^ quote filename ^ " " ^ quote (filename ^ ".p2vsaved"));
let lines = List.map (
function
| dev :: rest when String.starts_with dev "/dev/" ->
- let dev = String.sub dev 5 (String.length dev - 5) in
- let dev = remote_of_origin_dev dev in
- let dev = "/dev/" ^ dev in
- dev :: rest
+ let remote_dev =
+ match pv_of_dev dev with (* eg. /dev/sda1 where sda is in the map *)
+ | Some (PVPart (Part (pdev, partnum))) ->
+ (try List.assoc pdev remote_map ^ partnum
+ with Not_found -> dev
+ );
+ | Some (PVDev pdev) -> (* eg. /dev/sda *)
+ (try List.assoc pdev remote_map
+ with Not_found -> dev
+ );
+ | _ -> dev in
+ remote_dev :: rest
| line -> line
) lines in
(* 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" and size in bytes.
+ * This is a list of block_device, like HD "a", and size in bytes.
*)
- let all_block_devices : (string * int64) list =
- let rex = Pcre.regexp "^[hs]d" in
- let devices = Array.to_list (Sys.readdir "/sys/block") in
- let devices = List.sort devices in
- let devices = List.filter (fun d -> Pcre.pmatch ~rex d) devices in
- eprintf "all_block_devices: block devices: %s\n%!"
- (String.concat "; " devices);
- (* Run blockdev --getsize64 on each, and reject any where this fails
- * (probably removable devices).
- *)
- let devices = List.filter_map (
- fun d ->
- let cmd = "blockdev --getsize64 " ^ quote ("/dev/" ^ d) in
- let lines = shget cmd in
- match lines with
- | Some (blksize::_) -> Some (d, Int64.of_string blksize)
- | Some [] | None -> None
- ) devices in
- eprintf "all_block_devices: non-removable block devices: %s\n%!"
- (String.concat "; "
- (List.map (fun (d, b) -> sprintf "%s [%Ld]" d b) devices));
+ let all_block_devices : (block_device * int64) list =
+ let devices = get_all_block_devices () in
if devices = [] then
failwith
(s_ "No non-removable block devices (hard disks, etc.) could be found on this machine.");
*)
let all_partitions : partition list =
(* LVs & PVs. *)
- let lvs, pvs =
- let lvs = get_lvs () in
- let pvs = List.map (fun (_, pvs, _) -> pvs) lvs in
- let pvs = List.concat pvs in
- let pvs = sort_uniq pvs in
- eprintf "all_partitions: PVs: %s\n%!" (String.concat "; " pvs);
- let lvs = List.map (fun (lvname, _, _) -> lvname) lvs in
- eprintf "all_partitions: LVs: %s\n%!"
- (String.concat "; " (List.map dev_of_partition lvs));
- lvs, pvs in
+ let lvs, pvs = get_lvs () in
+ eprintf "all_partitions: PVs: %s\n%!"
+ (String.concat "; " (List.map string_of_pv pvs));
+ eprintf "all_partitions: LVs: %s\n%!"
+ (String.concat "; " (List.map dev_of_partition lvs));
+
+ (* For now just ignore any block devices which are PVs. *)
+ let block_devices =
+ List.filter (
+ fun (dev, _) -> not (List.mem (PVDev dev) pvs)
+ ) all_block_devices in
(* Partitions (eg. "sda1", "sda2"). *)
let parts =
- let parts = List.map fst all_block_devices in
+ let parts = List.map fst block_devices in
let parts = List.map get_partitions parts in
let parts = List.concat parts in
eprintf "all_partitions: all partitions: %s\n%!"
(* Remove any partitions which are PVs. *)
let parts = List.filter (
function
- | Part (dev, partnum) -> not (List.mem (dev ^ partnum) pvs)
+ | (Part _) as p -> not (List.mem (PVPart p) pvs)
| LV _ -> assert false
) parts in
parts in
let items = List.map (
fun (dev, size) ->
let label =
- sprintf "/dev/%s (%.3f GB)" dev
+ sprintf "%s (%.3f GB)" (dev_of_block_device dev)
((Int64.to_float size) /. (1024.*.1024.*.1024.)) in
(label, dev, true)
) all_block_devices in
(* Mount the root filesystem under /mnt/root. *)
(match config_root_filesystem with
- | Part (dev, partnum) ->
- let dev = dev ^ partnum in
+ | Part (dev, p) ->
let snapshot_dev = snapshot_name dev in
sh ("mount " ^ quote ("/dev/mapper/" ^ snapshot_dev) ^ " /mnt/root")
- | LV (vg, lv) ->
+ | (LV _) as lv ->
(* The LV will be backed by a snapshot device, so just mount
* directly.
*)
- sh ("mount " ^ quote ("/dev/" ^ vg ^ "/" ^ lv) ^ " /mnt/root")
+ let dev = dev_of_partition lv in
+ sh ("mount " ^ quote dev ^ " /mnt/root")
);
- (* Work out what devices will be called at the remote end. *)
- let config_devices_to_send = List.map (
- fun (origin_dev, snapshot_dev) ->
- let remote_dev = remote_of_origin_dev origin_dev in
- (origin_dev, snapshot_dev, remote_dev)
- ) config_devices_to_send in
+ (* Work out what devices will be called at the remote end and make
+ * a map of original device to remapped device name. This is
+ * quite simple for now: just map the devices to "hda", "hdb",
+ * etc. (assuming full virt target for now).
+ *)
+ let remote_map =
+ (* To generate "a", "b", ..., "aa", "ab", etc. The 'digits' are
+ * stored in reverse.
+ *)
+ let num = ref ['a'] in
+ let rec next_num_of num =
+ match num with
+ | [] -> assert false
+ | 'z' :: [] -> [ 'a'; 'a' ]
+ | 'z' :: nums -> 'a' :: next_num_of nums
+ | c :: nums -> Char.chr (Char.code c + 1) :: nums
+ in
+ let get_hdX num = "hd" ^ String.implode (List.rev num) in
+
+ List.map (
+ fun (origin_dev, _) ->
+ let remote_dev = get_hdX !num in
+ num := next_num_of !num;
+ (origin_dev, remote_dev)
+ ) config_devices_to_send in
(* Modify files on the root filesystem. *)
- rewrite_fstab ();
+ rewrite_fstab remote_map;
(* XXX Other files to rewrite? *)
(* Unmount the root filesystem and sync disks. *)
(* Work out what the image filenames will be at the remote end. *)
let config_devices_to_send = List.map (
- fun (origin_dev, snapshot_dev, remote_dev) ->
+ fun (origin_dev, snapshot_dev) ->
+ let remote_dev = List.assoc origin_dev remote_map in
let remote_name = basename ^ "-" ^ remote_dev ^ ".img" in
(origin_dev, snapshot_dev, remote_dev, remote_name)
) config_devices_to_send in
*)
List.iter (
fun (origin_dev, snapshot_dev, remote_dev, remote_name) ->
- eprintf "sending %s as %s\n%!" origin_dev remote_name;
+ eprintf "sending %s as %s\n%!"
+ (dev_of_block_device origin_dev) remote_name;
let size =
try List.assoc origin_dev all_block_devices