From 0dc5575b79e4d5e003966eaaeb4d0a6a6e8802ed Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Thu, 1 Jan 1970 00:00:00 +0000 Subject: [PATCH] Added offset_device, canonical_uuid function, pass LV device with LV filesystems --- virt-df/virt_df.ml | 32 +++++++++++++++++++++++++++++++- virt-df/virt_df.mli | 26 +++++++++++++++++++++++--- virt-df/virt_df_main.ml | 33 +++++++++++++++++++-------------- 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 *) @@ -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 ( -- 1.8.3.1