[Libguestfs] [PATCH 4/8] mllib: Add Registry.t = Guestfs.guestfs * Registry.node

Richard W.M. Jones rjones at redhat.com
Sat Feb 18 08:05:31 UTC 2017


Add a convenient tuple Registry.t for the currently open hive.  It
contains the guestfs handle and the root node of a registry.

The functions with_hive_readonly and with_hive_write are modified to
pass this tuple to their callbacks.
---
 customize/firstboot.ml |  4 ++--
 mllib/regedit.ml       |  4 ++--
 mllib/regedit.mli      |  2 +-
 mllib/registry.ml      | 15 +++++--------
 mllib/registry.mli     | 12 ++++++----
 v2v/convert_windows.ml | 60 +++++++++++++++++++++++++-------------------------
 v2v/windows_virtio.ml  | 10 ++++-----
 v2v/windows_virtio.mli |  9 ++++----
 8 files changed, 58 insertions(+), 58 deletions(-)

diff --git a/customize/firstboot.ml b/customize/firstboot.ml
index 3a5c10a..5489c21 100644
--- a/customize/firstboot.ml
+++ b/customize/firstboot.ml
@@ -317,7 +317,7 @@ echo uninstalling firstboot service
     let filename = sprintf "%s/system32/config/SYSTEM" systemroot in
     let filename = g#case_sensitive_path filename in
     Registry.with_hive_write g filename
-      (fun root_node ->
+      (fun reg ->
         let current_cs = g#inspect_get_windows_current_control_set root in
 
         (* Add a new rhsrvany service to the system registry to execute
@@ -339,7 +339,7 @@ echo uninstalling firstboot service
             REG_SZ ("cmd /c \"" ^ firstboot_dir_win ^ "\\firstboot.bat\"");
             "PWD", REG_SZ firstboot_dir_win ];
         ] in
-        reg_import g root_node regedits
+        reg_import reg regedits
       );
 
     firstboot_dir
diff --git a/mllib/regedit.ml b/mllib/regedit.ml
index a97699c..f49d931 100644
--- a/mllib/regedit.ml
+++ b/mllib/regedit.ml
@@ -32,7 +32,7 @@ and regtype =
 | REG_DWORD of int32
 | REG_MULTI_SZ of string list
 
-let rec import_key (g : Guestfs.guestfs) root (path, values) =
+let rec import_key ((g, root) : Registry.t) (path, values) =
   (* Create the path starting at the root node. *)
   let node =
     let rec loop parent = function
@@ -80,4 +80,4 @@ and import_value g node = function
     let ss = String.concat "" ss in
     g#hivex_node_set_value node key 7L ss
 
-let reg_import g root = List.iter (import_key g root)
+let reg_import reg = List.iter (import_key reg)
diff --git a/mllib/regedit.mli b/mllib/regedit.mli
index 6a5e383..06828cb 100644
--- a/mllib/regedit.mli
+++ b/mllib/regedit.mli
@@ -55,5 +55,5 @@ and regtype =
     UTF-16LE, and integers are automatically packed and
     byte-swapped. *)
 
-val reg_import : Guestfs.guestfs -> Registry.node -> regedits -> unit
+val reg_import : Registry.t -> regedits -> unit
 (** Import the edits in [regedits] into the currently opened hive. *)
diff --git a/mllib/registry.ml b/mllib/registry.ml
index a5f195f..ac85b50 100644
--- a/mllib/registry.ml
+++ b/mllib/registry.ml
@@ -24,23 +24,20 @@ open Common_utils
 type node = int64
 type value = int64
 
+type t = Guestfs.guestfs * node
+
 let with_hive_readonly (g : Guestfs.guestfs) hive_filename f =
   let verbose = verbose () in
   g#hivex_open ~write:false ~unsafe:true ~verbose (* ~debug:verbose *)
                hive_filename;
-  protect ~f:(
-    fun () ->
-      let root = g#hivex_root () in
-      f root
-  ) ~finally:g#hivex_close
+  protect ~f:(fun () -> f (g, g#hivex_root ())) ~finally:g#hivex_close
 
 let with_hive_write (g : Guestfs.guestfs) hive_filename f =
   let verbose = verbose () in
   g#hivex_open ~write:true ~verbose (* ~debug:verbose *) hive_filename;
   protect ~f:(
     fun () ->
-      let root = g#hivex_root () in
-      let ret = f root in
+      let ret = f (g, g#hivex_root ()) in
       g#hivex_commit None;
       ret
   ) ~finally:g#hivex_close
@@ -48,12 +45,12 @@ let with_hive_write (g : Guestfs.guestfs) hive_filename f =
 (* Find the given node in the current hive, relative to the starting
  * point.  Returns [None] if the node is not found.
  *)
-let rec get_node (g : Guestfs.guestfs) node = function
+let rec get_node ((g, node) : t) = function
   | [] -> Some node
   | x :: xs ->
      let node = g#hivex_node_get_child node x in
      if node = 0L then None
-     else get_node g node xs
+     else get_node (g, node) xs
 
 (* Take a 7 bit ASCII string and encode it as UTF16LE. *)
 let encode_utf16le str =
diff --git a/mllib/registry.mli b/mllib/registry.mli
index 1c9790d..9727cd5 100644
--- a/mllib/registry.mli
+++ b/mllib/registry.mli
@@ -21,8 +21,12 @@
 type node = int64
 type value = int64
 
-val with_hive_readonly : Guestfs.guestfs -> string -> (node -> 'a) -> 'a
-val with_hive_write : Guestfs.guestfs -> string -> (node -> 'a) -> 'a
+type t = Guestfs.guestfs * node
+(** [Registry.t] describes a currently open hive.  It contains the
+    guestfs handle and the root node of a registry. *)
+
+val with_hive_readonly : Guestfs.guestfs -> string -> (t -> 'a) -> 'a
+val with_hive_write : Guestfs.guestfs -> string -> (t -> 'a) -> 'a
 (** [with_hive_(readonly|write) g hive_filename f]
     are wrappers that handle opening and closing the hive
     named [hive_filename] around a function [f].
@@ -32,8 +36,8 @@ val with_hive_write : Guestfs.guestfs -> string -> (node -> 'a) -> 'a
     hive for writes, and commits the changes at the end if there
     were no errors. *)
 
-val get_node : Guestfs.guestfs -> node -> string list -> node option
-(** [get_node g root path] starts at the [root] node of the hive (it does
+val get_node : t -> string list -> node option
+(** [get_node (g, root) path] starts at the [root] node of the hive (it does
     not need to be the actual hive root), and searches down the [path].
     It returns [Some node] of the final node if found, or [None] if
     not found. *)
diff --git a/v2v/convert_windows.ml b/v2v/convert_windows.ml
index eabbd56..9e3849a 100644
--- a/v2v/convert_windows.ml
+++ b/v2v/convert_windows.ml
@@ -87,12 +87,12 @@ let convert ~keep_serial_console (g : G.guestfs) inspect source rcaps =
   (* If the Windows guest appears to be using group policy. *)
   let has_group_policy =
     Registry.with_hive_readonly g software_hive_filename
-      (fun root ->
+      (fun reg ->
        try
          let path = ["Microsoft"; "Windows"; "CurrentVersion";
                      "Group Policy"; "History"]  in
          let node =
-           match Registry.get_node g root path with
+           match Registry.get_node reg path with
            | None -> raise Not_found
            | Some node -> node in
          let children = g#hivex_node_children node in
@@ -130,12 +130,12 @@ let convert ~keep_serial_console (g : G.guestfs) inspect source rcaps =
     let xenpvreg = "Red Hat Paravirtualized Xen Drivers for Windows(R)" in
 
     Registry.with_hive_readonly g software_hive_filename
-      (fun root ->
+      (fun reg ->
        try
          let path = ["Microsoft"; "Windows"; "CurrentVersion"; "Uninstall";
                      xenpvreg] in
          let node =
-           match Registry.get_node g root path with
+           match Registry.get_node reg path with
            | None -> raise Not_found
            | Some node -> node in
          let uninstkey = "UninstallString" in
@@ -171,11 +171,11 @@ let convert ~keep_serial_console (g : G.guestfs) inspect source rcaps =
     let uninsts = ref [] in
 
     Registry.with_hive_readonly g software_hive_filename
-      (fun root ->
+      (fun reg ->
        try
          let path = ["Microsoft"; "Windows"; "CurrentVersion"; "Uninstall"] in
          let node =
-           match Registry.get_node g root path with
+           match Registry.get_node reg path with
            | None -> raise Not_found
            | Some node -> node in
          let uninstnodes = g#hivex_node_children node in
@@ -232,7 +232,7 @@ let convert ~keep_serial_console (g : G.guestfs) inspect source rcaps =
     unconfigure_xenpv ();
     unconfigure_prltools ()
 
-  and set_reg_val_dword_1 root key_path name =
+  and set_reg_val_dword_1 (g, root) key_path name =
     (* set reg value to REG_DWORD 1, creating intermediate keys if needed *)
     let node =
       let rec loop parent = function
@@ -279,8 +279,8 @@ reg delete \"%s\" /v %s /f" strkey name
                           "Settings"] in
           let name = "SuppressNewHWUI" in
           let value = Registry.with_hive_write g software_hive_filename (
-            fun root ->
-              set_reg_val_dword_1 root key_path name
+            fun reg ->
+              set_reg_val_dword_1 reg key_path name
           ) in
           reg_restore ("HKLM\\Software" :: key_path) name value
 
@@ -289,9 +289,9 @@ reg delete \"%s\" /v %s /f" strkey name
           let key_path = ["Services"; "PlugPlay"; "Parameters"] in
           let name = "SuppressUI" in
           let value = Registry.with_hive_write g system_hive_filename (
-            fun root ->
-              set_reg_val_dword_1 root (inspect.i_windows_current_control_set
-                                        :: key_path) name
+            fun reg ->
+              set_reg_val_dword_1 reg (inspect.i_windows_current_control_set
+                                       :: key_path) name
           ) in
           reg_restore ("HKLM\\SYSTEM\\CurrentControlSet" :: key_path) name
                       value
@@ -390,19 +390,19 @@ if errorlevel 3010 exit /b 0
     ) prltools_uninsts
   in
 
-  let rec update_system_hive root =
+  let rec update_system_hive reg =
     (* Update the SYSTEM hive.  When this function is called the hive has
      * already been opened as a hivex handle inside guestfs.
      *)
-    disable_xenpv_win_drivers root;
-    disable_prl_drivers root;
-    disable_autoreboot root;
-    Windows_virtio.install_drivers g inspect root rcaps
+    disable_xenpv_win_drivers reg;
+    disable_prl_drivers reg;
+    disable_autoreboot reg;
+    Windows_virtio.install_drivers reg inspect rcaps
 
-  and disable_xenpv_win_drivers root =
+  and disable_xenpv_win_drivers reg =
     (* Disable xenpv-win service (RHBZ#809273). *)
     let services =
-      Registry.get_node g root
+      Registry.get_node reg
                         [inspect.i_windows_current_control_set; "Services"] in
 
     match services with
@@ -412,10 +412,10 @@ if errorlevel 3010 exit /b 0
        if node <> 0L then
          g#hivex_node_set_value node "Start" 4_L (le32_of_int 4_L)
 
-  and disable_prl_drivers root =
+  and disable_prl_drivers reg =
     (* Prevent Parallels drivers from loading at boot. *)
     let services =
-      Registry.get_node g root
+      Registry.get_node reg
                         [inspect.i_windows_current_control_set; "Services"] in
     let prl_svcs = [ "prl_boot"; "prl_dd"; "prl_eth5"; "prl_fs"; "prl_memdev";
                      "prl_mouf"; "prl_pv32"; "prl_pv64"; "prl_scsi";
@@ -438,7 +438,7 @@ if errorlevel 3010 exit /b 0
     (* perfrom the equivalent of DelReg from prl_strg.inf:
      * HKLM, System\CurrentControlSet\Control\Class\{4d36e967-e325-11ce-bfc1-08002be10318}, LowerFilters, 0x00018002, prl_strg
      *)
-    let strg_cls = Registry.get_node g root
+    let strg_cls = Registry.get_node reg
                         [inspect.i_windows_current_control_set;
                          "Control"; "Class";
                          "{4d36e967-e325-11ce-bfc1-08002be10318}"] in
@@ -460,19 +460,19 @@ if errorlevel 3010 exit /b 0
           g#hivex_node_set_value strg_cls lfkey 7_L data
         )
 
-  and disable_autoreboot root =
+  and disable_autoreboot reg =
     (* If the guest reboots after a crash, it's hard to see the original
      * error (eg. the infamous 0x0000007B).  Turn off autoreboot.
      *)
     let crash_control =
-      Registry.get_node g root [inspect.i_windows_current_control_set;
-                                "Control"; "CrashControl"] in
+      Registry.get_node reg [inspect.i_windows_current_control_set;
+                             "Control"; "CrashControl"] in
     match crash_control with
     | None -> ()
     | Some crash_control ->
        g#hivex_node_set_value crash_control "AutoReboot" 4_L (le32_of_int 0_L)
 
-  and update_software_hive root =
+  and update_software_hive reg =
     (* Update the SOFTWARE hive.  When this function is called the
      * hive has already been opened as a hivex handle inside
      * guestfs.
@@ -483,7 +483,7 @@ if errorlevel 3010 exit /b 0
      * path to this key.
      *)
     let node =
-      Registry.get_node g root ["Microsoft"; "Windows"; "CurrentVersion"] in
+      Registry.get_node reg ["Microsoft"; "Windows"; "CurrentVersion"] in
     match node with
     | Some node ->
        let append = Registry.encode_utf16le ";%SystemRoot%\\Drivers\\VirtIO" in
@@ -590,17 +590,17 @@ if errorlevel 3010 exit /b 0
         let bcd_path = "/EFI/Microsoft/Boot/BCD" in
         Registry.with_hive_write g (esp_path ^ bcd_path) (
           (* Remove the 'graphicsmodedisabled' key in BCD *)
-          fun root ->
+          fun reg ->
           let path = ["Objects"; "{9dea862c-5cdd-4e70-acc1-f32b344d4795}";
                       "Elements"; "23000003"] in
           let boot_mgr_default_link =
-            match Registry.get_node g root path with
+            match Registry.get_node reg path with
             | None -> raise Not_found
             | Some node -> node in
           let current_boot_entry = g#hivex_value_utf8 (
             g#hivex_node_get_value boot_mgr_default_link "Element") in
           let path = ["Objects"; current_boot_entry; "Elements"; "16000046"] in
-          match Registry.get_node g root path with
+          match Registry.get_node reg path with
           | None -> raise Not_found
           | Some graphics_mode_disabled ->
             g#hivex_node_delete_child graphics_mode_disabled
diff --git a/v2v/windows_virtio.ml b/v2v/windows_virtio.ml
index 2c28524..2f5349d 100644
--- a/v2v/windows_virtio.ml
+++ b/v2v/windows_virtio.ml
@@ -37,7 +37,7 @@ let scsi_class_guid = "{4D36E97B-E325-11CE-BFC1-08002BE10318}"
 let viostor_pciid = "VEN_1AF4&DEV_1001&SUBSYS_00021AF4&REV_00"
 let vioscsi_pciid = "VEN_1AF4&DEV_1004&SUBSYS_00081AF4&REV_00"
 
-let rec install_drivers g inspect root rcaps =
+let rec install_drivers ((g, _) as reg) inspect rcaps =
   (* Copy the virtio drivers to the guest. *)
   let driverdir = sprintf "%s/Drivers/VirtIO" inspect.i_windows_systemroot in
   g#mkdir_p driverdir;
@@ -102,7 +102,7 @@ let rec install_drivers g inspect root rcaps =
                              inspect.i_windows_systemroot driver_name in
         let target = g#case_sensitive_path target in
         g#cp source target;
-        add_guestor_to_registry g inspect root driver_name viostor_pciid;
+        add_guestor_to_registry reg inspect driver_name viostor_pciid;
         Virtio_blk
 
       | Some Virtio_SCSI, _, true ->
@@ -113,7 +113,7 @@ let rec install_drivers g inspect root rcaps =
                              inspect.i_windows_systemroot in
         let target = g#case_sensitive_path target in
         g#cp source target;
-        add_guestor_to_registry g inspect root "vioscsi" vioscsi_pciid;
+        add_guestor_to_registry reg inspect "vioscsi" vioscsi_pciid;
         Virtio_SCSI
 
       | Some IDE, _, _ ->
@@ -168,7 +168,7 @@ let rec install_drivers g inspect root rcaps =
     (block, net, video)
   )
 
-and add_guestor_to_registry g inspect root drv_name drv_pciid =
+and add_guestor_to_registry ((g, root) as reg) inspect drv_name drv_pciid =
   let ddb_node = g#hivex_node_get_child root "DriverDatabase" in
 
   let regedits =
@@ -187,7 +187,7 @@ and add_guestor_to_registry g inspect root drv_name drv_pciid =
         "ImagePath", REG_EXPAND_SZ drv_sys_path ];
   ] in
 
-  reg_import g root (regedits @ common_regedits)
+  reg_import reg (regedits @ common_regedits)
 
 and cdb_regedits inspect drv_name drv_pciid =
   (* See http://rwmj.wordpress.com/2010/04/30/tip-install-a-device-driver-in-a-windows-vm/
diff --git a/v2v/windows_virtio.mli b/v2v/windows_virtio.mli
index 4ceeebe..0bc6faa 100644
--- a/v2v/windows_virtio.mli
+++ b/v2v/windows_virtio.mli
@@ -19,16 +19,15 @@
 (** Functions for installing Windows virtio drivers. *)
 
 val install_drivers
-    : Guestfs.guestfs -> Types.inspect -> Registry.node ->
-      Types.requested_guestcaps ->
+    : Registry.t -> Types.inspect -> Types.requested_guestcaps ->
       Types.guestcaps_block_type * Types.guestcaps_net_type * Types.guestcaps_video_type
-(** [install_drivers g inspect root rcaps]
+(** [install_drivers reg inspect rcaps]
     installs virtio drivers from the driver directory or driver
     ISO into the guest driver directory and updates the registry
     so that the [viostor.sys] driver gets loaded by Windows at boot.
 
-    [root] is the root node of the system hive (which is open for writes
-    when this function is called).
+    [reg] is the system hive which is open for writes when this
+    function is called.
 
     [rcaps] is the set of guest "capabilities" requested by the caller.  This
     may include the type of the block driver, network driver, and video driver.
-- 
2.10.2




More information about the Libguestfs mailing list