summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard W.M. Jones <rjones@redhat.com>2008-04-16 12:08:27 +0100
committerRichard W.M. Jones <rjones@redhat.com>2008-04-16 12:08:27 +0100
commit0dc5575b79e4d5e003966eaaeb4d0a6a6e8802ed (patch)
treee059df7e557e347871c62052ace97be64b690125
parent617ee3553ff13690643b42a084daaadd989b45c9 (diff)
downloadvirt-top-0dc5575b79e4d5e003966eaaeb4d0a6a6e8802ed.zip
virt-top-0dc5575b79e4d5e003966eaaeb4d0a6a6e8802ed.tar.gz
virt-top-0dc5575b79e4d5e003966eaaeb4d0a6a6e8802ed.tar.xz
Added offset_device, canonical_uuid function, pass LV device with LV filesystems
-rw-r--r--virt-df/virt_df.ml32
-rw-r--r--virt-df/virt_df.mli26
-rw-r--r--virt-df/virt_df_main.ml33
3 files changed, 73 insertions, 18 deletions
diff --git a/virt-df/virt_df.ml b/virt-df/virt_df.ml
index 5fd4d80..c02c8e3 100644
--- a/virt-df/virt_df.ml
+++ b/virt-df/virt_df.ml
@@ -67,6 +67,21 @@ object (self)
method name = filename
end
+(* A linear offset/size from an underlying device. *)
+class offset_device name start size (dev : device) =
+object
+ inherit device
+ method name = name
+ method size = size
+ method read offset len =
+ if offset < 0L || len < 0 || offset +^ Int64.of_int len > size then
+ invalid_arg (
+ sprintf "%s: tried to read outside device boundaries (%Ld/%d/%Ld)"
+ name offset len size
+ );
+ dev#read (start+^offset) len
+end
+
(* The null device. Any attempt to read generates an error. *)
let null_device : device =
object
@@ -80,7 +95,8 @@ type domain = {
dom_name : string; (* Domain name. *)
dom_id : int option; (* Domain ID (if running). *)
dom_disks : disk list; (* Domain disks. *)
- dom_lv_filesystems : filesystem list; (* Domain LV filesystems. *)
+ dom_lv_filesystems :
+ (lv * filesystem) list; (* Domain LV filesystems. *)
}
and disk = {
(* From the XML ... *)
@@ -163,6 +179,20 @@ let string_of_filesystem { fs_name = name; fs_is_swap = swap } =
if not swap then name
else name ^ " [swap]"
+(* Convert a UUID (containing '-' chars) to canonical form. *)
+let canonical_uuid uuid =
+ let uuid' = String.make 32 ' ' in
+ let j = ref 0 in
+ for i = 0 to String.length uuid - 1 do
+ if !j >= 32 then
+ invalid_arg (sprintf (f_ "canonical_uuid: UUID is too long: %s") uuid);
+ let c = uuid.[i] in
+ if c <> '-' then ( uuid'.[!j] <- c; incr j )
+ done;
+ if !j <> 32 then
+ invalid_arg (sprintf (f_ "canonical_uuid: invalid UUID: %s") uuid);
+ uuid'
+
(* Register a partition scheme. *)
let partition_types = ref []
let partition_type_register (parts_name : string) probe_fn =
diff --git a/virt-df/virt_df.mli b/virt-df/virt_df.mli
index f3d20a7..f35e0db 100644
--- a/virt-df/virt_df.mli
+++ b/virt-df/virt_df.mli
@@ -100,8 +100,7 @@ class virtual device :
Note the very rare use of OOP in OCaml!
*)
-class block_device :
- string ->
+class block_device : string ->
object
method name : string
method read : int64 -> int -> string
@@ -110,6 +109,23 @@ class block_device :
end
(** A concrete device which just direct-maps a file or /dev device. *)
+class offset_device : string -> int64 -> int64 -> device ->
+ object
+ method name : string
+ method read : int64 -> int -> string
+ method read_bitstring : int64 -> int -> string * int * int
+ method size : int64
+ end
+ (** A concrete device which maps a linear part of an underlying device.
+
+ [new offset_device name start size dev] creates a new
+ device which maps bytes from [start] to [start+size-1]
+ of the underlying device [dev] (ie. in this device they
+ appear as bytes [0] to [size-1]).
+
+ Useful for things like partitions.
+ *)
+
val null_device : device
(** The null device. Any attempt to read generates an error. *)
@@ -117,7 +133,8 @@ type domain = {
dom_name : string; (** Domain name. *)
dom_id : int option; (** Domain ID (if running). *)
dom_disks : disk list; (** Domain disks. *)
- dom_lv_filesystems : filesystem list; (** Domain LV filesystems. *)
+ dom_lv_filesystems :
+ (lv * filesystem) list; (** Domain LV filesystems. *)
}
and disk = {
d_type : string option; (** The <disk type=...> *)
@@ -177,6 +194,9 @@ val string_of_partition : partition -> string
val string_of_filesystem : filesystem -> string
(** Convert a partition or filesystem struct to a string (for debugging). *)
+val canonical_uuid : string -> string
+(** Convert a UUID which may contain '-' characters to canonical form. *)
+
(** {2 Plug-in registration functions} *)
val partition_type_register : string -> (device -> partitions) -> unit
diff --git a/virt-df/virt_df_main.ml b/virt-df/virt_df_main.ml
index 1e1db45..4a1110d 100644
--- a/virt-df/virt_df_main.ml
+++ b/virt-df/virt_df_main.ml
@@ -364,8 +364,7 @@ OPTIONS" in
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
@@ -373,7 +372,10 @@ OPTIONS" in
*)
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 }
@@ -403,45 +405,48 @@ OPTIONS" in
(* HOF to iterate over filesystems. *)
let iter_over_filesystems doms
- (f : domain -> ?disk:disk -> ?part:(partition * int) -> filesystem ->
+ (f : domain -> ?disk:disk -> ?partno: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
- | ({ 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
- | ({ part_content = `Filesystem fs } as part) ->
- f dom ~disk ~part:(part, i) fs
+ | { part_content = `Filesystem fs; part_dev = dev } ->
+ f dom ~disk ~partno:(i+1) dev fs
| _ -> ()
) 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. *)
- let print_stats dom ?disk ?part fs =
+ let print_stats dom ?disk ?partno dev fs =
(* 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
- | None -> "???" (* XXX keep LV dev around *)
+ | None -> dev#name
| Some disk -> disk.d_target
in
- match part with
+ match partno with
| None ->
dom_name ^ ":" ^ disk_name
- | Some (_, pnum) ->
- dom_name ^ ":" ^ disk_name ^ string_of_int pnum in
+ | Some partno ->
+ dom_name ^ ":" ^ disk_name ^ string_of_int partno in
printf "%-20s " name;
if fs.fs_is_swap then (