mirror of
https://github.com/libguestfs/libguestfs.git
synced 2026-03-22 07:03:38 +00:00
mllib: Add regedit mini-library.
This library replaces Win::Hivex::Regedit, or at least enough for us to be able to make the simple Registry modifications needed for installing firstboot scripts.
This commit is contained in:
Richard W.M. Jones
@@ -40,6 +40,8 @@ SOURCES = \
|
||||
progress-c.c \
|
||||
progress.mli \
|
||||
progress.ml \
|
||||
regedit.mli \
|
||||
regedit.ml \
|
||||
tty-c.c \
|
||||
tTY.mli \
|
||||
tTY.ml \
|
||||
@@ -62,7 +64,8 @@ ocaml_modules = config \
|
||||
progress \
|
||||
uRI \
|
||||
mkdtemp \
|
||||
planner
|
||||
planner \
|
||||
regedit
|
||||
|
||||
OBJECTS = \
|
||||
$(top_builddir)/fish/guestfish-progress.o \
|
||||
|
||||
101
mllib/regedit.ml
Normal file
101
mllib/regedit.ml
Normal file
@@ -0,0 +1,101 @@
|
||||
(* virt-v2v
|
||||
* Copyright (C) 2014 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 Common_utils
|
||||
open Common_gettext.Gettext
|
||||
|
||||
type regedits = regedit list
|
||||
and regedit = regkeypath * regvalues
|
||||
and regkeypath = string list
|
||||
and regvalues = regvalue list
|
||||
and regvalue = string * regtype
|
||||
and regtype =
|
||||
| REG_NONE
|
||||
| REG_SZ of string
|
||||
| REG_EXPAND_SZ of string
|
||||
| REG_BINARY of string
|
||||
| REG_DWORD of int32
|
||||
|
||||
(* Take a 7 bit ASCII string and encode it as UTF16LE. *)
|
||||
let encode_utf16le str =
|
||||
let len = String.length str in
|
||||
let copy = String.make (len*2) '\000' in
|
||||
for i = 0 to len-1 do
|
||||
String.unsafe_set copy (i*2) (String.unsafe_get str i)
|
||||
done;
|
||||
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 ~prog str =
|
||||
let len = String.length str in
|
||||
if len mod 2 <> 0 then
|
||||
error ~prog (f_"decode_utf16le: Windows string does not appear to be in UTF16-LE encoding. This could be a bug in %s.") prog;
|
||||
let copy = String.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 ~prog (f_"decode_utf16le: Windows UTF16-LE string contains non-7-bit characters. This is a bug in %s, please report it.") prog;
|
||||
String.unsafe_set copy i cl
|
||||
done;
|
||||
copy
|
||||
|
||||
let rec import_key (g : Guestfs.guestfs) root (path, values) =
|
||||
(* Create the path starting at the root node. *)
|
||||
let node =
|
||||
let rec loop parent = function
|
||||
| [] -> parent
|
||||
| x :: xs ->
|
||||
let node =
|
||||
match g#hivex_node_get_child parent x with
|
||||
| 0L -> g#hivex_node_add_child parent x (* not found, create *)
|
||||
| node -> node in
|
||||
loop node xs
|
||||
in
|
||||
loop root path in
|
||||
|
||||
(* Delete any existing values in this node. *)
|
||||
(* g#hivex_node_set_values ...
|
||||
XXX Or at least, it would be nice to do this, but there is no
|
||||
binding for it in libguestfs. I'm not sure how much this matters. *)
|
||||
|
||||
(* Create the values. *)
|
||||
import_values g node values
|
||||
|
||||
and import_values g node = List.iter (import_value g node)
|
||||
|
||||
and import_value g node = function
|
||||
| key, REG_NONE -> g#hivex_node_set_value node key 0L ""
|
||||
(* All string registry fields have a terminating NUL, which in
|
||||
* UTF-16LE means they have 3 zero bytes -- the first is the high
|
||||
* byte from the last character, and the second and third are the
|
||||
* UTF-16LE encoding of ASCII NUL. So we have to add two zero
|
||||
* bytes at the end of string fields.
|
||||
*)
|
||||
| key, REG_SZ s ->
|
||||
g#hivex_node_set_value node key 1L (encode_utf16le s ^ "\000\000")
|
||||
| key, REG_EXPAND_SZ s ->
|
||||
g#hivex_node_set_value node key 2L (encode_utf16le s ^ "\000\000")
|
||||
| key, REG_BINARY bin ->
|
||||
g#hivex_node_set_value node key 3L bin
|
||||
| key, REG_DWORD dw ->
|
||||
g#hivex_node_set_value node key 4L (le32_of_int (Int64.of_int32 dw))
|
||||
|
||||
let reg_import g root = List.iter (import_key g root)
|
||||
64
mllib/regedit.mli
Normal file
64
mllib/regedit.mli
Normal file
@@ -0,0 +1,64 @@
|
||||
(* virt-v2v
|
||||
* Copyright (C) 2014 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.
|
||||
*)
|
||||
|
||||
(** A simple registry editor.
|
||||
|
||||
This uses the libguestfs hivex bindings to implement a simple
|
||||
registry editor in the style of [regedit] / [hivexregedit]. We have
|
||||
to write this because the [Win::Hivex::Regedit] APIs are Perl-only.
|
||||
|
||||
It has a large number of limitations compared to
|
||||
[Win::Hivex::Regedit]. It's just enough code to allow us to
|
||||
implement virt-v2v and firstboot functionality, and no more. In
|
||||
particular it can only add keys, not delete or edit them. *)
|
||||
|
||||
type regedits = regedit list
|
||||
(** A list of registry "edits" (although only adding keys is supported). *)
|
||||
|
||||
and regedit = regkeypath * regvalues
|
||||
(** A single key ([regkeypath]) is added, with a list of values for that key. *)
|
||||
|
||||
and regkeypath = string list
|
||||
(** Path to the new key, starting from the root node. New path elements
|
||||
are created as required. *)
|
||||
|
||||
and regvalues = regvalue list
|
||||
|
||||
and regvalue = string * regtype
|
||||
|
||||
and regtype =
|
||||
| REG_NONE
|
||||
| REG_SZ of string (** String. *)
|
||||
| REG_EXPAND_SZ of string (** String with %env% *)
|
||||
| REG_BINARY of string (** Blob of binary data *)
|
||||
| REG_DWORD of int32 (** Little endian 32 bit integer *)
|
||||
(* There are more types in the Registry, but we don't support them here... *)
|
||||
(** Registry value type and data.
|
||||
|
||||
Note that strings are automatically converted from UTF-8 to
|
||||
UTF-16LE, and integers are automatically packed and
|
||||
byte-swapped. *)
|
||||
|
||||
val reg_import : Guestfs.guestfs -> int64 -> 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 : prog:string -> string -> string
|
||||
(** Helper: Take a UTF-16LE string and decode it to UTF-8. *)
|
||||
@@ -34,6 +34,7 @@ mllib/libdir.ml
|
||||
mllib/mkdtemp.ml
|
||||
mllib/planner.ml
|
||||
mllib/progress.ml
|
||||
mllib/regedit.ml
|
||||
mllib/tTY.ml
|
||||
mllib/uRI.ml
|
||||
resize/resize.ml
|
||||
|
||||
Reference in New Issue
Block a user