Can now use libvirt virDomainBlockPeek to access devices remotely

diff --git a/lib/diskimage.mli b/lib/diskimage.mli
index f16703c..fab0bb9 100644 (file)
--- a/lib/diskimage.mli
+++ b/lib/diskimage.mli
@@ -274,6 +274,11 @@ val open_machine : string -> (string * string) list -> machine
       LV filesystems in the returned structure.
   *)
 
+val open_machine_from_devices : string -> (string * block_device) list ->
+  machine
+  (** This is the same as {!open_machine} except that instead
+      of passing a path you should pass a {!block_device} object. *)
+
 val close_machine : machine -> unit
   (** This is a convenience function which calls the [dev#close]
       method on any open {!block_device}s owned by the machine.  This just

diff --git a/lib/diskimage_impl.ml b/lib/diskimage_impl.ml
index 4e338d2..7dbd5fb 100644 (file)
--- a/lib/diskimage_impl.ml
+++ b/lib/diskimage_impl.ml
@@ -404,13 +404,20 @@ let private_data_functions get_key =
 
 (*----------------------------------------------------------------------*)
 (* Create machine description. *)
+let open_machine_from_devices name disks =
+  let disks = List.map (
+    fun (name, dev) ->
+      { d_name = name; d_dev = dev; d_content = `Unknown }
+  ) disks in
+  { m_name = name; m_disks = disks; m_lv_filesystems = [] }
+
 let open_machine name disks =
   let disks = List.map (
     fun (name, path) ->
       let dev = new block_device path disk_block_size (* XXX *) in
-      { d_name = name; d_dev = dev; d_content = `Unknown }
+      name, dev
   ) disks in
-  { m_name = name; m_disks = disks; m_lv_filesystems = [] }
+  open_machine_from_devices name disks
 
 let close_machine { m_disks = m_disks } =
   (* Only close the disks, assume all other devices are derived from them. *)

diff --git a/lib/diskimage_impl.mli b/lib/diskimage_impl.mli
index 23f619f..c4299af 100644 (file)
--- a/lib/diskimage_impl.mli
+++ b/lib/diskimage_impl.mli
@@ -203,6 +203,8 @@ val range : int -> int -> int list
 (** {2 Functions} *)
 
 val open_machine : string -> (string * string) list -> machine
+val open_machine_from_devices : string -> (string * block_device) list ->
+  machine
 val close_machine : machine -> unit
 val scan_machine : machine -> machine
 

diff --git a/virt-df/virt_df_main.ml b/virt-df/virt_df_main.ml
index b0aac84..57d5081 100644 (file)
--- a/virt-df/virt_df_main.ml
+++ b/virt-df/virt_df_main.ml
@@ -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. *)