-and swap_stats = {
- swap_name : string;
- swap_block_size : int64; (* Block size (bytes). *)
- swap_blocks_total : int64; (* Total blocks. *)
-}
-and fs_probe_t = (* Return type of the probe_partition.*)
- | Filesystem of filesystem_stats
- | Swap of swap_stats
- | ProbeFailed of string (* Probe failed for some reason. *)
- | ProbeIgnore (* This filesystem should be ignored. *)
-
-(* Register a filesystem type. *)
-let filesystems = Hashtbl.create 13
-let fs_register part_types probe_fn =
- List.iter
- (fun part_type -> Hashtbl.replace filesystems part_type probe_fn)
- part_types
-
-(* Probe the devices and display.
- * - dom_name is the domain name
- * - target will be something like "hda"
- * - source will be the name of a file or disk partition on the local machine
- *)
-let rec probe_device dom_name target source =
- let fd = openfile source [ O_RDONLY ] 0 in
- let size = (LargeFile.fstat fd).LargeFile.st_size in
- let size = size /^ sector_size in (* Size in sectors. *)
-
- (*print_device dom_name target source size;*)
-
- let partitions = probe_mbr fd in
-
- if partitions <> [] then (
- let stats =
- List.mapi (
- fun i part ->
- if part.part_status = Bootable ||
- part.part_status = Nonbootable then (
- let pnum = i+1 in
- let target = target ^ string_of_int pnum in
- Some (target,
- probe_partition target (Some part.part_type)
- fd part.part_lba_start part.part_len)
- )
- else
- None
- ) partitions in
- let stats = List.filter_map (fun x -> x) stats in
- print_stats dom_name stats
- ) else (* Not an MBR, assume it's a single partition. *)
- print_stats dom_name [target, probe_partition target None fd 0L size];
-
- close fd
-
-(* Probe the master boot record (if it is one) and read the partitions.
- * Returns [] if this is not an MBR.
- * http://en.wikipedia.org/wiki/Master_boot_record
- *)
-and probe_mbr fd =
- lseek fd 510 SEEK_SET;
- let str = String.create 2 in
- if read fd str 0 2 <> 2 || str.[0] != '\x55' || str.[1] != '\xAA' then
- [] (* Not MBR *)
- else (
- (* Read the partition table. *)
- lseek fd 446 SEEK_SET;
- let str = String.create 64 in
- if read fd str 0 64 <> 64 then
- failwith (s_ "error reading partition table")
- else (
- (* Extract partitions from the data. *)
- let primaries = List.map (get_partition str) [ 0; 16; 32; 48 ] in
- (* XXX validate partition extents compared to disk. *)
- (* Read extended partition data. *)
- let extendeds = List.map (
- function
- | { part_type = 0x05 } as part ->
- probe_extended_partition
- max_extended_partitions fd part part.part_lba_start
- | part -> []
- ) primaries in
- let extendeds = List.concat extendeds in
- primaries @ extendeds
- )
- )
-
-(* Probe an extended partition. *)
-and probe_extended_partition max fd epart sect =
- if max > 0 then (
- (* Offset of the first EBR. *)
- let ebr_offs = sect *^ sector_size in
- (* EBR Signature? *)
- LargeFile.lseek fd (ebr_offs +^ 510L) SEEK_SET;
- let str = String.create 2 in
- if read fd str 0 2 <> 2 || str.[0] != '\x55' || str.[1] != '\xAA' then
- [] (* Not EBR *)
- else (
- (* Read the extended partition table entries (just 2 of them). *)
- LargeFile.lseek fd (ebr_offs +^ 446L) SEEK_SET;
- let str = String.create 32 in
- if read fd str 0 32 <> 32 then
- failwith (s_ "error reading extended partition")
- else (
- (* Extract partitions from the data. *)
- let part1, part2 =
- match List.map (get_partition str) [ 0; 16 ] with
- | [p1;p2] -> p1,p2
- | _ -> failwith (s_ "probe_extended_partition: internal error") in
- (* First partition entry has offset to the start of this partition. *)
- let part1 = { part1 with
- part_lba_start = sect +^ part1.part_lba_start } in
- (* Second partition entry is zeroes if end of list, otherwise points
- * to the next partition.
- *)
- if part2.part_status = NullEntry then
- [part1]
- else
- part1 :: probe_extended_partition
- (max-1) fd epart (sect +^ part2.part_lba_start)
- )
- )
- )
- else []
-
-(* Get the partition data from str.[offs] - str.[offs+15] *)
-and get_partition str offs =
- let part_type = Char.code str.[offs+4] in
- let part_lba_start = read_int32_le str (offs+8) in
- let part_len = read_int32_le str (offs+12) in
-
- let part_status =
- if part_type = 0 && part_lba_start = 0L && part_len = 0L then
- NullEntry
- else (
- let part_status = Char.code str.[offs] in
- match part_status with
- | 0x80 -> Bootable | 0 -> Nonbootable | _ -> Malformed
- ) in
-
- { part_status = part_status;
- part_type = part_type;
- part_lba_start = part_lba_start;
- part_len = part_len }
-
-(* Probe a single partition, which we assume contains either a
- * filesystem or is a PV.
- * - target will be something like "hda" or "hda1"
- * - part_type will be the partition type if known, or None
- * - fd is a file descriptor opened on the device
- * - start & size are where we think the start and size of the
- * partition is within the file descriptor (in SECTORS)
- *)
-and probe_partition target part_type fd start size =
- match part_type with
- | None ->
- ProbeFailed (s_ "detection of unpartitioned devices not yet supported")
- | Some 0x05 ->
- ProbeIgnore (* Extended partition - ignore it. *)
- | Some part_type ->
- try
- let probe_fn = Hashtbl.find filesystems part_type in
- probe_fn target part_type fd start size
- with
- Not_found ->
- ProbeFailed
- (sprintf (f_ "unsupported partition type %02x") part_type)
-
-and print_stats dom_name statss =
- List.iter (
- fun (target, fs_probe_t) ->
- let dom_target = dom_name ^ ":" ^ target in
- printf "%-20s " dom_target;
-
- match fs_probe_t with
- (* Swap partition. *)
- | Swap { swap_name = swap_name;
- swap_block_size = block_size;
- swap_blocks_total = blocks_total } ->
- if not !human then
- printf "%10Ld %s\n"
- (block_size *^ blocks_total /^ 1024L) swap_name
- else
- printf "%10s %s\n"
- (printable_size (block_size *^ blocks_total)) swap_name