git.annexia.org
/
virt-top.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Updated MANIFEST.
[virt-top.git]
/
virt-df
/
virt_df_main.ml
diff --git
a/virt-df/virt_df_main.ml
b/virt-df/virt_df_main.ml
index
e6ae53e
..
65d1f2f
100644
(file)
--- a/
virt-df/virt_df_main.ml
+++ b/
virt-df/virt_df_main.ml
@@
-54,6
+54,8
@@
let () =
"uri " ^ s_ "Connect to URI (default: Xen)";
"--connect", Arg.String set_uri,
"uri " ^ s_ "Connect to URI (default: Xen)";
"uri " ^ s_ "Connect to URI (default: Xen)";
"--connect", Arg.String set_uri,
"uri " ^ s_ "Connect to URI (default: Xen)";
+ "--debug", Arg.Set debug,
+ " " ^ s_ "Debug mode (default: false)";
"-h", Arg.Set human,
" " ^ s_ "Print sizes in human-readable format";
"--human-readable", Arg.Set human,
"-h", Arg.Set human,
" " ^ s_ "Print sizes in human-readable format";
"--human-readable", Arg.Set human,
@@
-63,7
+65,7
@@
let () =
"--inodes", Arg.Set inodes,
" " ^ s_ "Show inodes instead of blocks";
"-t", Arg.String test_mode,
"--inodes", Arg.Set inodes,
" " ^ s_ "Show inodes instead of blocks";
"-t", Arg.String test_mode,
- "dev" ^ s_ "(Test mode) Display contents of block device or file";
+ "dev
" ^ s_ "(Test mode) Display contents of block device or file";
"--version", Arg.Unit version,
" " ^ s_ "Display version and exit";
] in
"--version", Arg.Unit version,
" " ^ s_ "Display version and exit";
] in
@@
-362,8
+364,7
@@
OPTIONS" in
let lvs = group_by lvs in
let lvs =
let lvs = group_by lvs in
let lvs =
- List.map (fun (pv, devs) -> list_lvs pv.lvm_plugin_id devs)
- lvs in
+ List.map (fun (pv, devs) -> list_lvs pv.lvm_plugin_id devs) lvs in
let lvs = List.concat lvs in
(* lvs is a list of potential LV devices. Now run them through the
let lvs = List.concat lvs in
(* lvs is a list of potential LV devices. Now run them through the
@@
-371,7
+372,10
@@
OPTIONS" in
*)
let filesystems =
List.filter_map (
*)
let filesystems =
List.filter_map (
- fun { lv_dev = dev } -> probe_for_filesystem dev
+ fun ({ lv_dev = dev } as lv) ->
+ match probe_for_filesystem dev with
+ | Some fs -> Some (lv, fs)
+ | None -> None
) lvs in
{ dom with dom_lv_filesystems = filesystems }
) lvs in
{ dom with dom_lv_filesystems = filesystems }
@@
-401,45
+405,48
@@
OPTIONS" in
(* HOF to iterate over filesystems. *)
let iter_over_filesystems doms
(* HOF to iterate over filesystems. *)
let iter_over_filesystems doms
- (f : domain -> ?disk:disk -> ?part
:(partition * int)
-> filesystem ->
+ (f : domain -> ?disk:disk -> ?part
no:int -> device
-> filesystem ->
unit) =
List.iter (
fun ({ dom_disks = disks; dom_lv_filesystems = filesystems } as dom) ->
(* Ordinary filesystems found on disks & partitions. *)
List.iter (
function
unit) =
List.iter (
fun ({ dom_disks = disks; dom_lv_filesystems = filesystems } as dom) ->
(* Ordinary filesystems found on disks & partitions. *)
List.iter (
function
- | ({ d_content = `Filesystem fs } as disk) ->
- f dom ~disk fs
+ | ({ d_content = `Filesystem fs
; d_dev = dev
} as disk) ->
+ f dom ~disk
dev
fs
| ({ d_content = `Partitions partitions } as disk) ->
List.iteri (
fun i ->
function
| ({ d_content = `Partitions partitions } as disk) ->
List.iteri (
fun i ->
function
- |
({ part_content = `Filesystem fs } as part)
->
- f dom ~disk ~part
:(part, i)
fs
+ |
{ part_content = `Filesystem fs; part_dev = dev }
->
+ f dom ~disk ~part
no:(i+1) dev
fs
| _ -> ()
) partitions.parts
| _ -> ()
) disks;
(* LV filesystems. *)
| _ -> ()
) partitions.parts
| _ -> ()
) disks;
(* LV filesystems. *)
- List.iter (fun
fs -> f dom
fs) filesystems
+ List.iter (fun
({lv_dev = dev}, fs) -> f dom dev
fs) filesystems
) doms
in
(* Print stats for each recognized filesystem. *)
) doms
in
(* Print stats for each recognized filesystem. *)
- let print_stats dom ?disk ?part fs =
+ let print_stats dom ?disk ?part
no dev
fs =
(* Printable name is like "domain:hda" or "domain:hda1". *)
let name =
let dom_name = dom.dom_name in
(* Printable name is like "domain:hda" or "domain:hda1". *)
let name =
let dom_name = dom.dom_name in
+ (* Get the disk name (eg. "hda") from the domain XML, if
+ * we have it, otherwise use the device name (eg. for LVM).
+ *)
let disk_name =
match disk with
let disk_name =
match disk with
- | None ->
"???" (* XXX keep LV dev around *)
+ | None ->
dev#name
| Some disk -> disk.d_target
in
| Some disk -> disk.d_target
in
- match part with
+ match part
no
with
| None ->
dom_name ^ ":" ^ disk_name
| None ->
dom_name ^ ":" ^ disk_name
- | Some
(_, pnum)
->
- dom_name ^ ":" ^ disk_name ^ string_of_int p
num
in
+ | Some
partno
->
+ dom_name ^ ":" ^ disk_name ^ string_of_int p
artno
in
printf "%-20s " name;
if fs.fs_is_swap then (
printf "%-20s " name;
if fs.fs_is_swap then (