Added offset_device, canonical_uuid function, pass LV device with LV filesystems

diff --git a/virt-df/virt_df.ml b/virt-df/virt_df.ml
index 5fd4d80..c02c8e3 100644 (file)
--- a/virt-df/virt_df.ml
+++ b/virt-df/virt_df.ml
@@ -67,6 +67,21 @@ object (self)
   method name = filename
 end
 
   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
 (* 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_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 ... *)
 }
 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]"
 
   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 =
 (* 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 (file)
--- 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!
   *)
 
      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
   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. *)
 
   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. *)
 
 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_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=...> *)
 }
 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 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
 (** {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 (file)
--- 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 =
       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


@@ -373,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 }


@@ -403,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 -> ?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
        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 ~partno:(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 ?partno 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 partno with

       | None ->
          dom_name ^ ":" ^ disk_name
       | 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 (
     printf "%-20s " name;
 
     if fs.fs_is_swap then (