Fix alignment in -t option

[virt-top.git] / virt-df / virt_df.ml

diff --git a/virt-df/virt_df.ml b/virt-df/virt_df.ml
index 63bb090..c02c8e3 100644 (file)
--- a/virt-df/virt_df.ml
+++ b/virt-df/virt_df.ml
@@ -23,8 +23,6 @@ open Unix
 
 open Virt_df_gettext.Gettext
 
-let debug = true     (* If true emit lots of debugging information. *)
-
 let ( +* ) = Int32.add
 let ( -* ) = Int32.sub
 let ( ** ) = Int32.mul
@@ -35,6 +33,7 @@ let ( -^ ) = Int64.sub
 let ( *^ ) = Int64.mul
 let ( /^ ) = Int64.div
 
+let debug = ref false
 let uri = ref None
 let inodes = ref false
 let human = ref false
@@ -68,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
@@ -81,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 ... *)
@@ -164,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 =
@@ -171,7 +200,7 @@ let partition_type_register (parts_name : string) probe_fn =
 
 (* Probe a device for partitions.  Returns [Some parts] or [None]. *)
 let probe_for_partitions dev =
-  if debug then eprintf "probing for partitions on %s ...\n%!" dev#name;
+  if !debug then eprintf "probing for partitions on %s ...\n%!" dev#name;
   let rec loop = function
     | [] -> None
     | (parts_name, probe_fn) :: rest ->
@@ -179,7 +208,7 @@ let probe_for_partitions dev =
        with Not_found -> loop rest
   in
   let r = loop !partition_types in
-  if debug then (
+  if !debug then (
     match r with
     | None -> eprintf "no partitions found on %s\n%!" dev#name
     | Some { parts_name = name; parts = parts } ->
@@ -196,7 +225,7 @@ let filesystem_type_register (fs_name : string) probe_fn =
 
 (* Probe a device for a filesystem.  Returns [Some fs] or [None]. *)
 let probe_for_filesystem dev =
-  if debug then eprintf "probing for a filesystem on %s ...\n%!" dev#name;
+  if !debug then eprintf "probing for a filesystem on %s ...\n%!" dev#name;
   let rec loop = function
     | [] -> None
     | (fs_name, probe_fn) :: rest ->
@@ -204,7 +233,7 @@ let probe_for_filesystem dev =
        with Not_found -> loop rest
   in
   let r = loop !filesystem_types in
-  if debug then (
+  if !debug then (
     match r with
     | None -> eprintf "no filesystem found on %s\n%!" dev#name
     | Some fs ->
@@ -220,7 +249,7 @@ let lvm_type_register (lvm_name : string) probe_fn list_lvs_fn =
 
 (* Probe a device for a PV.  Returns [Some lvm_name] or [None]. *)
 let probe_for_pv dev =
-  if debug then eprintf "probing if %s is a PV ...\n%!" dev#name;
+  if !debug then eprintf "probing if %s is a PV ...\n%!" dev#name;
   let rec loop = function
     | [] -> None
     | (lvm_name, (probe_fn, _)) :: rest ->
@@ -228,7 +257,7 @@ let probe_for_pv dev =
        with Not_found -> loop rest
   in
   let r = loop !lvm_types in
-  if debug then (
+  if !debug then (
     match r with
     | None -> eprintf "no PV found on %s\n%!" dev#name
     | Some { lvm_plugin_id = name } ->