From e6cca10e5cf86b9bd280e371fb1195835a96bff0 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Fri, 28 Mar 2008 17:12:47 +0000 Subject: Internationalize virt-df program. --- virt-df/.depend | 18 +++++++------ virt-df/Makefile.in | 18 +++++++++---- virt-df/virt_df.ml | 63 +++++++++++++++++++++++++------------------ virt-df/virt_df_ext2.ml | 7 ++--- virt-df/virt_df_linux_swap.ml | 4 ++- virt-df/virt_df_lvm2.ml | 3 ++- 6 files changed, 69 insertions(+), 44 deletions(-) mode change 100755 => 100644 virt-df/virt_df_ext2.ml mode change 100755 => 100644 virt-df/virt_df_linux_swap.ml mode change 100755 => 100644 virt-df/virt_df_lvm2.ml (limited to 'virt-df') diff --git a/virt-df/.depend b/virt-df/.depend index 1a7750e..69ae982 100644 --- a/virt-df/.depend +++ b/virt-df/.depend @@ -1,10 +1,12 @@ -virt_df_ext2.cmo: virt_df.cmo -virt_df_ext2.cmx: virt_df.cmx -virt_df_linux_swap.cmo: virt_df.cmo -virt_df_linux_swap.cmx: virt_df.cmx -virt_df_lvm2.cmo: virt_df.cmo -virt_df_lvm2.cmx: virt_df.cmx +virt_df_ext2.cmo: virt_df_gettext.cmo virt_df.cmo +virt_df_ext2.cmx: virt_df_gettext.cmx virt_df.cmx +virt_df_linux_swap.cmo: virt_df_gettext.cmo virt_df.cmo +virt_df_linux_swap.cmx: virt_df_gettext.cmx virt_df.cmx +virt_df_lvm2.cmo: virt_df_gettext.cmo virt_df.cmo +virt_df_lvm2.cmx: virt_df_gettext.cmx virt_df.cmx virt_df_main.cmo: virt_df.cmo virt_df_main.cmx: virt_df.cmx -virt_df.cmo: ../libvirt/libvirt_version.cmi ../libvirt/libvirt.cmi -virt_df.cmx: ../libvirt/libvirt_version.cmx ../libvirt/libvirt.cmx +virt_df.cmo: virt_df_gettext.cmo ../libvirt/libvirt_version.cmi \ + ../libvirt/libvirt.cmi +virt_df.cmx: virt_df_gettext.cmx ../libvirt/libvirt_version.cmx \ + ../libvirt/libvirt.cmx diff --git a/virt-df/Makefile.in b/virt-df/Makefile.in index 1f3af53..057c8e5 100644 --- a/virt-df/Makefile.in +++ b/virt-df/Makefile.in @@ -26,14 +26,22 @@ exec_prefix = @exec_prefix@ bindir = @bindir@ pkg_xml_light = @pkg_xml_light@ +pkg_gettext = @pkg_gettext@ OCAMLCPACKAGES := -package unix,extlib,xml-light -OBJS := virt_df.cmo \ - virt_df_ext2.cmo \ - virt_df_linux_swap.cmo \ - virt_df_lvm2.cmo \ - virt_df_main.cmo +ifneq ($(pkg_gettext),no) +OCAMLCPACKAGES += -package gettext-stub +endif + +OBJS := \ + virt_df_gettext.cmo \ + virt_df.cmo \ + virt_df_ext2.cmo \ + virt_df_linux_swap.cmo \ + virt_df_lvm2.cmo \ + virt_df_main.cmo + XOBJS := $(OBJS:.cmo=.cmx) OCAMLCPACKAGES += -I ../libvirt diff --git a/virt-df/virt_df.ml b/virt-df/virt_df.ml index 350d535..4fbc706 100644 --- a/virt-df/virt_df.ml +++ b/virt-df/virt_df.ml @@ -19,9 +19,10 @@ open Printf open ExtList - open Unix +open Virt_df_gettext.Gettext + module C = Libvirt.Connect module D = Libvirt.Domain module N = Libvirt.Network @@ -145,7 +146,7 @@ and probe_mbr fd = lseek fd 446 SEEK_SET; let str = String.create 64 in if read fd str 0 64 <> 64 then - failwith "error reading partition table" + failwith (s_ "error reading partition table") else ( (* Extract partitions from the data. *) let primaries = List.map (get_partition str) [ 0; 16; 32; 48 ] in @@ -178,13 +179,13 @@ and probe_extended_partition max fd epart sect = LargeFile.lseek fd (ebr_offs +^ 446L) SEEK_SET; let str = String.create 32 in if read fd str 0 32 <> 32 then - failwith "error reading extended partition" + failwith (s_ "error reading extended partition") else ( (* Extract partitions from the data. *) let part1, part2 = match List.map (get_partition str) [ 0; 16 ] with | [p1;p2] -> p1,p2 - | _ -> failwith "probe_extended_partition: internal error" in + | _ -> failwith (s_ "probe_extended_partition: internal error") in (* First partition entry has offset to the start of this partition. *) let part1 = { part1 with part_lba_start = sect +^ part1.part_lba_start } in @@ -232,7 +233,7 @@ and get_partition str offs = and probe_partition target part_type fd start size = match part_type with | None -> - ProbeFailed "detection of unpartitioned devices not yet supported" + ProbeFailed (s_ "detection of unpartitioned devices not yet supported") | Some 0x05 -> ProbeIgnore (* Extended partition - ignore it. *) | Some part_type -> @@ -242,7 +243,7 @@ and probe_partition target part_type fd start size = with Not_found -> ProbeFailed - (sprintf "unsupported partition type %02x" part_type) + (sprintf (f_ "unsupported partition type %02x") part_type) and print_stats dom_name statss = List.iter ( @@ -337,19 +338,29 @@ let main () = in let argspec = Arg.align [ - "-a", Arg.Set all, " Show all domains (default: only active domains)"; - "--all", Arg.Set all, " Show all domains (default: only active domains)"; - "-c", Arg.String set_uri, "uri Connect to URI (default: Xen)"; - "--connect", Arg.String set_uri, "uri Connect to URI (default: Xen)"; - "-h", Arg.Set human, " Print sizes in human-readable format"; - "--human-readable", Arg.Set human, " Print sizes in human-readable format"; - "-i", Arg.Set inodes, " Show inodes instead of blocks"; - "--inodes", Arg.Set inodes, " Show inodes instead of blocks"; - "--version", Arg.Unit version, " Display version and exit"; + "-a", Arg.Set all, + " " ^ s_ "Show all domains (default: only active domains)"; + "--all", Arg.Set all, + " " ^ s_ "Show all domains (default: only active domains)"; + "-c", Arg.String set_uri, + "uri " ^ s_ "Connect to URI (default: Xen)"; + "--connect", Arg.String set_uri, + "uri " ^ s_ "Connect to URI (default: Xen)"; + "-h", Arg.Set human, + " " ^ s_ "Print sizes in human-readable format"; + "--human-readable", Arg.Set human, + " " ^ s_ "Print sizes in human-readable format"; + "-i", Arg.Set inodes, + " " ^ s_ "Show inodes instead of blocks"; + "--inodes", Arg.Set inodes, + " " ^ s_ "Show inodes instead of blocks"; + "--version", Arg.Unit version, + " " ^ s_ "Display version and exit"; ] in - let anon_fun str = raise (Arg.Bad (str ^ ": unknown parameter")) in - let usage_msg = "virt-df : like 'df', shows disk space used in guests + let anon_fun str = + raise (Arg.Bad (sprintf (f_ "%s: unknown parameter") str)) in + let usage_msg = s_ "virt-df : like 'df', shows disk space used in guests SUMMARY virt-df [-options] @@ -368,7 +379,7 @@ OPTIONS" in prerr_endline (Libvirt.Virterror.to_string err); (* If non-root and no explicit connection URI, print a warning. *) if geteuid () <> 0 && name = None then ( - print_endline "NB: If you want to monitor a local Xen hypervisor, you usually need to be root"; + print_endline (s_ "NB: If you want to monitor a local Xen hypervisor, you usually need to be root"); ); exit 1 in @@ -405,7 +416,7 @@ OPTIONS" in let nodes, domain_attrs = match xml with | Xml.Element ("domain", attrs, children) -> children, attrs - | _ -> failwith "get_xml_desc didn't return " in + | _ -> failwith (s_ "get_xml_desc didn't return ") in let domid = try Some (int_of_string (List.assoc "id" domain_attrs)) @@ -413,10 +424,10 @@ OPTIONS" in let rec loop = function | [] -> - failwith "get_xml_desc returned no node in XML" + failwith (s_ "get_xml_desc returned no node in XML") | Xml.Element ("name", _, [Xml.PCData name]) :: _ -> name | Xml.Element ("name", _, _) :: _ -> - failwith "get_xml_desc returned strange node" + failwith (s_ "get_xml_desc returned strange node") | _ :: rest -> loop rest in let name = loop nodes in @@ -484,11 +495,11 @@ OPTIONS" in let () = let total, used, avail = match !inodes, !human with - | false, false -> "1K-blocks", "Used", "Available" - | false, true -> "Size", "Used", "Available" - | true, _ -> "Inodes", "IUse", "IFree" in + | false, false -> s_ "1K-blocks", s_ "Used", s_ "Available" + | false, true -> s_ "Size", s_ "Used", s_ "Available" + | true, _ -> s_ "Inodes", s_ "IUse", s_ "IFree" in printf "%-20s %10s %10s %10s %s\n%!" - "Filesystem" total used avail "Type" in + (s_ "Filesystem") total used avail (s_ "Type") in (* Probe the devices. *) List.iter ( @@ -500,6 +511,6 @@ OPTIONS" in | { d_device = Some "cdrom" } -> () (* Ignore physical CD-ROM devices. *) | _ -> - printf "(device omitted)\n"; + print_endline (s_ "(device omitted)"); ) dom_disks ) doms diff --git a/virt-df/virt_df_ext2.ml b/virt-df/virt_df_ext2.ml old mode 100755 new mode 100644 index d2b51f3..1acd855 --- a/virt-df/virt_df_ext2.ml +++ b/virt-df/virt_df_ext2.ml @@ -21,6 +21,7 @@ open Unix open Printf +open Virt_df_gettext.Gettext (* Int64 operators for convenience. *) let (+^) = Int64.add @@ -35,10 +36,10 @@ let probe_ext2 target part_type fd start size = LargeFile.lseek fd ((start+^2L) *^ sector_size) SEEK_SET; let str = String.create 128 in if read fd str 0 128 <> 128 then - failwith "error reading ext2/ext3 magic" + failwith (s_ "error reading ext2/ext3 magic") else ( if str.[56] != '\x53' || str.[57] != '\xEF' then ( - Virt_df.ProbeFailed "partition marked EXT2/3 but no valid filesystem" + Virt_df.ProbeFailed (s_ "partition marked EXT2/3 but no valid filesystem") ) else ( (* Refer to *) let s_inodes_count = read_int32_le str 0 in @@ -78,7 +79,7 @@ let probe_ext2 target part_type fd start size = Virt_df.Filesystem { - Virt_df.fs_name = "Linux ext2/3"; + Virt_df.fs_name = s_ "Linux ext2/3"; fs_block_size = block_size; fs_blocks_total = s_blocks_count -^ overhead; fs_blocks_reserved = s_r_blocks_count; diff --git a/virt-df/virt_df_linux_swap.ml b/virt-df/virt_df_linux_swap.ml old mode 100755 new mode 100644 index 4638828..04e22b9 --- a/virt-df/virt_df_linux_swap.ml +++ b/virt-df/virt_df_linux_swap.ml @@ -20,6 +20,8 @@ Support for Linux swap partitions. *) +open Virt_df_gettext.Gettext + (* Int64 operators for convenience. *) let (+^) = Int64.add let (-^) = Int64.sub @@ -28,7 +30,7 @@ let (/^) = Int64.div let probe_swap target part_type fd start size = Virt_df.Swap { - Virt_df.swap_name = "Linux swap"; + Virt_df.swap_name = s_ "Linux swap"; swap_block_size = 4096L; (* XXX *) swap_blocks_total = size *^ 512L /^ 4096L; } diff --git a/virt-df/virt_df_lvm2.ml b/virt-df/virt_df_lvm2.ml old mode 100755 new mode 100644 index 8dc0c05..d01a5a8 --- a/virt-df/virt_df_lvm2.ml +++ b/virt-df/virt_df_lvm2.ml @@ -21,6 +21,7 @@ *) open Printf +open Virt_df_gettext.Gettext (* Int64 operators for convenience. *) let (+^) = Int64.add @@ -29,7 +30,7 @@ let ( *^ ) = Int64.mul let (/^) = Int64.div let probe_lvm2 target part_type fd start size = - Virt_df.ProbeFailed "LVM2 not supported yet" + Virt_df.ProbeFailed (s_ "LVM2 not supported yet") (* Register with main code. *) let () = -- cgit From 69a06d25bf078f994b3e17a4da1af765bb40ea1f Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Mon, 14 Apr 2008 17:48:00 +0100 Subject: pa_bitmatch package added. xml-light is now optional. MBR code now in its own file. --- virt-df/Makefile.in | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) (limited to 'virt-df') diff --git a/virt-df/Makefile.in b/virt-df/Makefile.in index 057c8e5..4a56d2d 100644 --- a/virt-df/Makefile.in +++ b/virt-df/Makefile.in @@ -25,10 +25,10 @@ prefix = @prefix@ exec_prefix = @exec_prefix@ bindir = @bindir@ -pkg_xml_light = @pkg_xml_light@ pkg_gettext = @pkg_gettext@ -OCAMLCPACKAGES := -package unix,extlib,xml-light +#OCAMLCPACKAGES := -package unix,extlib,xml-light,bitmatch +OCAMLCPACKAGES := -package unix,extlib,xml-light -I +bitmatch ifneq ($(pkg_gettext),no) OCAMLCPACKAGES += -package gettext-stub @@ -40,17 +40,24 @@ OBJS := \ virt_df_ext2.cmo \ virt_df_linux_swap.cmo \ virt_df_lvm2.cmo \ + virt_df_mbr.cmo \ virt_df_main.cmo XOBJS := $(OBJS:.cmo=.cmx) +SYNTAX := -pp "camlp4o -I`ocamlc -where`/bitmatch pa_bitmatch.cmo" + OCAMLCPACKAGES += -I ../libvirt -OCAMLCFLAGS := -g -w s -OCAMLCLIBS := -linkpkg +OCAMLCFLAGS := -g -w s $(SYNTAX) +#OCAMLCLIBS := -linkpkg +OCAMLCLIBS := -linkpkg bitmatch.cma OCAMLOPTPACKAGES := $(OCAMLCPACKAGES) -OCAMLOPTFLAGS := -w s -OCAMLOPTLIBS := $(OCAMLCLIBS) +OCAMLOPTFLAGS := -w s $(SYNTAX) +#OCAMLOPTLIBS := $(OCAMLCLIBS) +OCAMLOPTLIBS := -linkpkg bitmatch.cmxa + +OCAMLDEPFLAGS := $(SYNTAX) export LIBRARY_PATH=../libvirt export LD_LIBRARY_PATH=../libvirt -- cgit From f31c12ec325dd0f4f77e278c243d89da4ea228b8 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Mon, 14 Apr 2008 17:48:16 +0100 Subject: Updated deps. --- virt-df/.depend | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) (limited to 'virt-df') diff --git a/virt-df/.depend b/virt-df/.depend index 69ae982..5aa8cb7 100644 --- a/virt-df/.depend +++ b/virt-df/.depend @@ -1,11 +1,19 @@ -virt_df_ext2.cmo: virt_df_gettext.cmo virt_df.cmo -virt_df_ext2.cmx: virt_df_gettext.cmx virt_df.cmx -virt_df_linux_swap.cmo: virt_df_gettext.cmo virt_df.cmo -virt_df_linux_swap.cmx: virt_df_gettext.cmx virt_df.cmx +virt_df_ext2.cmo: virt_df_gettext.cmo virt_df.cmo \ + /usr/lib64/ocaml/bitmatch/bitmatch.cmi +virt_df_ext2.cmx: virt_df_gettext.cmx virt_df.cmx \ + /usr/lib64/ocaml/bitmatch/bitmatch.cmi +virt_df_linux_swap.cmo: virt_df_gettext.cmo virt_df.cmo \ + /usr/lib64/ocaml/bitmatch/bitmatch.cmi +virt_df_linux_swap.cmx: virt_df_gettext.cmx virt_df.cmx \ + /usr/lib64/ocaml/bitmatch/bitmatch.cmi virt_df_lvm2.cmo: virt_df_gettext.cmo virt_df.cmo virt_df_lvm2.cmx: virt_df_gettext.cmx virt_df.cmx virt_df_main.cmo: virt_df.cmo virt_df_main.cmx: virt_df.cmx +virt_df_mbr.cmo: virt_df_gettext.cmo virt_df.cmo \ + /usr/lib64/ocaml/bitmatch/bitmatch.cmi +virt_df_mbr.cmx: virt_df_gettext.cmx virt_df.cmx \ + /usr/lib64/ocaml/bitmatch/bitmatch.cmi virt_df.cmo: virt_df_gettext.cmo ../libvirt/libvirt_version.cmi \ ../libvirt/libvirt.cmi virt_df.cmx: virt_df_gettext.cmx ../libvirt/libvirt_version.cmx \ -- cgit From e6050cae9eee80791c3bb26f34c61f7dc89b142f Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Mon, 14 Apr 2008 17:48:49 +0100 Subject: Complete rewrite of virt-df: - Uses pa_bitmatch for robust parsing of disk structures. - Completely modularized. --- virt-df/virt_df.ml | 941 ++++++++++++++++++++++++------------------ virt-df/virt_df_ext2.ml | 164 +++++--- virt-df/virt_df_linux_swap.ml | 46 ++- virt-df/virt_df_lvm2.ml | 15 +- virt-df/virt_df_main.ml | 3 + virt-df/virt_df_mbr.ml | 195 +++++++++ 6 files changed, 874 insertions(+), 490 deletions(-) mode change 100755 => 100644 virt-df/virt_df_main.ml create mode 100644 virt-df/virt_df_mbr.ml (limited to 'virt-df') diff --git a/virt-df/virt_df.ml b/virt-df/virt_df.ml index 4fbc706..b972837 100644 --- a/virt-df/virt_df.ml +++ b/virt-df/virt_df.ml @@ -25,51 +25,163 @@ open Virt_df_gettext.Gettext module C = Libvirt.Connect module D = Libvirt.Domain -module N = Libvirt.Network -(* Int64 operators for convenience. - * For sanity we do all int operations as int64's. - *) -let (+^) = Int64.add -let (-^) = Int64.sub -let ( *^ ) = Int64.mul -let (/^) = Int64.div +(* If set to true, then emit lots of debugging information. *) +let debug = true -let uri = ref None -let inodes = ref false -let human = ref false -let all = ref false +(* Int32 infix operators for convenience. *) +let ( +* ) = Int32.add +let ( -* ) = Int32.sub +let ( ** ) = Int32.mul +let ( /* ) = Int32.div -(* Maximum number of extended partitions possible. *) -let max_extended_partitions = 100 +(* Int64 infix operators for convenience. *) +let ( +^ ) = Int64.add +let ( -^ ) = Int64.sub +let ( *^ ) = Int64.mul +let ( /^ ) = Int64.div + +(* State of command line arguments. *) +let uri = ref None (* Hypervisor/libvirt URI. *) +let inodes = ref false (* Display inodes. *) +let human = ref false (* Display human-readable. *) +let all = ref false (* Show all/active domains. *) +let test_files = ref [] (* Used for test mode only. *) + +(*----------------------------------------------------------------------*) +(* The "domain/device model" that we currently understand looks + * like this: + * + * domains + * | + * \--- host partitions / disk image files + * || + * guest block devices + * | + * +--> guest partitions (eg. using MBR) + * | | + * \-(1)->+--- filesystems (eg. ext3) + * | + * \--- PVs for LVM + * ||| + * VGs and LVs + * + * (1) Filesystems and PVs may also appear directly on guest + * block devices. + * + * Partition schemes (eg. MBR) and filesystems register themselves + * with this main module and they are queried first to get an idea + * of the physical devices, partitions and filesystems potentially + * available to the guest. + * + * Volume management schemes (eg. LVM) register themselves here + * and are called later with "spare" physical devices and partitions + * to see if they contain LVM data. If this results in additional + * logical volumes then these are checked for filesystems. + * + * Swap space is considered to be a dumb filesystem for the purposes + * of this discussion. + *) -let sector_size = 512L +(* A virtual (or physical!) device, encapsulating any translation + * that has to be done to access the device. eg. For partitions + * there is a simple offset, but for LVM you may need complicated + * table lookups. + * + * We keep the underlying file descriptors open for the duration + * of the program. There aren't likely to be many of them, and + * the program is short-lived, and it's easier than trying to + * track which device is using what fd. As a result, there is no + * need for any close/deallocation function. + * + * Note the very rare use of OOP in OCaml! + *) +class virtual device = +object (self) + method virtual read : int64 -> int -> string + method virtual size : int64 + method virtual name : string + + (* Helper method to read a chunk of data into a bitstring. *) + method read_bitstring offset len = + let str = self#read offset len in + (str, 0, len * 8) +end + +(* A concrete device which just direct-maps a file or /dev device. *) +class block_device filename = + let fd = openfile filename [ O_RDONLY ] 0 in + let size = (LargeFile.fstat fd).LargeFile.st_size in +object (self) + inherit device + method read offset len = + ignore (LargeFile.lseek fd offset SEEK_SET); + let str = String.make len '\000' in + read fd str 0 len; + str + method size = size + method name = filename +end + +(* A null device. Any attempt to read generates an error. *) +let null_device : device = +object + inherit device + method read _ _ = assert false + method size = 0L + method name = "null" +end + +(* Domains and candidate guest block devices. *) -(* Parse out the device XML to get the names of disks. *) type domain = { dom_name : string; (* Domain name. *) dom_id : int option; (* Domain ID (if running). *) dom_disks : disk list; (* Domain disks. *) } and disk = { + (* From the XML ... *) d_type : string option; (* The *) - d_device : string option; (* The *) - d_source : string option; (* The *) - d_target : string option; (* The *) -} + d_device : string; (* The (eg "disk") *) + d_source : string; (* The *) + d_target : string; (* The (eg "hda") *) -type partition = { + (* About the device itself. *) + d_dev : device; (* Disk device. *) + d_content : disk_content; (* What's on it. *) +} +and disk_content = + [ `Unknown (* Not probed or unknown. *) + | `Partitions of partitions (* Contains partitions. *) + | `Filesystem of filesystem (* Contains a filesystem directly. *) + | `PhysicalVolume of unit (* Contains an LVM PV. *) + ] + +(* Partitions. *) + +and partitions = { + parts_name : string; (* Name of partitioning scheme. *) + parts : partition list (* Partitions. *) +} +and partition = { part_status : partition_status; (* Bootable, etc. *) - part_type : int; (* Partition type. *) - part_lba_start : int64; (* LBA start sector. *) - part_len : int64; (* Length in sectors. *) + part_type : int; (* Partition filesystem type. *) + part_dev : device; (* Partition device. *) + part_content : partition_content; (* What's on it. *) } and partition_status = Bootable | Nonbootable | Malformed | NullEntry - -type filesystem_stats = { - fs_name : string; +and partition_content = + [ `Unknown (* Not probed or unknown. *) + | `Filesystem of filesystem (* Filesystem. *) + | `PhysicalVolume of unit (* Contains an LVM PV. *) + ] + +(* Filesystems (also swap devices). *) +and filesystem = { + fs_name : string; (* Name of filesystem. *) fs_block_size : int64; (* Block size (bytes). *) fs_blocks_total : int64; (* Total blocks. *) + fs_is_swap : bool; (* If swap, following not valid. *) fs_blocks_reserved : int64; (* Blocks reserved for super-user. *) fs_blocks_avail : int64; (* Blocks free (available). *) fs_blocks_used : int64; (* Blocks in use. *) @@ -78,250 +190,80 @@ type filesystem_stats = { fs_inodes_avail : int64; (* Inodes free (available). *) fs_inodes_used : int64; (* Inodes in use. *) } -and swap_stats = { - swap_name : string; - swap_block_size : int64; (* Block size (bytes). *) - swap_blocks_total : int64; (* Total blocks. *) -} -and fs_probe_t = (* Return type of the probe_partition.*) - | Filesystem of filesystem_stats - | Swap of swap_stats - | ProbeFailed of string (* Probe failed for some reason. *) - | ProbeIgnore (* This filesystem should be ignored. *) - -(* Register a filesystem type. *) -let filesystems = Hashtbl.create 13 -let fs_register part_types probe_fn = - List.iter - (fun part_type -> Hashtbl.replace filesystems part_type probe_fn) - part_types - -(* Probe the devices and display. - * - dom_name is the domain name - * - target will be something like "hda" - * - source will be the name of a file or disk partition on the local machine - *) -let rec probe_device dom_name target source = - let fd = openfile source [ O_RDONLY ] 0 in - let size = (LargeFile.fstat fd).LargeFile.st_size in - let size = size /^ sector_size in (* Size in sectors. *) - - (*print_device dom_name target source size;*) - - let partitions = probe_mbr fd in - - if partitions <> [] then ( - let stats = - List.mapi ( - fun i part -> - if part.part_status = Bootable || - part.part_status = Nonbootable then ( - let pnum = i+1 in - let target = target ^ string_of_int pnum in - Some (target, - probe_partition target (Some part.part_type) - fd part.part_lba_start part.part_len) - ) - else - None - ) partitions in - let stats = List.filter_map (fun x -> x) stats in - print_stats dom_name stats - ) else (* Not an MBR, assume it's a single partition. *) - print_stats dom_name [target, probe_partition target None fd 0L size]; - - close fd - -(* Probe the master boot record (if it is one) and read the partitions. - * Returns [] if this is not an MBR. - * http://en.wikipedia.org/wiki/Master_boot_record - *) -and probe_mbr fd = - lseek fd 510 SEEK_SET; - let str = String.create 2 in - if read fd str 0 2 <> 2 || str.[0] != '\x55' || str.[1] != '\xAA' then - [] (* Not MBR *) - else ( - (* Read the partition table. *) - lseek fd 446 SEEK_SET; - let str = String.create 64 in - if read fd str 0 64 <> 64 then - failwith (s_ "error reading partition table") - else ( - (* Extract partitions from the data. *) - let primaries = List.map (get_partition str) [ 0; 16; 32; 48 ] in - (* XXX validate partition extents compared to disk. *) - (* Read extended partition data. *) - let extendeds = List.map ( - function - | { part_type = 0x05 } as part -> - probe_extended_partition - max_extended_partitions fd part part.part_lba_start - | part -> [] - ) primaries in - let extendeds = List.concat extendeds in - primaries @ extendeds - ) - ) - -(* Probe an extended partition. *) -and probe_extended_partition max fd epart sect = - if max > 0 then ( - (* Offset of the first EBR. *) - let ebr_offs = sect *^ sector_size in - (* EBR Signature? *) - LargeFile.lseek fd (ebr_offs +^ 510L) SEEK_SET; - let str = String.create 2 in - if read fd str 0 2 <> 2 || str.[0] != '\x55' || str.[1] != '\xAA' then - [] (* Not EBR *) - else ( - (* Read the extended partition table entries (just 2 of them). *) - LargeFile.lseek fd (ebr_offs +^ 446L) SEEK_SET; - let str = String.create 32 in - if read fd str 0 32 <> 32 then - failwith (s_ "error reading extended partition") - else ( - (* Extract partitions from the data. *) - let part1, part2 = - match List.map (get_partition str) [ 0; 16 ] with - | [p1;p2] -> p1,p2 - | _ -> failwith (s_ "probe_extended_partition: internal error") in - (* First partition entry has offset to the start of this partition. *) - let part1 = { part1 with - part_lba_start = sect +^ part1.part_lba_start } in - (* Second partition entry is zeroes if end of list, otherwise points - * to the next partition. - *) - if part2.part_status = NullEntry then - [part1] - else - part1 :: probe_extended_partition - (max-1) fd epart (sect +^ part2.part_lba_start) - ) - ) - ) - else [] - -(* Get the partition data from str.[offs] - str.[offs+15] *) -and get_partition str offs = - let part_type = Char.code str.[offs+4] in - let part_lba_start = read_int32_le str (offs+8) in - let part_len = read_int32_le str (offs+12) in - - let part_status = - if part_type = 0 && part_lba_start = 0L && part_len = 0L then - NullEntry - else ( - let part_status = Char.code str.[offs] in - match part_status with - | 0x80 -> Bootable | 0 -> Nonbootable | _ -> Malformed - ) in - - { part_status = part_status; - part_type = part_type; - part_lba_start = part_lba_start; - part_len = part_len } - -(* Probe a single partition, which we assume contains either a - * filesystem or is a PV. - * - target will be something like "hda" or "hda1" - * - part_type will be the partition type if known, or None - * - fd is a file descriptor opened on the device - * - start & size are where we think the start and size of the - * partition is within the file descriptor (in SECTORS) - *) -and probe_partition target part_type fd start size = - match part_type with - | None -> - ProbeFailed (s_ "detection of unpartitioned devices not yet supported") - | Some 0x05 -> - ProbeIgnore (* Extended partition - ignore it. *) - | Some part_type -> - try - let probe_fn = Hashtbl.find filesystems part_type in - probe_fn target part_type fd start size - with - Not_found -> - ProbeFailed - (sprintf (f_ "unsupported partition type %02x") part_type) - -and print_stats dom_name statss = - List.iter ( - fun (target, fs_probe_t) -> - let dom_target = dom_name ^ ":" ^ target in - printf "%-20s " dom_target; - - match fs_probe_t with - (* Swap partition. *) - | Swap { swap_name = swap_name; - swap_block_size = block_size; - swap_blocks_total = blocks_total } -> - if not !human then - printf "%10Ld %s\n" - (block_size *^ blocks_total /^ 1024L) swap_name - else - printf "%10s %s\n" - (printable_size (block_size *^ blocks_total)) swap_name - (* Ordinary filesystem. *) - | Filesystem stats -> - if not !inodes then ( (* Block display. *) - (* 'df' doesn't count the restricted blocks. *) - let blocks_total = - stats.fs_blocks_total -^ stats.fs_blocks_reserved in - let blocks_avail = - stats.fs_blocks_avail -^ stats.fs_blocks_reserved in - let blocks_avail = - if blocks_avail < 0L then 0L else blocks_avail in - - if not !human then ( (* Display 1K blocks. *) - printf "%10Ld %10Ld %10Ld %s\n" - (blocks_total *^ stats.fs_block_size /^ 1024L) - (stats.fs_blocks_used *^ stats.fs_block_size /^ 1024L) - (blocks_avail *^ stats.fs_block_size /^ 1024L) - stats.fs_name - ) else ( (* Human-readable blocks. *) - printf "%10s %10s %10s %s\n" - (printable_size (blocks_total *^ stats.fs_block_size)) - (printable_size (stats.fs_blocks_used *^ stats.fs_block_size)) - (printable_size (blocks_avail *^ stats.fs_block_size)) - stats.fs_name - ) - ) else ( (* Inodes display. *) - printf "%10Ld %10Ld %10Ld %s\n" - stats.fs_inodes_total stats.fs_inodes_used stats.fs_inodes_avail - stats.fs_name - ) - - (* Unsupported filesystem or other failure. *) - | ProbeFailed reason -> - printf " %s\n" reason - - | ProbeIgnore -> () - ) statss - -(* Target is something like "hda" and size is the size in sectors. *) -and print_device dom_name target source size = - printf "%s /dev/%s (%s) %s\n" - dom_name target (printable_size (size *^ sector_size)) source - -and printable_size bytes = - if bytes < 1024L *^ 1024L then - sprintf "%Ld bytes" bytes - else if bytes < 1024L *^ 1024L *^ 1024L then - sprintf "%.1f MiB" (Int64.to_float (bytes /^ 1024L) /. 1024.) - else - sprintf "%.1f GiB" (Int64.to_float (bytes /^ 1024L /^ 1024L) /. 1024.) - -and read_int32_le str offs = - Int64.of_int (Char.code str.[offs]) +^ - 256L *^ Int64.of_int (Char.code str.[offs+1]) +^ - 65536L *^ Int64.of_int (Char.code str.[offs+2]) +^ - 16777216L *^ Int64.of_int (Char.code str.[offs+3]) - -and read_int16_le str offs = - Int64.of_int (Char.code str.[offs]) +^ - 256L *^ Int64.of_int (Char.code str.[offs+1]) +(* Convert partition, filesystem types to printable strings for debugging. *) +let string_of_partition + { part_status = status; part_type = typ; part_dev = dev } = + sprintf "%s: %s partition type %d" + dev#name + (match status with + | Bootable -> "bootable" + | Nonbootable -> "nonbootable" + | Malformed -> "malformed" + | NullEntry -> "empty") + typ + +let string_of_filesystem { fs_name = name; fs_is_swap = swap } = + if not swap then name + else name ^ " [swap]" + +(* Register a partition scheme. *) +let partition_types = ref [] +let partition_type_register (parts_name : string) probe_fn = + partition_types := (parts_name, probe_fn) :: !partition_types + +(* 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; + let rec loop = function + | [] -> None + | (parts_name, probe_fn) :: rest -> + try Some (probe_fn dev) + with Not_found -> loop rest + in + let r = loop !partition_types in + if debug then ( + match r with + | None -> eprintf "no partitions found on %s\n%!" dev#name + | Some { parts_name = name; parts = parts } -> + eprintf "found %d %s partitions on %s:\n" + (List.length parts) name dev#name; + List.iter (fun p -> eprintf "\t%s\n%!" (string_of_partition p)) parts + ); + r + +(* Register a filesystem type (or swap). *) +let filesystem_types = ref [] +let filesystem_type_register (fs_name : string) probe_fn = + filesystem_types := (fs_name, probe_fn) :: !filesystem_types + +(* Probe a device for filesystems. Returns [Some fs] or [None]. *) +let probe_for_filesystems dev = + if debug then eprintf "probing for a filesystem on %s ...\n%!" dev#name; + let rec loop = function + | [] -> None + | (fs_name, probe_fn) :: rest -> + try Some (probe_fn dev) + with Not_found -> loop rest + in + let r = loop !filesystem_types in + if debug then ( + match r with + | None -> eprintf "no filesystem found on %s\n%!" dev#name + | Some fs -> + eprintf "found a filesystem on %s:\n" dev#name; + eprintf "\t%s\n%!" (string_of_filesystem fs) + ); + r + +(* Register a volume management type. *) +(* +let lvm_types = ref [] +let lvm_type_register (lvm_name : string) probe_fn = + lvm_types := (lvm_name, probe_fn) :: !lvm_types +*) + +(*----------------------------------------------------------------------*) let main () = (* Command line argument parsing. *) @@ -337,6 +279,10 @@ let main () = exit 0 in + let test_mode filename = + test_files := filename :: !test_files + in + let argspec = Arg.align [ "-a", Arg.Set all, " " ^ s_ "Show all domains (default: only active domains)"; @@ -354,6 +300,8 @@ let main () = " " ^ s_ "Show inodes instead of blocks"; "--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"; "--version", Arg.Unit version, " " ^ s_ "Display version and exit"; ] in @@ -369,127 +317,230 @@ OPTIONS" in Arg.parse argspec anon_fun usage_msg; - let xmls = - (* Connect to the hypervisor. *) - let conn = - let name = !uri in - try C.connect_readonly ?name () - with - Libvirt.Virterror err -> - prerr_endline (Libvirt.Virterror.to_string err); - (* If non-root and no explicit connection URI, print a warning. *) - if geteuid () <> 0 && name = None then ( - print_endline (s_ "NB: If you want to monitor a local Xen hypervisor, you usually need to be root"); - ); - exit 1 in - - (* Get the list of active & inactive domains. *) - let doms = - let nr_active_doms = C.num_of_domains conn in - let active_doms = Array.to_list (C.list_domains conn nr_active_doms) in - let active_doms = List.map (D.lookup_by_id conn) active_doms in - if not !all then - active_doms - else ( - let nr_inactive_doms = C.num_of_defined_domains conn in - let inactive_doms = - Array.to_list (C.list_defined_domains conn nr_inactive_doms) in - let inactive_doms = List.map (D.lookup_by_name conn) inactive_doms in - active_doms @ inactive_doms - ) in - - (* Get their XML. *) - let xmls = List.map D.get_xml_desc doms in - - (* Parse the XML. *) - let xmls = List.map Xml.parse_string xmls in - - (* Return just the XML documents - everything else will be closed - * and freed including the connection to the hypervisor. - *) - xmls in - let doms : domain list = - (* Grr.. Need to use a library which has XPATH support (or cduce). *) - List.map ( - fun xml -> - let nodes, domain_attrs = - match xml with - | Xml.Element ("domain", attrs, children) -> children, attrs - | _ -> failwith (s_ "get_xml_desc didn't return ") in - - let domid = - try Some (int_of_string (List.assoc "id" domain_attrs)) - with Not_found -> None in - - let rec loop = function - | [] -> - failwith (s_ "get_xml_desc returned no node in XML") - | Xml.Element ("name", _, [Xml.PCData name]) :: _ -> name - | Xml.Element ("name", _, _) :: _ -> - failwith (s_ "get_xml_desc returned strange node") - | _ :: rest -> loop rest - in - let name = loop nodes in - - let devices = + if !test_files = [] then ( + let xmls = + (* Connect to the hypervisor. *) + let conn = + let name = !uri in + try C.connect_readonly ?name () + with + Libvirt.Virterror err -> + prerr_endline (Libvirt.Virterror.to_string err); + (* If non-root and no explicit connection URI, print a warning. *) + if geteuid () <> 0 && name = None then ( + print_endline (s_ "NB: If you want to monitor a local Xen hypervisor, you usually need to be root"); + ); + exit 1 in + + (* Get the list of active & inactive domains. *) + let doms = + let nr_active_doms = C.num_of_domains conn in + let active_doms = + Array.to_list (C.list_domains conn nr_active_doms) in + let active_doms = + List.map (D.lookup_by_id conn) active_doms in + if not !all then + active_doms + else ( + let nr_inactive_doms = C.num_of_defined_domains conn in + let inactive_doms = + Array.to_list (C.list_defined_domains conn nr_inactive_doms) in + let inactive_doms = + List.map (D.lookup_by_name conn) inactive_doms in + active_doms @ inactive_doms + ) in + + (* Get their XML. *) + let xmls = List.map D.get_xml_desc doms in + + (* Parse the XML. *) + let xmls = List.map Xml.parse_string xmls in + + (* Return just the XML documents - everything else will be closed + * and freed including the connection to the hypervisor. + *) + xmls in + + (* Grr.. Need to use a library which has XPATH support (or cduce). *) + List.map ( + fun xml -> + let nodes, domain_attrs = + match xml with + | Xml.Element ("domain", attrs, children) -> children, attrs + | _ -> failwith (s_ "get_xml_desc didn't return ") in + + let domid = + try Some (int_of_string (List.assoc "id" domain_attrs)) + with Not_found -> None in + + let rec loop = function + | [] -> + failwith (s_ "get_xml_desc returned no node in XML") + | Xml.Element ("name", _, [Xml.PCData name]) :: _ -> name + | Xml.Element ("name", _, _) :: _ -> + failwith (s_ "get_xml_desc returned strange node") + | _ :: rest -> loop rest + in + let name = loop nodes in + let devices = + let devices = + List.filter_map ( + function + | Xml.Element ("devices", _, devices) -> Some devices + | _ -> None + ) nodes in + List.concat devices in + + let rec target_dev_of = function + | [] -> None + | Xml.Element ("target", attrs, _) :: rest -> + (try Some (List.assoc "dev" attrs) + with Not_found -> target_dev_of rest) + | _ :: rest -> target_dev_of rest + in + + let rec source_file_of = function + | [] -> None + | Xml.Element ("source", attrs, _) :: rest -> + (try Some (List.assoc "file" attrs) + with Not_found -> source_file_of rest) + | _ :: rest -> source_file_of rest + in + + let rec source_dev_of = function + | [] -> None + | Xml.Element ("source", attrs, _) :: rest -> + (try Some (List.assoc "dev" attrs) + with Not_found -> source_dev_of rest) + | _ :: rest -> source_dev_of rest + in + + let disks = List.filter_map ( function - | Xml.Element ("devices", _, devices) -> Some devices + | Xml.Element ("disk", attrs, children) -> + let typ = + try Some (List.assoc "type" attrs) + with Not_found -> None in + let device = + try Some (List.assoc "device" attrs) + with Not_found -> None in + let source = + match source_file_of children with + | (Some _) as source -> source + | None -> source_dev_of children in + let target = target_dev_of children in + + (* We only care about devices where we have + * source and target. Ignore CD-ROM devices. + *) + (match source, target, device with + | _, _, Some "cdrom" -> None (* ignore *) + | Some source, Some target, Some device -> + (* Try to create a 'device' object for this + * device. If it fails, print a warning + * and ignore the device. + *) + (try + let dev = new block_device source in + Some { + d_type = typ; d_device = device; + d_source = source; d_target = target; + d_dev = dev; d_content = `Unknown + } + with + Unix_error (err, func, param) -> + eprintf "%s:%s: %s" func param (error_message err); + None + ) + | _ -> None (* ignore anything else *) + ) + | _ -> None - ) nodes in - List.concat devices in - - let rec target_dev_of = function - | [] -> None - | Xml.Element ("target", attrs, _) :: rest -> - (try Some (List.assoc "dev" attrs) - with Not_found -> target_dev_of rest) - | _ :: rest -> target_dev_of rest - in - - let rec source_file_of = function - | [] -> None - | Xml.Element ("source", attrs, _) :: rest -> - (try Some (List.assoc "file" attrs) - with Not_found -> source_file_of rest) - | _ :: rest -> source_file_of rest - in - - let rec source_dev_of = function - | [] -> None - | Xml.Element ("source", attrs, _) :: rest -> - (try Some (List.assoc "dev" attrs) - with Not_found -> source_dev_of rest) - | _ :: rest -> source_dev_of rest - in - - let disks = - List.filter_map ( - function - | Xml.Element ("disk", attrs, children) -> - let typ = - try Some (List.assoc "type" attrs) - with Not_found -> None in - let device = - try Some (List.assoc "device" attrs) - with Not_found -> None in - let source = - match source_file_of children with - | (Some _) as source -> source - | None -> source_dev_of children in - let target = target_dev_of children in - - Some { - d_type = typ; d_device = device; - d_source = source; d_target = target - } - | _ -> None - ) devices in - - { dom_name = name; dom_id = domid; dom_disks = disks } - ) xmls in + ) devices in + + { dom_name = name; dom_id = domid; dom_disks = disks } + ) xmls + ) else ( + (* In test mode (-t option) the user can pass one or more + * block devices or filenames (containing partitions/filesystems/etc) + * which we use for testing virt-df itself. We create fake domains + * from these. + *) + List.map ( + fun filename -> + { + dom_name = filename; dom_id = None; + dom_disks = [ + { + d_type = Some "disk"; d_device = "disk"; + d_source = filename; d_target = "hda"; + d_dev = new block_device filename; d_content = `Unknown; + } + ] + } + ) !test_files + ) in + + (* HOF to map over disks. *) + let map_over_disks doms f = + List.map ( + fun ({ dom_disks = disks } as dom) -> + let disks = List.map f disks in + { dom with dom_disks = disks } + ) doms + in + + (* 'doms' is our list of domains and their guest block devices, and + * we've successfully opened each block device. Now probe them + * to find out what they contain. + *) + let doms = map_over_disks doms ( + fun ({ d_dev = dev } as disk) -> + (* See if it is partitioned first. *) + let parts = probe_for_partitions dev in + match parts with + | Some parts -> + { disk with d_content = `Partitions parts } + | None -> + (* Not partitioned. Does it contain a filesystem? *) + let fs = probe_for_filesystems dev in + match fs with + | Some fs -> + { disk with d_content = `Filesystem fs } + | None -> + (* Not partitioned, no filesystem, so it's spare. *) + disk + ) in + + (* Now we have either detected partitions or a filesystem on each + * physical device (or perhaps neither). See what is on those + * partitions. + *) + let doms = map_over_disks doms ( + function + | ({ d_dev = dev; d_content = `Partitions parts } as disk) -> + let ps = List.map ( + fun p -> + if p.part_status = Bootable || p.part_status = Nonbootable then ( + let fs = probe_for_filesystems p.part_dev in + match fs with + | Some fs -> + { p with part_content = `Filesystem fs } + | None -> + p + ) else p + ) parts.parts in + let parts = { parts with parts = ps } in + { disk with d_content = `Partitions parts } + | disk -> disk + ) in + + (* XXX LVM stuff here. *) + + (* Print the title. *) let () = @@ -501,16 +552,108 @@ OPTIONS" in printf "%-20s %10s %10s %10s %s\n%!" (s_ "Filesystem") total used avail (s_ "Type") in - (* Probe the devices. *) - List.iter ( - fun { dom_name = dom_name; dom_disks = dom_disks } -> - List.iter ( - function - | { d_source = Some source; d_target = Some target } -> - probe_device dom_name target source - | { d_device = Some "cdrom" } -> - () (* Ignore physical CD-ROM devices. *) - | _ -> - print_endline (s_ "(device omitted)"); - ) dom_disks - ) doms + let printable_size bytes = + if bytes < 1024L *^ 1024L then + sprintf "%Ld bytes" bytes + else if bytes < 1024L *^ 1024L *^ 1024L then + sprintf "%.1f MiB" (Int64.to_float (bytes /^ 1024L) /. 1024.) + else + sprintf "%.1f GiB" (Int64.to_float (bytes /^ 1024L /^ 1024L) /. 1024.) + in + + (* HOF to iterate over filesystems. *) + let iter_over_filesystems doms f = + List.iter ( + fun ({ dom_disks = disks } as dom) -> + List.iter ( + function + | ({ d_content = `Filesystem fs } as disk) -> + f dom disk None fs + | ({ d_content = `Partitions partitions } as disk) -> + List.iteri ( + fun i -> + function + | ({ part_content = `Filesystem fs } as part) -> + f dom disk (Some (part, i)) fs + | _ -> () + ) partitions.parts + | _ -> () + ) disks + ) doms + in + + (* Print stats for each recognized filesystem. *) + let print_stats dom disk part fs = + (* Printable name is like "domain:hda" or "domain:hda1". *) + let name = + let dom_name = dom.dom_name in + let d_target = disk.d_target in + match part with + | None -> + dom_name ^ ":" ^ d_target + | Some (_, pnum) -> + dom_name ^ ":" ^ d_target ^ string_of_int pnum in + printf "%-20s " name; + + if fs.fs_is_swap then ( + (* Swap partition. *) + if not !human then + printf "%10Ld %s\n" + (fs.fs_block_size *^ fs.fs_blocks_total /^ 1024L) fs.fs_name + else + printf "%10s %s\n" + (printable_size (fs.fs_block_size *^ fs.fs_blocks_total)) fs.fs_name + ) else ( + (* Ordinary filesystem. *) + if not !inodes then ( (* Block display. *) + (* 'df' doesn't count the restricted blocks. *) + let blocks_total = fs.fs_blocks_total -^ fs.fs_blocks_reserved in + let blocks_avail = fs.fs_blocks_avail -^ fs.fs_blocks_reserved in + let blocks_avail = if blocks_avail < 0L then 0L else blocks_avail in + + if not !human then ( (* Display 1K blocks. *) + printf "%10Ld %10Ld %10Ld %s\n" + (blocks_total *^ fs.fs_block_size /^ 1024L) + (fs.fs_blocks_used *^ fs.fs_block_size /^ 1024L) + (blocks_avail *^ fs.fs_block_size /^ 1024L) + fs.fs_name + ) else ( (* Human-readable blocks. *) + printf "%10s %10s %10s %s\n" + (printable_size (blocks_total *^ fs.fs_block_size)) + (printable_size (fs.fs_blocks_used *^ fs.fs_block_size)) + (printable_size (blocks_avail *^ fs.fs_block_size)) + fs.fs_name + ) + ) else ( (* Inodes display. *) + printf "%10Ld %10Ld %10Ld %s\n" + fs.fs_inodes_total fs.fs_inodes_used fs.fs_inodes_avail + fs.fs_name + ) + ) + in + iter_over_filesystems doms print_stats + +(* +(* Probe a single partition, which we assume contains either a + * filesystem or is a PV. + * - target will be something like "hda" or "hda1" + * - part_type will be the partition type if known, or None + * - fd is a file descriptor opened on the device + * - start & size are where we think the start and size of the + * partition is within the file descriptor (in SECTORS) + *) +and probe_partition target part_type fd start size = + match part_type with + | None -> + ProbeFailed (s_ "detection of unpartitioned devices not yet supported") + | Some 0x05 -> + ProbeIgnore (* Extended partition - ignore it. *) + | Some part_type -> + try + let probe_fn = Hashtbl.find filesystems part_type in + probe_fn target part_type fd start size + with + Not_found -> + ProbeFailed + (sprintf (f_ "unsupported partition type %02x") part_type) +*) diff --git a/virt-df/virt_df_ext2.ml b/virt-df/virt_df_ext2.ml index 1acd855..0ea8a25 100644 --- a/virt-df/virt_df_ext2.ml +++ b/virt-df/virt_df_ext2.ml @@ -21,46 +21,82 @@ open Unix open Printf + open Virt_df_gettext.Gettext +open Virt_df + +let superblock_offset = 1024L + +let probe_ext2 (dev : device) = + (* Load the superblock. *) + let bits = dev#read_bitstring superblock_offset 1024 in + + (* The structure is straight from /usr/include/linux/ext3_fs.h *) + bitmatch bits with + | s_inodes_count : 32 : littleendian; (* Inodes count *) + s_blocks_count : 32 : littleendian; (* Blocks count *) + s_r_blocks_count : 32 : littleendian; (* Reserved blocks count *) + s_free_blocks_count : 32 : littleendian; (* Free blocks count *) + s_free_inodes_count : 32 : littleendian; (* Free inodes count *) + s_first_data_block : 32 : littleendian; (* First Data Block *) + s_log_block_size : 32 : littleendian; (* Block size *) + s_log_frag_size : 32 : littleendian; (* Fragment size *) + s_blocks_per_group : 32 : littleendian; (* # Blocks per group *) + s_frags_per_group : 32 : littleendian; (* # Fragments per group *) + s_inodes_per_group : 32 : littleendian; (* # Inodes per group *) + s_mtime : 32 : littleendian; (* Mount time *) + s_wtime : 32 : littleendian; (* Write time *) + s_mnt_count : 16 : littleendian; (* Mount count *) + s_max_mnt_count : 16 : littleendian; (* Maximal mount count *) + 0xef53 : 16 : littleendian; (* Magic signature *) + s_state : 16 : littleendian; (* File system state *) + s_errors : 16 : littleendian; (* Behaviour when detecting errors *) + s_minor_rev_level : 16 : littleendian; (* minor revision level *) + s_lastcheck : 32 : littleendian; (* time of last check *) + s_checkinterval : 32 : littleendian; (* max. time between checks *) + s_creator_os : 32 : littleendian; (* OS *) + s_rev_level : 32 : littleendian; (* Revision level *) + s_def_resuid : 16 : littleendian; (* Default uid for reserved blocks *) + s_def_resgid : 16 : littleendian; (* Default gid for reserved blocks *) + s_first_ino : 32 : littleendian; (* First non-reserved inode *) + s_inode_size : 16 : littleendian; (* size of inode structure *) + s_block_group_nr : 16 : littleendian; (* block group # of this superblock *) + s_feature_compat : 32 : littleendian; (* compatible feature set *) + s_feature_incompat : 32 : littleendian; (* incompatible feature set *) + s_feature_ro_compat : 32 : littleendian; (* readonly-compatible feature set *) + s_uuid : 128 : bitstring; (* 128-bit uuid for volume *) + s_volume_name : 128 : bitstring; (* volume name XXX string *) + s_last_mounted : 512 : bitstring; (* directory where last mounted XXX string *) + s_algorithm_usage_bitmap : 32 : littleendian; (* For compression *) + s_prealloc_blocks : 8; (* Nr of blocks to try to preallocate*) + s_prealloc_dir_blocks : 8; (* Nr to preallocate for dirs *) + s_reserved_gdt_blocks : 16 : littleendian; (* Per group desc for online growth *) + s_journal_uuid : 128 : bitstring; (* uuid of journal superblock *) + s_journal_inum : 32 : littleendian; (* inode number of journal file *) + s_journal_dev : 32 : littleendian; (* device number of journal file *) + s_last_orphan : 32 : littleendian; (* start of list of inodes to delete *) + s_hash_seed0 : 32 : littleendian; (* HTREE hash seed *) + s_hash_seed1 : 32 : littleendian; + s_hash_seed2 : 32 : littleendian; + s_hash_seed3 : 32 : littleendian; + s_def_hash_version : 8; (* Default hash version to use *) + s_reserved_char_pad : 8; + s_reserved_word_pad : 16 : littleendian; + s_default_mount_opts : 32 : littleendian; + s_first_meta_bg : 32 : littleendian; (* First metablock block group *) + s_reserved : 6080 : bitstring -> (* Padding to the end of the block *) -(* Int64 operators for convenience. *) -let (+^) = Int64.add -let (-^) = Int64.sub -let ( *^ ) = Int64.mul -let (/^) = Int64.div - -let sector_size = Virt_df.sector_size -let read_int32_le = Virt_df.read_int32_le - -let probe_ext2 target part_type fd start size = - LargeFile.lseek fd ((start+^2L) *^ sector_size) SEEK_SET; - let str = String.create 128 in - if read fd str 0 128 <> 128 then - failwith (s_ "error reading ext2/ext3 magic") - else ( - if str.[56] != '\x53' || str.[57] != '\xEF' then ( - Virt_df.ProbeFailed (s_ "partition marked EXT2/3 but no valid filesystem") - ) else ( - (* Refer to *) - let s_inodes_count = read_int32_le str 0 in - let s_blocks_count = read_int32_le str 4 in - let s_r_blocks_count = read_int32_le str 8 in - let s_free_blocks_count = read_int32_le str 12 in - let s_free_inodes_count = read_int32_le str 16 in - let s_first_data_block = read_int32_le str 20 in - let s_log_block_size = read_int32_le str 24 in - (*let s_log_frag_size = read_int32_le str 28 in*) - let s_blocks_per_group = read_int32_le str 32 in - - (* Work out the block size in bytes. *) - let s_log_block_size = Int64.to_int s_log_block_size in - let block_size = 1024L in - let block_size = Int64.shift_left block_size s_log_block_size in - - (* Number of groups. *) - let s_groups_count = - (s_blocks_count -^ s_first_data_block -^ 1L) - /^ s_blocks_per_group +^ 1L in + (* Work out the block size in bytes. *) + let s_log_block_size = Int32.to_int s_log_block_size in + let block_size = 1024L in + let block_size = Int64.shift_left block_size s_log_block_size in + + (* Number of groups. *) + let s_groups_count = + Int64.of_int32 ( + (s_blocks_count -* s_first_data_block -* 1l) + /* s_blocks_per_group +* 1l + ) in (* (* Number of group descriptors per block. *) @@ -71,30 +107,32 @@ let probe_ext2 target part_type fd start size = /^ s_desc_per_block *) - (* Calculate the block overhead (used by superblocks, inodes, etc.) - * See fs/ext2/super.c. - *) - let overhead = s_first_data_block in - let overhead = (* XXX *) overhead in - - - Virt_df.Filesystem { - Virt_df.fs_name = s_ "Linux ext2/3"; - fs_block_size = block_size; - fs_blocks_total = s_blocks_count -^ overhead; - fs_blocks_reserved = s_r_blocks_count; - fs_blocks_avail = s_free_blocks_count; - fs_blocks_used = s_blocks_count -^ overhead -^ s_free_blocks_count; - fs_inodes_total = s_inodes_count; - fs_inodes_reserved = 0L; (* XXX? *) - fs_inodes_avail = s_free_inodes_count; - fs_inodes_used = s_inodes_count (*-^ 0L*) -^ s_free_inodes_count; - } - ) - ) + (* Calculate the block overhead (used by superblocks, inodes, etc.) + * See fs/ext2/super.c. + *) + let overhead = Int64.of_int32 s_first_data_block in + let overhead = (* XXX *) overhead in + + { + fs_name = s_ "Linux ext2/3"; + fs_block_size = block_size; + fs_blocks_total = Int64.of_int32 s_blocks_count -^ overhead; + fs_is_swap = false; + fs_blocks_reserved = Int64.of_int32 s_r_blocks_count; + fs_blocks_avail = Int64.of_int32 s_free_blocks_count; + fs_blocks_used = + Int64.of_int32 s_blocks_count -^ overhead + -^ Int64.of_int32 s_free_blocks_count; + fs_inodes_total = Int64.of_int32 s_inodes_count; + fs_inodes_reserved = 0L; (* XXX? *) + fs_inodes_avail = Int64.of_int32 s_free_inodes_count; + fs_inodes_used = Int64.of_int32 s_inodes_count + (*-^ 0L*) + -^ Int64.of_int32 s_free_inodes_count; + } + + | _ -> + raise Not_found (* Not an EXT2/3 superblock. *) (* Register with main code. *) -let () = - Virt_df.fs_register - [ 0x83 ] (* Partition type. *) - probe_ext2 +let () = filesystem_type_register "ext2" probe_ext2 diff --git a/virt-df/virt_df_linux_swap.ml b/virt-df/virt_df_linux_swap.ml index 04e22b9..ad56149 100644 --- a/virt-df/virt_df_linux_swap.ml +++ b/virt-df/virt_df_linux_swap.ml @@ -21,22 +21,34 @@ *) open Virt_df_gettext.Gettext - -(* Int64 operators for convenience. *) -let (+^) = Int64.add -let (-^) = Int64.sub -let ( *^ ) = Int64.mul -let (/^) = Int64.div - -let probe_swap target part_type fd start size = - Virt_df.Swap { - Virt_df.swap_name = s_ "Linux swap"; - swap_block_size = 4096L; (* XXX *) - swap_blocks_total = size *^ 512L /^ 4096L; - } +open Virt_df + +let probe_swap (dev : device) = + (* Load the "superblock" (ie. first 0x1000 bytes). *) + let bits = dev#read_bitstring 0L 0x1000 in + + bitmatch bits with + (* Actually this isn't just padding. *) + | padding : 8*0x1000 - 10*8 : bitstring; + magic : 10*8 : bitstring + when Bitmatch.string_of_bitstring magic = "SWAPSPACE2" -> + { + fs_name = s_ "Linux swap"; + fs_block_size = 4096L; (* XXX *) + fs_blocks_total = dev#size /^ 4096L; + + (* The remaining fields are ignored when fs_is_swap is true. *) + fs_is_swap = true; + fs_blocks_reserved = 0L; + fs_blocks_avail = 0L; + fs_blocks_used = 0L; + fs_inodes_total = 0L; + fs_inodes_reserved = 0L; + fs_inodes_avail = 0L; + fs_inodes_used = 0L; + } + | _ -> + raise Not_found (* Not Linux swapspace. *) (* Register with main code. *) -let () = - Virt_df.fs_register - [ 0x82 ] (* Partition type. *) - probe_swap +let () = filesystem_type_register "linux_swap" probe_swap diff --git a/virt-df/virt_df_lvm2.ml b/virt-df/virt_df_lvm2.ml index d01a5a8..a79ec7f 100644 --- a/virt-df/virt_df_lvm2.ml +++ b/virt-df/virt_df_lvm2.ml @@ -22,18 +22,11 @@ open Printf open Virt_df_gettext.Gettext +open Virt_df -(* Int64 operators for convenience. *) -let (+^) = Int64.add -let (-^) = Int64.sub -let ( *^ ) = Int64.mul -let (/^) = Int64.div - -let probe_lvm2 target part_type fd start size = - Virt_df.ProbeFailed (s_ "LVM2 not supported yet") +let probe_lvm2 (dev : device) = + raise Not_found (* Register with main code. *) let () = - Virt_df.fs_register - [ 0x8e ] (* Partition type. *) - probe_lvm2 + filesystem_type_register "LVM2" probe_lvm2 diff --git a/virt-df/virt_df_main.ml b/virt-df/virt_df_main.ml old mode 100755 new mode 100644 index bc4096b..1359b28 --- a/virt-df/virt_df_main.ml +++ b/virt-df/virt_df_main.ml @@ -17,4 +17,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) +(* We just need this so that the filesystem modules get a chance to + * register themselves before we run the main program. + *) let () = Virt_df.main () diff --git a/virt-df/virt_df_mbr.ml b/virt-df/virt_df_mbr.ml new file mode 100644 index 0000000..b9a6cb7 --- /dev/null +++ b/virt-df/virt_df_mbr.ml @@ -0,0 +1,195 @@ +(* 'df' command for virtual domains. + + (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc. + http://libvirt.org/ + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + Support for Master Boot Record partition scheme. +*) + +open Printf +open Unix +open ExtList + +open Virt_df_gettext.Gettext +open Virt_df + +let sector_size = 512 +let sector_size64 = 512L + +(* Maximum number of extended partitions possible. *) +let max_extended_partitions = 100 + +(* Device representing a single partition. It just acts as an offset + * into the underlying device. + * + * Notes: + * (1) 'start'/'size' are measured in sectors. + * (2) 'partno' is the partition number, starting at 1 + * (cf. /dev/hda1 is the first partition). + * (3) 'dev' is the underlying block device. + *) +class partition_device dev partno start size = + let devname = dev#name in + let name = sprintf "%s%d" devname partno in + let start = start *^ sector_size64 in + let size = size *^ sector_size64 in +object (self) + 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 partition boundaries (%Ld/%d/%Ld)" + name offset len size + ); + dev#read (start+^offset) len +end + +(** Probe the + {{:http://en.wikipedia.org/wiki/Master_boot_record}master boot record} + (if it is one) and read the partitions. + + @raise Not_found if it is not an MBR. + *) +let rec probe_mbr (dev : device) = + (* Adjust size to sectors. *) + let size = dev#size /^ sector_size64 in + + (* Read the first sector. *) + let bits = + try dev#read_bitstring 0L sector_size + with exn -> raise Not_found in + + (* Does this match a likely-looking MBR? *) + bitmatch bits with + | padding : 3568 : bitstring; (* padding to byte offset 446 *) + part0 : 128 : bitstring; (* partitions *) + part1 : 128 : bitstring; + part2 : 128 : bitstring; + part3 : 128 : bitstring; + 0x55 : 8; 0xAA : 8 -> (* MBR signature *) + + (* Parse the partition table entries. *) + let primaries = + List.mapi (parse_mbr_entry dev) [part0;part1;part2;part3] in + +(* + (* Read extended partition data. *) + let extendeds = List.map ( + function + | { part_type = 0x05 } as part -> + probe_extended_partition + max_extended_partitions fd part part.part_lba_start + | part -> [] + ) primaries in + let extendeds = List.concat extendeds in + primaries @ extendeds +*) + { parts_name = "MBR"; parts = primaries } + + | _ -> + raise Not_found (* not an MBR *) + +(* Parse a single partition table entry. See the table here: + * http://en.wikipedia.org/wiki/Master_boot_record + *) +and parse_mbr_entry dev i bits = + bitmatch bits with + | 0l : 32; 0l : 32; 0l : 32; 0l : 32 -> + { part_status = NullEntry; part_type = 0; + part_dev = null_device; part_content = `Unknown } + + | 0 : 8; first_chs : 24; + part_type : 8; last_chs : 24; + first_lba : 32 : unsigned, littleendian; + part_size : 32 : unsigned, littleendian -> + make_mbr_entry Nonbootable dev (i+1) part_type first_lba part_size + + | 0x80 : 8; first_chs : 24; + part_type : 8; last_chs : 24; + first_lba : 32 : unsigned, littleendian; + part_size : 32 : unsigned, littleendian -> + make_mbr_entry Bootable dev (i+1) part_type first_lba part_size + + | _ -> + { part_status = Malformed; part_type = 0; + part_dev = null_device; part_content = `Unknown } + +and make_mbr_entry part_status dev partno part_type first_lba part_size = + let first_lba = uint64_of_int32 first_lba in + let part_size = uint64_of_int32 part_size in + eprintf "first_lba = %Lx\n" first_lba; + eprintf "part_size = %Lx\n" part_size; + { part_status = part_status; + part_type = part_type; + part_dev = new partition_device dev partno first_lba part_size; + part_content = `Unknown } + +(* +This code worked previously, but now needs some love ... +XXX + +(* Probe an extended partition. *) +and probe_extended_partition max fd epart sect = + if max > 0 then ( + (* Offset of the first EBR. *) + let ebr_offs = sect *^ sector_size in + (* EBR Signature? *) + LargeFile.lseek fd (ebr_offs +^ 510L) SEEK_SET; + let str = String.create 2 in + if read fd str 0 2 <> 2 || str.[0] != '\x55' || str.[1] != '\xAA' then + [] (* Not EBR *) + else ( + (* Read the extended partition table entries (just 2 of them). *) + LargeFile.lseek fd (ebr_offs +^ 446L) SEEK_SET; + let str = String.create 32 in + if read fd str 0 32 <> 32 then + failwith (s_ "error reading extended partition") + else ( + (* Extract partitions from the data. *) + let part1, part2 = + match List.map (get_partition str) [ 0; 16 ] with + | [p1;p2] -> p1,p2 + | _ -> failwith (s_ "probe_extended_partition: internal error") in + (* First partition entry has offset to the start of this partition. *) + let part1 = { part1 with + part_lba_start = sect +^ part1.part_lba_start } in + (* Second partition entry is zeroes if end of list, otherwise points + * to the next partition. + *) + if part2.part_status = NullEntry then + [part1] + else + part1 :: probe_extended_partition + (max-1) fd epart (sect +^ part2.part_lba_start) + ) + ) + ) + else [] +*) + +(* Ugh, fake a UInt32 -> UInt64 conversion without sign extension, until + * we get working UInt32/UInt64 modules in extlib. + *) +and uint64_of_int32 u32 = + let i64 = Int64.of_int32 u32 in + if u32 >= 0l then i64 + else Int64.add i64 0x1_0000_0000_L + +(* Register with main code. *) +let () = partition_type_register "MBR" probe_mbr -- cgit From 748302caa93af2c412bcd30dad5787a5a24e9af5 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 15 Apr 2008 11:00:29 +0100 Subject: Move main code to virt_df_main.ml and provide explicit interface virt_df.mli --- virt-df/.depend | 20 +-- virt-df/virt_df.ml | 466 +----------------------------------------------- virt-df/virt_df.mli | 181 +++++++++++++++++++ virt-df/virt_df_main.ml | 381 ++++++++++++++++++++++++++++++++++++++- 4 files changed, 575 insertions(+), 473 deletions(-) create mode 100644 virt-df/virt_df.mli (limited to 'virt-df') diff --git a/virt-df/.depend b/virt-df/.depend index 5aa8cb7..aad2cf0 100644 --- a/virt-df/.depend +++ b/virt-df/.depend @@ -1,20 +1,20 @@ -virt_df_ext2.cmo: virt_df_gettext.cmo virt_df.cmo \ +virt_df_ext2.cmo: virt_df_gettext.cmo virt_df.cmi \ /usr/lib64/ocaml/bitmatch/bitmatch.cmi virt_df_ext2.cmx: virt_df_gettext.cmx virt_df.cmx \ /usr/lib64/ocaml/bitmatch/bitmatch.cmi -virt_df_linux_swap.cmo: virt_df_gettext.cmo virt_df.cmo \ +virt_df_linux_swap.cmo: virt_df_gettext.cmo virt_df.cmi \ /usr/lib64/ocaml/bitmatch/bitmatch.cmi virt_df_linux_swap.cmx: virt_df_gettext.cmx virt_df.cmx \ /usr/lib64/ocaml/bitmatch/bitmatch.cmi -virt_df_lvm2.cmo: virt_df_gettext.cmo virt_df.cmo +virt_df_lvm2.cmo: virt_df_gettext.cmo virt_df.cmi virt_df_lvm2.cmx: virt_df_gettext.cmx virt_df.cmx -virt_df_main.cmo: virt_df.cmo -virt_df_main.cmx: virt_df.cmx -virt_df_mbr.cmo: virt_df_gettext.cmo virt_df.cmo \ +virt_df_main.cmo: virt_df_gettext.cmo virt_df.cmi \ + ../libvirt/libvirt_version.cmi ../libvirt/libvirt.cmi +virt_df_main.cmx: virt_df_gettext.cmx virt_df.cmx \ + ../libvirt/libvirt_version.cmx ../libvirt/libvirt.cmx +virt_df_mbr.cmo: virt_df_gettext.cmo virt_df.cmi \ /usr/lib64/ocaml/bitmatch/bitmatch.cmi virt_df_mbr.cmx: virt_df_gettext.cmx virt_df.cmx \ /usr/lib64/ocaml/bitmatch/bitmatch.cmi -virt_df.cmo: virt_df_gettext.cmo ../libvirt/libvirt_version.cmi \ - ../libvirt/libvirt.cmi -virt_df.cmx: virt_df_gettext.cmx ../libvirt/libvirt_version.cmx \ - ../libvirt/libvirt.cmx +virt_df.cmo: virt_df_gettext.cmo virt_df.cmi +virt_df.cmx: virt_df_gettext.cmx virt_df.cmi diff --git a/virt-df/virt_df.ml b/virt-df/virt_df.ml index b972837..c61f6df 100644 --- a/virt-df/virt_df.ml +++ b/virt-df/virt_df.ml @@ -23,79 +23,24 @@ open Unix open Virt_df_gettext.Gettext -module C = Libvirt.Connect -module D = Libvirt.Domain +let debug = true (* If true emit lots of debugging information. *) -(* If set to true, then emit lots of debugging information. *) -let debug = true - -(* Int32 infix operators for convenience. *) let ( +* ) = Int32.add let ( -* ) = Int32.sub let ( ** ) = Int32.mul let ( /* ) = Int32.div -(* Int64 infix operators for convenience. *) let ( +^ ) = Int64.add let ( -^ ) = Int64.sub let ( *^ ) = Int64.mul let ( /^ ) = Int64.div -(* State of command line arguments. *) -let uri = ref None (* Hypervisor/libvirt URI. *) -let inodes = ref false (* Display inodes. *) -let human = ref false (* Display human-readable. *) -let all = ref false (* Show all/active domains. *) -let test_files = ref [] (* Used for test mode only. *) - -(*----------------------------------------------------------------------*) -(* The "domain/device model" that we currently understand looks - * like this: - * - * domains - * | - * \--- host partitions / disk image files - * || - * guest block devices - * | - * +--> guest partitions (eg. using MBR) - * | | - * \-(1)->+--- filesystems (eg. ext3) - * | - * \--- PVs for LVM - * ||| - * VGs and LVs - * - * (1) Filesystems and PVs may also appear directly on guest - * block devices. - * - * Partition schemes (eg. MBR) and filesystems register themselves - * with this main module and they are queried first to get an idea - * of the physical devices, partitions and filesystems potentially - * available to the guest. - * - * Volume management schemes (eg. LVM) register themselves here - * and are called later with "spare" physical devices and partitions - * to see if they contain LVM data. If this results in additional - * logical volumes then these are checked for filesystems. - * - * Swap space is considered to be a dumb filesystem for the purposes - * of this discussion. - *) +let uri = ref None +let inodes = ref false +let human = ref false +let all = ref false +let test_files = ref [] -(* A virtual (or physical!) device, encapsulating any translation - * that has to be done to access the device. eg. For partitions - * there is a simple offset, but for LVM you may need complicated - * table lookups. - * - * We keep the underlying file descriptors open for the duration - * of the program. There aren't likely to be many of them, and - * the program is short-lived, and it's easier than trying to - * track which device is using what fd. As a result, there is no - * need for any close/deallocation function. - * - * Note the very rare use of OOP in OCaml! - *) class virtual device = object (self) method virtual read : int64 -> int -> string @@ -123,7 +68,7 @@ object (self) method name = filename end -(* A null device. Any attempt to read generates an error. *) +(* The null device. Any attempt to read generates an error. *) let null_device : device = object inherit device @@ -132,8 +77,6 @@ object method name = "null" end -(* Domains and candidate guest block devices. *) - type domain = { dom_name : string; (* Domain name. *) dom_id : int option; (* Domain ID (if running). *) @@ -262,398 +205,3 @@ let lvm_types = ref [] let lvm_type_register (lvm_name : string) probe_fn = lvm_types := (lvm_name, probe_fn) :: !lvm_types *) - -(*----------------------------------------------------------------------*) - -let main () = - (* Command line argument parsing. *) - let set_uri = function "" -> uri := None | u -> uri := Some u in - - let version () = - printf "virt-df %s\n" (Libvirt_version.version); - - let major, minor, release = - let v, _ = Libvirt.get_version () in - v / 1_000_000, (v / 1_000) mod 1_000, v mod 1_000 in - printf "libvirt %d.%d.%d\n" major minor release; - exit 0 - in - - let test_mode filename = - test_files := filename :: !test_files - in - - let argspec = Arg.align [ - "-a", Arg.Set all, - " " ^ s_ "Show all domains (default: only active domains)"; - "--all", Arg.Set all, - " " ^ s_ "Show all domains (default: only active domains)"; - "-c", Arg.String set_uri, - "uri " ^ s_ "Connect to URI (default: Xen)"; - "--connect", Arg.String set_uri, - "uri " ^ s_ "Connect to URI (default: Xen)"; - "-h", Arg.Set human, - " " ^ s_ "Print sizes in human-readable format"; - "--human-readable", Arg.Set human, - " " ^ s_ "Print sizes in human-readable format"; - "-i", Arg.Set inodes, - " " ^ s_ "Show inodes instead of blocks"; - "--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"; - "--version", Arg.Unit version, - " " ^ s_ "Display version and exit"; - ] in - - let anon_fun str = - raise (Arg.Bad (sprintf (f_ "%s: unknown parameter") str)) in - let usage_msg = s_ "virt-df : like 'df', shows disk space used in guests - -SUMMARY - virt-df [-options] - -OPTIONS" in - - Arg.parse argspec anon_fun usage_msg; - - let doms : domain list = - if !test_files = [] then ( - let xmls = - (* Connect to the hypervisor. *) - let conn = - let name = !uri in - try C.connect_readonly ?name () - with - Libvirt.Virterror err -> - prerr_endline (Libvirt.Virterror.to_string err); - (* If non-root and no explicit connection URI, print a warning. *) - if geteuid () <> 0 && name = None then ( - print_endline (s_ "NB: If you want to monitor a local Xen hypervisor, you usually need to be root"); - ); - exit 1 in - - (* Get the list of active & inactive domains. *) - let doms = - let nr_active_doms = C.num_of_domains conn in - let active_doms = - Array.to_list (C.list_domains conn nr_active_doms) in - let active_doms = - List.map (D.lookup_by_id conn) active_doms in - if not !all then - active_doms - else ( - let nr_inactive_doms = C.num_of_defined_domains conn in - let inactive_doms = - Array.to_list (C.list_defined_domains conn nr_inactive_doms) in - let inactive_doms = - List.map (D.lookup_by_name conn) inactive_doms in - active_doms @ inactive_doms - ) in - - (* Get their XML. *) - let xmls = List.map D.get_xml_desc doms in - - (* Parse the XML. *) - let xmls = List.map Xml.parse_string xmls in - - (* Return just the XML documents - everything else will be closed - * and freed including the connection to the hypervisor. - *) - xmls in - - (* Grr.. Need to use a library which has XPATH support (or cduce). *) - List.map ( - fun xml -> - let nodes, domain_attrs = - match xml with - | Xml.Element ("domain", attrs, children) -> children, attrs - | _ -> failwith (s_ "get_xml_desc didn't return ") in - - let domid = - try Some (int_of_string (List.assoc "id" domain_attrs)) - with Not_found -> None in - - let rec loop = function - | [] -> - failwith (s_ "get_xml_desc returned no node in XML") - | Xml.Element ("name", _, [Xml.PCData name]) :: _ -> name - | Xml.Element ("name", _, _) :: _ -> - failwith (s_ "get_xml_desc returned strange node") - | _ :: rest -> loop rest - in - let name = loop nodes in - - let devices = - let devices = - List.filter_map ( - function - | Xml.Element ("devices", _, devices) -> Some devices - | _ -> None - ) nodes in - List.concat devices in - - let rec target_dev_of = function - | [] -> None - | Xml.Element ("target", attrs, _) :: rest -> - (try Some (List.assoc "dev" attrs) - with Not_found -> target_dev_of rest) - | _ :: rest -> target_dev_of rest - in - - let rec source_file_of = function - | [] -> None - | Xml.Element ("source", attrs, _) :: rest -> - (try Some (List.assoc "file" attrs) - with Not_found -> source_file_of rest) - | _ :: rest -> source_file_of rest - in - - let rec source_dev_of = function - | [] -> None - | Xml.Element ("source", attrs, _) :: rest -> - (try Some (List.assoc "dev" attrs) - with Not_found -> source_dev_of rest) - | _ :: rest -> source_dev_of rest - in - - let disks = - List.filter_map ( - function - | Xml.Element ("disk", attrs, children) -> - let typ = - try Some (List.assoc "type" attrs) - with Not_found -> None in - let device = - try Some (List.assoc "device" attrs) - with Not_found -> None in - let source = - match source_file_of children with - | (Some _) as source -> source - | None -> source_dev_of children in - let target = target_dev_of children in - - (* We only care about devices where we have - * source and target. Ignore CD-ROM devices. - *) - (match source, target, device with - | _, _, Some "cdrom" -> None (* ignore *) - | Some source, Some target, Some device -> - (* Try to create a 'device' object for this - * device. If it fails, print a warning - * and ignore the device. - *) - (try - let dev = new block_device source in - Some { - d_type = typ; d_device = device; - d_source = source; d_target = target; - d_dev = dev; d_content = `Unknown - } - with - Unix_error (err, func, param) -> - eprintf "%s:%s: %s" func param (error_message err); - None - ) - | _ -> None (* ignore anything else *) - ) - - | _ -> None - ) devices in - - { dom_name = name; dom_id = domid; dom_disks = disks } - ) xmls - ) else ( - (* In test mode (-t option) the user can pass one or more - * block devices or filenames (containing partitions/filesystems/etc) - * which we use for testing virt-df itself. We create fake domains - * from these. - *) - List.map ( - fun filename -> - { - dom_name = filename; dom_id = None; - dom_disks = [ - { - d_type = Some "disk"; d_device = "disk"; - d_source = filename; d_target = "hda"; - d_dev = new block_device filename; d_content = `Unknown; - } - ] - } - ) !test_files - ) in - - (* HOF to map over disks. *) - let map_over_disks doms f = - List.map ( - fun ({ dom_disks = disks } as dom) -> - let disks = List.map f disks in - { dom with dom_disks = disks } - ) doms - in - - (* 'doms' is our list of domains and their guest block devices, and - * we've successfully opened each block device. Now probe them - * to find out what they contain. - *) - let doms = map_over_disks doms ( - fun ({ d_dev = dev } as disk) -> - (* See if it is partitioned first. *) - let parts = probe_for_partitions dev in - match parts with - | Some parts -> - { disk with d_content = `Partitions parts } - | None -> - (* Not partitioned. Does it contain a filesystem? *) - let fs = probe_for_filesystems dev in - match fs with - | Some fs -> - { disk with d_content = `Filesystem fs } - | None -> - (* Not partitioned, no filesystem, so it's spare. *) - disk - ) in - - (* Now we have either detected partitions or a filesystem on each - * physical device (or perhaps neither). See what is on those - * partitions. - *) - let doms = map_over_disks doms ( - function - | ({ d_dev = dev; d_content = `Partitions parts } as disk) -> - let ps = List.map ( - fun p -> - if p.part_status = Bootable || p.part_status = Nonbootable then ( - let fs = probe_for_filesystems p.part_dev in - match fs with - | Some fs -> - { p with part_content = `Filesystem fs } - | None -> - p - ) else p - ) parts.parts in - let parts = { parts with parts = ps } in - { disk with d_content = `Partitions parts } - | disk -> disk - ) in - - (* XXX LVM stuff here. *) - - - - (* Print the title. *) - let () = - let total, used, avail = - match !inodes, !human with - | false, false -> s_ "1K-blocks", s_ "Used", s_ "Available" - | false, true -> s_ "Size", s_ "Used", s_ "Available" - | true, _ -> s_ "Inodes", s_ "IUse", s_ "IFree" in - printf "%-20s %10s %10s %10s %s\n%!" - (s_ "Filesystem") total used avail (s_ "Type") in - - let printable_size bytes = - if bytes < 1024L *^ 1024L then - sprintf "%Ld bytes" bytes - else if bytes < 1024L *^ 1024L *^ 1024L then - sprintf "%.1f MiB" (Int64.to_float (bytes /^ 1024L) /. 1024.) - else - sprintf "%.1f GiB" (Int64.to_float (bytes /^ 1024L /^ 1024L) /. 1024.) - in - - (* HOF to iterate over filesystems. *) - let iter_over_filesystems doms f = - List.iter ( - fun ({ dom_disks = disks } as dom) -> - List.iter ( - function - | ({ d_content = `Filesystem fs } as disk) -> - f dom disk None fs - | ({ d_content = `Partitions partitions } as disk) -> - List.iteri ( - fun i -> - function - | ({ part_content = `Filesystem fs } as part) -> - f dom disk (Some (part, i)) fs - | _ -> () - ) partitions.parts - | _ -> () - ) disks - ) doms - in - - (* Print stats for each recognized filesystem. *) - let print_stats dom disk part fs = - (* Printable name is like "domain:hda" or "domain:hda1". *) - let name = - let dom_name = dom.dom_name in - let d_target = disk.d_target in - match part with - | None -> - dom_name ^ ":" ^ d_target - | Some (_, pnum) -> - dom_name ^ ":" ^ d_target ^ string_of_int pnum in - printf "%-20s " name; - - if fs.fs_is_swap then ( - (* Swap partition. *) - if not !human then - printf "%10Ld %s\n" - (fs.fs_block_size *^ fs.fs_blocks_total /^ 1024L) fs.fs_name - else - printf "%10s %s\n" - (printable_size (fs.fs_block_size *^ fs.fs_blocks_total)) fs.fs_name - ) else ( - (* Ordinary filesystem. *) - if not !inodes then ( (* Block display. *) - (* 'df' doesn't count the restricted blocks. *) - let blocks_total = fs.fs_blocks_total -^ fs.fs_blocks_reserved in - let blocks_avail = fs.fs_blocks_avail -^ fs.fs_blocks_reserved in - let blocks_avail = if blocks_avail < 0L then 0L else blocks_avail in - - if not !human then ( (* Display 1K blocks. *) - printf "%10Ld %10Ld %10Ld %s\n" - (blocks_total *^ fs.fs_block_size /^ 1024L) - (fs.fs_blocks_used *^ fs.fs_block_size /^ 1024L) - (blocks_avail *^ fs.fs_block_size /^ 1024L) - fs.fs_name - ) else ( (* Human-readable blocks. *) - printf "%10s %10s %10s %s\n" - (printable_size (blocks_total *^ fs.fs_block_size)) - (printable_size (fs.fs_blocks_used *^ fs.fs_block_size)) - (printable_size (blocks_avail *^ fs.fs_block_size)) - fs.fs_name - ) - ) else ( (* Inodes display. *) - printf "%10Ld %10Ld %10Ld %s\n" - fs.fs_inodes_total fs.fs_inodes_used fs.fs_inodes_avail - fs.fs_name - ) - ) - in - iter_over_filesystems doms print_stats - -(* -(* Probe a single partition, which we assume contains either a - * filesystem or is a PV. - * - target will be something like "hda" or "hda1" - * - part_type will be the partition type if known, or None - * - fd is a file descriptor opened on the device - * - start & size are where we think the start and size of the - * partition is within the file descriptor (in SECTORS) - *) -and probe_partition target part_type fd start size = - match part_type with - | None -> - ProbeFailed (s_ "detection of unpartitioned devices not yet supported") - | Some 0x05 -> - ProbeIgnore (* Extended partition - ignore it. *) - | Some part_type -> - try - let probe_fn = Hashtbl.find filesystems part_type in - probe_fn target part_type fd start size - with - Not_found -> - ProbeFailed - (sprintf (f_ "unsupported partition type %02x") part_type) -*) diff --git a/virt-df/virt_df.mli b/virt-df/virt_df.mli new file mode 100644 index 0000000..1b3f6ca --- /dev/null +++ b/virt-df/virt_df.mli @@ -0,0 +1,181 @@ +(** 'df' command for virtual domains. *) +(* (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc. + http://libvirt.org/ + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + *) + +(* This module (Virt_df) contains functions and values which are + * used throughout the plug-ins and main code. + *) + +val debug : bool +(** If true, emit logs of debugging information to stderr. *) + +val ( +* ) : int32 -> int32 -> int32 +val ( -* ) : int32 -> int32 -> int32 +val ( ** ) : int32 -> int32 -> int32 +val ( /* ) : int32 -> int32 -> int32 +val ( +^ ) : int64 -> int64 -> int64 +val ( -^ ) : int64 -> int64 -> int64 +val ( *^ ) : int64 -> int64 -> int64 +val ( /^ ) : int64 -> int64 -> int64 +(** int32 and int64 infix operators for convenience. *) + +val uri : string option ref (** Hypervisor/libvirt URI. *) +val inodes : bool ref (** Display inodes. *) +val human : bool ref (** Display human-readable. *) +val all : bool ref (** Show all or just active domains. *) +val test_files : string list ref (** In test mode (-t) list of files. *) +(** State of command line arguments. *) + +(** + {2 Domain/device model} + + The "domain/device model" that we currently understand looks + like this: + +{v +domains + | + \--- host partitions / disk image files + || + guest block devices + | + +--> guest partitions (eg. using MBR) + | | + \-(1)->+--- filesystems (eg. ext3) + | + \--- PVs for LVM + ||| + VGs and LVs +v} + + (1) Filesystems and PVs may also appear directly on guest + block devices. + + Partition schemes (eg. MBR) and filesystems register themselves + with this main module and they are queried first to get an idea + of the physical devices, partitions and filesystems potentially + available to the guest. + + Volume management schemes (eg. LVM) register themselves here + and are called later with "spare" physical devices and partitions + to see if they contain LVM data. If this results in additional + logical volumes then these are checked for filesystems. + + Swap space is considered to be a dumb filesystem for the purposes + of this discussion. +*) + +class virtual device : + object + method virtual name : string + method virtual read : int64 -> int -> string + method read_bitstring : int64 -> int -> string * int * int + method virtual size : int64 + end + (** + A virtual (or physical!) device, encapsulating any translation + that has to be done to access the device. eg. For partitions + there is a simple offset, but for LVM you may need complicated + table lookups. + + We keep the underlying file descriptors open for the duration + of the program. There aren't likely to be many of them, and + the program is short-lived, and it's easier than trying to + track which device is using what fd. As a result, there is no + need for any close/deallocation function. + + Note the very rare use of OOP in OCaml! + *) + +class block_device : + string -> + 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 just direct-maps a file or /dev device. *) + +val null_device : device + (** The null device. Any attempt to read generates an error. *) + +type domain = { + dom_name : string; (** Domain name. *) + dom_id : int option; (** Domain ID (if running). *) + dom_disks : disk list; (** Domain disks. *) +} +and disk = { + d_type : string option; (** The *) + d_device : string; (** The (eg "disk") *) + d_source : string; (** The *) + d_target : string; (** The (eg "hda") *) + d_dev : device; (** Disk device. *) + d_content : disk_content; (** What's on it. *) +} +and disk_content = + [ `Filesystem of filesystem (** Contains a direct filesystem. *) + | `Partitions of partitions (** Contains partitions. *) + | `PhysicalVolume of unit (** Contains an LVM PV. *) + | `Unknown (** Not probed or unknown. *) + ] +and partitions = { + parts_name : string; (** Name of partitioning scheme. *) + parts : partition list; (** Partitions. *) +} +and partition = { + part_status : partition_status; (** Bootable, etc. *) + part_type : int; (** Partition filesystem type. *) + part_dev : device; (** Partition device. *) + part_content : partition_content; (** What's on it. *) +} +and partition_status = Bootable | Nonbootable | Malformed | NullEntry +and partition_content = + [ `Filesystem of filesystem (** Filesystem. *) + | `PhysicalVolume of unit (** Contains an LVM PV. *) + | `Unknown (** Not probed or unknown. *) + ] +and filesystem = { + fs_name : string; (** Name of filesystem. *) + fs_block_size : int64; (** Block size (bytes). *) + fs_blocks_total : int64; (** Total blocks. *) + fs_is_swap : bool; (** If swap, following not valid. *) + fs_blocks_reserved : int64; (** Blocks reserved for super-user. *) + fs_blocks_avail : int64; (** Blocks free (available). *) + fs_blocks_used : int64; (** Blocks in use. *) + fs_inodes_total : int64; (** Total inodes. *) + fs_inodes_reserved : int64; (** Inodes reserved for super-user. *) + fs_inodes_avail : int64; (** Inodes free (available). *) + fs_inodes_used : int64; (** Inodes in use. *) +} + +val string_of_partition : partition -> string +val string_of_filesystem : filesystem -> string +(** Convert a partition or filesystem struct to a string (for debugging). *) + +val partition_type_register : string -> (device -> partitions) -> unit +(** Register a partition probing plugin. *) + +val probe_for_partitions : device -> partitions option +(** Do a partition probe on a device. Returns [Some partitions] or [None]. *) + +val filesystem_type_register : string -> (device -> filesystem) -> unit +(** Register a filesystem probing plugin. *) + +val probe_for_filesystems : device -> filesystem option +(** Do a filesystem probe on a device. Returns [Some filesystem] or [None]. *) diff --git a/virt-df/virt_df_main.ml b/virt-df/virt_df_main.ml index 1359b28..9504785 100644 --- a/virt-df/virt_df_main.ml +++ b/virt-df/virt_df_main.ml @@ -17,7 +17,380 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) -(* We just need this so that the filesystem modules get a chance to - * register themselves before we run the main program. - *) -let () = Virt_df.main () +open Printf +open ExtList +open Unix + +module C = Libvirt.Connect +module D = Libvirt.Domain + +open Virt_df_gettext.Gettext +open Virt_df + +let () = + (* Command line argument parsing. *) + let set_uri = function "" -> uri := None | u -> uri := Some u in + + let version () = + printf "virt-df %s\n" (Libvirt_version.version); + + let major, minor, release = + let v, _ = Libvirt.get_version () in + v / 1_000_000, (v / 1_000) mod 1_000, v mod 1_000 in + printf "libvirt %d.%d.%d\n" major minor release; + exit 0 + in + + let test_mode filename = + test_files := filename :: !test_files + in + + let argspec = Arg.align [ + "-a", Arg.Set all, + " " ^ s_ "Show all domains (default: only active domains)"; + "--all", Arg.Set all, + " " ^ s_ "Show all domains (default: only active domains)"; + "-c", Arg.String set_uri, + "uri " ^ s_ "Connect to URI (default: Xen)"; + "--connect", Arg.String set_uri, + "uri " ^ s_ "Connect to URI (default: Xen)"; + "-h", Arg.Set human, + " " ^ s_ "Print sizes in human-readable format"; + "--human-readable", Arg.Set human, + " " ^ s_ "Print sizes in human-readable format"; + "-i", Arg.Set inodes, + " " ^ s_ "Show inodes instead of blocks"; + "--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"; + "--version", Arg.Unit version, + " " ^ s_ "Display version and exit"; + ] in + + let anon_fun str = + raise (Arg.Bad (sprintf (f_ "%s: unknown parameter") str)) in + let usage_msg = s_ "virt-df : like 'df', shows disk space used in guests + +SUMMARY + virt-df [-options] + +OPTIONS" in + + Arg.parse argspec anon_fun usage_msg; + + let doms : domain list = + if !test_files = [] then ( + let xmls = + (* Connect to the hypervisor. *) + let conn = + let name = !uri in + try C.connect_readonly ?name () + with + Libvirt.Virterror err -> + prerr_endline (Libvirt.Virterror.to_string err); + (* If non-root and no explicit connection URI, print a warning. *) + if geteuid () <> 0 && name = None then ( + print_endline (s_ "NB: If you want to monitor a local Xen hypervisor, you usually need to be root"); + ); + exit 1 in + + (* Get the list of active & inactive domains. *) + let doms = + let nr_active_doms = C.num_of_domains conn in + let active_doms = + Array.to_list (C.list_domains conn nr_active_doms) in + let active_doms = + List.map (D.lookup_by_id conn) active_doms in + if not !all then + active_doms + else ( + let nr_inactive_doms = C.num_of_defined_domains conn in + let inactive_doms = + Array.to_list (C.list_defined_domains conn nr_inactive_doms) in + let inactive_doms = + List.map (D.lookup_by_name conn) inactive_doms in + active_doms @ inactive_doms + ) in + + (* Get their XML. *) + let xmls = List.map D.get_xml_desc doms in + + (* Parse the XML. *) + let xmls = List.map Xml.parse_string xmls in + + (* Return just the XML documents - everything else will be closed + * and freed including the connection to the hypervisor. + *) + xmls in + + (* Grr.. Need to use a library which has XPATH support (or cduce). *) + List.map ( + fun xml -> + let nodes, domain_attrs = + match xml with + | Xml.Element ("domain", attrs, children) -> children, attrs + | _ -> failwith (s_ "get_xml_desc didn't return ") in + + let domid = + try Some (int_of_string (List.assoc "id" domain_attrs)) + with Not_found -> None in + + let rec loop = function + | [] -> + failwith (s_ "get_xml_desc returned no node in XML") + | Xml.Element ("name", _, [Xml.PCData name]) :: _ -> name + | Xml.Element ("name", _, _) :: _ -> + failwith (s_ "get_xml_desc returned strange node") + | _ :: rest -> loop rest + in + let name = loop nodes in + + let devices = + let devices = + List.filter_map ( + function + | Xml.Element ("devices", _, devices) -> Some devices + | _ -> None + ) nodes in + List.concat devices in + + let rec target_dev_of = function + | [] -> None + | Xml.Element ("target", attrs, _) :: rest -> + (try Some (List.assoc "dev" attrs) + with Not_found -> target_dev_of rest) + | _ :: rest -> target_dev_of rest + in + + let rec source_file_of = function + | [] -> None + | Xml.Element ("source", attrs, _) :: rest -> + (try Some (List.assoc "file" attrs) + with Not_found -> source_file_of rest) + | _ :: rest -> source_file_of rest + in + + let rec source_dev_of = function + | [] -> None + | Xml.Element ("source", attrs, _) :: rest -> + (try Some (List.assoc "dev" attrs) + with Not_found -> source_dev_of rest) + | _ :: rest -> source_dev_of rest + in + + let disks = + List.filter_map ( + function + | Xml.Element ("disk", attrs, children) -> + let typ = + try Some (List.assoc "type" attrs) + with Not_found -> None in + let device = + try Some (List.assoc "device" attrs) + with Not_found -> None in + let source = + match source_file_of children with + | (Some _) as source -> source + | None -> source_dev_of children in + let target = target_dev_of children in + + (* We only care about devices where we have + * source and target. Ignore CD-ROM devices. + *) + (match source, target, device with + | _, _, Some "cdrom" -> None (* ignore *) + | Some source, Some target, Some device -> + (* Try to create a 'device' object for this + * device. If it fails, print a warning + * and ignore the device. + *) + (try + let dev = new block_device source in + Some { + d_type = typ; d_device = device; + d_source = source; d_target = target; + d_dev = dev; d_content = `Unknown + } + with + Unix_error (err, func, param) -> + eprintf "%s:%s: %s" func param (error_message err); + None + ) + | _ -> None (* ignore anything else *) + ) + + | _ -> None + ) devices in + + { dom_name = name; dom_id = domid; dom_disks = disks } + ) xmls + ) else ( + (* In test mode (-t option) the user can pass one or more + * block devices or filenames (containing partitions/filesystems/etc) + * which we use for testing virt-df itself. We create fake domains + * from these. + *) + List.map ( + fun filename -> + { + dom_name = filename; dom_id = None; + dom_disks = [ + { + d_type = Some "disk"; d_device = "disk"; + d_source = filename; d_target = "hda"; + d_dev = new block_device filename; d_content = `Unknown; + } + ] + } + ) !test_files + ) in + + (* HOF to map over disks. *) + let map_over_disks doms f = + List.map ( + fun ({ dom_disks = disks } as dom) -> + let disks = List.map f disks in + { dom with dom_disks = disks } + ) doms + in + + (* 'doms' is our list of domains and their guest block devices, and + * we've successfully opened each block device. Now probe them + * to find out what they contain. + *) + let doms = map_over_disks doms ( + fun ({ d_dev = dev } as disk) -> + (* See if it is partitioned first. *) + let parts = probe_for_partitions dev in + match parts with + | Some parts -> + { disk with d_content = `Partitions parts } + | None -> + (* Not partitioned. Does it contain a filesystem? *) + let fs = probe_for_filesystems dev in + match fs with + | Some fs -> + { disk with d_content = `Filesystem fs } + | None -> + (* Not partitioned, no filesystem, so it's spare. *) + disk + ) in + + (* Now we have either detected partitions or a filesystem on each + * physical device (or perhaps neither). See what is on those + * partitions. + *) + let doms = map_over_disks doms ( + function + | ({ d_dev = dev; d_content = `Partitions parts } as disk) -> + let ps = List.map ( + fun p -> + if p.part_status = Bootable || p.part_status = Nonbootable then ( + let fs = probe_for_filesystems p.part_dev in + match fs with + | Some fs -> + { p with part_content = `Filesystem fs } + | None -> + p + ) else p + ) parts.parts in + let parts = { parts with parts = ps } in + { disk with d_content = `Partitions parts } + | disk -> disk + ) in + + (* XXX LVM stuff here. *) + + + + (* Print the title. *) + let () = + let total, used, avail = + match !inodes, !human with + | false, false -> s_ "1K-blocks", s_ "Used", s_ "Available" + | false, true -> s_ "Size", s_ "Used", s_ "Available" + | true, _ -> s_ "Inodes", s_ "IUse", s_ "IFree" in + printf "%-20s %10s %10s %10s %s\n%!" + (s_ "Filesystem") total used avail (s_ "Type") in + + let printable_size bytes = + if bytes < 1024L *^ 1024L then + sprintf "%Ld bytes" bytes + else if bytes < 1024L *^ 1024L *^ 1024L then + sprintf "%.1f MiB" (Int64.to_float (bytes /^ 1024L) /. 1024.) + else + sprintf "%.1f GiB" (Int64.to_float (bytes /^ 1024L /^ 1024L) /. 1024.) + in + + (* HOF to iterate over filesystems. *) + let iter_over_filesystems doms f = + List.iter ( + fun ({ dom_disks = disks } as dom) -> + List.iter ( + function + | ({ d_content = `Filesystem fs } as disk) -> + f dom disk None fs + | ({ d_content = `Partitions partitions } as disk) -> + List.iteri ( + fun i -> + function + | ({ part_content = `Filesystem fs } as part) -> + f dom disk (Some (part, i)) fs + | _ -> () + ) partitions.parts + | _ -> () + ) disks + ) doms + in + + (* Print stats for each recognized filesystem. *) + let print_stats dom disk part fs = + (* Printable name is like "domain:hda" or "domain:hda1". *) + let name = + let dom_name = dom.dom_name in + let d_target = disk.d_target in + match part with + | None -> + dom_name ^ ":" ^ d_target + | Some (_, pnum) -> + dom_name ^ ":" ^ d_target ^ string_of_int pnum in + printf "%-20s " name; + + if fs.fs_is_swap then ( + (* Swap partition. *) + if not !human then + printf "%10Ld %s\n" + (fs.fs_block_size *^ fs.fs_blocks_total /^ 1024L) fs.fs_name + else + printf "%10s %s\n" + (printable_size (fs.fs_block_size *^ fs.fs_blocks_total)) fs.fs_name + ) else ( + (* Ordinary filesystem. *) + if not !inodes then ( (* Block display. *) + (* 'df' doesn't count the restricted blocks. *) + let blocks_total = fs.fs_blocks_total -^ fs.fs_blocks_reserved in + let blocks_avail = fs.fs_blocks_avail -^ fs.fs_blocks_reserved in + let blocks_avail = if blocks_avail < 0L then 0L else blocks_avail in + + if not !human then ( (* Display 1K blocks. *) + printf "%10Ld %10Ld %10Ld %s\n" + (blocks_total *^ fs.fs_block_size /^ 1024L) + (fs.fs_blocks_used *^ fs.fs_block_size /^ 1024L) + (blocks_avail *^ fs.fs_block_size /^ 1024L) + fs.fs_name + ) else ( (* Human-readable blocks. *) + printf "%10s %10s %10s %s\n" + (printable_size (blocks_total *^ fs.fs_block_size)) + (printable_size (fs.fs_blocks_used *^ fs.fs_block_size)) + (printable_size (blocks_avail *^ fs.fs_block_size)) + fs.fs_name + ) + ) else ( (* Inodes display. *) + printf "%10Ld %10Ld %10Ld %s\n" + fs.fs_inodes_total fs.fs_inodes_used fs.fs_inodes_avail + fs.fs_name + ) + ) + in + iter_over_filesystems doms print_stats -- cgit From 0019c13c600d34f12778e849246711bb20ba4ee2 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 15 Apr 2008 11:26:46 +0100 Subject: Don't need the ': device' typecasts any more. --- virt-df/virt_df_ext2.ml | 2 +- virt-df/virt_df_linux_swap.ml | 2 +- virt-df/virt_df_lvm2.ml | 30 +++++++++++++++++++++++++++--- virt-df/virt_df_mbr.ml | 2 +- 4 files changed, 30 insertions(+), 6 deletions(-) (limited to 'virt-df') diff --git a/virt-df/virt_df_ext2.ml b/virt-df/virt_df_ext2.ml index 0ea8a25..2d1d1b8 100644 --- a/virt-df/virt_df_ext2.ml +++ b/virt-df/virt_df_ext2.ml @@ -27,7 +27,7 @@ open Virt_df let superblock_offset = 1024L -let probe_ext2 (dev : device) = +let probe_ext2 dev = (* Load the superblock. *) let bits = dev#read_bitstring superblock_offset 1024 in diff --git a/virt-df/virt_df_linux_swap.ml b/virt-df/virt_df_linux_swap.ml index ad56149..afd671f 100644 --- a/virt-df/virt_df_linux_swap.ml +++ b/virt-df/virt_df_linux_swap.ml @@ -23,7 +23,7 @@ open Virt_df_gettext.Gettext open Virt_df -let probe_swap (dev : device) = +let probe_swap dev = (* Load the "superblock" (ie. first 0x1000 bytes). *) let bits = dev#read_bitstring 0L 0x1000 in diff --git a/virt-df/virt_df_lvm2.ml b/virt-df/virt_df_lvm2.ml index a79ec7f..4247dc3 100644 --- a/virt-df/virt_df_lvm2.ml +++ b/virt-df/virt_df_lvm2.ml @@ -24,9 +24,33 @@ open Printf open Virt_df_gettext.Gettext open Virt_df -let probe_lvm2 (dev : device) = - raise Not_found +let sector_size = 512 +let sector_size64 = 512L + +let pv_label_offset = sector_size64 + +let rec probe_pv dev = + try ignore (read_pv_label dev); true + with _ -> false + +and read_pv_label dev = + (* Load the second sector. *) + let bits = dev#read_bitstring pv_label_offset sector_size in + + bitmatch bits with + | labelone : 8*8 : bitstring; (* "LABELONE" *) + padding : 16*8 : bitstring; + lvm2_ver : 8*8 : bitstring; (* "LVM2 001" *) + uuid : 32*8 : bitstring (* UUID *) + when Bitmatch.string_of_bitstring labelone = "LABELONE" && + Bitmatch.string_of_bitstring lvm2_ver = "LVM2 001" -> + uuid + | _ -> + invalid_arg (sprintf "read_pv_label: %s: not an LVM2 physical volume" + dev#name) + +let list_lvs devs = [] (* Register with main code. *) let () = - filesystem_type_register "LVM2" probe_lvm2 + lvm_type_register "LVM2" probe_pv list_lvs diff --git a/virt-df/virt_df_mbr.ml b/virt-df/virt_df_mbr.ml index b9a6cb7..b56189c 100644 --- a/virt-df/virt_df_mbr.ml +++ b/virt-df/virt_df_mbr.ml @@ -66,7 +66,7 @@ end @raise Not_found if it is not an MBR. *) -let rec probe_mbr (dev : device) = +let rec probe_mbr dev = (* Adjust size to sectors. *) let size = dev#size /^ sector_size64 in -- cgit From 40c683ea4c9d921a6fe23c2639125261b92da472 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 15 Apr 2008 11:44:41 +0100 Subject: Add PV detection framework. --- virt-df/virt_df.ml | 31 +++++++++++++++++++++++-------- virt-df/virt_df.mli | 26 +++++++++++++++++++------- virt-df/virt_df_main.ml | 25 +++++++++++++++++++------ 3 files changed, 61 insertions(+), 21 deletions(-) (limited to 'virt-df') diff --git a/virt-df/virt_df.ml b/virt-df/virt_df.ml index c61f6df..b992e1b 100644 --- a/virt-df/virt_df.ml +++ b/virt-df/virt_df.ml @@ -97,7 +97,7 @@ and disk_content = [ `Unknown (* Not probed or unknown. *) | `Partitions of partitions (* Contains partitions. *) | `Filesystem of filesystem (* Contains a filesystem directly. *) - | `PhysicalVolume of unit (* Contains an LVM PV. *) + | `PhysicalVolume of string (* Contains an LVM PV. *) ] (* Partitions. *) @@ -116,7 +116,7 @@ and partition_status = Bootable | Nonbootable | Malformed | NullEntry and partition_content = [ `Unknown (* Not probed or unknown. *) | `Filesystem of filesystem (* Filesystem. *) - | `PhysicalVolume of unit (* Contains an LVM PV. *) + | `PhysicalVolume of string (* Contains an LVM PV. *) ] (* Filesystems (also swap devices). *) @@ -180,8 +180,8 @@ let filesystem_types = ref [] let filesystem_type_register (fs_name : string) probe_fn = filesystem_types := (fs_name, probe_fn) :: !filesystem_types -(* Probe a device for filesystems. Returns [Some fs] or [None]. *) -let probe_for_filesystems dev = +(* 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; let rec loop = function | [] -> None @@ -200,8 +200,23 @@ let probe_for_filesystems dev = r (* Register a volume management type. *) -(* let lvm_types = ref [] -let lvm_type_register (lvm_name : string) probe_fn = - lvm_types := (lvm_name, probe_fn) :: !lvm_types -*) +let lvm_type_register (lvm_name : string) probe_fn list_lvs_fn = + lvm_types := (lvm_name, (probe_fn, list_lvs_fn)) :: !lvm_types + +(* 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; + let rec loop = function + | [] -> None + | (lvm_name, (probe_fn, _)) :: rest -> + if probe_fn dev then Some lvm_name else loop rest + in + let r = loop !lvm_types in + if debug then ( + match r with + | None -> eprintf "no PV found on %s\n%!" dev#name + | Some lvm_name -> + eprintf "%s contains a %s PV\n%!" dev#name lvm_name + ); + r diff --git a/virt-df/virt_df.mli b/virt-df/virt_df.mli index 1b3f6ca..db98af2 100644 --- a/virt-df/virt_df.mli +++ b/virt-df/virt_df.mli @@ -17,9 +17,9 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) -(* This module (Virt_df) contains functions and values which are - * used throughout the plug-ins and main code. - *) +(** This module (Virt_df) contains functions and values which are + used throughout the plug-ins and main code. +*) val debug : bool (** If true, emit logs of debugging information to stderr. *) @@ -71,7 +71,7 @@ v} of the physical devices, partitions and filesystems potentially available to the guest. - Volume management schemes (eg. LVM) register themselves here + Volume management schemes (eg. LVM2) register themselves here and are called later with "spare" physical devices and partitions to see if they contain LVM data. If this results in additional logical volumes then these are checked for filesystems. @@ -131,7 +131,7 @@ and disk = { and disk_content = [ `Filesystem of filesystem (** Contains a direct filesystem. *) | `Partitions of partitions (** Contains partitions. *) - | `PhysicalVolume of unit (** Contains an LVM PV. *) + | `PhysicalVolume of string (** Contains an LVM PV. *) | `Unknown (** Not probed or unknown. *) ] and partitions = { @@ -147,7 +147,7 @@ and partition = { and partition_status = Bootable | Nonbootable | Malformed | NullEntry and partition_content = [ `Filesystem of filesystem (** Filesystem. *) - | `PhysicalVolume of unit (** Contains an LVM PV. *) + | `PhysicalVolume of string (** Contains an LVM PV. *) | `Unknown (** Not probed or unknown. *) ] and filesystem = { @@ -177,5 +177,17 @@ val probe_for_partitions : device -> partitions option val filesystem_type_register : string -> (device -> filesystem) -> unit (** Register a filesystem probing plugin. *) -val probe_for_filesystems : device -> filesystem option +val probe_for_filesystem : device -> filesystem option (** Do a filesystem probe on a device. Returns [Some filesystem] or [None]. *) + +val lvm_type_register : + string -> (device -> bool) -> (device list -> device list) -> unit +(** [lvm_type_register lvm_name probe_fn list_lvs_fn] + registers a new LVM type. [probe_fn] is a function which + should probe a device to find out if it contains a PV. + [list_lvs_fn] is a function which should take a list of + devices (PVs) and construct a list of LV devices. +*) + +val probe_for_pv : device -> string option +(** Do a PV probe on a device. Returns [Some lvm_name] or [None]. *) diff --git a/virt-df/virt_df_main.ml b/virt-df/virt_df_main.ml index 9504785..c989d76 100644 --- a/virt-df/virt_df_main.ml +++ b/virt-df/virt_df_main.ml @@ -268,13 +268,18 @@ OPTIONS" in { disk with d_content = `Partitions parts } | None -> (* Not partitioned. Does it contain a filesystem? *) - let fs = probe_for_filesystems dev in + let fs = probe_for_filesystem dev in match fs with | Some fs -> { disk with d_content = `Filesystem fs } | None -> - (* Not partitioned, no filesystem, so it's spare. *) - disk + (* Not partitioned, no filesystem, is it a PV? *) + let pv = probe_for_pv dev in + match pv with + | Some lvm_name -> + { disk with d_content = `PhysicalVolume lvm_name } + | None -> + disk (* Spare/unknown. *) ) in (* Now we have either detected partitions or a filesystem on each @@ -287,12 +292,18 @@ OPTIONS" in let ps = List.map ( fun p -> if p.part_status = Bootable || p.part_status = Nonbootable then ( - let fs = probe_for_filesystems p.part_dev in + let fs = probe_for_filesystem p.part_dev in match fs with | Some fs -> { p with part_content = `Filesystem fs } | None -> - p + (* Is it a PV? *) + let pv = probe_for_pv p.part_dev in + match pv with + | Some lvm_name -> + { p with part_content = `PhysicalVolume lvm_name } + | None -> + p (* Spare/unknown. *) ) else p ) parts.parts in let parts = { parts with parts = ps } in @@ -300,7 +311,9 @@ OPTIONS" in | disk -> disk ) in - (* XXX LVM stuff here. *) + (* XXX LVM filesystem detection ... *) + + -- cgit From bb0788a39d9b8675db60a61ecd2baebfdfb5ca10 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 15 Apr 2008 11:44:54 +0100 Subject: LVM2 PV detection. --- virt-df/virt_df_lvm2.ml | 8 ++++++++ 1 file changed, 8 insertions(+) (limited to 'virt-df') diff --git a/virt-df/virt_df_lvm2.ml b/virt-df/virt_df_lvm2.ml index 4247dc3..9355597 100644 --- a/virt-df/virt_df_lvm2.ml +++ b/virt-df/virt_df_lvm2.ml @@ -29,6 +29,7 @@ let sector_size64 = 512L let pv_label_offset = sector_size64 +(* Probe to see if it's an LVM2 PV. Look for the "LABELONE" label. *) let rec probe_pv dev = try ignore (read_pv_label dev); true with _ -> false @@ -37,6 +38,8 @@ and read_pv_label dev = (* Load the second sector. *) let bits = dev#read_bitstring pv_label_offset sector_size in + Bitmatch.hexdump_bitstring stdout bits; + bitmatch bits with | labelone : 8*8 : bitstring; (* "LABELONE" *) padding : 16*8 : bitstring; @@ -49,6 +52,11 @@ and read_pv_label dev = invalid_arg (sprintf "read_pv_label: %s: not an LVM2 physical volume" dev#name) +(* We are passed a list of devices which we previously identified + * as PVs belonging to us. From these produce a list of all LVs + * (as devices) and return them. Note that we don't try to detect + * what is on these LVs - that will be done in the main code. + *) let list_lvs devs = [] (* Register with main code. *) -- cgit From 0c2134a62abc82f2b558e648cdaea22b098d4bc9 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 15 Apr 2008 11:44:59 +0100 Subject: Update deps. --- virt-df/.depend | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'virt-df') diff --git a/virt-df/.depend b/virt-df/.depend index aad2cf0..9bf7fd7 100644 --- a/virt-df/.depend +++ b/virt-df/.depend @@ -6,8 +6,10 @@ virt_df_linux_swap.cmo: virt_df_gettext.cmo virt_df.cmi \ /usr/lib64/ocaml/bitmatch/bitmatch.cmi virt_df_linux_swap.cmx: virt_df_gettext.cmx virt_df.cmx \ /usr/lib64/ocaml/bitmatch/bitmatch.cmi -virt_df_lvm2.cmo: virt_df_gettext.cmo virt_df.cmi -virt_df_lvm2.cmx: virt_df_gettext.cmx virt_df.cmx +virt_df_lvm2.cmo: virt_df_gettext.cmo virt_df.cmi \ + /usr/lib64/ocaml/bitmatch/bitmatch.cmi +virt_df_lvm2.cmx: virt_df_gettext.cmx virt_df.cmx \ + /usr/lib64/ocaml/bitmatch/bitmatch.cmi virt_df_main.cmo: virt_df_gettext.cmo virt_df.cmi \ ../libvirt/libvirt_version.cmi ../libvirt/libvirt.cmi virt_df_main.cmx: virt_df_gettext.cmx virt_df.cmx \ -- cgit From be71668a1a4b6c87da3e82458ca97a199a24aa32 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 15 Apr 2008 12:57:58 +0100 Subject: Infrastructure to detect filesystems on LVs. --- virt-df/virt_df.ml | 24 +++++++++++++ virt-df/virt_df.mli | 17 +++++++-- virt-df/virt_df_main.ml | 96 ++++++++++++++++++++++++++++++++++++++++--------- 3 files changed, 119 insertions(+), 18 deletions(-) (limited to 'virt-df') diff --git a/virt-df/virt_df.ml b/virt-df/virt_df.ml index b992e1b..1cd0617 100644 --- a/virt-df/virt_df.ml +++ b/virt-df/virt_df.ml @@ -81,6 +81,7 @@ 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. *) } and disk = { (* From the XML ... *) @@ -220,3 +221,26 @@ let probe_for_pv dev = eprintf "%s contains a %s PV\n%!" dev#name lvm_name ); r + +let list_lvs lvm_name devs = + let _, list_lvs_fn = List.assoc lvm_name !lvm_types in + list_lvs_fn devs + +(*----------------------------------------------------------------------*) + +(* This version by Isaac Trotts. *) +let group_by ?(cmp = Pervasives.compare) ls = + let ls' = + List.fold_left + (fun acc (day1, x1) -> + match acc with + [] -> [day1, [x1]] + | (day2, ls2) :: acctl -> + if cmp day1 day2 = 0 + then (day1, x1 :: ls2) :: acctl + else (day1, [x1]) :: acc) + [] + ls + in + let ls' = List.rev ls' in + List.map (fun (x, xs) -> x, List.rev xs) ls' diff --git a/virt-df/virt_df.mli b/virt-df/virt_df.mli index db98af2..4a9368c 100644 --- a/virt-df/virt_df.mli +++ b/virt-df/virt_df.mli @@ -119,6 +119,7 @@ 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. *) } and disk = { d_type : string option; (** The *) @@ -168,14 +169,16 @@ val string_of_partition : partition -> string val string_of_filesystem : filesystem -> string (** Convert a partition or filesystem struct to a string (for debugging). *) +(** {2 Plug-in registration functions} *) + val partition_type_register : string -> (device -> partitions) -> unit -(** Register a partition probing plugin. *) +(** Register a partition probing plug-in. *) val probe_for_partitions : device -> partitions option (** Do a partition probe on a device. Returns [Some partitions] or [None]. *) val filesystem_type_register : string -> (device -> filesystem) -> unit -(** Register a filesystem probing plugin. *) +(** Register a filesystem probing plug-in. *) val probe_for_filesystem : device -> filesystem option (** Do a filesystem probe on a device. Returns [Some filesystem] or [None]. *) @@ -191,3 +194,13 @@ val lvm_type_register : val probe_for_pv : device -> string option (** Do a PV probe on a device. Returns [Some lvm_name] or [None]. *) + +val list_lvs : string -> device list -> device list +(** Construct LV devices from a list of PVs. The first argument + is the [lvm_name] which all PVs should belong to. +*) + +(** {2 Utility functions} *) + +val group_by : ?cmp:('a -> 'a -> int) -> ('a * 'b) list -> ('a * 'b list) list +(** Group a sorted list of pairs by the first element of the pair. *) diff --git a/virt-df/virt_df_main.ml b/virt-df/virt_df_main.ml index c989d76..82fe920 100644 --- a/virt-df/virt_df_main.ml +++ b/virt-df/virt_df_main.ml @@ -223,7 +223,8 @@ OPTIONS" in | _ -> None ) devices in - { dom_name = name; dom_id = domid; dom_disks = disks } + { dom_name = name; dom_id = domid; + dom_disks = disks; dom_lv_filesystems = [] } ) xmls ) else ( (* In test mode (-t option) the user can pass one or more @@ -241,7 +242,8 @@ OPTIONS" in d_source = filename; d_target = "hda"; d_dev = new block_device filename; d_content = `Unknown; } - ] + ]; + dom_lv_filesystems = [] } ) !test_files ) in @@ -311,13 +313,66 @@ OPTIONS" in | disk -> disk ) in - (* XXX LVM filesystem detection ... *) - - - + (* LVM filesystem detection + * + * For each domain, look for all disks/partitions which have been + * identified as PVs and pass those back to the respective LVM + * plugin for LV detection. + * + * (Note - a two-stage process because an LV can be spread over + * several PVs, so we have to detect all PVs belonging to a + * domain first). + *) + (* First: LV detection. *) + let doms = List.map ( + fun ({ dom_disks = disks } as dom) -> + (* Find all physical volumes, can be disks or partitions. *) + let pvs_on_disks = List.filter_map ( + function + | { d_dev = d_dev; + d_content = `PhysicalVolume lvm_name } -> Some (lvm_name, d_dev) + | _ -> None + ) disks in + let pvs_on_partitions = List.map ( + function + | { d_content = `Partitions { parts = parts } } -> + List.filter_map ( + function + | { part_dev = part_dev; + part_content = `PhysicalVolume lvm_name } -> + Some (lvm_name, part_dev) + | _ -> None + ) parts + | _ -> [] + ) disks in + let lvs = List.concat (pvs_on_disks :: pvs_on_partitions) in + dom, lvs + ) doms in + + (* Second: filesystem on LV detection. *) + let doms = List.map ( + fun (dom, lvs) -> + (* Group the LVs by plug-in type. *) + let cmp ((a:string),_) ((b:string),_) = compare a b in + let lvs = List.sort ~cmp lvs in + let lvs = group_by lvs in + + let lvs = + List.map (fun (lvm_name, devs) -> list_lvs lvm_name devs) lvs in + let lvs = List.concat lvs in + + (* lvs is a list of potential LV devices. Now run them through the + * probes to see if any contain filesystems. + *) + let filesystems = List.filter_map probe_for_filesystem lvs in + { dom with dom_lv_filesystems = filesystems } + ) doms in - (* Print the title. *) + (* Now print the results. + * + * Print the title. + *) let () = let total, used, avail = match !inodes, !human with @@ -337,37 +392,46 @@ OPTIONS" in in (* HOF to iterate over filesystems. *) - let iter_over_filesystems doms f = + let iter_over_filesystems doms + (f : domain -> ?disk:disk -> ?part:(partition * int) -> filesystem -> + unit) = List.iter ( - fun ({ dom_disks = disks } as dom) -> + 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 None fs + f dom ~disk fs | ({ d_content = `Partitions partitions } as disk) -> List.iteri ( fun i -> function | ({ part_content = `Filesystem fs } as part) -> - f dom disk (Some (part, i)) fs + f dom ~disk ~part:(part, i) fs | _ -> () ) partitions.parts | _ -> () - ) disks + ) disks; + (* LV filesystems. *) + List.iter (fun fs -> f dom fs) filesystems ) doms in (* Print stats for each recognized filesystem. *) - let print_stats dom disk part fs = + let print_stats dom ?disk ?part fs = (* Printable name is like "domain:hda" or "domain:hda1". *) let name = let dom_name = dom.dom_name in - let d_target = disk.d_target in + let disk_name = + match disk with + | None -> "???" (* XXX keep LV dev around *) + | Some disk -> disk.d_target + in match part with | None -> - dom_name ^ ":" ^ d_target + dom_name ^ ":" ^ disk_name | Some (_, pnum) -> - dom_name ^ ":" ^ d_target ^ string_of_int pnum in + dom_name ^ ":" ^ disk_name ^ string_of_int pnum in printf "%-20s " name; if fs.fs_is_swap then ( -- cgit From 2f24ddc7c65beb0df82f208bf7410ea09102f7a8 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 15 Apr 2008 13:51:57 +0100 Subject: Refactor the types so we have distinct PV & LV types. --- virt-df/virt_df.ml | 24 +++++++++++++++++++----- virt-df/virt_df.mli | 26 +++++++++++++++++--------- virt-df/virt_df_lvm2.ml | 16 ++++++++++------ virt-df/virt_df_main.ml | 16 ++++++++++------ 4 files changed, 56 insertions(+), 26 deletions(-) (limited to 'virt-df') diff --git a/virt-df/virt_df.ml b/virt-df/virt_df.ml index 1cd0617..f8f34ab 100644 --- a/virt-df/virt_df.ml +++ b/virt-df/virt_df.ml @@ -98,7 +98,7 @@ and disk_content = [ `Unknown (* Not probed or unknown. *) | `Partitions of partitions (* Contains partitions. *) | `Filesystem of filesystem (* Contains a filesystem directly. *) - | `PhysicalVolume of string (* Contains an LVM PV. *) + | `PhysicalVolume of pv (* Contains an LVM PV. *) ] (* Partitions. *) @@ -117,7 +117,7 @@ and partition_status = Bootable | Nonbootable | Malformed | NullEntry and partition_content = [ `Unknown (* Not probed or unknown. *) | `Filesystem of filesystem (* Filesystem. *) - | `PhysicalVolume of string (* Contains an LVM PV. *) + | `PhysicalVolume of pv (* Contains an LVM PV. *) ] (* Filesystems (also swap devices). *) @@ -135,6 +135,19 @@ and filesystem = { fs_inodes_used : int64; (* Inodes in use. *) } +(* Physical volumes. *) +and pv = { + lvm_plugin_id : lvm_plugin_id; (* The LVM plug-in. *) + pv_uuid : string; (* UUID. *) +} + +(* Logical volumes. *) +and lv = { + lv_dev : device; (* Logical volume device. *) +} + +and lvm_plugin_id = string + (* Convert partition, filesystem types to printable strings for debugging. *) let string_of_partition { part_status = status; part_type = typ; part_dev = dev } = @@ -211,14 +224,15 @@ let probe_for_pv dev = let rec loop = function | [] -> None | (lvm_name, (probe_fn, _)) :: rest -> - if probe_fn dev then Some lvm_name else loop rest + try Some (probe_fn lvm_name dev) + with Not_found -> loop rest in let r = loop !lvm_types in if debug then ( match r with | None -> eprintf "no PV found on %s\n%!" dev#name - | Some lvm_name -> - eprintf "%s contains a %s PV\n%!" dev#name lvm_name + | Some { lvm_plugin_id = name } -> + eprintf "%s contains a %s PV\n%!" dev#name name ); r diff --git a/virt-df/virt_df.mli b/virt-df/virt_df.mli index 4a9368c..b36d003 100644 --- a/virt-df/virt_df.mli +++ b/virt-df/virt_df.mli @@ -132,7 +132,7 @@ and disk = { and disk_content = [ `Filesystem of filesystem (** Contains a direct filesystem. *) | `Partitions of partitions (** Contains partitions. *) - | `PhysicalVolume of string (** Contains an LVM PV. *) + | `PhysicalVolume of pv (** Contains an LVM PV. *) | `Unknown (** Not probed or unknown. *) ] and partitions = { @@ -148,7 +148,7 @@ and partition = { and partition_status = Bootable | Nonbootable | Malformed | NullEntry and partition_content = [ `Filesystem of filesystem (** Filesystem. *) - | `PhysicalVolume of string (** Contains an LVM PV. *) + | `PhysicalVolume of pv (** Contains an LVM PV. *) | `Unknown (** Not probed or unknown. *) ] and filesystem = { @@ -164,6 +164,16 @@ and filesystem = { fs_inodes_avail : int64; (** Inodes free (available). *) fs_inodes_used : int64; (** Inodes in use. *) } +and pv = { + lvm_plugin_id : lvm_plugin_id; (** The LVM plug-in which detected + this. *) + pv_uuid : string; (** UUID. *) +} +and lv = { + lv_dev : device; (** Logical volume device. *) +} + +and lvm_plugin_id val string_of_partition : partition -> string val string_of_filesystem : filesystem -> string @@ -184,7 +194,7 @@ val probe_for_filesystem : device -> filesystem option (** Do a filesystem probe on a device. Returns [Some filesystem] or [None]. *) val lvm_type_register : - string -> (device -> bool) -> (device list -> device list) -> unit + string -> (lvm_plugin_id -> device -> pv) -> (device list -> lv list) -> unit (** [lvm_type_register lvm_name probe_fn list_lvs_fn] registers a new LVM type. [probe_fn] is a function which should probe a device to find out if it contains a PV. @@ -192,13 +202,11 @@ val lvm_type_register : devices (PVs) and construct a list of LV devices. *) -val probe_for_pv : device -> string option -(** Do a PV probe on a device. Returns [Some lvm_name] or [None]. *) +val probe_for_pv : device -> pv option +(** Do a PV probe on a device. Returns [Some pv] or [None]. *) -val list_lvs : string -> device list -> device list -(** Construct LV devices from a list of PVs. The first argument - is the [lvm_name] which all PVs should belong to. -*) +val list_lvs : lvm_plugin_id -> device list -> lv list +(** Construct LV devices from a list of PVs. *) (** {2 Utility functions} *) diff --git a/virt-df/virt_df_lvm2.ml b/virt-df/virt_df_lvm2.ml index 9355597..dc97656 100644 --- a/virt-df/virt_df_lvm2.ml +++ b/virt-df/virt_df_lvm2.ml @@ -24,21 +24,25 @@ open Printf open Virt_df_gettext.Gettext open Virt_df +let plugin_name = "LVM2" + let sector_size = 512 let sector_size64 = 512L let pv_label_offset = sector_size64 (* Probe to see if it's an LVM2 PV. Look for the "LABELONE" label. *) -let rec probe_pv dev = - try ignore (read_pv_label dev); true - with _ -> false +let rec probe_pv lvm_plugin_id dev = + try + let uuid = read_pv_label dev in + { lvm_plugin_id = lvm_plugin_id; pv_uuid = uuid } + with _ -> raise Not_found and read_pv_label dev = (* Load the second sector. *) let bits = dev#read_bitstring pv_label_offset sector_size in - Bitmatch.hexdump_bitstring stdout bits; + (*Bitmatch.hexdump_bitstring stdout bits;*) bitmatch bits with | labelone : 8*8 : bitstring; (* "LABELONE" *) @@ -47,7 +51,7 @@ and read_pv_label dev = uuid : 32*8 : bitstring (* UUID *) when Bitmatch.string_of_bitstring labelone = "LABELONE" && Bitmatch.string_of_bitstring lvm2_ver = "LVM2 001" -> - uuid + Bitmatch.string_of_bitstring uuid | _ -> invalid_arg (sprintf "read_pv_label: %s: not an LVM2 physical volume" dev#name) @@ -61,4 +65,4 @@ let list_lvs devs = [] (* Register with main code. *) let () = - lvm_type_register "LVM2" probe_pv list_lvs + lvm_type_register plugin_name probe_pv list_lvs diff --git a/virt-df/virt_df_main.ml b/virt-df/virt_df_main.ml index 82fe920..9cfde39 100644 --- a/virt-df/virt_df_main.ml +++ b/virt-df/virt_df_main.ml @@ -330,7 +330,7 @@ OPTIONS" in let pvs_on_disks = List.filter_map ( function | { d_dev = d_dev; - d_content = `PhysicalVolume lvm_name } -> Some (lvm_name, d_dev) + d_content = `PhysicalVolume pv } -> Some (pv, d_dev) | _ -> None ) disks in let pvs_on_partitions = List.map ( @@ -339,8 +339,8 @@ OPTIONS" in List.filter_map ( function | { part_dev = part_dev; - part_content = `PhysicalVolume lvm_name } -> - Some (lvm_name, part_dev) + part_content = `PhysicalVolume pv } -> + Some (pv, part_dev) | _ -> None ) parts | _ -> [] @@ -353,18 +353,22 @@ OPTIONS" in let doms = List.map ( fun (dom, lvs) -> (* Group the LVs by plug-in type. *) - let cmp ((a:string),_) ((b:string),_) = compare a b in + let cmp (a,_) (b,_) = compare a b in let lvs = List.sort ~cmp lvs in let lvs = group_by lvs in let lvs = - List.map (fun (lvm_name, devs) -> list_lvs lvm_name 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 * probes to see if any contain filesystems. *) - let filesystems = List.filter_map probe_for_filesystem lvs in + let filesystems = + List.filter_map ( + fun { lv_dev = dev } -> probe_for_filesystem dev + ) lvs in { dom with dom_lv_filesystems = filesystems } ) doms in -- cgit From bf03017c3a390f75130d810bed403008abcbe7f4 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 15 Apr 2008 15:08:34 +0100 Subject: Read out metadata offset & length from PV header. --- virt-df/virt_df_lvm2.ml | 54 ++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 42 insertions(+), 12 deletions(-) (limited to 'virt-df') diff --git a/virt-df/virt_df_lvm2.ml b/virt-df/virt_df_lvm2.ml index dc97656..abc247e 100644 --- a/virt-df/virt_df_lvm2.ml +++ b/virt-df/virt_df_lvm2.ml @@ -29,29 +29,58 @@ let plugin_name = "LVM2" let sector_size = 512 let sector_size64 = 512L -let pv_label_offset = sector_size64 - (* Probe to see if it's an LVM2 PV. Look for the "LABELONE" label. *) let rec probe_pv lvm_plugin_id dev = try - let uuid = read_pv_label dev in + let uuid, metadata_offset, metadata_length = read_pv_label dev in + if debug then + eprintf "LVM2 detected UUID %s md offset 0x%lx len %ld\n%!" + uuid metadata_offset metadata_length; { lvm_plugin_id = lvm_plugin_id; pv_uuid = uuid } with _ -> raise Not_found and read_pv_label dev = - (* Load the second sector. *) - let bits = dev#read_bitstring pv_label_offset sector_size in + (* Load the first 8 sectors. I found by experimentation that + * the second sector contains the header ("LABELONE" etc) and + * the nineth sector contains some additional information about + * the location of the current metadata. + *) + let bits = dev#read_bitstring 0L (9 * sector_size) in - (*Bitmatch.hexdump_bitstring stdout bits;*) + Bitmatch.hexdump_bitstring stdout bits; bitmatch bits with - | labelone : 8*8 : bitstring; (* "LABELONE" *) - padding : 16*8 : bitstring; + | sector0 : sector_size*8 : bitstring; (* sector 0 *) + labelone : 8*8 : bitstring; (* "LABELONE" *) + padding : 16*8 : bitstring; (* Seems to contain something. *) lvm2_ver : 8*8 : bitstring; (* "LVM2 001" *) - uuid : 32*8 : bitstring (* UUID *) + uuid : 32*8 : bitstring; (* UUID *) + padding2 : (sector_size-64)*8 : bitstring; (* to end of second sector *) + sector234567 : sector_size*8 * 6 : bitstring; (* sectors 2-6 *) + padding3 : 0x28*8 : bitstring; (* start of sector 8 *) + metadata_offset : 32 : littleendian;(* metadata offset *) + padding4 : 4*8 : bitstring; + metadata_length : 32 : littleendian (* length of metadata (bytes) *) when Bitmatch.string_of_bitstring labelone = "LABELONE" && - Bitmatch.string_of_bitstring lvm2_ver = "LVM2 001" -> - Bitmatch.string_of_bitstring uuid + Bitmatch.string_of_bitstring lvm2_ver = "LVM2 001" -> + let metadata_offset = metadata_offset +* 0x1000_l in + + (* Check the metadata offset & length look reasonable for this + * device. Otherwise maybe it's a newer or older header which + * we don't really understand properly. + *) + let () = + let size = + if dev#size <= Int64.of_int32 Int32.max_int then Int64.to_int32 dev#size + else Int32.max_int in + if metadata_offset < 0x1200_l || metadata_offset >= size + || metadata_length < 0_l || metadata_offset+*metadata_length >= size + then + invalid_arg "read_pv_label: bad metadata offset or length" in + + Bitmatch.string_of_bitstring uuid, metadata_offset, metadata_length + + | _ -> invalid_arg (sprintf "read_pv_label: %s: not an LVM2 physical volume" dev#name) @@ -61,7 +90,8 @@ and read_pv_label dev = * (as devices) and return them. Note that we don't try to detect * what is on these LVs - that will be done in the main code. *) -let list_lvs devs = [] +let list_lvs devs = + [] (* Register with main code. *) let () = -- cgit From c0e4c9e257316408d4097b5d75a85617d97c6c35 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 15 Apr 2008 15:08:52 +0100 Subject: Added a documentation note about RAID devices. --- virt-df/virt_df_main.ml | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'virt-df') diff --git a/virt-df/virt_df_main.ml b/virt-df/virt_df_main.ml index 9cfde39..e6ae53e 100644 --- a/virt-df/virt_df_main.ml +++ b/virt-df/virt_df_main.ml @@ -322,6 +322,10 @@ OPTIONS" in * (Note - a two-stage process because an LV can be spread over * several PVs, so we have to detect all PVs belonging to a * domain first). + * + * XXX To deal with RAID (ie. md devices) we will need to loop + * around here because RAID is like LVM except that they normally + * present as block devices which can be used by LVM. *) (* First: LV detection. *) let doms = List.map ( -- cgit From b25ac692bd7107b56850de8fa25123791dfdf73e Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 15 Apr 2008 15:27:06 +0100 Subject: Read out the actual metadata. --- virt-df/virt_df_lvm2.ml | 55 +++++++++++++++++++++++++++++-------------------- 1 file changed, 33 insertions(+), 22 deletions(-) (limited to 'virt-df') diff --git a/virt-df/virt_df_lvm2.ml b/virt-df/virt_df_lvm2.ml index abc247e..afcab66 100644 --- a/virt-df/virt_df_lvm2.ml +++ b/virt-df/virt_df_lvm2.ml @@ -32,12 +32,13 @@ let sector_size64 = 512L (* Probe to see if it's an LVM2 PV. Look for the "LABELONE" label. *) let rec probe_pv lvm_plugin_id dev = try - let uuid, metadata_offset, metadata_length = read_pv_label dev in + let uuid, _ = read_pv_label dev in if debug then - eprintf "LVM2 detected UUID %s md offset 0x%lx len %ld\n%!" - uuid metadata_offset metadata_length; + eprintf "LVM2 detected PV UUID %s\n%!" uuid; { lvm_plugin_id = lvm_plugin_id; pv_uuid = uuid } - with _ -> raise Not_found + with exn -> + if debug then prerr_endline (Printexc.to_string exn); + raise Not_found and read_pv_label dev = (* Load the first 8 sectors. I found by experimentation that @@ -47,7 +48,7 @@ and read_pv_label dev = *) let bits = dev#read_bitstring 0L (9 * sector_size) in - Bitmatch.hexdump_bitstring stdout bits; + (*Bitmatch.hexdump_bitstring stdout bits;*) bitmatch bits with | sector0 : sector_size*8 : bitstring; (* sector 0 *) @@ -64,26 +65,36 @@ and read_pv_label dev = when Bitmatch.string_of_bitstring labelone = "LABELONE" && Bitmatch.string_of_bitstring lvm2_ver = "LVM2 001" -> let metadata_offset = metadata_offset +* 0x1000_l in + let metadata = read_metadata dev metadata_offset metadata_length in + (*prerr_endline metadata;*) + let uuid = Bitmatch.string_of_bitstring uuid in - (* Check the metadata offset & length look reasonable for this - * device. Otherwise maybe it's a newer or older header which - * we don't really understand properly. - *) - let () = - let size = - if dev#size <= Int64.of_int32 Int32.max_int then Int64.to_int32 dev#size - else Int32.max_int in - if metadata_offset < 0x1200_l || metadata_offset >= size - || metadata_length < 0_l || metadata_offset+*metadata_length >= size - then - invalid_arg "read_pv_label: bad metadata offset or length" in - - Bitmatch.string_of_bitstring uuid, metadata_offset, metadata_length - + uuid, metadata | _ -> - invalid_arg (sprintf "read_pv_label: %s: not an LVM2 physical volume" - dev#name) + invalid_arg + (sprintf "LVM2: read_pv_label: %s: not an LVM2 physical volume" dev#name) + +and read_metadata dev offset32 len32 = + if debug then + eprintf "metadata: offset 0x%lx len %ld bytes\n" offset32 len32; + + (* Check the offset and length are sensible. *) + let offset64 = + if offset32 <= Int32.max_int then Int64.of_int32 offset32 + else invalid_arg "LVM2: read_metadata: metadata offset too large" in + let len64 = + if len32 <= 2_147_483_647_l then Int64.of_int32 len32 + else invalid_arg "LVM2: read_metadata: metadata length too large" in + + if offset64 <= 0x1200L || offset64 >= dev#size + || len64 <= 0L || offset64 +^ len64 >= dev#size then + invalid_arg "LVM2: read_metadata: bad metadata offset or length"; + + (* If it is outside the disk boundaries, this will throw an exception, + * otherwise it will read and return the metadata string. + *) + dev#read offset64 (Int64.to_int len64) (* We are passed a list of devices which we previously identified * as PVs belonging to us. From these produce a list of all LVs -- cgit From 479659599edaaf6cd9385ce00750407d61baf0f0 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 15 Apr 2008 15:33:08 +0100 Subject: Cosmetic fixes and comments. --- virt-df/virt_df_lvm2.ml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'virt-df') diff --git a/virt-df/virt_df_lvm2.ml b/virt-df/virt_df_lvm2.ml index afcab66..16d8e89 100644 --- a/virt-df/virt_df_lvm2.ml +++ b/virt-df/virt_df_lvm2.ml @@ -29,7 +29,7 @@ let plugin_name = "LVM2" let sector_size = 512 let sector_size64 = 512L -(* Probe to see if it's an LVM2 PV. Look for the "LABELONE" label. *) +(* Probe to see if it's an LVM2 PV. *) let rec probe_pv lvm_plugin_id dev = try let uuid, _ = read_pv_label dev in @@ -77,7 +77,7 @@ and read_pv_label dev = and read_metadata dev offset32 len32 = if debug then - eprintf "metadata: offset 0x%lx len %ld bytes\n" offset32 len32; + eprintf "metadata: offset 0x%lx len %ld bytes\n%!" offset32 len32; (* Check the offset and length are sensible. *) let offset64 = @@ -102,6 +102,8 @@ and read_metadata dev offset32 len32 = * what is on these LVs - that will be done in the main code. *) let list_lvs devs = + (* Read the UUID and metadata (again) from each device. *) + let uuidmetas = List.map read_pv_label devs in [] (* Register with main code. *) -- cgit From b9320ec4678a8a7bb88a8b8aa72805b79ce48daf Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 15 Apr 2008 15:33:30 +0100 Subject: Empty *.mli files to stop those modules from exporting symbols. --- virt-df/.depend | 16 ++++++++-------- virt-df/virt_df_ext2.mli | 22 ++++++++++++++++++++++ virt-df/virt_df_linux_swap.mli | 22 ++++++++++++++++++++++ virt-df/virt_df_lvm2.mli | 22 ++++++++++++++++++++++ virt-df/virt_df_mbr.mli | 22 ++++++++++++++++++++++ 5 files changed, 96 insertions(+), 8 deletions(-) create mode 100644 virt-df/virt_df_ext2.mli create mode 100644 virt-df/virt_df_linux_swap.mli create mode 100644 virt-df/virt_df_lvm2.mli create mode 100644 virt-df/virt_df_mbr.mli (limited to 'virt-df') diff --git a/virt-df/.depend b/virt-df/.depend index 9bf7fd7..d253040 100644 --- a/virt-df/.depend +++ b/virt-df/.depend @@ -1,22 +1,22 @@ virt_df_ext2.cmo: virt_df_gettext.cmo virt_df.cmi \ - /usr/lib64/ocaml/bitmatch/bitmatch.cmi + /usr/lib64/ocaml/bitmatch/bitmatch.cmi virt_df_ext2.cmi virt_df_ext2.cmx: virt_df_gettext.cmx virt_df.cmx \ - /usr/lib64/ocaml/bitmatch/bitmatch.cmi + /usr/lib64/ocaml/bitmatch/bitmatch.cmi virt_df_ext2.cmi virt_df_linux_swap.cmo: virt_df_gettext.cmo virt_df.cmi \ - /usr/lib64/ocaml/bitmatch/bitmatch.cmi + /usr/lib64/ocaml/bitmatch/bitmatch.cmi virt_df_linux_swap.cmi virt_df_linux_swap.cmx: virt_df_gettext.cmx virt_df.cmx \ - /usr/lib64/ocaml/bitmatch/bitmatch.cmi + /usr/lib64/ocaml/bitmatch/bitmatch.cmi virt_df_linux_swap.cmi virt_df_lvm2.cmo: virt_df_gettext.cmo virt_df.cmi \ - /usr/lib64/ocaml/bitmatch/bitmatch.cmi + /usr/lib64/ocaml/bitmatch/bitmatch.cmi virt_df_lvm2.cmi virt_df_lvm2.cmx: virt_df_gettext.cmx virt_df.cmx \ - /usr/lib64/ocaml/bitmatch/bitmatch.cmi + /usr/lib64/ocaml/bitmatch/bitmatch.cmi virt_df_lvm2.cmi virt_df_main.cmo: virt_df_gettext.cmo virt_df.cmi \ ../libvirt/libvirt_version.cmi ../libvirt/libvirt.cmi virt_df_main.cmx: virt_df_gettext.cmx virt_df.cmx \ ../libvirt/libvirt_version.cmx ../libvirt/libvirt.cmx virt_df_mbr.cmo: virt_df_gettext.cmo virt_df.cmi \ - /usr/lib64/ocaml/bitmatch/bitmatch.cmi + /usr/lib64/ocaml/bitmatch/bitmatch.cmi virt_df_mbr.cmi virt_df_mbr.cmx: virt_df_gettext.cmx virt_df.cmx \ - /usr/lib64/ocaml/bitmatch/bitmatch.cmi + /usr/lib64/ocaml/bitmatch/bitmatch.cmi virt_df_mbr.cmi virt_df.cmo: virt_df_gettext.cmo virt_df.cmi virt_df.cmx: virt_df_gettext.cmx virt_df.cmi diff --git a/virt-df/virt_df_ext2.mli b/virt-df/virt_df_ext2.mli new file mode 100644 index 0000000..d32a0f8 --- /dev/null +++ b/virt-df/virt_df_ext2.mli @@ -0,0 +1,22 @@ +(* 'df' command for virtual domains. + (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc. + http://libvirt.org/ + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + *) + +(* This file is empty to stop this plug-in from exporting any + symbols to other modules by accident. +*) diff --git a/virt-df/virt_df_linux_swap.mli b/virt-df/virt_df_linux_swap.mli new file mode 100644 index 0000000..d32a0f8 --- /dev/null +++ b/virt-df/virt_df_linux_swap.mli @@ -0,0 +1,22 @@ +(* 'df' command for virtual domains. + (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc. + http://libvirt.org/ + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + *) + +(* This file is empty to stop this plug-in from exporting any + symbols to other modules by accident. +*) diff --git a/virt-df/virt_df_lvm2.mli b/virt-df/virt_df_lvm2.mli new file mode 100644 index 0000000..d32a0f8 --- /dev/null +++ b/virt-df/virt_df_lvm2.mli @@ -0,0 +1,22 @@ +(* 'df' command for virtual domains. + (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc. + http://libvirt.org/ + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + *) + +(* This file is empty to stop this plug-in from exporting any + symbols to other modules by accident. +*) diff --git a/virt-df/virt_df_mbr.mli b/virt-df/virt_df_mbr.mli new file mode 100644 index 0000000..d32a0f8 --- /dev/null +++ b/virt-df/virt_df_mbr.mli @@ -0,0 +1,22 @@ +(* 'df' command for virtual domains. + (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc. + http://libvirt.org/ + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + *) + +(* This file is empty to stop this plug-in from exporting any + symbols to other modules by accident. +*) -- cgit From 81294675f6a5058a3381871f1dc99c806922d77c Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 15 Apr 2008 18:30:49 +0100 Subject: Metadata parser. --- virt-df/.depend | 17 +++- virt-df/Makefile.in | 8 ++ virt-df/virt_df_lvm2.ml | 40 ++++++++- virt-df/virt_df_lvm2_lexer.mll | 165 ++++++++++++++++++++++++++++++++++++++ virt-df/virt_df_lvm2_metadata.ml | 65 +++++++++++++++ virt-df/virt_df_lvm2_metadata.mli | 38 +++++++++ virt-df/virt_df_lvm2_parser.mly | 70 ++++++++++++++++ 7 files changed, 395 insertions(+), 8 deletions(-) create mode 100644 virt-df/virt_df_lvm2_lexer.mll create mode 100644 virt-df/virt_df_lvm2_metadata.ml create mode 100644 virt-df/virt_df_lvm2_metadata.mli create mode 100644 virt-df/virt_df_lvm2_parser.mly (limited to 'virt-df') diff --git a/virt-df/.depend b/virt-df/.depend index d253040..e7cd81e 100644 --- a/virt-df/.depend +++ b/virt-df/.depend @@ -1,3 +1,4 @@ +virt_df_lvm2_parser.cmi: virt_df_lvm2_metadata.cmi virt_df_ext2.cmo: virt_df_gettext.cmo virt_df.cmi \ /usr/lib64/ocaml/bitmatch/bitmatch.cmi virt_df_ext2.cmi virt_df_ext2.cmx: virt_df_gettext.cmx virt_df.cmx \ @@ -6,10 +7,18 @@ virt_df_linux_swap.cmo: virt_df_gettext.cmo virt_df.cmi \ /usr/lib64/ocaml/bitmatch/bitmatch.cmi virt_df_linux_swap.cmi virt_df_linux_swap.cmx: virt_df_gettext.cmx virt_df.cmx \ /usr/lib64/ocaml/bitmatch/bitmatch.cmi virt_df_linux_swap.cmi -virt_df_lvm2.cmo: virt_df_gettext.cmo virt_df.cmi \ - /usr/lib64/ocaml/bitmatch/bitmatch.cmi virt_df_lvm2.cmi -virt_df_lvm2.cmx: virt_df_gettext.cmx virt_df.cmx \ - /usr/lib64/ocaml/bitmatch/bitmatch.cmi virt_df_lvm2.cmi +virt_df_lvm2_lexer.cmo: virt_df_lvm2_parser.cmi virt_df.cmi +virt_df_lvm2_lexer.cmx: virt_df_lvm2_parser.cmx virt_df.cmx +virt_df_lvm2_metadata.cmo: virt_df_lvm2_metadata.cmi +virt_df_lvm2_metadata.cmx: virt_df_lvm2_metadata.cmi +virt_df_lvm2.cmo: virt_df_lvm2_metadata.cmi virt_df_lvm2_lexer.cmo \ + virt_df_gettext.cmo virt_df.cmi /usr/lib64/ocaml/bitmatch/bitmatch.cmi \ + virt_df_lvm2.cmi +virt_df_lvm2.cmx: virt_df_lvm2_metadata.cmx virt_df_lvm2_lexer.cmx \ + virt_df_gettext.cmx virt_df.cmx /usr/lib64/ocaml/bitmatch/bitmatch.cmi \ + virt_df_lvm2.cmi +virt_df_lvm2_parser.cmo: virt_df_lvm2_metadata.cmi virt_df_lvm2_parser.cmi +virt_df_lvm2_parser.cmx: virt_df_lvm2_metadata.cmx virt_df_lvm2_parser.cmi virt_df_main.cmo: virt_df_gettext.cmo virt_df.cmi \ ../libvirt/libvirt_version.cmi ../libvirt/libvirt.cmi virt_df_main.cmx: virt_df_gettext.cmx virt_df.cmx \ diff --git a/virt-df/Makefile.in b/virt-df/Makefile.in index 4a56d2d..4fb088c 100644 --- a/virt-df/Makefile.in +++ b/virt-df/Makefile.in @@ -39,6 +39,9 @@ OBJS := \ virt_df.cmo \ virt_df_ext2.cmo \ virt_df_linux_swap.cmo \ + virt_df_lvm2_metadata.cmo \ + virt_df_lvm2_parser.cmo \ + virt_df_lvm2_lexer.cmo \ virt_df_lvm2.cmo \ virt_df_mbr.cmo \ virt_df_main.cmo @@ -82,6 +85,11 @@ virt-df.opt: $(XOBJS) $(OCAMLOPTPACKAGES) $(OCAMLOPTFLAGS) $(OCAMLOPTLIBS) \ ../libvirt/mllibvirt.cmxa -o $@ $^ +# 'make depend' doesn't catch these dependencies because the .mli file +# is auto-generated. +virt_df_lvm2_parser.cmo: virt_df_lvm2_parser.mli +virt_df_lvm2_parser.cmx: virt_df_lvm2_parser.mli + # Manual page. ifeq ($(HAVE_PERLDOC),perldoc) virt-df.1: virt-df.pod diff --git a/virt-df/virt_df_lvm2.ml b/virt-df/virt_df_lvm2.ml index 16d8e89..fcf1fd2 100644 --- a/virt-df/virt_df_lvm2.ml +++ b/virt-df/virt_df_lvm2.ml @@ -24,6 +24,8 @@ open Printf open Virt_df_gettext.Gettext open Virt_df +open Virt_df_lvm2_metadata + let plugin_name = "LVM2" let sector_size = 512 @@ -64,9 +66,16 @@ and read_pv_label dev = metadata_length : 32 : littleendian (* length of metadata (bytes) *) when Bitmatch.string_of_bitstring labelone = "LABELONE" && Bitmatch.string_of_bitstring lvm2_ver = "LVM2 001" -> + + (* Metadata offset is relative to end of PV label. *) let metadata_offset = metadata_offset +* 0x1000_l in + (* Metadata length appears to include the trailing \000 which + * we don't want. + *) + let metadata_length = metadata_length -* 1_l in + let metadata = read_metadata dev metadata_offset metadata_length in - (*prerr_endline metadata;*) + let uuid = Bitmatch.string_of_bitstring uuid in uuid, metadata @@ -101,11 +110,34 @@ and read_metadata dev offset32 len32 = * (as devices) and return them. Note that we don't try to detect * what is on these LVs - that will be done in the main code. *) -let list_lvs devs = - (* Read the UUID and metadata (again) from each device. *) - let uuidmetas = List.map read_pv_label devs in +let rec list_lvs devs = + (* Read the UUID and metadata (again) from each device to end up with + * an assoc list of PVs, keyed on the UUID. + *) + let pvs = List.map read_pv_label devs in + + (* Parse the metadata using the external lexer/parser. *) + let pvs = List.map ( + fun (uuid, metadata) -> + eprintf "parsing: %s\n<<<<\n" metadata; + uuid, Virt_df_lvm2_lexer.parse_lvm2_metadata_from_string metadata + ) pvs in + + (* Print the parsed metadata. *) + List.iter ( + fun (uuid, metadata) -> + eprintf "metadata for UUID %s:\n" uuid; + output_metadata stderr metadata + ) pvs; + [] + + + + + + (* Register with main code. *) let () = lvm_type_register plugin_name probe_pv list_lvs diff --git a/virt-df/virt_df_lvm2_lexer.mll b/virt-df/virt_df_lvm2_lexer.mll new file mode 100644 index 0000000..2dbe7e5 --- /dev/null +++ b/virt-df/virt_df_lvm2_lexer.mll @@ -0,0 +1,165 @@ +(* 'df' command for virtual domains. + (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc. + http://libvirt.org/ + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + *) + +(* Scanner for LVM2 metadata. + * ocamllex tutorial: + * http://plus.kaist.ac.kr/~shoh/ocaml/ocamllex-ocamlyacc/ocamllex-tutorial/ + *) + +{ + open Printf + open Lexing + + open Virt_df + open Virt_df_lvm2_parser + + (* Temporary buffer used for parsing strings, etc. *) + let tmp = Buffer.create 80 + + exception Error of string +} + +let digit = ['0'-'9'] +let alpha = ['a'-'z' 'A'-'Z'] +let alphau = ['a'-'z' 'A'-'Z' '_'] +let alnum = ['a'-'z' 'A'-'Z' '0'-'9'] +let alnumu = ['a'-'z' 'A'-'Z' '0'-'9' '_'] +let ident = alphau alnumu* + +let whitespace = [' ' '\t' '\r' '\n']+ + +let escaped_char = '\\' _ + +rule token = parse + (* ignore whitespace and comments *) + | whitespace + | '#' [^ '\n']* + { token lexbuf } + + (* scan single character tokens *) + | '{' { LBRACE } + | '}' { RBRACE } + | '[' { LSQUARE } + | ']' { RSQUARE } + | '=' { EQ } + | ',' { COMMA } + + (* strings - see LVM2/lib/config/config.c *) + | '"' + { + Buffer.reset tmp; + STRING (dq_string lexbuf) + } + | '\'' + { + Buffer.reset tmp; + STRING (dq_string lexbuf) + } + + (* floats *) + | ('-'? digit+ '.' digit*) as f + { + let f = float_of_string f in + FLOAT f + } + + (* integers *) + | ('-'? digit+) as i + { + let i = Int64.of_string i in + INT i + } + + (* identifiers *) + | ident as id + { IDENT id } + + (* end of file *) + | eof + { EOF } + + | _ as c + { raise (Error (sprintf "%c: invalid character in input" c)) } + +and dq_string = parse + | '"' + { Buffer.contents tmp } + | escaped_char as str + { Buffer.add_char tmp str.[1]; dq_string lexbuf } + | eof + { raise (Error "unterminated string in metadata") } + | _ as c + { Buffer.add_char tmp c; dq_string lexbuf } + +and q_string = parse + | '\'' + { Buffer.contents tmp } + | escaped_char as str + { Buffer.add_char tmp str.[1]; q_string lexbuf } + | eof + { raise (Error "unterminated string in metadata") } + | _ as c + { Buffer.add_char tmp c; q_string lexbuf } + +{ + (* Demonstration of how to wrap the token function + with extra debugging statements: + let token lexbuf = + try + let r = token lexbuf in + if debug then + eprintf "Lexer: token returned is %s\n" + (match r with + | LBRACE -> "LBRACE" + | RBRACE -> "RBRACE" + | LSQUARE -> "LSQUARE" + | RSQUARE -> "RSQUARE" + | EQ -> "EQ" + | COMMA -> "COMMA" + | STRING s -> sprintf "STRING(%S)" s + | INT i -> sprintf "INT(%Ld)" i + | FLOAT f -> sprintf "FLOAT(%g)" f + | IDENT s -> sprintf "IDENT(%s)" s + | EOF -> "EOF"); + r + with + exn -> + prerr_endline (Printexc.to_string exn); + raise exn + *) + + (* Lex and parse input. + * + * Return the parsed metadata structure if everything went to plan. + * Raises [Error msg] if there was some parsing problem. + *) + let rec parse_lvm2_metadata_from_string str = + let lexbuf = Lexing.from_string str in + parse_lvm2_metadata lexbuf + and parse_lvm2_metadata_from_channel chan = + let lexbuf = Lexing.from_channel chan in + parse_lvm2_metadata lexbuf + and parse_lvm2_metadata lexbuf = + try + input token lexbuf + with + | Error _ as exn -> raise exn + | Parsing.Parse_error -> raise (Error "Parse error") + | exn -> raise (Error ("Exception: " ^ Printexc.to_string exn)) +} diff --git a/virt-df/virt_df_lvm2_metadata.ml b/virt-df/virt_df_lvm2_metadata.ml new file mode 100644 index 0000000..d293577 --- /dev/null +++ b/virt-df/virt_df_lvm2_metadata.ml @@ -0,0 +1,65 @@ +(* 'df' command for virtual domains. -*- text -*- + (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc. + http://libvirt.org/ + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + *) + +(* Part of the parser for LVM2 metadata. *) + +type metadata = metastmt list + +and metastmt = string * metavalue + +and metavalue = + | Metadata of metadata (* name { ... } *) + | String of string (* name = "..." *) + | Int of int64 + | Float of float + | List of metavalue list (* name = [...] *) + +let rec output_metadata chan md = + _output_metadata chan "" md + +and _output_metadata chan prefix = function + | [] -> () + | (name, value) :: rest -> + output_string chan prefix; + output_string chan name; + output_string chan " = "; + output_metavalue chan prefix value; + output_string chan "\n"; + _output_metadata chan prefix rest + +and output_metavalue chan prefix = function + | Metadata md -> + output_string chan "{\n"; + _output_metadata chan (prefix ^ " ") md; + output_string chan prefix; + output_string chan "}\n"; + | String str -> + output_char chan '"'; + output_string chan str; + output_char chan '"'; + | Int i -> + output_string chan (Int64.to_string i) + | Float f -> + output_string chan (string_of_float f) + | List [] -> () + | List [x] -> output_metavalue chan prefix x + | List (x :: xs) -> + output_metavalue chan prefix x; + output_string chan ", "; + output_metavalue chan prefix (List xs) diff --git a/virt-df/virt_df_lvm2_metadata.mli b/virt-df/virt_df_lvm2_metadata.mli new file mode 100644 index 0000000..b7e821b --- /dev/null +++ b/virt-df/virt_df_lvm2_metadata.mli @@ -0,0 +1,38 @@ +(* 'df' command for virtual domains. -*- text -*- + (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc. + http://libvirt.org/ + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + *) + +(* Part of the parser for LVM2 metadata. *) + +type metadata = metastmt list + +and metastmt = string * metavalue + +and metavalue = + | Metadata of metadata (* name { ... } *) + | String of string (* name = "..." *) + | Int of int64 + | Float of float + | List of metavalue list (* name = [...] *) + +val output_metadata : out_channel -> metadata -> unit +(** This function prints out the metadata on the selected channel. + + The output format isn't particularly close to the input + format. This is just for debugging purposes. +*) diff --git a/virt-df/virt_df_lvm2_parser.mly b/virt-df/virt_df_lvm2_parser.mly new file mode 100644 index 0000000..9f47ced --- /dev/null +++ b/virt-df/virt_df_lvm2_parser.mly @@ -0,0 +1,70 @@ +/* 'df' command for virtual domains. -*- text -*- + (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc. + http://libvirt.org/ + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + */ + +/* Parser for LVM2 metadata. + ocamlyacc tutorial: + http://plus.kaist.ac.kr/~shoh/ocaml/ocamllex-ocamlyacc/ocamlyacc-tutorial/ + */ + +%{ + open Virt_df_lvm2_metadata +%} + +%token LBRACE RBRACE /* { } */ +%token LSQUARE RSQUARE /* [ ] */ +%token EQ /* = */ +%token COMMA /* , */ +%token STRING /* "string" */ +%token INT /* an integer */ +%token FLOAT /* a float */ +%token IDENT /* a naked keyword/identifier */ +%token EOF /* end of file */ + +%start input +%type input + +%% + +input : lines EOF { List.rev $1 } + ; + +lines : /* empty */ { prerr_endline "empty line"; [] } + | lines line { prerr_endline "input line"; $2 :: $1 } + ; + +line : /* empty */ /* These dummy entries get removed after parsing. */ + { ("", String "") } + | IDENT EQ value + { ($1, $3) } + | IDENT LBRACE lines RBRACE + { ($1, Metadata (List.rev $3)) } + ; + +value : STRING { String $1 } + | INT { Int $1 } + | FLOAT { Float $1 } + | LSQUARE list RSQUARE + { List (List.rev $2) } + ; + +list : /* empty */ { [] } + | value { [$1] } + | list COMMA value + { $3 :: $1 } + ; -- cgit From 4268ee74b7237c3e8bc1d78b92b6e3669cbec6da Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 15 Apr 2008 20:49:30 +0100 Subject: Added developer documentation. --- virt-df/README | 68 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 67 insertions(+), 1 deletion(-) (limited to 'virt-df') diff --git a/virt-df/README b/virt-df/README index 0623030..c3ba4fe 100644 --- a/virt-df/README +++ b/virt-df/README @@ -1,2 +1,68 @@ +$Id$ + +For user documentation: + Please see the manual page (virt-df.pod or virt-df.txt in this -directory). \ No newline at end of file +directory). + +Developer documentation +---------------------------------------------------------------------- + +This program has suddenly become rather large and confusing. +Hopefully this documentation should go some way towards explaining +what is going on inside the source. + +The main program consists of two modules: + + - virt_df.ml / virt_df.mli (module name: Virt_df) + + This has evolved into a library of miscellaneous functions + and values which are included throughout the rest of the + program. If you see an unexplained function then it's + likely that it is defined in here. + + Start by reading virt_df.mli which contains the full types + and plenty of documentation. + + - virt_df_main.ml + + This is the program. It reads the command line arguments, + loads the domain descriptions, calls out to the plug-ins + to probe for disks / partitions / filesystems / etc., and + finally prints the results. + + The file consists of basically one large program that + does all of the above in sequence. + +Everything else in this directory is a plug-in specialized for probing +a particular filesystem, partition scheme or type of LVM. The +plug-ins at time of writing are: + + - virt_df_ext2.ml / virt_df_ext2.mli + + EXT2/3/4 plug-in. + + - virt_df_linux_swap.ml / virt_df_linux_swap.mli + + Linux swap (new style). + + - virt_df_mbr.ml / virt_df_mbr.mli + + Master Boot Record (MS-DOS) disk partitioning. + + - virt_df_lvm2* + + LVM2 parsing, which is by far the most complex plug-in. + It consists of: + + - virt_df_lvm2.ml + - virt_df_lvm2.mli + LVM2 probing, PV detection. + + - virt_df_lvm2_parser.mly + - virt_df_lvm2_lexer.mll + Scanner/parser for parsing LVM2 metadata definitions. + + - virt_df_lvm2_metadata.ml + - virt_df_lvm2_metadata.mli + AST for LVM2 metadata definitions. -- cgit From 5e15e5798813ee7d1f459685e669fcc22c870ec2 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 15 Apr 2008 20:51:46 +0100 Subject: Removed text-mode annotation. --- virt-df/virt_df_lvm2_metadata.ml | 2 +- virt-df/virt_df_lvm2_metadata.mli | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) (limited to 'virt-df') diff --git a/virt-df/virt_df_lvm2_metadata.ml b/virt-df/virt_df_lvm2_metadata.ml index d293577..2929cb0 100644 --- a/virt-df/virt_df_lvm2_metadata.ml +++ b/virt-df/virt_df_lvm2_metadata.ml @@ -1,4 +1,4 @@ -(* 'df' command for virtual domains. -*- text -*- +(* 'df' command for virtual domains. (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc. http://libvirt.org/ diff --git a/virt-df/virt_df_lvm2_metadata.mli b/virt-df/virt_df_lvm2_metadata.mli index b7e821b..778f393 100644 --- a/virt-df/virt_df_lvm2_metadata.mli +++ b/virt-df/virt_df_lvm2_metadata.mli @@ -1,4 +1,4 @@ -(* 'df' command for virtual domains. -*- text -*- +(* 'df' command for virtual domains. (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc. http://libvirt.org/ -- cgit From eb57a2de474de79b12bacf61a7e9ed94d3b82429 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 15 Apr 2008 22:30:27 +0100 Subject: Removed some debugging prints. --- virt-df/virt_df_lvm2_parser.mly | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'virt-df') diff --git a/virt-df/virt_df_lvm2_parser.mly b/virt-df/virt_df_lvm2_parser.mly index 9f47ced..c4ee574 100644 --- a/virt-df/virt_df_lvm2_parser.mly +++ b/virt-df/virt_df_lvm2_parser.mly @@ -44,8 +44,8 @@ input : lines EOF { List.rev $1 } ; -lines : /* empty */ { prerr_endline "empty line"; [] } - | lines line { prerr_endline "input line"; $2 :: $1 } +lines : /* empty */ { [] } + | lines line { $2 :: $1 } ; line : /* empty */ /* These dummy entries get removed after parsing. */ -- cgit From 3ae5297d795db6e8da8c9b02a7e85a808a93388e Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 15 Apr 2008 22:30:45 +0100 Subject: Redundant newline. --- virt-df/virt_df_lvm2_metadata.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'virt-df') diff --git a/virt-df/virt_df_lvm2_metadata.ml b/virt-df/virt_df_lvm2_metadata.ml index 2929cb0..c5e3f90 100644 --- a/virt-df/virt_df_lvm2_metadata.ml +++ b/virt-df/virt_df_lvm2_metadata.ml @@ -48,7 +48,7 @@ and output_metavalue chan prefix = function output_string chan "{\n"; _output_metadata chan (prefix ^ " ") md; output_string chan prefix; - output_string chan "}\n"; + output_string chan "}"; | String str -> output_char chan '"'; output_string chan str; -- cgit From b06f8da33e1e87a64ec785e248e47e47fee9073f Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 15 Apr 2008 22:31:08 +0100 Subject: Added range library function. --- virt-df/virt_df.ml | 4 ++++ virt-df/virt_df.mli | 5 +++++ 2 files changed, 9 insertions(+) (limited to 'virt-df') diff --git a/virt-df/virt_df.ml b/virt-df/virt_df.ml index f8f34ab..63bb090 100644 --- a/virt-df/virt_df.ml +++ b/virt-df/virt_df.ml @@ -258,3 +258,7 @@ let group_by ?(cmp = Pervasives.compare) ls = in let ls' = List.rev ls' in List.map (fun (x, xs) -> x, List.rev xs) ls' + +let rec range a b = + if a < b then a :: range (a+1) b + else [] diff --git a/virt-df/virt_df.mli b/virt-df/virt_df.mli index b36d003..d40c934 100644 --- a/virt-df/virt_df.mli +++ b/virt-df/virt_df.mli @@ -212,3 +212,8 @@ val list_lvs : lvm_plugin_id -> device list -> lv list val group_by : ?cmp:('a -> 'a -> int) -> ('a * 'b) list -> ('a * 'b list) list (** Group a sorted list of pairs by the first element of the pair. *) + +val range : int -> int -> int list +(** [range a b] returns the list of integers [a <= i < b]. + If [a >= b] then the empty list is returned. +*) -- cgit From 291265b7171d332d2969e07ac189d876e3d7f26d Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 15 Apr 2008 22:31:24 +0100 Subject: Almost complete VG & LV metadata parsing. --- virt-df/virt_df_lvm2.ml | 140 ++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 130 insertions(+), 10 deletions(-) (limited to 'virt-df') diff --git a/virt-df/virt_df_lvm2.ml b/virt-df/virt_df_lvm2.ml index fcf1fd2..af58f97 100644 --- a/virt-df/virt_df_lvm2.ml +++ b/virt-df/virt_df_lvm2.ml @@ -21,6 +21,8 @@ *) open Printf +open ExtList + open Virt_df_gettext.Gettext open Virt_df @@ -114,29 +116,147 @@ let rec list_lvs devs = (* Read the UUID and metadata (again) from each device to end up with * an assoc list of PVs, keyed on the UUID. *) - let pvs = List.map read_pv_label devs in + let pvs = List.map ( + fun dev -> + let uuid, metadata = read_pv_label dev in + (uuid, (metadata, dev)) + ) devs in (* Parse the metadata using the external lexer/parser. *) let pvs = List.map ( - fun (uuid, metadata) -> - eprintf "parsing: %s\n<<<<\n" metadata; - uuid, Virt_df_lvm2_lexer.parse_lvm2_metadata_from_string metadata + fun (uuid, (metadata, dev)) -> + uuid, (Virt_df_lvm2_lexer.parse_lvm2_metadata_from_string metadata, + dev) ) pvs in - (* Print the parsed metadata. *) + (* Print the parsed metadata. List.iter ( - fun (uuid, metadata) -> + fun (uuid, (metadata, dev)) -> eprintf "metadata for UUID %s:\n" uuid; output_metadata stderr metadata ) pvs; + *) - [] - - + (* Scan for volume groups. The first entry in the metadata + * appears to be the volume group name. This gives us a + * list of VGs and the metadata for each underlying PV. + *) + let vgnames = + List.filter_map ( + function + | pvuuid, (((vgname, Metadata vgmeta) :: _), dev) -> + Some (vgname, (pvuuid, vgmeta)) + | _ -> None + ) pvs in + + let cmp ((a:string),_) ((b:string),_) = compare a b in + let vgnames = List.sort ~cmp vgnames in + let vgs = group_by vgnames in + + (* Note that the metadata is supposed to be duplicated + * identically across all PVs (for redundancy purposes). + * In theory we should check this and use the 'seqno' + * field to find the latest metadata if it doesn't match, + * but in fact we don't check this. + *) + let vgs = List.map ( + fun (vgname, metas) -> + let pvuuids = List.map fst metas in + let _, vgmeta = List.hd metas in (* just pick any metadata *) + vgname, (pvuuids, vgmeta)) vgs in + (* Print the VGs. *) + if debug then + List.iter ( + fun (vgname, (pvuuids, vgmeta)) -> + eprintf "VG %s is on PVs: %s\n%!" vgname (String.concat "," pvuuids) + ) vgs; + (* Some useful getter functions. If these can't get a value + * from the metadata or if the type is wrong they raise Not_found. + *) + let rec get_int64 field meta = + match List.assoc field meta with + | Int i -> i + | _ -> raise Not_found + and get_int field meta min max = + match List.assoc field meta with + | Int i when Int64.of_int min <= i && i <= Int64.of_int max -> + Int64.to_int i + | _ -> raise Not_found + and get_string field meta = + match List.assoc field meta with + | String s -> s + | _ -> raise Not_found + and get_meta field meta = + match List.assoc field meta with + | Metadata md -> md + | _ -> raise Not_found in + in + + (* Scan for logical volumes. Each VG contains several LVs. + * This gives us a list of LVs within each VG (hence extends + * the vgs variable). + *) + let vgs = List.map ( + fun (vgname, (pvuuids, vgmeta)) -> + let lvs = + try + let extent_size = get_int "extent_size" vgmeta 0 (256*1024) in + let lvs = get_meta "logical_volumes" vgmeta in + let lvs = List.filter_map ( + function + | lvname, Metadata lvmeta -> + (try + let segment_count = get_int "segment_count" lvmeta 0 1024 in + + (* Get the segments for this LV. *) + let segments = range 1 (segment_count+1) in + let segments = + List.map + (fun i -> get_meta ("segment" ^ string_of_int i) lvmeta) + segments in + + let segments = + List.map ( + fun segmeta -> + let start_extent = + get_int64 "start_extent" segmeta in + let extent_count = + get_int64 "extent_count" segmeta in + let segtype = get_string "type" segmeta in + if segtype <> "striped" then raise Not_found; + let stripe_count = + get_int "stripe_count" segmeta 0 1024 in + (* let stripes = in *) + + (start_extent, extent_count, stripe_count) + ) segments in + + Some (lvname, (lvmeta, segments)) + with + (* Something went wrong with segments - omit this LV. *) + Not_found -> None) + | _ -> None + ) lvs in + + lvs + with + Not_found -> + (* Something went wrong - assume no LVs found. *) + [] in + (vgname, (pvuuids, vgmeta, lvs)) + ) vgs in + + (* Print the LVs. *) + if debug then + List.iter ( + fun (vgname, (pvuuids, vgmeta, lvs)) -> + let lvnames = List.map fst lvs in + eprintf "VG %s contains LVs: %s\n%!" vgname (String.concat ", " lvnames) + ) vgs; - + [] (* Register with main code. *) let () = -- cgit From 027b0d92ed236fa24f211e053e81189cddffe7d7 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Wed, 16 Apr 2008 08:15:56 +0100 Subject: Make debug selectable at runtime. --- virt-df/virt_df.ml | 15 +++++++-------- virt-df/virt_df.mli | 4 +--- virt-df/virt_df_lvm2.ml | 10 +++++----- virt-df/virt_df_main.ml | 2 ++ virt-df/virt_df_mbr.ml | 5 +++-- 5 files changed, 18 insertions(+), 18 deletions(-) (limited to 'virt-df') diff --git a/virt-df/virt_df.ml b/virt-df/virt_df.ml index 63bb090..5fd4d80 100644 --- 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 @@ -171,7 +170,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 +178,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 +195,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 +203,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 +219,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 +227,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 } -> diff --git a/virt-df/virt_df.mli b/virt-df/virt_df.mli index d40c934..f3d20a7 100644 --- a/virt-df/virt_df.mli +++ b/virt-df/virt_df.mli @@ -21,9 +21,6 @@ used throughout the plug-ins and main code. *) -val debug : bool -(** If true, emit logs of debugging information to stderr. *) - val ( +* ) : int32 -> int32 -> int32 val ( -* ) : int32 -> int32 -> int32 val ( ** ) : int32 -> int32 -> int32 @@ -34,6 +31,7 @@ val ( *^ ) : int64 -> int64 -> int64 val ( /^ ) : int64 -> int64 -> int64 (** int32 and int64 infix operators for convenience. *) +val debug : bool ref (** If true, emit debug info to stderr*) val uri : string option ref (** Hypervisor/libvirt URI. *) val inodes : bool ref (** Display inodes. *) val human : bool ref (** Display human-readable. *) diff --git a/virt-df/virt_df_lvm2.ml b/virt-df/virt_df_lvm2.ml index af58f97..314586e 100644 --- a/virt-df/virt_df_lvm2.ml +++ b/virt-df/virt_df_lvm2.ml @@ -37,11 +37,11 @@ let sector_size64 = 512L let rec probe_pv lvm_plugin_id dev = try let uuid, _ = read_pv_label dev in - if debug then + if !debug then eprintf "LVM2 detected PV UUID %s\n%!" uuid; { lvm_plugin_id = lvm_plugin_id; pv_uuid = uuid } with exn -> - if debug then prerr_endline (Printexc.to_string exn); + if !debug then prerr_endline (Printexc.to_string exn); raise Not_found and read_pv_label dev = @@ -87,7 +87,7 @@ and read_pv_label dev = (sprintf "LVM2: read_pv_label: %s: not an LVM2 physical volume" dev#name) and read_metadata dev offset32 len32 = - if debug then + if !debug then eprintf "metadata: offset 0x%lx len %ld bytes\n%!" offset32 len32; (* Check the offset and length are sensible. *) @@ -166,7 +166,7 @@ let rec list_lvs devs = vgname, (pvuuids, vgmeta)) vgs in (* Print the VGs. *) - if debug then + if !debug then List.iter ( fun (vgname, (pvuuids, vgmeta)) -> eprintf "VG %s is on PVs: %s\n%!" vgname (String.concat "," pvuuids) @@ -249,7 +249,7 @@ let rec list_lvs devs = ) vgs in (* Print the LVs. *) - if debug then + if !debug then List.iter ( fun (vgname, (pvuuids, vgmeta, lvs)) -> let lvnames = List.map fst lvs in diff --git a/virt-df/virt_df_main.ml b/virt-df/virt_df_main.ml index e6ae53e..1e1db45 100644 --- 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)"; + "--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, diff --git a/virt-df/virt_df_mbr.ml b/virt-df/virt_df_mbr.ml index b56189c..75e0661 100644 --- a/virt-df/virt_df_mbr.ml +++ b/virt-df/virt_df_mbr.ml @@ -133,8 +133,9 @@ and parse_mbr_entry dev i bits = and make_mbr_entry part_status dev partno part_type first_lba part_size = let first_lba = uint64_of_int32 first_lba in let part_size = uint64_of_int32 part_size in - eprintf "first_lba = %Lx\n" first_lba; - eprintf "part_size = %Lx\n" part_size; + if !debug then + eprintf "make_mbr_entry: first_lba = %Lx part_size = %Lx\n%!" + first_lba part_size; { part_status = part_status; part_type = part_type; part_dev = new partition_device dev partno first_lba part_size; -- cgit From 617ee3553ff13690643b42a084daaadd989b45c9 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Wed, 16 Apr 2008 12:07:17 +0100 Subject: Minor clarifications to developer docs. --- virt-df/README | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'virt-df') diff --git a/virt-df/README b/virt-df/README index c3ba4fe..65acef9 100644 --- a/virt-df/README +++ b/virt-df/README @@ -44,11 +44,11 @@ plug-ins at time of writing are: - virt_df_linux_swap.ml / virt_df_linux_swap.mli - Linux swap (new style). + Linux swap (new style) plug-in. - virt_df_mbr.ml / virt_df_mbr.mli - Master Boot Record (MS-DOS) disk partitioning. + Master Boot Record (MS-DOS) disk partitioning plug-in. - virt_df_lvm2* -- cgit From 0dc5575b79e4d5e003966eaaeb4d0a6a6e8802ed Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Wed, 16 Apr 2008 12:08:27 +0100 Subject: 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(-) (limited to 'virt-df') 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 ( -- cgit From e9fa5a983e2e4c92676022a5912eaa4458ffd4c9 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Wed, 16 Apr 2008 12:08:41 +0100 Subject: Use offset_device --- virt-df/virt_df_mbr.ml | 15 +++------------ 1 file changed, 3 insertions(+), 12 deletions(-) (limited to 'virt-df') diff --git a/virt-df/virt_df_mbr.ml b/virt-df/virt_df_mbr.ml index 75e0661..9516e3c 100644 --- a/virt-df/virt_df_mbr.ml +++ b/virt-df/virt_df_mbr.ml @@ -42,22 +42,13 @@ let max_extended_partitions = 100 * (cf. /dev/hda1 is the first partition). * (3) 'dev' is the underlying block device. *) -class partition_device dev partno start size = +class partition_device partno start size dev = let devname = dev#name in let name = sprintf "%s%d" devname partno in let start = start *^ sector_size64 in let size = size *^ sector_size64 in object (self) - 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 partition boundaries (%Ld/%d/%Ld)" - name offset len size - ); - dev#read (start+^offset) len + inherit offset_device name start size dev end (** Probe the @@ -138,7 +129,7 @@ and make_mbr_entry part_status dev partno part_type first_lba part_size = first_lba part_size; { part_status = part_status; part_type = part_type; - part_dev = new partition_device dev partno first_lba part_size; + part_dev = new partition_device partno first_lba part_size dev; part_content = `Unknown } (* -- cgit From 81593022de32f72e6dd7430519009cb70659eab6 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Wed, 16 Apr 2008 12:08:54 +0100 Subject: LVM2 parsing complete and working. --- virt-df/virt_df_lvm2.ml | 207 +++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 188 insertions(+), 19 deletions(-) (limited to 'virt-df') diff --git a/virt-df/virt_df_lvm2.ml b/virt-df/virt_df_lvm2.ml index 314586e..6a8f573 100644 --- a/virt-df/virt_df_lvm2.ml +++ b/virt-df/virt_df_lvm2.ml @@ -33,6 +33,63 @@ let plugin_name = "LVM2" let sector_size = 512 let sector_size64 = 512L +(*----------------------------------------------------------------------*) +(* Block device which can do linear maps, same as the kernel dm-linear.c *) +class linear_map_device name extent_size segments = + (* The segments are passed containing (start_extent, extent_count, ...) + * but it's easier to deal with (start_extent, end_extent, ...) so + * rewrite them. + *) + let segments = List.map + (fun (start_extent, extent_count, dev, pvoffset) -> + (start_extent, start_extent +^ extent_count, dev, pvoffset) + ) segments in + + (* Calculate the size of the device (in bytes). Note that because + * of the random nature of the mapping this doesn't imply that we can + * satisfy any read request up to the full size. + *) + let size_in_extents = + List.fold_left max 0L + (List.map (fun (_, end_extent, _, _) -> end_extent) segments) in + let size = size_in_extents *^ extent_size in +object + inherit device + method name = name + method size = size + + (* Read method checks which segment the request lies inside and + * maps it to the underlying device. If there is no mapping then + * we have to return an error. + * + * The request must lie inside a single extent, otherwise this is + * also an error (XXX - should lift this restriction, however default + * extent size is 4 MB so we probably won't hit this very often). + *) + method read offset len = + let offset_in_extents = offset /^ extent_size in + + (* Check we don't cross an extent boundary. *) + if (offset +^ Int64.of_int (len-1)) /^ extent_size <> offset_in_extents + then invalid_arg "linear_map_device: request crosses extent boundary"; + + if offset_in_extents < 0L || offset_in_extents >= size_in_extents then + invalid_arg "linear_map_device: read outside device"; + + let rec loop = function + | [] -> + invalid_arg "linear_map_device: offset not mapped" + | (start_extent, end_extent, dev, pvoffset) :: rest -> + eprintf "pvoffset = %Ld\n" pvoffset; + if start_extent <= offset_in_extents && + offset_in_extents < end_extent + then dev#read (offset +^ pvoffset *^ extent_size) len + else loop rest + in + loop segments +end + +(*----------------------------------------------------------------------*) (* Probe to see if it's an LVM2 PV. *) let rec probe_pv lvm_plugin_id dev = try @@ -107,6 +164,7 @@ and read_metadata dev offset32 len32 = *) dev#read offset64 (Int64.to_int len64) +(*----------------------------------------------------------------------*) (* We are passed a list of devices which we previously identified * as PVs belonging to us. From these produce a list of all LVs * (as devices) and return them. Note that we don't try to detect @@ -129,13 +187,13 @@ let rec list_lvs devs = dev) ) pvs in - (* Print the parsed metadata. - List.iter ( - fun (uuid, (metadata, dev)) -> - eprintf "metadata for UUID %s:\n" uuid; - output_metadata stderr metadata - ) pvs; - *) + (* Print the parsed metadata. *) + if !debug then + List.iter ( + fun (uuid, (metadata, dev)) -> + eprintf "metadata for PV UUID %s on %s:\n" uuid dev#name; + output_metadata stderr metadata + ) pvs; (* Scan for volume groups. The first entry in the metadata * appears to be the volume group name. This gives us a @@ -191,18 +249,76 @@ let rec list_lvs devs = and get_meta field meta = match List.assoc field meta with | Metadata md -> md - | _ -> raise Not_found in + | _ -> raise Not_found + and get_stripes field meta = (* List of (string,int) pairs. *) + match List.assoc field meta with + | List xs -> + let rec loop = function + | [] -> [] + | String pvname :: Int offset :: xs -> + (pvname, offset) :: loop xs + | _ -> raise Not_found + in + loop xs + | _ -> raise Not_found in + (* The volume groups refer to the physical volumes using their + * own naming system ("pv0", "pv1", etc.) instead of PV UUIDs. + * + * Each PV also has a start (in sectors) & count (in extents) + * of the writable area (the bit after the superblock and metadata) + * which normally starts at sector 384. + * + * Create a PV device (simple offset + size) and a map from PV + * names to these devices. + *) + let vgs = List.map ( + fun (vgname, (pvuuids, vgmeta)) -> + let pvdevs, extent_size = + try + (* NB: extent_size is in sectors here - we convert to bytes. *) + let extent_size = get_int "extent_size" vgmeta 0 (1024*1024) in + let extent_size = Int64.of_int extent_size *^ sector_size64 in + + (* Get the physical_volumes section of the metadata. *) + let pvdevs = get_meta "physical_volumes" vgmeta in + + List.filter_map ( + function + | (pvname, Metadata meta) -> + (* Get the UUID. *) + let pvuuid = get_string "id" meta in + let pvuuid = canonical_uuid pvuuid in + + (* Get the underlying physical device. *) + let _, dev = List.assoc pvuuid pvs in + + (* Construct a PV device. *) + let pe_start = get_int64 "pe_start" meta in + let pe_start = pe_start *^ sector_size64 in + let pe_count = get_int64 "pe_count" meta in + let pe_count = pe_count *^ extent_size in + let pvdev = new offset_device pvuuid pe_start pe_count dev in + + Some (pvname, pvdev) + | _ -> + None + ) pvdevs, extent_size + with + (* Something went wrong - just return an empty map. *) + Not_found -> [], 0L in + (vgname, (pvuuids, vgmeta, pvdevs, extent_size)) + ) vgs in + (* Scan for logical volumes. Each VG contains several LVs. * This gives us a list of LVs within each VG (hence extends * the vgs variable). *) let vgs = List.map ( - fun (vgname, (pvuuids, vgmeta)) -> + fun (vgname, (pvuuids, vgmeta, pvdevs, extent_size)) -> let lvs = try - let extent_size = get_int "extent_size" vgmeta 0 (256*1024) in let lvs = get_meta "logical_volumes" vgmeta in let lvs = List.filter_map ( function @@ -225,15 +341,29 @@ let rec list_lvs devs = let extent_count = get_int64 "extent_count" segmeta in let segtype = get_string "type" segmeta in + + (* Can only handle striped segments at the + * moment. XXX + *) if segtype <> "striped" then raise Not_found; + let stripe_count = get_int "stripe_count" segmeta 0 1024 in - (* let stripes = in *) + let stripes = get_stripes "stripes" segmeta in + + if List.length stripes <> stripe_count then + raise Not_found; - (start_extent, extent_count, stripe_count) + (* Can only handle linear striped segments at + * the moment. XXX + *) + if stripe_count <> 1 then raise Not_found; + let pvname, pvoffset = List.hd stripes in + + (start_extent, extent_count, pvname, pvoffset) ) segments in - Some (lvname, (lvmeta, segments)) + Some (lvname, segments) with (* Something went wrong with segments - omit this LV. *) Not_found -> None) @@ -245,19 +375,58 @@ let rec list_lvs devs = Not_found -> (* Something went wrong - assume no LVs found. *) [] in - (vgname, (pvuuids, vgmeta, lvs)) + (vgname, (pvuuids, vgmeta, pvdevs, extent_size, lvs)) ) vgs in (* Print the LVs. *) - if !debug then + if !debug then ( List.iter ( - fun (vgname, (pvuuids, vgmeta, lvs)) -> - let lvnames = List.map fst lvs in - eprintf "VG %s contains LVs: %s\n%!" vgname (String.concat ", " lvnames) + fun (vgname, (pvuuids, vgmeta, pvdevs, extent_size, lvs)) -> + eprintf "VG %s: (extent_size = %Ld bytes)\n" vgname extent_size; + List.iter ( + fun (lvname, segments) -> + eprintf " %s/%s:\n" vgname lvname; + List.iter ( + fun (start_extent, extent_count, pvname, pvoffset) -> + eprintf " start %Ld count %Ld at %s:%Ld\n" + start_extent extent_count pvname pvoffset + ) segments + ) lvs ) vgs; + flush stderr + ); + + (* Finally we can set up devices for the LVs. *) + let lvs = + List.map ( + fun (vgname, (pvuuid, vgmeta, pvdevs, extent_size, lvs)) -> + try + List.map ( + fun (lvname, segments) -> + let name = vgname ^ "/" ^ lvname in + let segments = List.map ( + fun (start_extent, extent_count, pvname, pvoffset) -> + (* Get the PV device. *) + let pvdev = List.assoc pvname pvdevs in + + (* Extents mapped to: *) + (start_extent, extent_count, pvdev, pvoffset) + ) segments in + + (* Create a linear mapping device. *) + let lv_dev = new linear_map_device name extent_size segments in + + { lv_dev = lv_dev } + ) lvs + with + Not_found -> [] + ) vgs in + let lvs = List.concat lvs in - [] + (* Return the list of LV devices. *) + lvs +(*----------------------------------------------------------------------*) (* Register with main code. *) let () = lvm_type_register plugin_name probe_pv list_lvs -- cgit From 4cb0481ebc30cdb05d1a0e8672e5dda8cd2352c2 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Wed, 16 Apr 2008 12:58:00 +0100 Subject: Fix alignment in -t option --- virt-df/virt_df_main.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'virt-df') diff --git a/virt-df/virt_df_main.ml b/virt-df/virt_df_main.ml index 4a1110d..65d1f2f 100644 --- a/virt-df/virt_df_main.ml +++ b/virt-df/virt_df_main.ml @@ -65,7 +65,7 @@ let () = "--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 -- cgit From de3eddf0801b9a36a786e7579733e81ff509f339 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Wed, 16 Apr 2008 12:58:06 +0100 Subject: Update manpage. --- virt-df/virt-df.1 | 21 +++++++++++++-------- virt-df/virt-df.pod | 21 ++++++++++++++------- virt-df/virt-df.txt | 19 ++++++++++++------- 3 files changed, 39 insertions(+), 22 deletions(-) (limited to 'virt-df') diff --git a/virt-df/virt-df.1 b/virt-df/virt-df.1 index ff7e92d..93c4ad7 100644 --- a/virt-df/virt-df.1 +++ b/virt-df/virt-df.1 @@ -129,7 +129,7 @@ .\" ======================================================================== .\" .IX Title "VIRT-DF 1" -.TH VIRT-DF 1 "2008-03-04" "ocaml-libvirt-0.4.0.3" "Virtualization Support" +.TH VIRT-DF 1 "2008-04-16" "ocaml-libvirt-0.4.1.1" "Virtualization Support" .SH "NAME" virt\-df \- 'df'\-like utility for virtualization stats .SH "SUMMARY" @@ -156,6 +156,10 @@ Show all domains. The default is show only running (active) domains. .IX Item "-c uri, --connect uri" Connect to libvirt \s-1URI\s0. The default is to connect to the default libvirt \s-1URI\s0, normally Xen. +.IP "\fB\-\-debug\fR" 4 +.IX Item "--debug" +Emit debugging information on stderr. Please supply this if you +report a bug. .IP "\fB\-h\fR, \fB\-\-human\-readable\fR" 4 .IX Item "-h, --human-readable" Display human-readable sizes (eg. 10GiB). @@ -165,6 +169,11 @@ Display inode information. .IP "\fB\-\-help\fR" 4 .IX Item "--help" Display usage summary. +.IP "\fB\-t diskimage\fR" 4 +.IX Item "-t diskimage" +Test mode. Instead of checking libvirt for domain information, this +runs virt-df directly on the disk image (or device) supplied. You may +specify the \fB\-t\fR option multiple times. .IP "\fB\-\-version\fR" 4 .IX Item "--version" Display version and exit. @@ -202,12 +211,8 @@ superblock, for example \fIfsync\fR\|(2) [that is my reading of the ext2/3 source code at least]. .SH "SECURITY" .IX Header "SECURITY" -The current code is probably not secure against malicious guests. In -particular a malicious guest can set up a disk in such a way that disk -structures with loops can cause virt-df to spin forever. We are -preparing a parsing library which can fix these sorts of problems. -.PP -In the meantime, do not run virt-df on untrusted guests. +The current code tries hard to be secure against malicious guests, for +example guests which set up malicious disk partitions. .SH "SEE ALSO" .IX Header "SEE ALSO" \&\fIdf\fR\|(1), @@ -254,7 +259,7 @@ have fixed it. Run .Sp .Vb 1 -\& virt-df > virt-df.log 2>&1 +\& virt-df --debug > virt-df.log 2>&1 .Ve .Sp and keep \fIvirt\-df.log\fR. It contains error messages which you should diff --git a/virt-df/virt-df.pod b/virt-df/virt-df.pod index 84b1d97..ffde02b 100644 --- a/virt-df/virt-df.pod +++ b/virt-df/virt-df.pod @@ -32,6 +32,11 @@ Show all domains. The default is show only running (active) domains. Connect to libvirt URI. The default is to connect to the default libvirt URI, normally Xen. +=item B<--debug> + +Emit debugging information on stderr. Please supply this if you +report a bug. + =item B<-h>, B<--human-readable> Display human-readable sizes (eg. 10GiB). @@ -44,6 +49,12 @@ Display inode information. Display usage summary. +=item B<-t diskimage> + +Test mode. Instead of checking libvirt for domain information, this +runs virt-df directly on the disk image (or device) supplied. You may +specify the B<-t> option multiple times. + =item B<--version> Display version and exit. @@ -85,12 +96,8 @@ source code at least]. =head1 SECURITY -The current code is probably not secure against malicious guests. In -particular a malicious guest can set up a disk in such a way that disk -structures with loops can cause virt-df to spin forever. We are -preparing a parsing library which can fix these sorts of problems. - -In the meantime, do not run virt-df on untrusted guests. +The current code tries hard to be secure against malicious guests, for +example guests which set up malicious disk partitions. =head1 SEE ALSO @@ -144,7 +151,7 @@ have fixed it. Run - virt-df > virt-df.log 2>&1 + virt-df --debug > virt-df.log 2>&1 and keep I. It contains error messages which you should submit with your bug report. diff --git a/virt-df/virt-df.txt b/virt-df/virt-df.txt index fcddafb..aa02a8f 100644 --- a/virt-df/virt-df.txt +++ b/virt-df/virt-df.txt @@ -23,6 +23,10 @@ OPTIONS Connect to libvirt URI. The default is to connect to the default libvirt URI, normally Xen. + --debug + Emit debugging information on stderr. Please supply this if you + report a bug. + -h, --human-readable Display human-readable sizes (eg. 10GiB). @@ -32,6 +36,11 @@ OPTIONS --help Display usage summary. + -t diskimage + Test mode. Instead of checking libvirt for domain information, this + runs virt-df directly on the disk image (or device) supplied. You + may specify the -t option multiple times. + --version Display version and exit. @@ -68,12 +77,8 @@ SHORTCOMINGS least]. SECURITY - The current code is probably not secure against malicious guests. In - particular a malicious guest can set up a disk in such a way that disk - structures with loops can cause virt-df to spin forever. We are - preparing a parsing library which can fix these sorts of problems. - - In the meantime, do not run virt-df on untrusted guests. + The current code tries hard to be secure against malicious guests, for + example guests which set up malicious disk partitions. SEE ALSO df(1), virsh(1), xm(1), , @@ -115,7 +120,7 @@ REPORTING BUGS 2. Capture debug and error messages Run - virt-df > virt-df.log 2>&1 + virt-df --debug > virt-df.log 2>&1 and keep *virt-df.log*. It contains error messages which you should submit with your bug report. -- cgit From 02f1c03c9f81e25353aae4900ce19e194b507f71 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Wed, 16 Apr 2008 13:51:14 +0100 Subject: Removed virt-ctrl, virt-df, ocaml-libvirt - now in separate repositories. --- virt-df/Makefile.in | 109 --------- virt-df/README | 68 ------ virt-df/virt-df.1 | 285 ---------------------- virt-df/virt-df.pod | 181 -------------- virt-df/virt-df.txt | 144 ----------- virt-df/virt_df.ml | 293 ----------------------- virt-df/virt_df.mli | 237 ------------------ virt-df/virt_df_ext2.ml | 138 ----------- virt-df/virt_df_ext2.mli | 22 -- virt-df/virt_df_linux_swap.ml | 54 ----- virt-df/virt_df_linux_swap.mli | 22 -- virt-df/virt_df_lvm2.ml | 432 --------------------------------- virt-df/virt_df_lvm2.mli | 22 -- virt-df/virt_df_lvm2_lexer.mll | 165 ------------- virt-df/virt_df_lvm2_metadata.ml | 65 ----- virt-df/virt_df_lvm2_metadata.mli | 38 --- virt-df/virt_df_lvm2_parser.mly | 70 ------ virt-df/virt_df_main.ml | 488 -------------------------------------- virt-df/virt_df_mbr.ml | 187 --------------- virt-df/virt_df_mbr.mli | 22 -- 20 files changed, 3042 deletions(-) delete mode 100644 virt-df/Makefile.in delete mode 100644 virt-df/README delete mode 100644 virt-df/virt-df.1 delete mode 100644 virt-df/virt-df.pod delete mode 100644 virt-df/virt-df.txt delete mode 100644 virt-df/virt_df.ml delete mode 100644 virt-df/virt_df.mli delete mode 100644 virt-df/virt_df_ext2.ml delete mode 100644 virt-df/virt_df_ext2.mli delete mode 100644 virt-df/virt_df_linux_swap.ml delete mode 100644 virt-df/virt_df_linux_swap.mli delete mode 100644 virt-df/virt_df_lvm2.ml delete mode 100644 virt-df/virt_df_lvm2.mli delete mode 100644 virt-df/virt_df_lvm2_lexer.mll delete mode 100644 virt-df/virt_df_lvm2_metadata.ml delete mode 100644 virt-df/virt_df_lvm2_metadata.mli delete mode 100644 virt-df/virt_df_lvm2_parser.mly delete mode 100644 virt-df/virt_df_main.ml delete mode 100644 virt-df/virt_df_mbr.ml delete mode 100644 virt-df/virt_df_mbr.mli (limited to 'virt-df') diff --git a/virt-df/Makefile.in b/virt-df/Makefile.in deleted file mode 100644 index 4fb088c..0000000 --- a/virt-df/Makefile.in +++ /dev/null @@ -1,109 +0,0 @@ -# virt-df -# Copyright (C) 2007 Red Hat Inc., Richard W.M. Jones -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - -PACKAGE := @PACKAGE_NAME@ -VERSION := @PACKAGE_VERSION@ - -INSTALL := @INSTALL@ -HAVE_PERLDOC := @HAVE_PERLDOC@ - -prefix = @prefix@ -exec_prefix = @exec_prefix@ -bindir = @bindir@ - -pkg_gettext = @pkg_gettext@ - -#OCAMLCPACKAGES := -package unix,extlib,xml-light,bitmatch -OCAMLCPACKAGES := -package unix,extlib,xml-light -I +bitmatch - -ifneq ($(pkg_gettext),no) -OCAMLCPACKAGES += -package gettext-stub -endif - -OBJS := \ - virt_df_gettext.cmo \ - virt_df.cmo \ - virt_df_ext2.cmo \ - virt_df_linux_swap.cmo \ - virt_df_lvm2_metadata.cmo \ - virt_df_lvm2_parser.cmo \ - virt_df_lvm2_lexer.cmo \ - virt_df_lvm2.cmo \ - virt_df_mbr.cmo \ - virt_df_main.cmo - -XOBJS := $(OBJS:.cmo=.cmx) - -SYNTAX := -pp "camlp4o -I`ocamlc -where`/bitmatch pa_bitmatch.cmo" - -OCAMLCPACKAGES += -I ../libvirt -OCAMLCFLAGS := -g -w s $(SYNTAX) -#OCAMLCLIBS := -linkpkg -OCAMLCLIBS := -linkpkg bitmatch.cma - -OCAMLOPTPACKAGES := $(OCAMLCPACKAGES) -OCAMLOPTFLAGS := -w s $(SYNTAX) -#OCAMLOPTLIBS := $(OCAMLCLIBS) -OCAMLOPTLIBS := -linkpkg bitmatch.cmxa - -OCAMLDEPFLAGS := $(SYNTAX) - -export LIBRARY_PATH=../libvirt -export LD_LIBRARY_PATH=../libvirt - -BYTE_TARGETS := virt-df -OPT_TARGETS := virt-df.opt - -ifeq ($(HAVE_PERLDOC),perldoc) -BYTE_TARGETS += virt-df.1 virt-df.txt -endif - -all: $(BYTE_TARGETS) - -opt: $(OPT_TARGETS) - -virt-df: $(OBJS) - ocamlfind ocamlc $(OCAMLCPACKAGES) $(OCAMLCFLAGS) $(OCAMLCLIBS) \ - ../libvirt/mllibvirt.cma -o $@ $^ - -virt-df.opt: $(XOBJS) - ocamlfind ocamlopt \ - $(OCAMLOPTPACKAGES) $(OCAMLOPTFLAGS) $(OCAMLOPTLIBS) \ - ../libvirt/mllibvirt.cmxa -o $@ $^ - -# 'make depend' doesn't catch these dependencies because the .mli file -# is auto-generated. -virt_df_lvm2_parser.cmo: virt_df_lvm2_parser.mli -virt_df_lvm2_parser.cmx: virt_df_lvm2_parser.mli - -# Manual page. -ifeq ($(HAVE_PERLDOC),perldoc) -virt-df.1: virt-df.pod - pod2man -c "Virtualization Support" --release "$(PACKAGE)-$(VERSION)" \ - $< > $@ - -virt-df.txt: virt-df.pod - pod2text $< > $@ -endif - -install: - if [ -x virt-df.opt ]; then \ - mkdir -p $(DESTDIR)$(bindir); \ - $(INSTALL) -m 0755 virt-df.opt $(DESTDIR)$(bindir)/virt-df; \ - fi - -include ../Make.rules diff --git a/virt-df/README b/virt-df/README deleted file mode 100644 index 65acef9..0000000 --- a/virt-df/README +++ /dev/null @@ -1,68 +0,0 @@ -$Id$ - -For user documentation: - -Please see the manual page (virt-df.pod or virt-df.txt in this -directory). - -Developer documentation ----------------------------------------------------------------------- - -This program has suddenly become rather large and confusing. -Hopefully this documentation should go some way towards explaining -what is going on inside the source. - -The main program consists of two modules: - - - virt_df.ml / virt_df.mli (module name: Virt_df) - - This has evolved into a library of miscellaneous functions - and values which are included throughout the rest of the - program. If you see an unexplained function then it's - likely that it is defined in here. - - Start by reading virt_df.mli which contains the full types - and plenty of documentation. - - - virt_df_main.ml - - This is the program. It reads the command line arguments, - loads the domain descriptions, calls out to the plug-ins - to probe for disks / partitions / filesystems / etc., and - finally prints the results. - - The file consists of basically one large program that - does all of the above in sequence. - -Everything else in this directory is a plug-in specialized for probing -a particular filesystem, partition scheme or type of LVM. The -plug-ins at time of writing are: - - - virt_df_ext2.ml / virt_df_ext2.mli - - EXT2/3/4 plug-in. - - - virt_df_linux_swap.ml / virt_df_linux_swap.mli - - Linux swap (new style) plug-in. - - - virt_df_mbr.ml / virt_df_mbr.mli - - Master Boot Record (MS-DOS) disk partitioning plug-in. - - - virt_df_lvm2* - - LVM2 parsing, which is by far the most complex plug-in. - It consists of: - - - virt_df_lvm2.ml - - virt_df_lvm2.mli - LVM2 probing, PV detection. - - - virt_df_lvm2_parser.mly - - virt_df_lvm2_lexer.mll - Scanner/parser for parsing LVM2 metadata definitions. - - - virt_df_lvm2_metadata.ml - - virt_df_lvm2_metadata.mli - AST for LVM2 metadata definitions. diff --git a/virt-df/virt-df.1 b/virt-df/virt-df.1 deleted file mode 100644 index 93c4ad7..0000000 --- a/virt-df/virt-df.1 +++ /dev/null @@ -1,285 +0,0 @@ -.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32 -.\" -.\" Standard preamble: -.\" ======================================================================== -.de Sh \" Subsection heading -.br -.if t .Sp -.ne 5 -.PP -\fB\\$1\fR -.PP -.. -.de Sp \" Vertical space (when we can't use .PP) -.if t .sp .5v -.if n .sp -.. -.de Vb \" Begin verbatim text -.ft CW -.nf -.ne \\$1 -.. -.de Ve \" End verbatim text -.ft R -.fi -.. -.\" Set up some character translations and predefined strings. \*(-- will -.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left -.\" double quote, and \*(R" will give a right double quote. | will give a -.\" real vertical bar. \*(C+ will give a nicer C++. Capital omega is used to -.\" do unbreakable dashes and therefore won't be available. \*(C` and \*(C' -.\" expand to `' in nroff, nothing in troff, for use with C<>. -.tr \(*W-|\(bv\*(Tr -.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' -.ie n \{\ -. ds -- \(*W- -. ds PI pi -. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch -. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch -. ds L" "" -. ds R" "" -. ds C` "" -. ds C' "" -'br\} -.el\{\ -. ds -- \|\(em\| -. ds PI \(*p -. ds L" `` -. ds R" '' -'br\} -.\" -.\" If the F register is turned on, we'll generate index entries on stderr for -.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index -.\" entries marked with X<> in POD. Of course, you'll have to process the -.\" output yourself in some meaningful fashion. -.if \nF \{\ -. de IX -. tm Index:\\$1\t\\n%\t"\\$2" -.. -. nr % 0 -. rr F -.\} -.\" -.\" For nroff, turn off justification. Always turn off hyphenation; it makes -.\" way too many mistakes in technical documents. -.hy 0 -.if n .na -.\" -.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). -.\" Fear. Run. Save yourself. No user-serviceable parts. -. \" fudge factors for nroff and troff -.if n \{\ -. ds #H 0 -. ds #V .8m -. ds #F .3m -. ds #[ \f1 -. ds #] \fP -.\} -.if t \{\ -. ds #H ((1u-(\\\\n(.fu%2u))*.13m) -. ds #V .6m -. ds #F 0 -. ds #[ \& -. ds #] \& -.\} -. \" simple accents for nroff and troff -.if n \{\ -. ds ' \& -. ds ` \& -. ds ^ \& -. ds , \& -. ds ~ ~ -. ds / -.\} -.if t \{\ -. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" -. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' -. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' -. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' -. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' -. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' -.\} -. \" troff and (daisy-wheel) nroff accents -.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' -.ds 8 \h'\*(#H'\(*b\h'-\*(#H' -.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] -.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' -.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' -.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] -.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] -.ds ae a\h'-(\w'a'u*4/10)'e -.ds Ae A\h'-(\w'A'u*4/10)'E -. \" corrections for vroff -.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' -.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' -. \" for low resolution devices (crt and lpr) -.if \n(.H>23 .if \n(.V>19 \ -\{\ -. ds : e -. ds 8 ss -. ds o a -. ds d- d\h'-1'\(ga -. ds D- D\h'-1'\(hy -. ds th \o'bp' -. ds Th \o'LP' -. ds ae ae -. ds Ae AE -.\} -.rm #[ #] #H #V #F C -.\" ======================================================================== -.\" -.IX Title "VIRT-DF 1" -.TH VIRT-DF 1 "2008-04-16" "ocaml-libvirt-0.4.1.1" "Virtualization Support" -.SH "NAME" -virt\-df \- 'df'\-like utility for virtualization stats -.SH "SUMMARY" -.IX Header "SUMMARY" -virt-df [\-options] -.SH "DESCRIPTION" -.IX Header "DESCRIPTION" -virt-df is a \fIdf\fR\|(1)\-like utility for showing the actual disk usage -of guests. Many command line options are the same as for ordinary -\&\fIdf\fR. -.PP -It uses libvirt so it is capable of showing stats across a variety of -different virtualization systems. -.PP -There are some shortcomings to the whole approach of reading disk -state from outside the guest. Please read \s-1SHORTCOMINGS\s0 section below -for more details. -.SH "OPTIONS" -.IX Header "OPTIONS" -.IP "\fB\-a\fR, \fB\-\-all\fR" 4 -.IX Item "-a, --all" -Show all domains. The default is show only running (active) domains. -.IP "\fB\-c uri\fR, \fB\-\-connect uri\fR" 4 -.IX Item "-c uri, --connect uri" -Connect to libvirt \s-1URI\s0. The default is to connect to the default -libvirt \s-1URI\s0, normally Xen. -.IP "\fB\-\-debug\fR" 4 -.IX Item "--debug" -Emit debugging information on stderr. Please supply this if you -report a bug. -.IP "\fB\-h\fR, \fB\-\-human\-readable\fR" 4 -.IX Item "-h, --human-readable" -Display human-readable sizes (eg. 10GiB). -.IP "\fB\-i\fR, \fB\-\-inodes\fR" 4 -.IX Item "-i, --inodes" -Display inode information. -.IP "\fB\-\-help\fR" 4 -.IX Item "--help" -Display usage summary. -.IP "\fB\-t diskimage\fR" 4 -.IX Item "-t diskimage" -Test mode. Instead of checking libvirt for domain information, this -runs virt-df directly on the disk image (or device) supplied. You may -specify the \fB\-t\fR option multiple times. -.IP "\fB\-\-version\fR" 4 -.IX Item "--version" -Display version and exit. -.SH "SHORTCOMINGS" -.IX Header "SHORTCOMINGS" -virt-df spies on the guest's disk image to try to work out how much -disk space it is actually using. There are some shortcomings to this, -described here. -.PP -(1) It does not work over remote connections. The storage \s-1API\s0 does -not support peeking into remote disks, and libvirt has rejected a -request to add this support. -.PP -(2) It only understands a limited set of partition types. Assuming -that the files and partitions that we get back from libvirt / Xen -correspond to block devices in the guests, we can go some way towards -manually parsing those partitions to find out what they contain. We -can read the \s-1MBR\s0, \s-1LVM\s0, superblocks and so on. However that's a lot of -parsing work, and currently there is no library which understands a -wide range of partition schemes and filesystem types (not even -libparted which doesn't support \s-1LVM\s0 yet). The Linux kernel does -support that, but there's not really any good way to access that work. -.PP -The current implementation uses a hand-coded parser which understands -some simple formats (\s-1MBR\s0, \s-1LVM2\s0, ext2/3). In future we should use -something like libparted. -.PP -(3) The statistics you get are delayed. The real state of, for -example, an ext2 filesystem is only stored in the memory of the -guest's kernel. The ext2 superblock contains some meta-information -about blocks used and free, but this superblock is not up to date. In -fact the guest kernel may not update it even on a 'sync', not until -the filesystem is unmounted. Some operations do appear to write the -superblock, for example \fIfsync\fR\|(2) [that is my reading of the ext2/3 -source code at least]. -.SH "SECURITY" -.IX Header "SECURITY" -The current code tries hard to be secure against malicious guests, for -example guests which set up malicious disk partitions. -.SH "SEE ALSO" -.IX Header "SEE ALSO" -\&\fIdf\fR\|(1), -\&\fIvirsh\fR\|(1), -\&\fIxm\fR\|(1), -, -, -, - -.SH "AUTHORS" -.IX Header "AUTHORS" -Richard W.M. Jones -.SH "COPYRIGHT" -.IX Header "COPYRIGHT" -(C) Copyright 2007\-2008 Red Hat Inc., Richard W.M. Jones -http://libvirt.org/ -.PP -This program is free software; you can redistribute it and/or modify -it under the terms of the \s-1GNU\s0 General Public License as published by -the Free Software Foundation; either version 2 of the License, or -(at your option) any later version. -.PP -This program is distributed in the hope that it will be useful, -but \s-1WITHOUT\s0 \s-1ANY\s0 \s-1WARRANTY\s0; without even the implied warranty of -\&\s-1MERCHANTABILITY\s0 or \s-1FITNESS\s0 \s-1FOR\s0 A \s-1PARTICULAR\s0 \s-1PURPOSE\s0. See the -\&\s-1GNU\s0 General Public License for more details. -.PP -You should have received a copy of the \s-1GNU\s0 General Public License -along with this program; if not, write to the Free Software -Foundation, Inc., 675 Mass Ave, Cambridge, \s-1MA\s0 02139, \s-1USA\s0. -.SH "REPORTING BUGS" -.IX Header "REPORTING BUGS" -Bugs can be viewed on the Red Hat Bugzilla page: -. -.PP -If you find a bug in virt\-df, please follow these steps to report it: -.IP "1. Check for existing bug reports" 4 -.IX Item "1. Check for existing bug reports" -Go to and search for similar bugs. -Someone may already have reported the same bug, and they may even -have fixed it. -.IP "2. Capture debug and error messages" 4 -.IX Item "2. Capture debug and error messages" -Run -.Sp -.Vb 1 -\& virt-df --debug > virt-df.log 2>&1 -.Ve -.Sp -and keep \fIvirt\-df.log\fR. It contains error messages which you should -submit with your bug report. -.IP "3. Get version of virt-df and version of libvirt." 4 -.IX Item "3. Get version of virt-df and version of libvirt." -Run -.Sp -.Vb 1 -\& virt-df --version -.Ve -.IP "4. Submit a bug report." 4 -.IX Item "4. Submit a bug report." -Go to and enter a new bug. -Please describe the problem in as much detail as possible. -.Sp -Remember to include the version numbers (step 3) and the debug -messages file (step 2). -.IP "5. Assign the bug to rjones @ redhat.com" 4 -.IX Item "5. Assign the bug to rjones @ redhat.com" -Assign or reassign the bug to \fBrjones @ redhat.com\fR (without the -spaces). You can also send me an email with the bug number if you -want a faster response. diff --git a/virt-df/virt-df.pod b/virt-df/virt-df.pod deleted file mode 100644 index ffde02b..0000000 --- a/virt-df/virt-df.pod +++ /dev/null @@ -1,181 +0,0 @@ -=head1 NAME - -virt-df - 'df'-like utility for virtualization stats - -=head1 SUMMARY - -virt-df [-options] - -=head1 DESCRIPTION - -virt-df is a L-like utility for showing the actual disk usage -of guests. Many command line options are the same as for ordinary -I. - -It uses libvirt so it is capable of showing stats across a variety of -different virtualization systems. - -There are some shortcomings to the whole approach of reading disk -state from outside the guest. Please read SHORTCOMINGS section below -for more details. - -=head1 OPTIONS - -=over 4 - -=item B<-a>, B<--all> - -Show all domains. The default is show only running (active) domains. - -=item B<-c uri>, B<--connect uri> - -Connect to libvirt URI. The default is to connect to the default -libvirt URI, normally Xen. - -=item B<--debug> - -Emit debugging information on stderr. Please supply this if you -report a bug. - -=item B<-h>, B<--human-readable> - -Display human-readable sizes (eg. 10GiB). - -=item B<-i>, B<--inodes> - -Display inode information. - -=item B<--help> - -Display usage summary. - -=item B<-t diskimage> - -Test mode. Instead of checking libvirt for domain information, this -runs virt-df directly on the disk image (or device) supplied. You may -specify the B<-t> option multiple times. - -=item B<--version> - -Display version and exit. - -=back - -=head1 SHORTCOMINGS - -virt-df spies on the guest's disk image to try to work out how much -disk space it is actually using. There are some shortcomings to this, -described here. - -(1) It does not work over remote connections. The storage API does -not support peeking into remote disks, and libvirt has rejected a -request to add this support. - -(2) It only understands a limited set of partition types. Assuming -that the files and partitions that we get back from libvirt / Xen -correspond to block devices in the guests, we can go some way towards -manually parsing those partitions to find out what they contain. We -can read the MBR, LVM, superblocks and so on. However that's a lot of -parsing work, and currently there is no library which understands a -wide range of partition schemes and filesystem types (not even -libparted which doesn't support LVM yet). The Linux kernel does -support that, but there's not really any good way to access that work. - -The current implementation uses a hand-coded parser which understands -some simple formats (MBR, LVM2, ext2/3). In future we should use -something like libparted. - -(3) The statistics you get are delayed. The real state of, for -example, an ext2 filesystem is only stored in the memory of the -guest's kernel. The ext2 superblock contains some meta-information -about blocks used and free, but this superblock is not up to date. In -fact the guest kernel may not update it even on a 'sync', not until -the filesystem is unmounted. Some operations do appear to write the -superblock, for example L [that is my reading of the ext2/3 -source code at least]. - -=head1 SECURITY - -The current code tries hard to be secure against malicious guests, for -example guests which set up malicious disk partitions. - -=head1 SEE ALSO - -L, -L, -L, -L, -L, -L, -L - -=head1 AUTHORS - -Richard W.M. Jones - -=head1 COPYRIGHT - -(C) Copyright 2007-2008 Red Hat Inc., Richard W.M. Jones -http://libvirt.org/ - -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2 of the License, or -(at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with this program; if not, write to the Free Software -Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - -=head1 REPORTING BUGS - -Bugs can be viewed on the Red Hat Bugzilla page: -L. - -If you find a bug in virt-df, please follow these steps to report it: - -=over 4 - -=item 1. Check for existing bug reports - -Go to L and search for similar bugs. -Someone may already have reported the same bug, and they may even -have fixed it. - -=item 2. Capture debug and error messages - -Run - - virt-df --debug > virt-df.log 2>&1 - -and keep I. It contains error messages which you should -submit with your bug report. - -=item 3. Get version of virt-df and version of libvirt. - -Run - - virt-df --version - -=item 4. Submit a bug report. - -Go to L and enter a new bug. -Please describe the problem in as much detail as possible. - -Remember to include the version numbers (step 3) and the debug -messages file (step 2). - -=item 5. Assign the bug to rjones @ redhat.com - -Assign or reassign the bug to B (without the -spaces). You can also send me an email with the bug number if you -want a faster response. - -=back - -=end diff --git a/virt-df/virt-df.txt b/virt-df/virt-df.txt deleted file mode 100644 index aa02a8f..0000000 --- a/virt-df/virt-df.txt +++ /dev/null @@ -1,144 +0,0 @@ -NAME - virt-df - 'df'-like utility for virtualization stats - -SUMMARY - virt-df [-options] - -DESCRIPTION - virt-df is a df(1)-like utility for showing the actual disk usage of - guests. Many command line options are the same as for ordinary *df*. - - It uses libvirt so it is capable of showing stats across a variety of - different virtualization systems. - - There are some shortcomings to the whole approach of reading disk state - from outside the guest. Please read SHORTCOMINGS section below for more - details. - -OPTIONS - -a, --all - Show all domains. The default is show only running (active) domains. - - -c uri, --connect uri - Connect to libvirt URI. The default is to connect to the default - libvirt URI, normally Xen. - - --debug - Emit debugging information on stderr. Please supply this if you - report a bug. - - -h, --human-readable - Display human-readable sizes (eg. 10GiB). - - -i, --inodes - Display inode information. - - --help - Display usage summary. - - -t diskimage - Test mode. Instead of checking libvirt for domain information, this - runs virt-df directly on the disk image (or device) supplied. You - may specify the -t option multiple times. - - --version - Display version and exit. - -SHORTCOMINGS - virt-df spies on the guest's disk image to try to work out how much disk - space it is actually using. There are some shortcomings to this, - described here. - - (1) It does not work over remote connections. The storage API does not - support peeking into remote disks, and libvirt has rejected a request to - add this support. - - (2) It only understands a limited set of partition types. Assuming that - the files and partitions that we get back from libvirt / Xen correspond - to block devices in the guests, we can go some way towards manually - parsing those partitions to find out what they contain. We can read the - MBR, LVM, superblocks and so on. However that's a lot of parsing work, - and currently there is no library which understands a wide range of - partition schemes and filesystem types (not even libparted which doesn't - support LVM yet). The Linux kernel does support that, but there's not - really any good way to access that work. - - The current implementation uses a hand-coded parser which understands - some simple formats (MBR, LVM2, ext2/3). In future we should use - something like libparted. - - (3) The statistics you get are delayed. The real state of, for example, - an ext2 filesystem is only stored in the memory of the guest's kernel. - The ext2 superblock contains some meta-information about blocks used and - free, but this superblock is not up to date. In fact the guest kernel - may not update it even on a 'sync', not until the filesystem is - unmounted. Some operations do appear to write the superblock, for - example fsync(2) [that is my reading of the ext2/3 source code at - least]. - -SECURITY - The current code tries hard to be secure against malicious guests, for - example guests which set up malicious disk partitions. - -SEE ALSO - df(1), virsh(1), xm(1), , - , , - - -AUTHORS - Richard W.M. Jones - -COPYRIGHT - (C) Copyright 2007-2008 Red Hat Inc., Richard W.M. Jones - http://libvirt.org/ - - This program is free software; you can redistribute it and/or modify it - under the terms of the GNU General Public License as published by the - Free Software Foundation; either version 2 of the License, or (at your - option) any later version. - - This program is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General - Public License for more details. - - You should have received a copy of the GNU General Public License along - with this program; if not, write to the Free Software Foundation, Inc., - 675 Mass Ave, Cambridge, MA 02139, USA. - -REPORTING BUGS - Bugs can be viewed on the Red Hat Bugzilla page: - . - - If you find a bug in virt-df, please follow these steps to report it: - - 1. Check for existing bug reports - Go to and search for similar bugs. - Someone may already have reported the same bug, and they may even - have fixed it. - - 2. Capture debug and error messages - Run - - virt-df --debug > virt-df.log 2>&1 - - and keep *virt-df.log*. It contains error messages which you should - submit with your bug report. - - 3. Get version of virt-df and version of libvirt. - Run - - virt-df --version - - 4. Submit a bug report. - Go to and enter a new bug. Please - describe the problem in as much detail as possible. - - Remember to include the version numbers (step 3) and the debug - messages file (step 2). - - 5. Assign the bug to rjones @ redhat.com - Assign or reassign the bug to rjones @ redhat.com (without the - spaces). You can also send me an email with the bug number if you - want a faster response. - diff --git a/virt-df/virt_df.ml b/virt-df/virt_df.ml deleted file mode 100644 index c02c8e3..0000000 --- a/virt-df/virt_df.ml +++ /dev/null @@ -1,293 +0,0 @@ -(* 'df' command for virtual domains. - (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc. - http://libvirt.org/ - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - *) - -open Printf -open ExtList -open Unix - -open Virt_df_gettext.Gettext - -let ( +* ) = Int32.add -let ( -* ) = Int32.sub -let ( ** ) = Int32.mul -let ( /* ) = Int32.div - -let ( +^ ) = Int64.add -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 -let all = ref false -let test_files = ref [] - -class virtual device = -object (self) - method virtual read : int64 -> int -> string - method virtual size : int64 - method virtual name : string - - (* Helper method to read a chunk of data into a bitstring. *) - method read_bitstring offset len = - let str = self#read offset len in - (str, 0, len * 8) -end - -(* A concrete device which just direct-maps a file or /dev device. *) -class block_device filename = - let fd = openfile filename [ O_RDONLY ] 0 in - let size = (LargeFile.fstat fd).LargeFile.st_size in -object (self) - inherit device - method read offset len = - ignore (LargeFile.lseek fd offset SEEK_SET); - let str = String.make len '\000' in - read fd str 0 len; - str - method size = size - 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 - inherit device - method read _ _ = assert false - method size = 0L - method name = "null" -end - -type domain = { - dom_name : string; (* Domain name. *) - dom_id : int option; (* Domain ID (if running). *) - dom_disks : disk list; (* Domain disks. *) - dom_lv_filesystems : - (lv * filesystem) list; (* Domain LV filesystems. *) -} -and disk = { - (* From the XML ... *) - d_type : string option; (* The *) - d_device : string; (* The (eg "disk") *) - d_source : string; (* The *) - d_target : string; (* The (eg "hda") *) - - (* About the device itself. *) - d_dev : device; (* Disk device. *) - d_content : disk_content; (* What's on it. *) -} -and disk_content = - [ `Unknown (* Not probed or unknown. *) - | `Partitions of partitions (* Contains partitions. *) - | `Filesystem of filesystem (* Contains a filesystem directly. *) - | `PhysicalVolume of pv (* Contains an LVM PV. *) - ] - -(* Partitions. *) - -and partitions = { - parts_name : string; (* Name of partitioning scheme. *) - parts : partition list (* Partitions. *) -} -and partition = { - part_status : partition_status; (* Bootable, etc. *) - part_type : int; (* Partition filesystem type. *) - part_dev : device; (* Partition device. *) - part_content : partition_content; (* What's on it. *) -} -and partition_status = Bootable | Nonbootable | Malformed | NullEntry -and partition_content = - [ `Unknown (* Not probed or unknown. *) - | `Filesystem of filesystem (* Filesystem. *) - | `PhysicalVolume of pv (* Contains an LVM PV. *) - ] - -(* Filesystems (also swap devices). *) -and filesystem = { - fs_name : string; (* Name of filesystem. *) - fs_block_size : int64; (* Block size (bytes). *) - fs_blocks_total : int64; (* Total blocks. *) - fs_is_swap : bool; (* If swap, following not valid. *) - fs_blocks_reserved : int64; (* Blocks reserved for super-user. *) - fs_blocks_avail : int64; (* Blocks free (available). *) - fs_blocks_used : int64; (* Blocks in use. *) - fs_inodes_total : int64; (* Total inodes. *) - fs_inodes_reserved : int64; (* Inodes reserved for super-user. *) - fs_inodes_avail : int64; (* Inodes free (available). *) - fs_inodes_used : int64; (* Inodes in use. *) -} - -(* Physical volumes. *) -and pv = { - lvm_plugin_id : lvm_plugin_id; (* The LVM plug-in. *) - pv_uuid : string; (* UUID. *) -} - -(* Logical volumes. *) -and lv = { - lv_dev : device; (* Logical volume device. *) -} - -and lvm_plugin_id = string - -(* Convert partition, filesystem types to printable strings for debugging. *) -let string_of_partition - { part_status = status; part_type = typ; part_dev = dev } = - sprintf "%s: %s partition type %d" - dev#name - (match status with - | Bootable -> "bootable" - | Nonbootable -> "nonbootable" - | Malformed -> "malformed" - | NullEntry -> "empty") - typ - -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 = - partition_types := (parts_name, probe_fn) :: !partition_types - -(* 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; - let rec loop = function - | [] -> None - | (parts_name, probe_fn) :: rest -> - try Some (probe_fn dev) - with Not_found -> loop rest - in - let r = loop !partition_types in - if !debug then ( - match r with - | None -> eprintf "no partitions found on %s\n%!" dev#name - | Some { parts_name = name; parts = parts } -> - eprintf "found %d %s partitions on %s:\n" - (List.length parts) name dev#name; - List.iter (fun p -> eprintf "\t%s\n%!" (string_of_partition p)) parts - ); - r - -(* Register a filesystem type (or swap). *) -let filesystem_types = ref [] -let filesystem_type_register (fs_name : string) probe_fn = - filesystem_types := (fs_name, probe_fn) :: !filesystem_types - -(* 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; - let rec loop = function - | [] -> None - | (fs_name, probe_fn) :: rest -> - try Some (probe_fn dev) - with Not_found -> loop rest - in - let r = loop !filesystem_types in - if !debug then ( - match r with - | None -> eprintf "no filesystem found on %s\n%!" dev#name - | Some fs -> - eprintf "found a filesystem on %s:\n" dev#name; - eprintf "\t%s\n%!" (string_of_filesystem fs) - ); - r - -(* Register a volume management type. *) -let lvm_types = ref [] -let lvm_type_register (lvm_name : string) probe_fn list_lvs_fn = - lvm_types := (lvm_name, (probe_fn, list_lvs_fn)) :: !lvm_types - -(* 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; - let rec loop = function - | [] -> None - | (lvm_name, (probe_fn, _)) :: rest -> - try Some (probe_fn lvm_name dev) - with Not_found -> loop rest - in - let r = loop !lvm_types in - if !debug then ( - match r with - | None -> eprintf "no PV found on %s\n%!" dev#name - | Some { lvm_plugin_id = name } -> - eprintf "%s contains a %s PV\n%!" dev#name name - ); - r - -let list_lvs lvm_name devs = - let _, list_lvs_fn = List.assoc lvm_name !lvm_types in - list_lvs_fn devs - -(*----------------------------------------------------------------------*) - -(* This version by Isaac Trotts. *) -let group_by ?(cmp = Pervasives.compare) ls = - let ls' = - List.fold_left - (fun acc (day1, x1) -> - match acc with - [] -> [day1, [x1]] - | (day2, ls2) :: acctl -> - if cmp day1 day2 = 0 - then (day1, x1 :: ls2) :: acctl - else (day1, [x1]) :: acc) - [] - ls - in - let ls' = List.rev ls' in - List.map (fun (x, xs) -> x, List.rev xs) ls' - -let rec range a b = - if a < b then a :: range (a+1) b - else [] diff --git a/virt-df/virt_df.mli b/virt-df/virt_df.mli deleted file mode 100644 index f35e0db..0000000 --- a/virt-df/virt_df.mli +++ /dev/null @@ -1,237 +0,0 @@ -(** 'df' command for virtual domains. *) -(* (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc. - http://libvirt.org/ - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - *) - -(** This module (Virt_df) contains functions and values which are - used throughout the plug-ins and main code. -*) - -val ( +* ) : int32 -> int32 -> int32 -val ( -* ) : int32 -> int32 -> int32 -val ( ** ) : int32 -> int32 -> int32 -val ( /* ) : int32 -> int32 -> int32 -val ( +^ ) : int64 -> int64 -> int64 -val ( -^ ) : int64 -> int64 -> int64 -val ( *^ ) : int64 -> int64 -> int64 -val ( /^ ) : int64 -> int64 -> int64 -(** int32 and int64 infix operators for convenience. *) - -val debug : bool ref (** If true, emit debug info to stderr*) -val uri : string option ref (** Hypervisor/libvirt URI. *) -val inodes : bool ref (** Display inodes. *) -val human : bool ref (** Display human-readable. *) -val all : bool ref (** Show all or just active domains. *) -val test_files : string list ref (** In test mode (-t) list of files. *) -(** State of command line arguments. *) - -(** - {2 Domain/device model} - - The "domain/device model" that we currently understand looks - like this: - -{v -domains - | - \--- host partitions / disk image files - || - guest block devices - | - +--> guest partitions (eg. using MBR) - | | - \-(1)->+--- filesystems (eg. ext3) - | - \--- PVs for LVM - ||| - VGs and LVs -v} - - (1) Filesystems and PVs may also appear directly on guest - block devices. - - Partition schemes (eg. MBR) and filesystems register themselves - with this main module and they are queried first to get an idea - of the physical devices, partitions and filesystems potentially - available to the guest. - - Volume management schemes (eg. LVM2) register themselves here - and are called later with "spare" physical devices and partitions - to see if they contain LVM data. If this results in additional - logical volumes then these are checked for filesystems. - - Swap space is considered to be a dumb filesystem for the purposes - of this discussion. -*) - -class virtual device : - object - method virtual name : string - method virtual read : int64 -> int -> string - method read_bitstring : int64 -> int -> string * int * int - method virtual size : int64 - end - (** - A virtual (or physical!) device, encapsulating any translation - that has to be done to access the device. eg. For partitions - there is a simple offset, but for LVM you may need complicated - table lookups. - - We keep the underlying file descriptors open for the duration - of the program. There aren't likely to be many of them, and - the program is short-lived, and it's easier than trying to - track which device is using what fd. As a result, there is no - need for any close/deallocation function. - - Note the very rare use of OOP in OCaml! - *) - -class block_device : string -> - 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 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. *) - -type domain = { - dom_name : string; (** Domain name. *) - dom_id : int option; (** Domain ID (if running). *) - dom_disks : disk list; (** Domain disks. *) - dom_lv_filesystems : - (lv * filesystem) list; (** Domain LV filesystems. *) -} -and disk = { - d_type : string option; (** The *) - d_device : string; (** The (eg "disk") *) - d_source : string; (** The *) - d_target : string; (** The (eg "hda") *) - d_dev : device; (** Disk device. *) - d_content : disk_content; (** What's on it. *) -} -and disk_content = - [ `Filesystem of filesystem (** Contains a direct filesystem. *) - | `Partitions of partitions (** Contains partitions. *) - | `PhysicalVolume of pv (** Contains an LVM PV. *) - | `Unknown (** Not probed or unknown. *) - ] -and partitions = { - parts_name : string; (** Name of partitioning scheme. *) - parts : partition list; (** Partitions. *) -} -and partition = { - part_status : partition_status; (** Bootable, etc. *) - part_type : int; (** Partition filesystem type. *) - part_dev : device; (** Partition device. *) - part_content : partition_content; (** What's on it. *) -} -and partition_status = Bootable | Nonbootable | Malformed | NullEntry -and partition_content = - [ `Filesystem of filesystem (** Filesystem. *) - | `PhysicalVolume of pv (** Contains an LVM PV. *) - | `Unknown (** Not probed or unknown. *) - ] -and filesystem = { - fs_name : string; (** Name of filesystem. *) - fs_block_size : int64; (** Block size (bytes). *) - fs_blocks_total : int64; (** Total blocks. *) - fs_is_swap : bool; (** If swap, following not valid. *) - fs_blocks_reserved : int64; (** Blocks reserved for super-user. *) - fs_blocks_avail : int64; (** Blocks free (available). *) - fs_blocks_used : int64; (** Blocks in use. *) - fs_inodes_total : int64; (** Total inodes. *) - fs_inodes_reserved : int64; (** Inodes reserved for super-user. *) - fs_inodes_avail : int64; (** Inodes free (available). *) - fs_inodes_used : int64; (** Inodes in use. *) -} -and pv = { - lvm_plugin_id : lvm_plugin_id; (** The LVM plug-in which detected - this. *) - pv_uuid : string; (** UUID. *) -} -and lv = { - lv_dev : device; (** Logical volume device. *) -} - -and lvm_plugin_id - -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 -(** Register a partition probing plug-in. *) - -val probe_for_partitions : device -> partitions option -(** Do a partition probe on a device. Returns [Some partitions] or [None]. *) - -val filesystem_type_register : string -> (device -> filesystem) -> unit -(** Register a filesystem probing plug-in. *) - -val probe_for_filesystem : device -> filesystem option -(** Do a filesystem probe on a device. Returns [Some filesystem] or [None]. *) - -val lvm_type_register : - string -> (lvm_plugin_id -> device -> pv) -> (device list -> lv list) -> unit -(** [lvm_type_register lvm_name probe_fn list_lvs_fn] - registers a new LVM type. [probe_fn] is a function which - should probe a device to find out if it contains a PV. - [list_lvs_fn] is a function which should take a list of - devices (PVs) and construct a list of LV devices. -*) - -val probe_for_pv : device -> pv option -(** Do a PV probe on a device. Returns [Some pv] or [None]. *) - -val list_lvs : lvm_plugin_id -> device list -> lv list -(** Construct LV devices from a list of PVs. *) - -(** {2 Utility functions} *) - -val group_by : ?cmp:('a -> 'a -> int) -> ('a * 'b) list -> ('a * 'b list) list -(** Group a sorted list of pairs by the first element of the pair. *) - -val range : int -> int -> int list -(** [range a b] returns the list of integers [a <= i < b]. - If [a >= b] then the empty list is returned. -*) diff --git a/virt-df/virt_df_ext2.ml b/virt-df/virt_df_ext2.ml deleted file mode 100644 index 2d1d1b8..0000000 --- a/virt-df/virt_df_ext2.ml +++ /dev/null @@ -1,138 +0,0 @@ -(* 'df' command for virtual domains. - (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc. - http://libvirt.org/ - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - Support for EXT2/EXT3 filesystems. -*) - -open Unix -open Printf - -open Virt_df_gettext.Gettext -open Virt_df - -let superblock_offset = 1024L - -let probe_ext2 dev = - (* Load the superblock. *) - let bits = dev#read_bitstring superblock_offset 1024 in - - (* The structure is straight from /usr/include/linux/ext3_fs.h *) - bitmatch bits with - | s_inodes_count : 32 : littleendian; (* Inodes count *) - s_blocks_count : 32 : littleendian; (* Blocks count *) - s_r_blocks_count : 32 : littleendian; (* Reserved blocks count *) - s_free_blocks_count : 32 : littleendian; (* Free blocks count *) - s_free_inodes_count : 32 : littleendian; (* Free inodes count *) - s_first_data_block : 32 : littleendian; (* First Data Block *) - s_log_block_size : 32 : littleendian; (* Block size *) - s_log_frag_size : 32 : littleendian; (* Fragment size *) - s_blocks_per_group : 32 : littleendian; (* # Blocks per group *) - s_frags_per_group : 32 : littleendian; (* # Fragments per group *) - s_inodes_per_group : 32 : littleendian; (* # Inodes per group *) - s_mtime : 32 : littleendian; (* Mount time *) - s_wtime : 32 : littleendian; (* Write time *) - s_mnt_count : 16 : littleendian; (* Mount count *) - s_max_mnt_count : 16 : littleendian; (* Maximal mount count *) - 0xef53 : 16 : littleendian; (* Magic signature *) - s_state : 16 : littleendian; (* File system state *) - s_errors : 16 : littleendian; (* Behaviour when detecting errors *) - s_minor_rev_level : 16 : littleendian; (* minor revision level *) - s_lastcheck : 32 : littleendian; (* time of last check *) - s_checkinterval : 32 : littleendian; (* max. time between checks *) - s_creator_os : 32 : littleendian; (* OS *) - s_rev_level : 32 : littleendian; (* Revision level *) - s_def_resuid : 16 : littleendian; (* Default uid for reserved blocks *) - s_def_resgid : 16 : littleendian; (* Default gid for reserved blocks *) - s_first_ino : 32 : littleendian; (* First non-reserved inode *) - s_inode_size : 16 : littleendian; (* size of inode structure *) - s_block_group_nr : 16 : littleendian; (* block group # of this superblock *) - s_feature_compat : 32 : littleendian; (* compatible feature set *) - s_feature_incompat : 32 : littleendian; (* incompatible feature set *) - s_feature_ro_compat : 32 : littleendian; (* readonly-compatible feature set *) - s_uuid : 128 : bitstring; (* 128-bit uuid for volume *) - s_volume_name : 128 : bitstring; (* volume name XXX string *) - s_last_mounted : 512 : bitstring; (* directory where last mounted XXX string *) - s_algorithm_usage_bitmap : 32 : littleendian; (* For compression *) - s_prealloc_blocks : 8; (* Nr of blocks to try to preallocate*) - s_prealloc_dir_blocks : 8; (* Nr to preallocate for dirs *) - s_reserved_gdt_blocks : 16 : littleendian; (* Per group desc for online growth *) - s_journal_uuid : 128 : bitstring; (* uuid of journal superblock *) - s_journal_inum : 32 : littleendian; (* inode number of journal file *) - s_journal_dev : 32 : littleendian; (* device number of journal file *) - s_last_orphan : 32 : littleendian; (* start of list of inodes to delete *) - s_hash_seed0 : 32 : littleendian; (* HTREE hash seed *) - s_hash_seed1 : 32 : littleendian; - s_hash_seed2 : 32 : littleendian; - s_hash_seed3 : 32 : littleendian; - s_def_hash_version : 8; (* Default hash version to use *) - s_reserved_char_pad : 8; - s_reserved_word_pad : 16 : littleendian; - s_default_mount_opts : 32 : littleendian; - s_first_meta_bg : 32 : littleendian; (* First metablock block group *) - s_reserved : 6080 : bitstring -> (* Padding to the end of the block *) - - (* Work out the block size in bytes. *) - let s_log_block_size = Int32.to_int s_log_block_size in - let block_size = 1024L in - let block_size = Int64.shift_left block_size s_log_block_size in - - (* Number of groups. *) - let s_groups_count = - Int64.of_int32 ( - (s_blocks_count -* s_first_data_block -* 1l) - /* s_blocks_per_group +* 1l - ) in - -(* - (* Number of group descriptors per block. *) - let s_inodes_per_block = s_blocksize / - let s_desc_per_block = block_size / s_inodes_per_block in - let db_count = - (s_groups_count +^ s_desc_per_block -^ 1L) - /^ s_desc_per_block -*) - - (* Calculate the block overhead (used by superblocks, inodes, etc.) - * See fs/ext2/super.c. - *) - let overhead = Int64.of_int32 s_first_data_block in - let overhead = (* XXX *) overhead in - - { - fs_name = s_ "Linux ext2/3"; - fs_block_size = block_size; - fs_blocks_total = Int64.of_int32 s_blocks_count -^ overhead; - fs_is_swap = false; - fs_blocks_reserved = Int64.of_int32 s_r_blocks_count; - fs_blocks_avail = Int64.of_int32 s_free_blocks_count; - fs_blocks_used = - Int64.of_int32 s_blocks_count -^ overhead - -^ Int64.of_int32 s_free_blocks_count; - fs_inodes_total = Int64.of_int32 s_inodes_count; - fs_inodes_reserved = 0L; (* XXX? *) - fs_inodes_avail = Int64.of_int32 s_free_inodes_count; - fs_inodes_used = Int64.of_int32 s_inodes_count - (*-^ 0L*) - -^ Int64.of_int32 s_free_inodes_count; - } - - | _ -> - raise Not_found (* Not an EXT2/3 superblock. *) - -(* Register with main code. *) -let () = filesystem_type_register "ext2" probe_ext2 diff --git a/virt-df/virt_df_ext2.mli b/virt-df/virt_df_ext2.mli deleted file mode 100644 index d32a0f8..0000000 --- a/virt-df/virt_df_ext2.mli +++ /dev/null @@ -1,22 +0,0 @@ -(* 'df' command for virtual domains. - (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc. - http://libvirt.org/ - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - *) - -(* This file is empty to stop this plug-in from exporting any - symbols to other modules by accident. -*) diff --git a/virt-df/virt_df_linux_swap.ml b/virt-df/virt_df_linux_swap.ml deleted file mode 100644 index afd671f..0000000 --- a/virt-df/virt_df_linux_swap.ml +++ /dev/null @@ -1,54 +0,0 @@ -(* 'df' command for virtual domains. - - (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc. - http://libvirt.org/ - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - Support for Linux swap partitions. -*) - -open Virt_df_gettext.Gettext -open Virt_df - -let probe_swap dev = - (* Load the "superblock" (ie. first 0x1000 bytes). *) - let bits = dev#read_bitstring 0L 0x1000 in - - bitmatch bits with - (* Actually this isn't just padding. *) - | padding : 8*0x1000 - 10*8 : bitstring; - magic : 10*8 : bitstring - when Bitmatch.string_of_bitstring magic = "SWAPSPACE2" -> - { - fs_name = s_ "Linux swap"; - fs_block_size = 4096L; (* XXX *) - fs_blocks_total = dev#size /^ 4096L; - - (* The remaining fields are ignored when fs_is_swap is true. *) - fs_is_swap = true; - fs_blocks_reserved = 0L; - fs_blocks_avail = 0L; - fs_blocks_used = 0L; - fs_inodes_total = 0L; - fs_inodes_reserved = 0L; - fs_inodes_avail = 0L; - fs_inodes_used = 0L; - } - | _ -> - raise Not_found (* Not Linux swapspace. *) - -(* Register with main code. *) -let () = filesystem_type_register "linux_swap" probe_swap diff --git a/virt-df/virt_df_linux_swap.mli b/virt-df/virt_df_linux_swap.mli deleted file mode 100644 index d32a0f8..0000000 --- a/virt-df/virt_df_linux_swap.mli +++ /dev/null @@ -1,22 +0,0 @@ -(* 'df' command for virtual domains. - (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc. - http://libvirt.org/ - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - *) - -(* This file is empty to stop this plug-in from exporting any - symbols to other modules by accident. -*) diff --git a/virt-df/virt_df_lvm2.ml b/virt-df/virt_df_lvm2.ml deleted file mode 100644 index 6a8f573..0000000 --- a/virt-df/virt_df_lvm2.ml +++ /dev/null @@ -1,432 +0,0 @@ -(* 'df' command for virtual domains. - - (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc. - http://libvirt.org/ - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - Support for LVM2 PVs. -*) - -open Printf -open ExtList - -open Virt_df_gettext.Gettext -open Virt_df - -open Virt_df_lvm2_metadata - -let plugin_name = "LVM2" - -let sector_size = 512 -let sector_size64 = 512L - -(*----------------------------------------------------------------------*) -(* Block device which can do linear maps, same as the kernel dm-linear.c *) -class linear_map_device name extent_size segments = - (* The segments are passed containing (start_extent, extent_count, ...) - * but it's easier to deal with (start_extent, end_extent, ...) so - * rewrite them. - *) - let segments = List.map - (fun (start_extent, extent_count, dev, pvoffset) -> - (start_extent, start_extent +^ extent_count, dev, pvoffset) - ) segments in - - (* Calculate the size of the device (in bytes). Note that because - * of the random nature of the mapping this doesn't imply that we can - * satisfy any read request up to the full size. - *) - let size_in_extents = - List.fold_left max 0L - (List.map (fun (_, end_extent, _, _) -> end_extent) segments) in - let size = size_in_extents *^ extent_size in -object - inherit device - method name = name - method size = size - - (* Read method checks which segment the request lies inside and - * maps it to the underlying device. If there is no mapping then - * we have to return an error. - * - * The request must lie inside a single extent, otherwise this is - * also an error (XXX - should lift this restriction, however default - * extent size is 4 MB so we probably won't hit this very often). - *) - method read offset len = - let offset_in_extents = offset /^ extent_size in - - (* Check we don't cross an extent boundary. *) - if (offset +^ Int64.of_int (len-1)) /^ extent_size <> offset_in_extents - then invalid_arg "linear_map_device: request crosses extent boundary"; - - if offset_in_extents < 0L || offset_in_extents >= size_in_extents then - invalid_arg "linear_map_device: read outside device"; - - let rec loop = function - | [] -> - invalid_arg "linear_map_device: offset not mapped" - | (start_extent, end_extent, dev, pvoffset) :: rest -> - eprintf "pvoffset = %Ld\n" pvoffset; - if start_extent <= offset_in_extents && - offset_in_extents < end_extent - then dev#read (offset +^ pvoffset *^ extent_size) len - else loop rest - in - loop segments -end - -(*----------------------------------------------------------------------*) -(* Probe to see if it's an LVM2 PV. *) -let rec probe_pv lvm_plugin_id dev = - try - let uuid, _ = read_pv_label dev in - if !debug then - eprintf "LVM2 detected PV UUID %s\n%!" uuid; - { lvm_plugin_id = lvm_plugin_id; pv_uuid = uuid } - with exn -> - if !debug then prerr_endline (Printexc.to_string exn); - raise Not_found - -and read_pv_label dev = - (* Load the first 8 sectors. I found by experimentation that - * the second sector contains the header ("LABELONE" etc) and - * the nineth sector contains some additional information about - * the location of the current metadata. - *) - let bits = dev#read_bitstring 0L (9 * sector_size) in - - (*Bitmatch.hexdump_bitstring stdout bits;*) - - bitmatch bits with - | sector0 : sector_size*8 : bitstring; (* sector 0 *) - labelone : 8*8 : bitstring; (* "LABELONE" *) - padding : 16*8 : bitstring; (* Seems to contain something. *) - lvm2_ver : 8*8 : bitstring; (* "LVM2 001" *) - uuid : 32*8 : bitstring; (* UUID *) - padding2 : (sector_size-64)*8 : bitstring; (* to end of second sector *) - sector234567 : sector_size*8 * 6 : bitstring; (* sectors 2-6 *) - padding3 : 0x28*8 : bitstring; (* start of sector 8 *) - metadata_offset : 32 : littleendian;(* metadata offset *) - padding4 : 4*8 : bitstring; - metadata_length : 32 : littleendian (* length of metadata (bytes) *) - when Bitmatch.string_of_bitstring labelone = "LABELONE" && - Bitmatch.string_of_bitstring lvm2_ver = "LVM2 001" -> - - (* Metadata offset is relative to end of PV label. *) - let metadata_offset = metadata_offset +* 0x1000_l in - (* Metadata length appears to include the trailing \000 which - * we don't want. - *) - let metadata_length = metadata_length -* 1_l in - - let metadata = read_metadata dev metadata_offset metadata_length in - - let uuid = Bitmatch.string_of_bitstring uuid in - - uuid, metadata - - | _ -> - invalid_arg - (sprintf "LVM2: read_pv_label: %s: not an LVM2 physical volume" dev#name) - -and read_metadata dev offset32 len32 = - if !debug then - eprintf "metadata: offset 0x%lx len %ld bytes\n%!" offset32 len32; - - (* Check the offset and length are sensible. *) - let offset64 = - if offset32 <= Int32.max_int then Int64.of_int32 offset32 - else invalid_arg "LVM2: read_metadata: metadata offset too large" in - let len64 = - if len32 <= 2_147_483_647_l then Int64.of_int32 len32 - else invalid_arg "LVM2: read_metadata: metadata length too large" in - - if offset64 <= 0x1200L || offset64 >= dev#size - || len64 <= 0L || offset64 +^ len64 >= dev#size then - invalid_arg "LVM2: read_metadata: bad metadata offset or length"; - - (* If it is outside the disk boundaries, this will throw an exception, - * otherwise it will read and return the metadata string. - *) - dev#read offset64 (Int64.to_int len64) - -(*----------------------------------------------------------------------*) -(* We are passed a list of devices which we previously identified - * as PVs belonging to us. From these produce a list of all LVs - * (as devices) and return them. Note that we don't try to detect - * what is on these LVs - that will be done in the main code. - *) -let rec list_lvs devs = - (* Read the UUID and metadata (again) from each device to end up with - * an assoc list of PVs, keyed on the UUID. - *) - let pvs = List.map ( - fun dev -> - let uuid, metadata = read_pv_label dev in - (uuid, (metadata, dev)) - ) devs in - - (* Parse the metadata using the external lexer/parser. *) - let pvs = List.map ( - fun (uuid, (metadata, dev)) -> - uuid, (Virt_df_lvm2_lexer.parse_lvm2_metadata_from_string metadata, - dev) - ) pvs in - - (* Print the parsed metadata. *) - if !debug then - List.iter ( - fun (uuid, (metadata, dev)) -> - eprintf "metadata for PV UUID %s on %s:\n" uuid dev#name; - output_metadata stderr metadata - ) pvs; - - (* Scan for volume groups. The first entry in the metadata - * appears to be the volume group name. This gives us a - * list of VGs and the metadata for each underlying PV. - *) - let vgnames = - List.filter_map ( - function - | pvuuid, (((vgname, Metadata vgmeta) :: _), dev) -> - Some (vgname, (pvuuid, vgmeta)) - | _ -> None - ) pvs in - - let cmp ((a:string),_) ((b:string),_) = compare a b in - let vgnames = List.sort ~cmp vgnames in - let vgs = group_by vgnames in - - (* Note that the metadata is supposed to be duplicated - * identically across all PVs (for redundancy purposes). - * In theory we should check this and use the 'seqno' - * field to find the latest metadata if it doesn't match, - * but in fact we don't check this. - *) - let vgs = List.map ( - fun (vgname, metas) -> - let pvuuids = List.map fst metas in - let _, vgmeta = List.hd metas in (* just pick any metadata *) - vgname, (pvuuids, vgmeta)) vgs in - - (* Print the VGs. *) - if !debug then - List.iter ( - fun (vgname, (pvuuids, vgmeta)) -> - eprintf "VG %s is on PVs: %s\n%!" vgname (String.concat "," pvuuids) - ) vgs; - - (* Some useful getter functions. If these can't get a value - * from the metadata or if the type is wrong they raise Not_found. - *) - let rec get_int64 field meta = - match List.assoc field meta with - | Int i -> i - | _ -> raise Not_found - and get_int field meta min max = - match List.assoc field meta with - | Int i when Int64.of_int min <= i && i <= Int64.of_int max -> - Int64.to_int i - | _ -> raise Not_found - and get_string field meta = - match List.assoc field meta with - | String s -> s - | _ -> raise Not_found - and get_meta field meta = - match List.assoc field meta with - | Metadata md -> md - | _ -> raise Not_found - and get_stripes field meta = (* List of (string,int) pairs. *) - match List.assoc field meta with - | List xs -> - let rec loop = function - | [] -> [] - | String pvname :: Int offset :: xs -> - (pvname, offset) :: loop xs - | _ -> raise Not_found - in - loop xs - | _ -> raise Not_found - in - - (* The volume groups refer to the physical volumes using their - * own naming system ("pv0", "pv1", etc.) instead of PV UUIDs. - * - * Each PV also has a start (in sectors) & count (in extents) - * of the writable area (the bit after the superblock and metadata) - * which normally starts at sector 384. - * - * Create a PV device (simple offset + size) and a map from PV - * names to these devices. - *) - let vgs = List.map ( - fun (vgname, (pvuuids, vgmeta)) -> - let pvdevs, extent_size = - try - (* NB: extent_size is in sectors here - we convert to bytes. *) - let extent_size = get_int "extent_size" vgmeta 0 (1024*1024) in - let extent_size = Int64.of_int extent_size *^ sector_size64 in - - (* Get the physical_volumes section of the metadata. *) - let pvdevs = get_meta "physical_volumes" vgmeta in - - List.filter_map ( - function - | (pvname, Metadata meta) -> - (* Get the UUID. *) - let pvuuid = get_string "id" meta in - let pvuuid = canonical_uuid pvuuid in - - (* Get the underlying physical device. *) - let _, dev = List.assoc pvuuid pvs in - - (* Construct a PV device. *) - let pe_start = get_int64 "pe_start" meta in - let pe_start = pe_start *^ sector_size64 in - let pe_count = get_int64 "pe_count" meta in - let pe_count = pe_count *^ extent_size in - let pvdev = new offset_device pvuuid pe_start pe_count dev in - - Some (pvname, pvdev) - | _ -> - None - ) pvdevs, extent_size - with - (* Something went wrong - just return an empty map. *) - Not_found -> [], 0L in - (vgname, (pvuuids, vgmeta, pvdevs, extent_size)) - ) vgs in - - (* Scan for logical volumes. Each VG contains several LVs. - * This gives us a list of LVs within each VG (hence extends - * the vgs variable). - *) - let vgs = List.map ( - fun (vgname, (pvuuids, vgmeta, pvdevs, extent_size)) -> - let lvs = - try - let lvs = get_meta "logical_volumes" vgmeta in - let lvs = List.filter_map ( - function - | lvname, Metadata lvmeta -> - (try - let segment_count = get_int "segment_count" lvmeta 0 1024 in - - (* Get the segments for this LV. *) - let segments = range 1 (segment_count+1) in - let segments = - List.map - (fun i -> get_meta ("segment" ^ string_of_int i) lvmeta) - segments in - - let segments = - List.map ( - fun segmeta -> - let start_extent = - get_int64 "start_extent" segmeta in - let extent_count = - get_int64 "extent_count" segmeta in - let segtype = get_string "type" segmeta in - - (* Can only handle striped segments at the - * moment. XXX - *) - if segtype <> "striped" then raise Not_found; - - let stripe_count = - get_int "stripe_count" segmeta 0 1024 in - let stripes = get_stripes "stripes" segmeta in - - if List.length stripes <> stripe_count then - raise Not_found; - - (* Can only handle linear striped segments at - * the moment. XXX - *) - if stripe_count <> 1 then raise Not_found; - let pvname, pvoffset = List.hd stripes in - - (start_extent, extent_count, pvname, pvoffset) - ) segments in - - Some (lvname, segments) - with - (* Something went wrong with segments - omit this LV. *) - Not_found -> None) - | _ -> None - ) lvs in - - lvs - with - Not_found -> - (* Something went wrong - assume no LVs found. *) - [] in - (vgname, (pvuuids, vgmeta, pvdevs, extent_size, lvs)) - ) vgs in - - (* Print the LVs. *) - if !debug then ( - List.iter ( - fun (vgname, (pvuuids, vgmeta, pvdevs, extent_size, lvs)) -> - eprintf "VG %s: (extent_size = %Ld bytes)\n" vgname extent_size; - List.iter ( - fun (lvname, segments) -> - eprintf " %s/%s:\n" vgname lvname; - List.iter ( - fun (start_extent, extent_count, pvname, pvoffset) -> - eprintf " start %Ld count %Ld at %s:%Ld\n" - start_extent extent_count pvname pvoffset - ) segments - ) lvs - ) vgs; - flush stderr - ); - - (* Finally we can set up devices for the LVs. *) - let lvs = - List.map ( - fun (vgname, (pvuuid, vgmeta, pvdevs, extent_size, lvs)) -> - try - List.map ( - fun (lvname, segments) -> - let name = vgname ^ "/" ^ lvname in - let segments = List.map ( - fun (start_extent, extent_count, pvname, pvoffset) -> - (* Get the PV device. *) - let pvdev = List.assoc pvname pvdevs in - - (* Extents mapped to: *) - (start_extent, extent_count, pvdev, pvoffset) - ) segments in - - (* Create a linear mapping device. *) - let lv_dev = new linear_map_device name extent_size segments in - - { lv_dev = lv_dev } - ) lvs - with - Not_found -> [] - ) vgs in - let lvs = List.concat lvs in - - (* Return the list of LV devices. *) - lvs - -(*----------------------------------------------------------------------*) -(* Register with main code. *) -let () = - lvm_type_register plugin_name probe_pv list_lvs diff --git a/virt-df/virt_df_lvm2.mli b/virt-df/virt_df_lvm2.mli deleted file mode 100644 index d32a0f8..0000000 --- a/virt-df/virt_df_lvm2.mli +++ /dev/null @@ -1,22 +0,0 @@ -(* 'df' command for virtual domains. - (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc. - http://libvirt.org/ - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - *) - -(* This file is empty to stop this plug-in from exporting any - symbols to other modules by accident. -*) diff --git a/virt-df/virt_df_lvm2_lexer.mll b/virt-df/virt_df_lvm2_lexer.mll deleted file mode 100644 index 2dbe7e5..0000000 --- a/virt-df/virt_df_lvm2_lexer.mll +++ /dev/null @@ -1,165 +0,0 @@ -(* 'df' command for virtual domains. - (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc. - http://libvirt.org/ - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - *) - -(* Scanner for LVM2 metadata. - * ocamllex tutorial: - * http://plus.kaist.ac.kr/~shoh/ocaml/ocamllex-ocamlyacc/ocamllex-tutorial/ - *) - -{ - open Printf - open Lexing - - open Virt_df - open Virt_df_lvm2_parser - - (* Temporary buffer used for parsing strings, etc. *) - let tmp = Buffer.create 80 - - exception Error of string -} - -let digit = ['0'-'9'] -let alpha = ['a'-'z' 'A'-'Z'] -let alphau = ['a'-'z' 'A'-'Z' '_'] -let alnum = ['a'-'z' 'A'-'Z' '0'-'9'] -let alnumu = ['a'-'z' 'A'-'Z' '0'-'9' '_'] -let ident = alphau alnumu* - -let whitespace = [' ' '\t' '\r' '\n']+ - -let escaped_char = '\\' _ - -rule token = parse - (* ignore whitespace and comments *) - | whitespace - | '#' [^ '\n']* - { token lexbuf } - - (* scan single character tokens *) - | '{' { LBRACE } - | '}' { RBRACE } - | '[' { LSQUARE } - | ']' { RSQUARE } - | '=' { EQ } - | ',' { COMMA } - - (* strings - see LVM2/lib/config/config.c *) - | '"' - { - Buffer.reset tmp; - STRING (dq_string lexbuf) - } - | '\'' - { - Buffer.reset tmp; - STRING (dq_string lexbuf) - } - - (* floats *) - | ('-'? digit+ '.' digit*) as f - { - let f = float_of_string f in - FLOAT f - } - - (* integers *) - | ('-'? digit+) as i - { - let i = Int64.of_string i in - INT i - } - - (* identifiers *) - | ident as id - { IDENT id } - - (* end of file *) - | eof - { EOF } - - | _ as c - { raise (Error (sprintf "%c: invalid character in input" c)) } - -and dq_string = parse - | '"' - { Buffer.contents tmp } - | escaped_char as str - { Buffer.add_char tmp str.[1]; dq_string lexbuf } - | eof - { raise (Error "unterminated string in metadata") } - | _ as c - { Buffer.add_char tmp c; dq_string lexbuf } - -and q_string = parse - | '\'' - { Buffer.contents tmp } - | escaped_char as str - { Buffer.add_char tmp str.[1]; q_string lexbuf } - | eof - { raise (Error "unterminated string in metadata") } - | _ as c - { Buffer.add_char tmp c; q_string lexbuf } - -{ - (* Demonstration of how to wrap the token function - with extra debugging statements: - let token lexbuf = - try - let r = token lexbuf in - if debug then - eprintf "Lexer: token returned is %s\n" - (match r with - | LBRACE -> "LBRACE" - | RBRACE -> "RBRACE" - | LSQUARE -> "LSQUARE" - | RSQUARE -> "RSQUARE" - | EQ -> "EQ" - | COMMA -> "COMMA" - | STRING s -> sprintf "STRING(%S)" s - | INT i -> sprintf "INT(%Ld)" i - | FLOAT f -> sprintf "FLOAT(%g)" f - | IDENT s -> sprintf "IDENT(%s)" s - | EOF -> "EOF"); - r - with - exn -> - prerr_endline (Printexc.to_string exn); - raise exn - *) - - (* Lex and parse input. - * - * Return the parsed metadata structure if everything went to plan. - * Raises [Error msg] if there was some parsing problem. - *) - let rec parse_lvm2_metadata_from_string str = - let lexbuf = Lexing.from_string str in - parse_lvm2_metadata lexbuf - and parse_lvm2_metadata_from_channel chan = - let lexbuf = Lexing.from_channel chan in - parse_lvm2_metadata lexbuf - and parse_lvm2_metadata lexbuf = - try - input token lexbuf - with - | Error _ as exn -> raise exn - | Parsing.Parse_error -> raise (Error "Parse error") - | exn -> raise (Error ("Exception: " ^ Printexc.to_string exn)) -} diff --git a/virt-df/virt_df_lvm2_metadata.ml b/virt-df/virt_df_lvm2_metadata.ml deleted file mode 100644 index c5e3f90..0000000 --- a/virt-df/virt_df_lvm2_metadata.ml +++ /dev/null @@ -1,65 +0,0 @@ -(* 'df' command for virtual domains. - (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc. - http://libvirt.org/ - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - *) - -(* Part of the parser for LVM2 metadata. *) - -type metadata = metastmt list - -and metastmt = string * metavalue - -and metavalue = - | Metadata of metadata (* name { ... } *) - | String of string (* name = "..." *) - | Int of int64 - | Float of float - | List of metavalue list (* name = [...] *) - -let rec output_metadata chan md = - _output_metadata chan "" md - -and _output_metadata chan prefix = function - | [] -> () - | (name, value) :: rest -> - output_string chan prefix; - output_string chan name; - output_string chan " = "; - output_metavalue chan prefix value; - output_string chan "\n"; - _output_metadata chan prefix rest - -and output_metavalue chan prefix = function - | Metadata md -> - output_string chan "{\n"; - _output_metadata chan (prefix ^ " ") md; - output_string chan prefix; - output_string chan "}"; - | String str -> - output_char chan '"'; - output_string chan str; - output_char chan '"'; - | Int i -> - output_string chan (Int64.to_string i) - | Float f -> - output_string chan (string_of_float f) - | List [] -> () - | List [x] -> output_metavalue chan prefix x - | List (x :: xs) -> - output_metavalue chan prefix x; - output_string chan ", "; - output_metavalue chan prefix (List xs) diff --git a/virt-df/virt_df_lvm2_metadata.mli b/virt-df/virt_df_lvm2_metadata.mli deleted file mode 100644 index 778f393..0000000 --- a/virt-df/virt_df_lvm2_metadata.mli +++ /dev/null @@ -1,38 +0,0 @@ -(* 'df' command for virtual domains. - (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc. - http://libvirt.org/ - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - *) - -(* Part of the parser for LVM2 metadata. *) - -type metadata = metastmt list - -and metastmt = string * metavalue - -and metavalue = - | Metadata of metadata (* name { ... } *) - | String of string (* name = "..." *) - | Int of int64 - | Float of float - | List of metavalue list (* name = [...] *) - -val output_metadata : out_channel -> metadata -> unit -(** This function prints out the metadata on the selected channel. - - The output format isn't particularly close to the input - format. This is just for debugging purposes. -*) diff --git a/virt-df/virt_df_lvm2_parser.mly b/virt-df/virt_df_lvm2_parser.mly deleted file mode 100644 index c4ee574..0000000 --- a/virt-df/virt_df_lvm2_parser.mly +++ /dev/null @@ -1,70 +0,0 @@ -/* 'df' command for virtual domains. -*- text -*- - (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc. - http://libvirt.org/ - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - */ - -/* Parser for LVM2 metadata. - ocamlyacc tutorial: - http://plus.kaist.ac.kr/~shoh/ocaml/ocamllex-ocamlyacc/ocamlyacc-tutorial/ - */ - -%{ - open Virt_df_lvm2_metadata -%} - -%token LBRACE RBRACE /* { } */ -%token LSQUARE RSQUARE /* [ ] */ -%token EQ /* = */ -%token COMMA /* , */ -%token STRING /* "string" */ -%token INT /* an integer */ -%token FLOAT /* a float */ -%token IDENT /* a naked keyword/identifier */ -%token EOF /* end of file */ - -%start input -%type input - -%% - -input : lines EOF { List.rev $1 } - ; - -lines : /* empty */ { [] } - | lines line { $2 :: $1 } - ; - -line : /* empty */ /* These dummy entries get removed after parsing. */ - { ("", String "") } - | IDENT EQ value - { ($1, $3) } - | IDENT LBRACE lines RBRACE - { ($1, Metadata (List.rev $3)) } - ; - -value : STRING { String $1 } - | INT { Int $1 } - | FLOAT { Float $1 } - | LSQUARE list RSQUARE - { List (List.rev $2) } - ; - -list : /* empty */ { [] } - | value { [$1] } - | list COMMA value - { $3 :: $1 } - ; diff --git a/virt-df/virt_df_main.ml b/virt-df/virt_df_main.ml deleted file mode 100644 index 65d1f2f..0000000 --- a/virt-df/virt_df_main.ml +++ /dev/null @@ -1,488 +0,0 @@ -(* 'df' command for virtual domains. - (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc. - http://libvirt.org/ - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - *) - -open Printf -open ExtList -open Unix - -module C = Libvirt.Connect -module D = Libvirt.Domain - -open Virt_df_gettext.Gettext -open Virt_df - -let () = - (* Command line argument parsing. *) - let set_uri = function "" -> uri := None | u -> uri := Some u in - - let version () = - printf "virt-df %s\n" (Libvirt_version.version); - - let major, minor, release = - let v, _ = Libvirt.get_version () in - v / 1_000_000, (v / 1_000) mod 1_000, v mod 1_000 in - printf "libvirt %d.%d.%d\n" major minor release; - exit 0 - in - - let test_mode filename = - test_files := filename :: !test_files - in - - let argspec = Arg.align [ - "-a", Arg.Set all, - " " ^ s_ "Show all domains (default: only active domains)"; - "--all", Arg.Set all, - " " ^ s_ "Show all domains (default: only active domains)"; - "-c", Arg.String set_uri, - "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, - " " ^ s_ "Print sizes in human-readable format"; - "-i", Arg.Set inodes, - " " ^ s_ "Show inodes instead of blocks"; - "--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"; - "--version", Arg.Unit version, - " " ^ s_ "Display version and exit"; - ] in - - let anon_fun str = - raise (Arg.Bad (sprintf (f_ "%s: unknown parameter") str)) in - let usage_msg = s_ "virt-df : like 'df', shows disk space used in guests - -SUMMARY - virt-df [-options] - -OPTIONS" in - - Arg.parse argspec anon_fun usage_msg; - - let doms : domain list = - if !test_files = [] then ( - let xmls = - (* Connect to the hypervisor. *) - let conn = - let name = !uri in - try C.connect_readonly ?name () - with - Libvirt.Virterror err -> - prerr_endline (Libvirt.Virterror.to_string err); - (* If non-root and no explicit connection URI, print a warning. *) - if geteuid () <> 0 && name = None then ( - print_endline (s_ "NB: If you want to monitor a local Xen hypervisor, you usually need to be root"); - ); - exit 1 in - - (* Get the list of active & inactive domains. *) - let doms = - let nr_active_doms = C.num_of_domains conn in - let active_doms = - Array.to_list (C.list_domains conn nr_active_doms) in - let active_doms = - List.map (D.lookup_by_id conn) active_doms in - if not !all then - active_doms - else ( - let nr_inactive_doms = C.num_of_defined_domains conn in - let inactive_doms = - Array.to_list (C.list_defined_domains conn nr_inactive_doms) in - let inactive_doms = - List.map (D.lookup_by_name conn) inactive_doms in - active_doms @ inactive_doms - ) in - - (* Get their XML. *) - let xmls = List.map D.get_xml_desc doms in - - (* Parse the XML. *) - let xmls = List.map Xml.parse_string xmls in - - (* Return just the XML documents - everything else will be closed - * and freed including the connection to the hypervisor. - *) - xmls in - - (* Grr.. Need to use a library which has XPATH support (or cduce). *) - List.map ( - fun xml -> - let nodes, domain_attrs = - match xml with - | Xml.Element ("domain", attrs, children) -> children, attrs - | _ -> failwith (s_ "get_xml_desc didn't return ") in - - let domid = - try Some (int_of_string (List.assoc "id" domain_attrs)) - with Not_found -> None in - - let rec loop = function - | [] -> - failwith (s_ "get_xml_desc returned no node in XML") - | Xml.Element ("name", _, [Xml.PCData name]) :: _ -> name - | Xml.Element ("name", _, _) :: _ -> - failwith (s_ "get_xml_desc returned strange node") - | _ :: rest -> loop rest - in - let name = loop nodes in - - let devices = - let devices = - List.filter_map ( - function - | Xml.Element ("devices", _, devices) -> Some devices - | _ -> None - ) nodes in - List.concat devices in - - let rec target_dev_of = function - | [] -> None - | Xml.Element ("target", attrs, _) :: rest -> - (try Some (List.assoc "dev" attrs) - with Not_found -> target_dev_of rest) - | _ :: rest -> target_dev_of rest - in - - let rec source_file_of = function - | [] -> None - | Xml.Element ("source", attrs, _) :: rest -> - (try Some (List.assoc "file" attrs) - with Not_found -> source_file_of rest) - | _ :: rest -> source_file_of rest - in - - let rec source_dev_of = function - | [] -> None - | Xml.Element ("source", attrs, _) :: rest -> - (try Some (List.assoc "dev" attrs) - with Not_found -> source_dev_of rest) - | _ :: rest -> source_dev_of rest - in - - let disks = - List.filter_map ( - function - | Xml.Element ("disk", attrs, children) -> - let typ = - try Some (List.assoc "type" attrs) - with Not_found -> None in - let device = - try Some (List.assoc "device" attrs) - with Not_found -> None in - let source = - match source_file_of children with - | (Some _) as source -> source - | None -> source_dev_of children in - let target = target_dev_of children in - - (* We only care about devices where we have - * source and target. Ignore CD-ROM devices. - *) - (match source, target, device with - | _, _, Some "cdrom" -> None (* ignore *) - | Some source, Some target, Some device -> - (* Try to create a 'device' object for this - * device. If it fails, print a warning - * and ignore the device. - *) - (try - let dev = new block_device source in - Some { - d_type = typ; d_device = device; - d_source = source; d_target = target; - d_dev = dev; d_content = `Unknown - } - with - Unix_error (err, func, param) -> - eprintf "%s:%s: %s" func param (error_message err); - None - ) - | _ -> None (* ignore anything else *) - ) - - | _ -> None - ) devices in - - { dom_name = name; dom_id = domid; - dom_disks = disks; dom_lv_filesystems = [] } - ) xmls - ) else ( - (* In test mode (-t option) the user can pass one or more - * block devices or filenames (containing partitions/filesystems/etc) - * which we use for testing virt-df itself. We create fake domains - * from these. - *) - List.map ( - fun filename -> - { - dom_name = filename; dom_id = None; - dom_disks = [ - { - d_type = Some "disk"; d_device = "disk"; - d_source = filename; d_target = "hda"; - d_dev = new block_device filename; d_content = `Unknown; - } - ]; - dom_lv_filesystems = [] - } - ) !test_files - ) in - - (* HOF to map over disks. *) - let map_over_disks doms f = - List.map ( - fun ({ dom_disks = disks } as dom) -> - let disks = List.map f disks in - { dom with dom_disks = disks } - ) doms - in - - (* 'doms' is our list of domains and their guest block devices, and - * we've successfully opened each block device. Now probe them - * to find out what they contain. - *) - let doms = map_over_disks doms ( - fun ({ d_dev = dev } as disk) -> - (* See if it is partitioned first. *) - let parts = probe_for_partitions dev in - match parts with - | Some parts -> - { disk with d_content = `Partitions parts } - | None -> - (* Not partitioned. Does it contain a filesystem? *) - let fs = probe_for_filesystem dev in - match fs with - | Some fs -> - { disk with d_content = `Filesystem fs } - | None -> - (* Not partitioned, no filesystem, is it a PV? *) - let pv = probe_for_pv dev in - match pv with - | Some lvm_name -> - { disk with d_content = `PhysicalVolume lvm_name } - | None -> - disk (* Spare/unknown. *) - ) in - - (* Now we have either detected partitions or a filesystem on each - * physical device (or perhaps neither). See what is on those - * partitions. - *) - let doms = map_over_disks doms ( - function - | ({ d_dev = dev; d_content = `Partitions parts } as disk) -> - let ps = List.map ( - fun p -> - if p.part_status = Bootable || p.part_status = Nonbootable then ( - let fs = probe_for_filesystem p.part_dev in - match fs with - | Some fs -> - { p with part_content = `Filesystem fs } - | None -> - (* Is it a PV? *) - let pv = probe_for_pv p.part_dev in - match pv with - | Some lvm_name -> - { p with part_content = `PhysicalVolume lvm_name } - | None -> - p (* Spare/unknown. *) - ) else p - ) parts.parts in - let parts = { parts with parts = ps } in - { disk with d_content = `Partitions parts } - | disk -> disk - ) in - - (* LVM filesystem detection - * - * For each domain, look for all disks/partitions which have been - * identified as PVs and pass those back to the respective LVM - * plugin for LV detection. - * - * (Note - a two-stage process because an LV can be spread over - * several PVs, so we have to detect all PVs belonging to a - * domain first). - * - * XXX To deal with RAID (ie. md devices) we will need to loop - * around here because RAID is like LVM except that they normally - * present as block devices which can be used by LVM. - *) - (* First: LV detection. *) - let doms = List.map ( - fun ({ dom_disks = disks } as dom) -> - (* Find all physical volumes, can be disks or partitions. *) - let pvs_on_disks = List.filter_map ( - function - | { d_dev = d_dev; - d_content = `PhysicalVolume pv } -> Some (pv, d_dev) - | _ -> None - ) disks in - let pvs_on_partitions = List.map ( - function - | { d_content = `Partitions { parts = parts } } -> - List.filter_map ( - function - | { part_dev = part_dev; - part_content = `PhysicalVolume pv } -> - Some (pv, part_dev) - | _ -> None - ) parts - | _ -> [] - ) disks in - let lvs = List.concat (pvs_on_disks :: pvs_on_partitions) in - dom, lvs - ) doms in - - (* Second: filesystem on LV detection. *) - let doms = List.map ( - fun (dom, lvs) -> - (* Group the LVs by plug-in type. *) - let cmp (a,_) (b,_) = compare a b in - let lvs = List.sort ~cmp lvs in - let lvs = group_by lvs in - - let lvs = - 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 - * probes to see if any contain filesystems. - *) - let filesystems = - List.filter_map ( - 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 } - ) doms in - - (* Now print the results. - * - * Print the title. - *) - let () = - let total, used, avail = - match !inodes, !human with - | false, false -> s_ "1K-blocks", s_ "Used", s_ "Available" - | false, true -> s_ "Size", s_ "Used", s_ "Available" - | true, _ -> s_ "Inodes", s_ "IUse", s_ "IFree" in - printf "%-20s %10s %10s %10s %s\n%!" - (s_ "Filesystem") total used avail (s_ "Type") in - - let printable_size bytes = - if bytes < 1024L *^ 1024L then - sprintf "%Ld bytes" bytes - else if bytes < 1024L *^ 1024L *^ 1024L then - sprintf "%.1f MiB" (Int64.to_float (bytes /^ 1024L) /. 1024.) - else - sprintf "%.1f GiB" (Int64.to_float (bytes /^ 1024L /^ 1024L) /. 1024.) - in - - (* HOF to iterate over filesystems. *) - let iter_over_filesystems doms - (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; 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; part_dev = dev } -> - f dom ~disk ~partno:(i+1) dev fs - | _ -> () - ) partitions.parts - | _ -> () - ) disks; - (* LV 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 ?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 -> dev#name - | Some disk -> disk.d_target - in - match partno with - | None -> - dom_name ^ ":" ^ disk_name - | Some partno -> - dom_name ^ ":" ^ disk_name ^ string_of_int partno in - printf "%-20s " name; - - if fs.fs_is_swap then ( - (* Swap partition. *) - if not !human then - printf "%10Ld %s\n" - (fs.fs_block_size *^ fs.fs_blocks_total /^ 1024L) fs.fs_name - else - printf "%10s %s\n" - (printable_size (fs.fs_block_size *^ fs.fs_blocks_total)) fs.fs_name - ) else ( - (* Ordinary filesystem. *) - if not !inodes then ( (* Block display. *) - (* 'df' doesn't count the restricted blocks. *) - let blocks_total = fs.fs_blocks_total -^ fs.fs_blocks_reserved in - let blocks_avail = fs.fs_blocks_avail -^ fs.fs_blocks_reserved in - let blocks_avail = if blocks_avail < 0L then 0L else blocks_avail in - - if not !human then ( (* Display 1K blocks. *) - printf "%10Ld %10Ld %10Ld %s\n" - (blocks_total *^ fs.fs_block_size /^ 1024L) - (fs.fs_blocks_used *^ fs.fs_block_size /^ 1024L) - (blocks_avail *^ fs.fs_block_size /^ 1024L) - fs.fs_name - ) else ( (* Human-readable blocks. *) - printf "%10s %10s %10s %s\n" - (printable_size (blocks_total *^ fs.fs_block_size)) - (printable_size (fs.fs_blocks_used *^ fs.fs_block_size)) - (printable_size (blocks_avail *^ fs.fs_block_size)) - fs.fs_name - ) - ) else ( (* Inodes display. *) - printf "%10Ld %10Ld %10Ld %s\n" - fs.fs_inodes_total fs.fs_inodes_used fs.fs_inodes_avail - fs.fs_name - ) - ) - in - iter_over_filesystems doms print_stats diff --git a/virt-df/virt_df_mbr.ml b/virt-df/virt_df_mbr.ml deleted file mode 100644 index 9516e3c..0000000 --- a/virt-df/virt_df_mbr.ml +++ /dev/null @@ -1,187 +0,0 @@ -(* 'df' command for virtual domains. - - (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc. - http://libvirt.org/ - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - Support for Master Boot Record partition scheme. -*) - -open Printf -open Unix -open ExtList - -open Virt_df_gettext.Gettext -open Virt_df - -let sector_size = 512 -let sector_size64 = 512L - -(* Maximum number of extended partitions possible. *) -let max_extended_partitions = 100 - -(* Device representing a single partition. It just acts as an offset - * into the underlying device. - * - * Notes: - * (1) 'start'/'size' are measured in sectors. - * (2) 'partno' is the partition number, starting at 1 - * (cf. /dev/hda1 is the first partition). - * (3) 'dev' is the underlying block device. - *) -class partition_device partno start size dev = - let devname = dev#name in - let name = sprintf "%s%d" devname partno in - let start = start *^ sector_size64 in - let size = size *^ sector_size64 in -object (self) - inherit offset_device name start size dev -end - -(** Probe the - {{:http://en.wikipedia.org/wiki/Master_boot_record}master boot record} - (if it is one) and read the partitions. - - @raise Not_found if it is not an MBR. - *) -let rec probe_mbr dev = - (* Adjust size to sectors. *) - let size = dev#size /^ sector_size64 in - - (* Read the first sector. *) - let bits = - try dev#read_bitstring 0L sector_size - with exn -> raise Not_found in - - (* Does this match a likely-looking MBR? *) - bitmatch bits with - | padding : 3568 : bitstring; (* padding to byte offset 446 *) - part0 : 128 : bitstring; (* partitions *) - part1 : 128 : bitstring; - part2 : 128 : bitstring; - part3 : 128 : bitstring; - 0x55 : 8; 0xAA : 8 -> (* MBR signature *) - - (* Parse the partition table entries. *) - let primaries = - List.mapi (parse_mbr_entry dev) [part0;part1;part2;part3] in - -(* - (* Read extended partition data. *) - let extendeds = List.map ( - function - | { part_type = 0x05 } as part -> - probe_extended_partition - max_extended_partitions fd part part.part_lba_start - | part -> [] - ) primaries in - let extendeds = List.concat extendeds in - primaries @ extendeds -*) - { parts_name = "MBR"; parts = primaries } - - | _ -> - raise Not_found (* not an MBR *) - -(* Parse a single partition table entry. See the table here: - * http://en.wikipedia.org/wiki/Master_boot_record - *) -and parse_mbr_entry dev i bits = - bitmatch bits with - | 0l : 32; 0l : 32; 0l : 32; 0l : 32 -> - { part_status = NullEntry; part_type = 0; - part_dev = null_device; part_content = `Unknown } - - | 0 : 8; first_chs : 24; - part_type : 8; last_chs : 24; - first_lba : 32 : unsigned, littleendian; - part_size : 32 : unsigned, littleendian -> - make_mbr_entry Nonbootable dev (i+1) part_type first_lba part_size - - | 0x80 : 8; first_chs : 24; - part_type : 8; last_chs : 24; - first_lba : 32 : unsigned, littleendian; - part_size : 32 : unsigned, littleendian -> - make_mbr_entry Bootable dev (i+1) part_type first_lba part_size - - | _ -> - { part_status = Malformed; part_type = 0; - part_dev = null_device; part_content = `Unknown } - -and make_mbr_entry part_status dev partno part_type first_lba part_size = - let first_lba = uint64_of_int32 first_lba in - let part_size = uint64_of_int32 part_size in - if !debug then - eprintf "make_mbr_entry: first_lba = %Lx part_size = %Lx\n%!" - first_lba part_size; - { part_status = part_status; - part_type = part_type; - part_dev = new partition_device partno first_lba part_size dev; - part_content = `Unknown } - -(* -This code worked previously, but now needs some love ... -XXX - -(* Probe an extended partition. *) -and probe_extended_partition max fd epart sect = - if max > 0 then ( - (* Offset of the first EBR. *) - let ebr_offs = sect *^ sector_size in - (* EBR Signature? *) - LargeFile.lseek fd (ebr_offs +^ 510L) SEEK_SET; - let str = String.create 2 in - if read fd str 0 2 <> 2 || str.[0] != '\x55' || str.[1] != '\xAA' then - [] (* Not EBR *) - else ( - (* Read the extended partition table entries (just 2 of them). *) - LargeFile.lseek fd (ebr_offs +^ 446L) SEEK_SET; - let str = String.create 32 in - if read fd str 0 32 <> 32 then - failwith (s_ "error reading extended partition") - else ( - (* Extract partitions from the data. *) - let part1, part2 = - match List.map (get_partition str) [ 0; 16 ] with - | [p1;p2] -> p1,p2 - | _ -> failwith (s_ "probe_extended_partition: internal error") in - (* First partition entry has offset to the start of this partition. *) - let part1 = { part1 with - part_lba_start = sect +^ part1.part_lba_start } in - (* Second partition entry is zeroes if end of list, otherwise points - * to the next partition. - *) - if part2.part_status = NullEntry then - [part1] - else - part1 :: probe_extended_partition - (max-1) fd epart (sect +^ part2.part_lba_start) - ) - ) - ) - else [] -*) - -(* Ugh, fake a UInt32 -> UInt64 conversion without sign extension, until - * we get working UInt32/UInt64 modules in extlib. - *) -and uint64_of_int32 u32 = - let i64 = Int64.of_int32 u32 in - if u32 >= 0l then i64 - else Int64.add i64 0x1_0000_0000_L - -(* Register with main code. *) -let () = partition_type_register "MBR" probe_mbr diff --git a/virt-df/virt_df_mbr.mli b/virt-df/virt_df_mbr.mli deleted file mode 100644 index d32a0f8..0000000 --- a/virt-df/virt_df_mbr.mli +++ /dev/null @@ -1,22 +0,0 @@ -(* 'df' command for virtual domains. - (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc. - http://libvirt.org/ - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - *) - -(* This file is empty to stop this plug-in from exporting any - symbols to other modules by accident. -*) -- cgit From e86f4987469c26213c6693b35cde3b48a4732524 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Wed, 16 Apr 2008 14:11:41 +0100 Subject: *** THIS REPO IS JUST FOR VIRT-TOP NOW *** - See http://hg.et.redhat.com/applications/virt/ for bindings and the other applications. --- virt-df/.depend | 31 ------------------------------- 1 file changed, 31 deletions(-) delete mode 100644 virt-df/.depend (limited to 'virt-df') diff --git a/virt-df/.depend b/virt-df/.depend deleted file mode 100644 index e7cd81e..0000000 --- a/virt-df/.depend +++ /dev/null @@ -1,31 +0,0 @@ -virt_df_lvm2_parser.cmi: virt_df_lvm2_metadata.cmi -virt_df_ext2.cmo: virt_df_gettext.cmo virt_df.cmi \ - /usr/lib64/ocaml/bitmatch/bitmatch.cmi virt_df_ext2.cmi -virt_df_ext2.cmx: virt_df_gettext.cmx virt_df.cmx \ - /usr/lib64/ocaml/bitmatch/bitmatch.cmi virt_df_ext2.cmi -virt_df_linux_swap.cmo: virt_df_gettext.cmo virt_df.cmi \ - /usr/lib64/ocaml/bitmatch/bitmatch.cmi virt_df_linux_swap.cmi -virt_df_linux_swap.cmx: virt_df_gettext.cmx virt_df.cmx \ - /usr/lib64/ocaml/bitmatch/bitmatch.cmi virt_df_linux_swap.cmi -virt_df_lvm2_lexer.cmo: virt_df_lvm2_parser.cmi virt_df.cmi -virt_df_lvm2_lexer.cmx: virt_df_lvm2_parser.cmx virt_df.cmx -virt_df_lvm2_metadata.cmo: virt_df_lvm2_metadata.cmi -virt_df_lvm2_metadata.cmx: virt_df_lvm2_metadata.cmi -virt_df_lvm2.cmo: virt_df_lvm2_metadata.cmi virt_df_lvm2_lexer.cmo \ - virt_df_gettext.cmo virt_df.cmi /usr/lib64/ocaml/bitmatch/bitmatch.cmi \ - virt_df_lvm2.cmi -virt_df_lvm2.cmx: virt_df_lvm2_metadata.cmx virt_df_lvm2_lexer.cmx \ - virt_df_gettext.cmx virt_df.cmx /usr/lib64/ocaml/bitmatch/bitmatch.cmi \ - virt_df_lvm2.cmi -virt_df_lvm2_parser.cmo: virt_df_lvm2_metadata.cmi virt_df_lvm2_parser.cmi -virt_df_lvm2_parser.cmx: virt_df_lvm2_metadata.cmx virt_df_lvm2_parser.cmi -virt_df_main.cmo: virt_df_gettext.cmo virt_df.cmi \ - ../libvirt/libvirt_version.cmi ../libvirt/libvirt.cmi -virt_df_main.cmx: virt_df_gettext.cmx virt_df.cmx \ - ../libvirt/libvirt_version.cmx ../libvirt/libvirt.cmx -virt_df_mbr.cmo: virt_df_gettext.cmo virt_df.cmi \ - /usr/lib64/ocaml/bitmatch/bitmatch.cmi virt_df_mbr.cmi -virt_df_mbr.cmx: virt_df_gettext.cmx virt_df.cmx \ - /usr/lib64/ocaml/bitmatch/bitmatch.cmi virt_df_mbr.cmi -virt_df.cmo: virt_df_gettext.cmo virt_df.cmi -virt_df.cmx: virt_df_gettext.cmx virt_df.cmi -- cgit