2:05 a.m.
Move the functions decode_utf16le, encode_utf16le, get_node,
with_hive_readonly and with_hive_write to common code in a new module
called Registry.
This also defines types for nodes and values, instead of using int64
directly.
Just code motion.
---
mllib/Makefile.am | 2 ++
mllib/regedit.ml | 32 ++------------------
mllib/regedit.mli | 8 +----
mllib/registry.ml | 82 ++++++++++++++++++++++++++++++++++++++++++++++++++
mllib/registry.mli | 45 +++++++++++++++++++++++++++
v2v/convert_windows.ml | 44 +++++++++++++--------------
v2v/windows.ml | 31 -------------------
v2v/windows.mli | 17 -----------
v2v/windows_virtio.mli | 2 +-
9 files changed, 156 insertions(+), 107 deletions(-)
create mode 100644 mllib/registry.ml
create mode 100644 mllib/registry.mli
diff --git a/mllib/Makefile.am b/mllib/Makefile.am
index aa5472a..ff687b6 100644
--- a/mllib/Makefile.am
+++ b/mllib/Makefile.am
@@ -43,6 +43,7 @@ SOURCES_MLI = \
planner.mli \
progress.mli \
regedit.mli \
+ registry.mli \
StatVFS.mli \
stringMap.mli \
URI.mli \
@@ -64,6 +65,7 @@ SOURCES_ML = \
visit.ml \
fnmatch.ml \
planner.ml \
+ registry.ml \
regedit.ml \
StatVFS.ml \
JSON.ml \
diff --git a/mllib/regedit.ml b/mllib/regedit.ml
index 1ec7d4b..a97699c 100644
--- a/mllib/regedit.ml
+++ b/mllib/regedit.ml
@@ -32,32 +32,6 @@ and regtype =
| REG_DWORD of int32
| REG_MULTI_SZ of string list
-(* Take a 7 bit ASCII string and encode it as UTF16LE. *)
-let encode_utf16le str =
- let len = String.length str in
- let copy = Bytes.make (len*2) '\000' in
- for i = 0 to len-1 do
- Bytes.unsafe_set copy (i*2) (String.unsafe_get str i)
- done;
- Bytes.to_string copy
-
-(* Take a UTF16LE string and decode it to UTF-8. Actually this
- * fails if the string is not 7 bit ASCII. XXX Use iconv here.
- *)
-let decode_utf16le str =
- let len = String.length str in
- if len mod 2 <> 0 then
- error (f_"decode_utf16le: Windows string does not appear to be in UTF16-LE
encoding. This could be a bug in %s.") prog;
- let copy = Bytes.create (len/2) in
- for i = 0 to (len/2)-1 do
- let cl = String.unsafe_get str (i*2) in
- let ch = String.unsafe_get str ((i*2)+1) in
- if ch != '\000' || Char.code cl >= 127 then
- error (f_"decode_utf16le: Windows UTF16-LE string contains non-7-bit
characters. This is a bug in %s, please report it.") prog;
- Bytes.unsafe_set copy i cl
- done;
- Bytes.to_string copy
-
let rec import_key (g : Guestfs.guestfs) root (path, values) =
(* Create the path starting at the root node. *)
let node =
@@ -91,9 +65,9 @@ and import_value g node = function
* bytes at the end of string fields.
*)
| key, REG_SZ s ->
- g#hivex_node_set_value node key 1L (encode_utf16le s ^ "\000\000")
+ g#hivex_node_set_value node key 1L (Registry.encode_utf16le s ^
"\000\000")
| key, REG_EXPAND_SZ s ->
- g#hivex_node_set_value node key 2L (encode_utf16le s ^ "\000\000")
+ g#hivex_node_set_value node key 2L (Registry.encode_utf16le s ^
"\000\000")
| key, REG_BINARY bin ->
g#hivex_node_set_value node key 3L bin
| key, REG_DWORD dw ->
@@ -102,7 +76,7 @@ and import_value g node = function
(* http://blogs.msdn.com/oldnewthing/archive/2009/10/08/9904646.aspx *)
List.iter (fun s -> assert (s <> "")) ss;
let ss = ss @ [""] in
- let ss = List.map (fun s -> encode_utf16le s ^ "\000\000") ss in
+ let ss = List.map (fun s -> Registry.encode_utf16le s ^ "\000\000") ss
in
let ss = String.concat "" ss in
g#hivex_node_set_value node key 7L ss
diff --git a/mllib/regedit.mli b/mllib/regedit.mli
index a65f5d3..6a5e383 100644
--- a/mllib/regedit.mli
+++ b/mllib/regedit.mli
@@ -55,11 +55,5 @@ and regtype =
UTF-16LE, and integers are automatically packed and
byte-swapped. *)
-val reg_import : Guestfs.guestfs -> int64 -> regedits -> unit
+val reg_import : Guestfs.guestfs -> Registry.node -> regedits -> unit
(** Import the edits in [regedits] into the currently opened hive. *)
-
-val encode_utf16le : string -> string
-(** Helper: Take a 7 bit ASCII string and encode it as UTF-16LE. *)
-
-val decode_utf16le : string -> string
-(** Helper: Take a UTF-16LE string and decode it to UTF-8. *)
diff --git a/mllib/registry.ml b/mllib/registry.ml
new file mode 100644
index 0000000..a5f195f
--- /dev/null
+++ b/mllib/registry.ml
@@ -0,0 +1,82 @@
+(* virt-v2v
+ * Copyright (C) 2009-2017 Red Hat Inc.
+ *
+ * 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.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+open Printf
+
+open Common_gettext.Gettext
+open Common_utils
+
+type node = int64
+type value = int64
+
+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
+
+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
+ g#hivex_commit None;
+ ret
+ ) ~finally:g#hivex_close
+
+(* 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
+ | [] -> 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
+
+(* Take a 7 bit ASCII string and encode it as UTF16LE. *)
+let encode_utf16le str =
+ let len = String.length str in
+ let copy = Bytes.make (len*2) '\000' in
+ for i = 0 to len-1 do
+ Bytes.unsafe_set copy (i*2) (String.unsafe_get str i)
+ done;
+ Bytes.to_string copy
+
+(* Take a UTF16LE string and decode it to UTF-8. Actually this
+ * fails if the string is not 7 bit ASCII. XXX Use iconv here.
+ *)
+let decode_utf16le str =
+ let len = String.length str in
+ if len mod 2 <> 0 then
+ error (f_"decode_utf16le: Windows string does not appear to be in UTF16-LE
encoding. This could be a bug in %s.") prog;
+ let copy = Bytes.create (len/2) in
+ for i = 0 to (len/2)-1 do
+ let cl = String.unsafe_get str (i*2) in
+ let ch = String.unsafe_get str ((i*2)+1) in
+ if ch != '\000' || Char.code cl >= 127 then
+ error (f_"decode_utf16le: Windows UTF16-LE string contains non-7-bit
characters. This is a bug in %s, please report it.") prog;
+ Bytes.unsafe_set copy i cl
+ done;
+ Bytes.to_string copy
diff --git a/mllib/registry.mli b/mllib/registry.mli
new file mode 100644
index 0000000..1c9790d
--- /dev/null
+++ b/mllib/registry.mli
@@ -0,0 +1,45 @@
+(* mllib
+ * Copyright (C) 2009-2017 Red Hat Inc.
+ *
+ * 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.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+(** Common Windows Registry types and functions. *)
+
+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
+(** [with_hive_(readonly|write) g hive_filename f]
+ are wrappers that handle opening and closing the hive
+ named [hive_filename] around a function [f].
+
+ [with_hive_readonly] opens the hive for read-only (attempts
+ to write will throw an error). [with_hive_write] opens the
+ 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
+ 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. *)
+
+val encode_utf16le : string -> string
+(** Helper: Take a 7 bit ASCII string and encode it as UTF-16LE. *)
+
+val decode_utf16le : string -> string
+(** Helper: Take a UTF-16LE string and decode it to UTF-8. *)
diff --git a/v2v/convert_windows.ml b/v2v/convert_windows.ml
index 424288d..a231219 100644
--- a/v2v/convert_windows.ml
+++ b/v2v/convert_windows.ml
@@ -87,13 +87,13 @@ 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 =
- Windows.with_hive_readonly g software_hive_filename
+ Registry.with_hive_readonly g software_hive_filename
(fun root ->
try
let path = ["Microsoft"; "Windows";
"CurrentVersion";
"Group Policy"; "History"] in
let node =
- match Windows.get_node g root path with
+ match Registry.get_node g root path with
| None -> raise Not_found
| Some node -> node in
let children = g#hivex_node_children node in
@@ -130,13 +130,13 @@ let convert ~keep_serial_console (g : G.guestfs) inspect source
rcaps =
let xenpv_uninst =
let xenpvreg = "Red Hat Paravirtualized Xen Drivers for Windows(R)" in
- Windows.with_hive_readonly g software_hive_filename
+ Registry.with_hive_readonly g software_hive_filename
(fun root ->
try
let path = ["Microsoft"; "Windows";
"CurrentVersion"; "Uninstall";
xenpvreg] in
let node =
- match Windows.get_node g root path with
+ match Registry.get_node g root path with
| None -> raise Not_found
| Some node -> node in
let uninstkey = "UninstallString" in
@@ -147,7 +147,7 @@ let convert ~keep_serial_console (g : G.guestfs) inspect source rcaps
=
raise Not_found
);
let data = g#hivex_value_value valueh in
- let data = Regedit.decode_utf16le data in
+ let data = Registry.decode_utf16le data in
(* The uninstall program will be uninst.exe. This is a wrapper
* around _uninst.exe which prompts the user. As we don't want
@@ -171,12 +171,12 @@ let convert ~keep_serial_console (g : G.guestfs) inspect source
rcaps =
let prltools_uninsts =
let uninsts = ref [] in
- Windows.with_hive_readonly g software_hive_filename
+ Registry.with_hive_readonly g software_hive_filename
(fun root ->
try
let path = ["Microsoft"; "Windows";
"CurrentVersion"; "Uninstall"] in
let node =
- match Windows.get_node g root path with
+ match Registry.get_node g root path with
| None -> raise Not_found
| Some node -> node in
let uninstnodes = g#hivex_node_children node in
@@ -286,7 +286,7 @@ reg delete \"%s\" /v %s /f" strkey name
let key_path = ["Policies"; "Microsoft";
"Windows"; "DeviceInstall";
"Settings"] in
let name = "SuppressNewHWUI" in
- let value = Windows.with_hive_write g software_hive_filename (
+ let value = Registry.with_hive_write g software_hive_filename (
fun root ->
set_reg_val_dword_1 root key_path name
) in
@@ -296,7 +296,7 @@ reg delete \"%s\" /v %s /f" strkey name
| 5, 2 ->
let key_path = ["Services"; "PlugPlay";
"Parameters"] in
let name = "SuppressUI" in
- let value = Windows.with_hive_write g system_hive_filename (
+ let value = Registry.with_hive_write g system_hive_filename (
fun root ->
let current_cs = get_current_cs root in
set_reg_val_dword_1 root (current_cs :: key_path) name
@@ -413,7 +413,7 @@ if errorlevel 3010 exit /b 0
and disable_xenpv_win_drivers root current_cs =
(* Disable xenpv-win service (RHBZ#809273). *)
- let services = Windows.get_node g root [current_cs; "Services"] in
+ let services = Registry.get_node g root [current_cs; "Services"] in
match services with
| None -> ()
@@ -424,7 +424,7 @@ if errorlevel 3010 exit /b 0
and disable_prl_drivers root current_cs =
(* Prevent Parallels drivers from loading at boot. *)
- let services = Windows.get_node g root [current_cs; "Services"] in
+ let services = Registry.get_node g root [current_cs; "Services"] in
let prl_svcs = [ "prl_boot"; "prl_dd"; "prl_eth5";
"prl_fs"; "prl_memdev";
"prl_mouf"; "prl_pv32"; "prl_pv64";
"prl_scsi";
"prl_sound"; "prl_strg"; "prl_tg";
"prl_time";
@@ -446,7 +446,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 = Windows.get_node g root
+ let strg_cls = Registry.get_node g root
[current_cs; "Control"; "Class";
"{4d36e967-e325-11ce-bfc1-08002be10318}"] in
match strg_cls with
@@ -456,12 +456,12 @@ if errorlevel 3010 exit /b 0
let valueh = g#hivex_node_get_value strg_cls lfkey in
if valueh <> 0L then (
let data = g#hivex_value_value valueh in
- let filters = String.nsplit "\000" (Regedit.decode_utf16le data) in
+ let filters = String.nsplit "\000" (Registry.decode_utf16le data) in
let filters = List.filter (
fun x -> x <> "prl_strg" && x <>
""
) filters in
let filters = List.map (
- fun x -> Regedit.encode_utf16le x ^ "\000\000"
+ fun x -> Registry.encode_utf16le x ^ "\000\000"
) (filters @ [""]) in
let data = String.concat "" filters in
g#hivex_node_set_value strg_cls lfkey 7_L data
@@ -472,7 +472,7 @@ if errorlevel 3010 exit /b 0
* error (eg. the infamous 0x0000007B). Turn off autoreboot.
*)
let crash_control =
- Windows.get_node g root [current_cs; "Control"; "CrashControl"]
in
+ Registry.get_node g root [current_cs; "Control";
"CrashControl"] in
match crash_control with
| None -> ()
| Some crash_control ->
@@ -489,10 +489,10 @@ if errorlevel 3010 exit /b 0
* path to this key.
*)
let node =
- Windows.get_node g root ["Microsoft"; "Windows";
"CurrentVersion"] in
+ Registry.get_node g root ["Microsoft"; "Windows";
"CurrentVersion"] in
match node with
| Some node ->
- let append = Regedit.encode_utf16le ";%SystemRoot%\\Drivers\\VirtIO" in
+ let append = Registry.encode_utf16le ";%SystemRoot%\\Drivers\\VirtIO"
in
let values = Array.to_list (g#hivex_node_values node) in
let rec loop = function
| [] -> () (* DevicePath not found -- ignore this case *)
@@ -594,19 +594,19 @@ if errorlevel 3010 exit /b 0
let fix_win_uefi_bcd esp_path =
try
let bcd_path = "/EFI/Microsoft/Boot/BCD" in
- Windows.with_hive_write g (esp_path ^ bcd_path) (
+ Registry.with_hive_write g (esp_path ^ bcd_path) (
(* Remove the 'graphicsmodedisabled' key in BCD *)
fun root ->
let path = ["Objects";
"{9dea862c-5cdd-4e70-acc1-f32b344d4795}";
"Elements"; "23000003"] in
let boot_mgr_default_link =
- match Windows.get_node g root path with
+ match Registry.get_node g root 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 Windows.get_node g root path with
+ match Registry.get_node g root path with
| None -> raise Not_found
| Some graphics_mode_disabled ->
g#hivex_node_delete_child graphics_mode_disabled
@@ -635,10 +635,10 @@ if errorlevel 3010 exit /b 0
(* Open the system hive for writes and update it. *)
let block_driver, net_driver, video_driver =
- Windows.with_hive_write g system_hive_filename update_system_hive in
+ Registry.with_hive_write g system_hive_filename update_system_hive in
(* Open the software hive for writes and update it. *)
- Windows.with_hive_write g software_hive_filename update_software_hive;
+ Registry.with_hive_write g software_hive_filename update_software_hive;
fix_ntfs_heads ();
diff --git a/v2v/windows.ml b/v2v/windows.ml
index 79a14aa..6c6ed01 100644
--- a/v2v/windows.ml
+++ b/v2v/windows.ml
@@ -46,34 +46,3 @@ and check_app { Guestfs.app2_name = name;
and (=~) str rex =
try ignore (Str.search_forward rex str 0); true with Not_found -> false
-
-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
-
-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
- g#hivex_commit None;
- ret
- ) ~finally:g#hivex_close
-
-(* 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
- | [] -> 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
diff --git a/v2v/windows.mli b/v2v/windows.mli
index 95c4471..619a786 100644
--- a/v2v/windows.mli
+++ b/v2v/windows.mli
@@ -21,20 +21,3 @@
val detect_antivirus : Types.inspect -> bool
(** Return [true] if anti-virus (AV) software was detected in
this Windows guest. *)
-
-val with_hive_readonly : Guestfs.guestfs -> string -> (int64 -> 'a) ->
'a
-val with_hive_write : Guestfs.guestfs -> string -> (int64 -> '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].
-
- [with_hive_readonly] opens the hive for read-only (attempts
- to write will throw an error). [with_hive_write] opens the
- hive for writes, and commits the changes at the end if there
- were no errors. *)
-
-val get_node : Guestfs.guestfs -> int64 -> string list -> int64 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/windows_virtio.mli b/v2v/windows_virtio.mli
index e6f984c..1d25260 100644
--- a/v2v/windows_virtio.mli
+++ b/v2v/windows_virtio.mli
@@ -19,7 +19,7 @@
(** Functions for installing Windows virtio drivers. *)
val install_drivers
- : Guestfs.guestfs -> Types.inspect -> string -> int64 -> string ->
+ : Guestfs.guestfs -> Types.inspect -> string -> Registry.node -> string
->
Types.requested_guestcaps ->
Types.guestcaps_block_type * Types.guestcaps_net_type * Types.guestcaps_video_type
(** [install_drivers g inspect systemroot root current_cs rcaps]
--
2.10.2