+let inodes = ref false
+let human = ref false
+
+(* Maximum number of extended partitions possible. *)
+let max_extended_partitions = 100
+
+let sector_size = 512L
+
+(* Parse out the device XML to get the names of disks. *)
+type domain = {
+ dom_name : string; (* Domain name. *)
+ dom_id : int option; (* Domain ID (if running). *)
+ dom_disks : disk list; (* Domain disks. *)
+}
+and disk = {
+ d_type : string option; (* The <disk type=...> *)
+ d_device : string option; (* The <disk device=...> *)
+ d_source : string option; (* The <source file=... or dev> *)
+ d_target : string option; (* The <target dev=...> *)
+}
+
+type partition = {
+ part_status : partition_status; (* Bootable, etc. *)
+ part_type : int; (* Partition type. *)
+ part_lba_start : int64; (* LBA start sector. *)
+ part_len : int64; (* Length in sectors. *)
+}
+and partition_status = Bootable | Nonbootable | Malformed | NullEntry
+
+type filesystem_stats = {
+ fs_name : string;
+ fs_block_size : int64; (* Block size (bytes). *)
+ fs_blocks_total : int64; (* Total blocks. *)
+ fs_blocks_reserved : int64; (* Blocks reserved for super-user. *)
+ fs_blocks_avail : int64; (* Blocks free (available). *)
+ fs_blocks_used : int64; (* Blocks in use. *)
+ fs_inodes_total : int64; (* Total inodes. *)
+ fs_inodes_reserved : int64; (* Inodes reserved for super-user. *)
+ fs_inodes_avail : int64; (* Inodes free (available). *)
+ fs_inodes_used : int64; (* Inodes in use. *)
+}
+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 stats
+ ) else (* Not an MBR, assume it's a single partition. *)
+ print_stats [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 "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 "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 "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 }