module C = Libvirt.Connect
module D = Libvirt.Domain
+open Int63.Operators
+
open Virt_df_gettext.Gettext
open Virt_df
-let ( +* ) = Int32.add
-let ( -* ) = Int32.sub
-let ( ** ) = Int32.mul
-let ( /* ) = Int32.div
-
-let ( +^ ) = Int64.add
-let ( -^ ) = Int64.sub
-let ( *^ ) = Int64.mul
-let ( /^ ) = Int64.div
+let disk_block_size = ~^512
+
+(* A libvirt-backed block device. *)
+class libvirt_device dom name path blocksize =
+ (* Size is never really used. *)
+ let size = ~^0 in
+object (self)
+ inherit Diskimage.device
+ method read offset len =
+ let offset = Int63.to_int64 offset in
+ let len = Int63.to_int len in
+ let str = String.make len '\000' in
+ ignore (D.block_peek dom path offset len str 0);
+ str
+ method size = size
+ method name = name
+ method blocksize = blocksize
+ method map_block _ = []
+ method contiguous offset = size -^ offset
+ method close () = ()
+ initializer
+ (* Check that access is possible - throws a virterror if not. *)
+ D.block_peek dom path 0L 0 "" 0
+end
let () =
(* Command line argument parsing. *)
csv_write stdout
in
- (* name target dev_path *)
- let doms : (string * (string * string) list) list =
+ let doms =
if !test_files = [] then (
let xmls =
(* Connect to the hypervisor. *)
) in
(* Get their XML. *)
- let xmls = List.map D.get_xml_desc doms in
+ let xmls = List.map (fun dom -> dom, D.get_xml_desc dom) doms in
(* Parse the XML. *)
- let xmls = List.map Xml.parse_string xmls in
+ let xmls = List.map (fun (dom, xml) ->
+ dom, Xml.parse_string xml) xmls in
- (* Return just the XML documents - everything else will be closed
- * and freed including the connection to the hypervisor.
- *)
xmls in
(* Grr.. Need to use a library which has XPATH support (or cduce). *)
List.map (
- fun xml ->
+ fun (dom, xml) ->
let nodes, domain_attrs =
match xml with
| Xml.Element ("domain", attrs, children) -> children, attrs
| _ -> None
) devices in
+ let disks = List.filter_map (
+ fun (name, path) ->
+ try Some (name, new libvirt_device dom name path disk_block_size)
+ with Libvirt.Virterror err ->
+ eprintf "%s: %s\n" name (Libvirt.Virterror.to_string err);
+ None
+ ) disks in
+
name, disks
) xmls
) else (
* which we use for testing virt-df itself. We create fake domains
* from these.
*)
- List.map (
+ List.filter_map (
fun filename ->
- filename, ["hda", filename]
+ try Some (filename,
+ ["hda",
+ new Diskimage.block_device filename disk_block_size])
+ with Unix.Unix_error (err, func, param) ->
+ eprintf "%s:%s: %s\n" func param (Unix.error_message err);
+ None
) !test_files
) in
(* Convert these to Diskimage library 'machine's. *)
- let machines = List.filter_map (
- fun (name, disks) ->
- try Some (Diskimage.open_machine name disks)
- with Unix.Unix_error (err, func, param) ->
- eprintf "%s:%s: %s" func param (Unix.error_message err);
- None
+ let machines = List.map (
+ fun (name, disks) -> Diskimage.open_machine_from_devices name disks
) doms in
(* Scan them. *)
csv_write [ "Filesystem"; total; used; avail; "Type" ] in
let printable_size bytes =
- if bytes < 1024L *^ 1024L then
- sprintf "%Ld bytes" bytes
- else if bytes < 1024L *^ 1024L *^ 1024L then
- sprintf "%.1f MiB" (Int64.to_float (bytes /^ 1024L) /. 1024.)
+ if bytes < ~^1024 *^ ~^1024 then
+ sprintf "%s bytes" (Int63.to_string bytes)
+ else if bytes < ~^1024 *^ ~^1024 *^ ~^1024 then
+ sprintf "%.1f MiB" (Int63.to_float (bytes /^ ~^1024) /. 1024.)
else
- sprintf "%.1f GiB" (Int64.to_float (bytes /^ 1024L /^ 1024L) /. 1024.)
+ sprintf "%.1f GiB" (Int63.to_float (bytes /^ ~^1024 /^ ~^1024) /. 1024.)
in
(* HOF to iterate over filesystems. *)
List.iter (
function
| ({ Diskimage.d_content = `Filesystem fs; d_dev = dev } as disk) ->
- f dom ~disk dev fs
+ f dom ~disk (dev :> Diskimage.device) fs
| ({ Diskimage.d_content = `Partitions partitions } as disk) ->
List.iteri (
fun i ->
printf "%-32s " name;
let {
- Diskimage.fs_plugin_id = fs_plugin_id;
- fs_block_size = fs_block_size;
+ Diskimage.fs_blocksize = fs_blocksize;
fs_blocks_total = fs_blocks_total;
fs_is_swap = fs_is_swap;
fs_blocks_reserved = fs_blocks_reserved;
fs_inodes_used = fs_inodes_used
} = fs in
- let fs_name = Diskimage.name_of_filesystem fs_plugin_id in
+ let fs_name = Diskimage.name_of_filesystem fs in
if fs_is_swap then (
(* Swap partition. *)
if not !human then
- printf "%10Ld %s\n"
- (fs_block_size *^ fs_blocks_total /^ 1024L) fs_name
+ printf "%10s %s\n"
+ (Int63.to_string (fs_blocksize *^ fs_blocks_total /^ ~^1024))
+ fs_name
else
printf "%10s %s\n"
- (printable_size (fs_block_size *^ fs_blocks_total)) fs_name
+ (printable_size (fs_blocksize *^ fs_blocks_total))
+ fs_name
) else (
(* Ordinary filesystem. *)
if not !inodes then ( (* Block display. *)
(* 'df' doesn't count the restricted blocks. *)
let blocks_total = fs_blocks_total -^ fs_blocks_reserved in
let blocks_avail = fs_blocks_avail -^ fs_blocks_reserved in
- let blocks_avail = if blocks_avail < 0L then 0L else blocks_avail in
+ let blocks_avail = if blocks_avail < ~^0 then ~^0 else blocks_avail in
if not !human then ( (* Display 1K blocks. *)
- printf "%10Ld %10Ld %10Ld %s\n"
- (blocks_total *^ fs_block_size /^ 1024L)
- (fs_blocks_used *^ fs_block_size /^ 1024L)
- (blocks_avail *^ fs_block_size /^ 1024L)
+ printf "%10s %10s %10s %s\n"
+ (Int63.to_string (blocks_total *^ fs_blocksize /^ ~^1024))
+ (Int63.to_string (fs_blocks_used *^ fs_blocksize /^ ~^1024))
+ (Int63.to_string (blocks_avail *^ fs_blocksize /^ ~^1024))
fs_name
) else ( (* Human-readable blocks. *)
printf "%10s %10s %10s %s\n"
- (printable_size (blocks_total *^ fs_block_size))
- (printable_size (fs_blocks_used *^ fs_block_size))
- (printable_size (blocks_avail *^ fs_block_size))
+ (printable_size (blocks_total *^ fs_blocksize))
+ (printable_size (fs_blocks_used *^ fs_blocksize))
+ (printable_size (blocks_avail *^ fs_blocksize))
fs_name
)
) else ( (* Inodes display. *)
- printf "%10Ld %10Ld %10Ld %s\n"
- fs_inodes_total fs_inodes_used fs_inodes_avail
+ printf "%10s %10s %10s %s\n"
+ (Int63.to_string fs_inodes_total)
+ (Int63.to_string fs_inodes_used)
+ (Int63.to_string fs_inodes_avail)
fs_name
)
)
let name = printable_name machine ?disk ?partno dev in
let {
- Diskimage.fs_plugin_id = fs_plugin_id;
- fs_block_size = fs_block_size;
+ Diskimage.fs_blocksize = fs_blocksize;
fs_blocks_total = fs_blocks_total;
fs_is_swap = fs_is_swap;
fs_blocks_reserved = fs_blocks_reserved;
fs_inodes_used = fs_inodes_used
} = fs in
- let fs_name = Diskimage.name_of_filesystem fs_plugin_id in
+ let fs_name = Diskimage.name_of_filesystem fs in
let row =
if fs_is_swap then
(* Swap partition. *)
- [ Int64.to_string (fs_block_size *^ fs_blocks_total /^ 1024L);
+ [ Int63.to_string (fs_blocksize *^ fs_blocks_total /^ ~^1024);
""; "" ]
else (
(* Ordinary filesystem. *)
- if not !inodes then ( (* Block display. *)
+ if not !inodes then ( (* 1K block display. *)
(* 'df' doesn't count the restricted blocks. *)
let blocks_total = fs_blocks_total -^ fs_blocks_reserved in
let blocks_avail = fs_blocks_avail -^ fs_blocks_reserved in
- let blocks_avail = if blocks_avail < 0L then 0L else blocks_avail in
+ let blocks_avail = if blocks_avail < ~^0 then ~^0 else blocks_avail in
- [ Int64.to_string (blocks_total *^ fs_block_size /^ 1024L);
- Int64.to_string (fs_blocks_used *^ fs_block_size /^ 1024L);
- Int64.to_string (blocks_avail *^ fs_block_size /^ 1024L) ]
+ [ Int63.to_string (blocks_total *^ fs_blocksize /^ ~^1024);
+ Int63.to_string (fs_blocks_used *^ fs_blocksize /^ ~^1024);
+ Int63.to_string (blocks_avail *^ fs_blocksize /^ ~^1024) ]
) else ( (* Inodes display. *)
- [ Int64.to_string fs_inodes_total;
- Int64.to_string fs_inodes_used;
- Int64.to_string fs_inodes_avail ]
+ [ Int63.to_string fs_inodes_total;
+ Int63.to_string fs_inodes_used;
+ Int63.to_string fs_inodes_avail ]
)
) in
git.annexia.org / virt-df.git / blobdiff