Can now use libvirt virDomainBlockPeek to access devices remotely
[virt-df.git] / virt-df / virt_df_main.ml
index 4572099..57d5081 100644 (file)
@@ -28,6 +28,31 @@ open Int63.Operators
 open Virt_df_gettext.Gettext
 open Virt_df
 
+let disk_block_size = ~^512
+
+(* A libvirt-backed block device. *)
+class libvirt_device dom name path blocksize =
+  (* Size is never really used. *)
+  let size = ~^0 in
+object (self)
+  inherit Diskimage.device
+  method read offset len =
+    let offset = Int63.to_int64 offset in
+    let len = Int63.to_int len in
+    let str = String.make len '\000' in
+    ignore (D.block_peek dom path offset len str 0);
+    str
+  method size = size
+  method name = name
+  method blocksize = blocksize
+  method map_block _ = []
+  method contiguous offset = size -^ offset
+  method close () = ()
+  initializer
+    (* Check that access is possible - throws a virterror if not. *)
+    D.block_peek dom path 0L 0 "" 0
+end
+
 let () =
   (* Command line argument parsing. *)
   let set_uri = function "" -> uri := None | u -> uri := Some u in
@@ -95,8 +120,7 @@ OPTIONS" in
          csv_write stdout
   in
 
-  (*          name      target   dev_path *)
-  let doms : (string * (string * string) list) list =
+  let doms =
     if !test_files = [] then (
       let xmls =
        (* Connect to the hypervisor. *)
@@ -131,19 +155,17 @@ OPTIONS" in
          ) in
 
        (* Get their XML. *)
-       let xmls = List.map D.get_xml_desc doms in
+       let xmls = List.map (fun dom -> dom, D.get_xml_desc dom) doms in
 
        (* Parse the XML. *)
-       let xmls = List.map Xml.parse_string xmls in
+       let xmls = List.map (fun (dom, xml) ->
+                              dom, Xml.parse_string xml) 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 ->
+       fun (dom, xml) ->
          let nodes, domain_attrs =
            match xml with
            | Xml.Element ("domain", attrs, children) -> children, attrs
@@ -224,6 +246,14 @@ OPTIONS" in
              | _ -> None
            ) devices in
 
+         let disks = List.filter_map (
+           fun (name, path) ->
+             try Some (name, new libvirt_device dom name path disk_block_size)
+             with Libvirt.Virterror err ->
+               eprintf "%s: %s\n" name (Libvirt.Virterror.to_string err);
+               None
+         ) disks in
+
          name, disks
       ) xmls
     ) else (
@@ -232,19 +262,20 @@ OPTIONS" in
        * which we use for testing virt-df itself.  We create fake domains
        * from these.
        *)
-      List.map (
+      List.filter_map (
        fun filename ->
-         filename, ["hda", filename]
+         try Some (filename,
+                   ["hda",
+                    new Diskimage.block_device filename disk_block_size])
+         with Unix.Unix_error (err, func, param) ->
+           eprintf "%s:%s: %s\n" func param (Unix.error_message err);
+           None
       ) !test_files
     ) in
 
   (* Convert these to Diskimage library 'machine's. *)
-  let machines = List.filter_map (
-    fun (name, disks) ->
-      try Some (Diskimage.open_machine name disks)
-      with Unix.Unix_error (err, func, param) ->
-       eprintf "%s:%s: %s" func param (Unix.error_message err);
-       None
+  let machines = List.map (
+    fun (name, disks) -> Diskimage.open_machine_from_devices name disks
   ) doms in
 
   (* Scan them. *)
@@ -330,8 +361,7 @@ OPTIONS" in
     printf "%-32s " name;
 
     let {
-      Diskimage.fs_plugin_id = fs_plugin_id;
-      fs_blocksize = fs_blocksize;
+      Diskimage.fs_blocksize = fs_blocksize;
       fs_blocks_total = fs_blocks_total;
       fs_is_swap = fs_is_swap;
       fs_blocks_reserved = fs_blocks_reserved;
@@ -343,7 +373,7 @@ OPTIONS" in
       fs_inodes_used = fs_inodes_used
     } = fs in
 
-    let fs_name = Diskimage.name_of_filesystem fs_plugin_id in
+    let fs_name = Diskimage.name_of_filesystem fs in
 
     if fs_is_swap then (
       (* Swap partition. *)
@@ -394,8 +424,7 @@ OPTIONS" in
     let name = printable_name machine ?disk ?partno dev in
 
     let {
-      Diskimage.fs_plugin_id = fs_plugin_id;
-      fs_blocksize = fs_blocksize;
+      Diskimage.fs_blocksize = fs_blocksize;
       fs_blocks_total = fs_blocks_total;
       fs_is_swap = fs_is_swap;
       fs_blocks_reserved = fs_blocks_reserved;
@@ -407,7 +436,7 @@ OPTIONS" in
       fs_inodes_used = fs_inodes_used
     } = fs in
 
-    let fs_name = Diskimage.name_of_filesystem fs_plugin_id in
+    let fs_name = Diskimage.name_of_filesystem fs in
 
     let row =
       if fs_is_swap then