[Libguestfs] [PATCH] Win::Hivex::Regedit module for importing and exporting regedit format files.
Richard W.M. Jones
rjones at redhat.com
Thu Mar 25 20:26:30 UTC 2010
This is the first part (of three) of a set of changes to support
merging Windows Registry entries from the common 'regedit' format.
https://bugzilla.redhat.com/show_bug.cgi?id=575738
This adds a Perl library Win::Hivex::Regedit which supports two
functions for importing and exporting the format.
I've tested this on some real output from the Windows regedit.exe
program successfully. However these files are not well specified, and
therefore there are bound to be undiscovered inconsistencies and
corner cases.
The second part will add a command line tool to hivex for merging a
regedit file with a local hive. The third part will involve enhancing
virt-win-reg to support this for VMs.
Rich.
--
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
New in Fedora 11: Fedora Windows cross-compiler. Compile Windows
programs, test, and build Windows installers. Over 70 libraries supprt'd
http://fedoraproject.org/wiki/MinGW http://www.annexia.org/fedora_mingw
-------------- next part --------------
>From 8fd897034a031fa7fac3c94493cbf92ad4d6006b Mon Sep 17 00:00:00 2001
From: Richard Jones <rjones at redhat.com>
Date: Thu, 25 Mar 2010 12:03:36 +0000
Subject: [PATCH] Win::Hivex::Regedit module for importing and exporting regedit format files.
---
configure.ac | 2 +-
perl/lib/Win/Hivex/Regedit.pm | 649 +++++++++++++++++++++++++++++++++++++++++
perl/t/510-regedit-load.t | 24 ++
perl/t/550-regedit-export.t | 102 +++++++
perl/t/560-regedit-import.t | 154 ++++++++++
perl/t/570-regedit-import2.t | 82 ++++++
po/POTFILES.in | 1 +
7 files changed, 1013 insertions(+), 1 deletions(-)
create mode 100644 perl/lib/Win/Hivex/Regedit.pm
create mode 100644 perl/t/510-regedit-load.t
create mode 100644 perl/t/550-regedit-export.t
create mode 100644 perl/t/560-regedit-import.t
create mode 100644 perl/t/570-regedit-import2.t
diff --git a/configure.ac b/configure.ac
index 853cf40..11f14ea 100644
--- a/configure.ac
+++ b/configure.ac
@@ -203,7 +203,7 @@ AC_CHECK_PROG([PERL],[perl],[perl],[no])
dnl Check for Perl modules that must be present to compile and
dnl test the Perl bindings.
missing_perl_modules=no
-for pm in Test::More Test::Pod Test::Pod::Coverage ExtUtils::MakeMaker; do
+for pm in Test::More Test::Pod Test::Pod::Coverage ExtUtils::MakeMaker IO::Stringy; do
AC_MSG_CHECKING([for $pm])
if ! perl -M$pm -e1 >/dev/null 2>&1; then
AC_MSG_RESULT([no])
diff --git a/perl/lib/Win/Hivex/Regedit.pm b/perl/lib/Win/Hivex/Regedit.pm
new file mode 100644
index 0000000..4be451d
--- /dev/null
+++ b/perl/lib/Win/Hivex/Regedit.pm
@@ -0,0 +1,649 @@
+# Win::Hivex::Regedit
+# Copyright (C) 2009-2010 Red Hat Inc.
+# Derived from code by Petter Nordahl-Hagen under a compatible license:
+# Copyright (c) 1997-2007 Petter Nordahl-Hagen.
+# Derived from code by Markus Stephany under a compatible license:
+# Copyright (c)2000-2004, Markus Stephany.
+#
+# This library is free software; you can redistribute it and/or
+# modify it under the terms of the GNU Lesser General Public
+# License as published by the Free Software Foundation; either
+# version 2 of the License, or (at your option) any later version.
+#
+# This library 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
+# Lesser General Public License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public
+# License along with this library; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+=pod
+
+=head1 NAME
+
+Win::Hivex::Regedit - Helper for reading and writing regedit format files
+
+=head1 SYNOPSIS
+
+ use Win::Hivex;
+ use Win::Hivex::Regedit qw(reg_import reg_export);
+
+ $h = Win::Hivex->open ('SOFTWARE', write => 1);
+
+ open FILE, "updates.reg";
+ reg_import ($h, \*FILE,
+ prefix => "HKEY_LOCAL_MACHINE\\SOFTWARE");
+ $h->commit ();
+
+ reg_export ($h, "\\Microsoft\\Windows NT\\CurrentVersion", $fh,
+ prefix => "HKEY_LOCAL_MACHINE\\SOFTWARE");
+
+=head1 DESCRIPTION
+
+Win::Hivex::Regedit is a helper library for reading and writing the
+Windows regedit (or C<.REG>) file format. This is the textual format
+that is commonly used on Windows for distributing groups of Windows
+Registry changes, and this format is read and written by the
+proprietary C<reg.exe> and C<regedit.exe> programs supplied with
+Windows. It is I<not> the same as the binary "hive" format which the
+hivex library itself can read and write. Note that the regedit format
+is not well-specified, and hence deviations can occur between what the
+Windows program can read/write and what we can read/write. (Please
+file bugs for any deviations found).
+
+Win::Hivex::Regedit is the low-level Perl library. There is also a
+command line tool for combining hive files and reg files
+(L<hivexreg(1)>). If you have a Windows virtual machine that you need
+to merge regedit-format changes into, use the high-level
+L<virt-win-reg(1)> tool (part of libguestfs tools).
+
+=head2 FUNCTIONS
+
+=cut
+
+package Win::Hivex::Regedit;
+
+use strict;
+use warnings;
+
+use Carp qw(croak confess);
+use Encode qw(encode);
+
+require Exporter;
+
+use vars qw(@EXPORT_OK @ISA);
+
+ at ISA = qw(Exporter);
+ at EXPORT_OK = qw(reg_import reg_export);
+
+=head2 reg_import
+
+ reg_import ($h, $fh, [prefix => $prefix],
+ [encoding => "UTF-16LE"]);
+
+This function imports the registry keys from file handle C<$fh> into
+the hive C<$h>.
+
+The hive handle C<$h> must have been opened for writing, ie.
+using the C<write =E<gt> 1> flag to C<Win::Hivex-E<gt>open>.
+
+Optionally (but almost always necessary) you should give a
+C<$prefix>. The prefix is stripped from registry key names
+which appear in the regedit file, in order to match them to
+how keys actually appear in the hive file. For example in
+the SOFTWARE hive, keys are conventionally named
+C<HKEY_LOCAL_MACHINE\SOFTWARE\SomeKey>, but in the hive
+file itself they appear as just C<\SomeKey>, so in this
+case you would set prefix to C<HKEY_LOCAL_MACHINE\SOFTWARE>.
+
+C<encoding> is the encoding used by default for strings. If not
+specified, this defaults to C<"UTF-16LE">, however we highly advise
+you to specify it. See L</ENCODING STRINGS> below.
+
+As with the regedit program, we merge the new registry keys with
+existing ones, and new node values with old ones. You can use the
+C<-> (minus) character to delete individual keys and values. This is
+explained in detail in the Wikipedia page on the Windows Registry.
+
+Remember you need to call C<$h-E<gt>commit> on the hivex handle before
+any changes are written to the hive file.
+See L<hivex(3)/WRITING TO HIVE FILES>.
+
+=cut
+
+sub reg_import
+{
+ local $_;
+ my $h = shift;
+ my $fh = shift;
+ my %params = @_;
+
+ my $encoding = $params{encoding} || "utf-16le";
+
+ my $state = "outer";
+ my $newnode;
+ my @newvalues;
+ my @delvalues;
+ my $lineno = 0;
+
+ while (<$fh>) {
+ # Join continuation lines. This is recipe 8.1 from the Perl
+ # Cookbook.
+ $lineno++;
+ chomp;
+ if (s/\\$//) {
+ $_ .= <$fh>;
+ redo unless eof ($fh);
+ }
+
+ #print STDERR "reg_import: parsing <<<$_>>>\n";
+
+ if ($state eq "outer") {
+ # Ignore blank lines, headers.
+ next if /^\s*$/;
+
+ # .* is needed before Windows Registry Editor Version.. in
+ # order to eat a possible Unicode BOM which regedit writes
+ # there.
+ next if /^.*Windows Registry Editor Version.*/;
+ next if /^REGEDIT/;
+
+ # Expect to see [...] or -[...]
+ # to merge or delete a node respectively.
+ if (/^\[(.*)\]\s*$/) {
+ $state = "inner";
+ $newnode = $1;
+ @newvalues = ();
+ @delvalues = ();
+ } elsif (/^-\[(.*)\]\s*$/) {
+ _delete_node ($h, \%params, $1);
+ $state = "outer";
+ } else {
+ croak (_unexpected ($_, $lineno));
+ }
+ } elsif ($state eq "inner") {
+ if (/^(".*)=-\s*$/) { # delete value
+ my $key = _parse_quoted_string ($_);
+ croak (_parse_error ($_, $lineno)) unless defined $key;
+ push @delvalues, $key;
+ } elsif (/^@=-\s*$/) { # delete default key
+ push @delvalues, "";
+ } elsif (/^".*"=/) { # ordinary value
+ my $value = _parse_key_value ($_, $encoding);
+ croak (_parse_error ($_, $lineno)) unless defined $value;
+ push @newvalues, $value;
+ } elsif (/^@=(.*)/) { # default key
+ my $value = _parse_value ("", $1, $encoding);
+ croak (_parse_error ($_, $lineno)) unless defined $value;
+ push @newvalues, $value;
+ } elsif (/^\s*$/) { # blank line after values
+ _merge_node ($h, \%params, $newnode, \@newvalues, \@delvalues);
+ $state = "outer";
+ } else {
+ croak (_unexpected ($_, $lineno));
+ }
+ }
+ } # while
+
+ # Still got a node left over to merge?
+ if ($state eq "inner") {
+ _merge_node ($h, \%params, $newnode, \@newvalues, \@delvalues);
+ }
+}
+
+sub _parse_key_value
+{
+ local $_ = shift;
+ my $encoding = shift;
+ my ($key, $_) = _parse_quoted_string ($_);
+ return undef unless defined $key;
+ return undef unless substr ($_, 0, 1) eq "=";
+ return _parse_value ($key, substr ($_, 1), $encoding);
+}
+
+# Parse a double-quoted string, returning the string. \ is used to
+# escape double-quotes and other backslash characters.
+#
+# If called in array context and if there is anything after the quoted
+# string, it is returned as the second element of the array.
+#
+# Returns undef if there was a parse error.
+sub _parse_quoted_string
+{
+ local $_ = shift;
+
+ # No initial quote character.
+ return undef if substr ($_, 0, 1) ne "\"";
+
+ my $i;
+ my $out = "";
+ for ($i = 1; $i < length; ++$i) {
+ my $c = substr ($_, $i, 1);
+ if ($c eq "\"") {
+ last
+ } elsif ($c eq "\\") {
+ $i++;
+ $c = substr ($_, $i, 1);
+ $out .= $c;
+ } else {
+ $out .= $c;
+ }
+ }
+
+ # No final quote character.
+ return undef if $i == length;
+
+ $_ = substr ($_, $i+1);
+ if (wantarray) {
+ return ($out, $_);
+ } else {
+ return $out;
+ }
+}
+
+# Parse the value, optionally prefixed by a type.
+
+sub _parse_value
+{
+ local $_;
+ my $key = shift;
+ $_ = shift;
+ my $encoding = shift; # default encoding for strings
+
+ my $type;
+ my $data;
+
+ if (m/^dword:([[:xdigit:]]{8})$/) { # DWORD
+ $type = 4;
+ $data = _dword_le (hex ($1));
+ } elsif (m/^hex:(.*)$/) { # hex digits
+ $type = 3;
+ $data = _data_from_hex_digits ($1);
+ return undef unless defined $data;
+ } elsif (m/^hex\(([[:xdigit:]]+)\):(.*)$/) { # hex digits
+ $type = hex ($1);
+ $data = _data_from_hex_digits ($2);
+ return undef unless defined $data;
+ } elsif (m/^str:(".*")$/) { # only in Wine fake-registries, I think
+ $type = 1;
+ $data = _parse_quoted_string ($1);
+ return undef unless defined $data;
+ $data = encode ($encoding, $data);
+ } elsif (m/^str\(([[:xdigit:]]+)\):(".*")$/) {
+ $type = hex ($1);
+ $data = _parse_quoted_string ($2);
+ return undef unless defined $data;
+ $data = encode ($encoding, $data);
+ } elsif (m/^(".*")$/) {
+ $type = 1;
+ $data = _parse_quoted_string ($1);
+ return undef unless defined $data;
+ $data = encode ($encoding, $data);
+ } else {
+ return undef;
+ }
+
+ my %h = ( key => $key, t => $type, value => $data );
+ return \%h;
+}
+
+sub _dword_le
+{
+ pack ("V", $_[0]);
+}
+
+sub _data_from_hex_digits
+{
+ local $_ = shift;
+ s/[,[:space:]]//g;
+ pack ("H*", $_)
+}
+
+sub _merge_node
+{
+ local $_;
+ my $h = shift;
+ my $params = shift;
+ my $path = shift;
+ my $newvalues = shift;
+ my $delvalues = shift;
+
+ # Remove prefix from the start of the new node name, matching
+ # case insensitively.
+ my $prefix = $params->{prefix};
+ if (defined $prefix) {
+ my $len = length $prefix;
+ if (length $path >= $len &&
+ lc (substr ($path, 0, $len)) eq lc ($prefix)) {
+ $path = substr ($path, $len);
+ }
+ }
+
+ my $node = _node_lookup ($h, $path);
+ if (!defined $node) { # Need to create this node.
+ my $name = $path;
+ $name = $1 if $path =~ /([^\\]+)$/;
+ my $parentpath = $path;
+ $parentpath =~ s/[^\\]+$//;
+ my $parent = _node_lookup ($h, $parentpath);
+ if (!defined $parent) {
+ confess "reg_import: cannot create $path since parent $parentpath does not exist"
+ }
+ $node = $h->node_add_child ($parent, $name);
+ }
+
+ # Get the current set of values at this node.
+ my @values = $h->node_values ($node);
+
+ # Delete values in @delvalues original and values that are going
+ # to be replaced.
+ my @delvalues = @$delvalues;
+ foreach (@$newvalues) {
+ push @delvalues, $_->{key};
+ }
+ @values = grep { ! _member ($h->value_key ($_), @$delvalues) } @values;
+
+ # Get the actual values from the hive.
+ @values = map {
+ my $key = $h->value_key ($_);
+ my ($type, $data) = $h->value_value ($_);
+ my %h = ( key => $key, t => $type, value => $data );
+ $_ = \%h;
+ } @values;
+
+ # Add the new values.
+ push @values, @$newvalues;
+
+ $h->node_set_values ($node, \@values);
+}
+
+sub _delete_node
+{
+ local $_;
+ my $h = shift;
+ my $params = shift;
+ my $path = shift;
+
+ # Remove prefix from the start of the path, matching
+ # case insensitively.
+ my $prefix = $params->{prefix};
+ if (defined $prefix) {
+ my $len = length $prefix;
+ if (length $path >= $len &&
+ lc (substr ($path, 0, $len)) eq lc ($prefix)) {
+ $path = substr ($path, $len);
+ }
+ }
+
+ my $node = _node_lookup ($h, $path);
+ # Not an error to delete a non-existant node.
+ return unless defined $node;
+
+ # However you cannot delete the root node.
+ confess "reg_import: the root node of a hive cannot be deleted"
+ if $node == $h->root ();
+
+ $h->node_delete_child ($node);
+}
+
+sub _member
+{
+ local $_;
+ my $item = shift;
+
+ foreach (@_) {
+ return 1 if $_ eq $item;
+ }
+ return 0;
+}
+
+sub _unexpected
+{
+ local $_ = shift;
+ my $lineno = shift;
+
+ "reg_import: parse error: unexpected text found at line $lineno near\n$_"
+}
+
+sub _parse_error
+{
+ local $_ = shift;
+ my $lineno = shift;
+
+ "reg_import: parse error: at line $lineno near\n$_"
+}
+
+=head2 reg_export
+
+ reg_export ($h, $key, $fh, [prefix => $prefix]);
+
+This function exports the registry keys starting at the root
+C<$key> and recursively downwards into the file handle C<$fh>.
+
+C<$key> is a case-insensitive path of the node to start from, relative
+to the root of the hive. It is an error if this path does not exist.
+Path elements should be separated by backslash characters.
+
+C<$prefix> is prefixed to each key name. The usual use for this is to
+make key names appear as they would on Windows. For example the key
+C<\Foo> in the SOFTWARE Registry, with $prefix
+C<HKEY_LOCAL_MACHINE\SOFTWARE>, would be written as:
+
+ [HKEY_LOCAL_MACHINE\SOFTWARE\Foo]
+ "Key 1"=...
+ "Key 2"=...
+
+The output is written as pure 7 bit ASCII, with line endings which are
+the default for the local host. You may need to convert the file's
+encoding using L<iconv(1)> and line endings using L<unix2dos(1)> if
+sending to a Windows user. Strings are always encoded as hex bytes.
+See L</ENCODING STRINGS> below.
+
+Nodes and keys are sorted alphabetically in the output.
+
+This function does I<not> print a header. The real regedit program
+will print a header like:
+
+ Windows Registry Editor Version 5.00
+
+followed by a blank line. (Other headers are possible, see the
+Wikipedia page on the Windows Registry). If you want a header, you
+need to write it out yourself.
+
+=cut
+
+sub reg_export
+{
+ my $h = shift;
+ my $key = shift;
+
+ my $node = _node_lookup ($h, $key);
+ croak "$key: path not found in this hive" unless $node;
+
+ reg_export_node ($h, $node, @_);
+}
+
+=head2 reg_export_node
+
+ reg_export_node ($h, $node, $fh, ...);
+
+This is exactly the same as L</reg_export> except that instead
+of specifying the path to a key as a string, you pass a hivex
+library C<$node> handle.
+
+=cut
+
+sub reg_export_node
+{
+ local $_;
+ my $h = shift;
+ my $node = shift;
+ my $fh = shift;
+ my %params = @_;
+
+ confess "reg_export_node: \$node parameter was undef" unless defined $node;
+
+ # Get the canonical path of this node.
+ my $path = _node_canonical_path ($h, $node);
+
+ # Print the path.
+ print $fh "[";
+ my $prefix = $params{prefix};
+ if (defined $prefix) {
+ chop $prefix if substr ($prefix, -1, 1) eq "\\";
+ print $fh $prefix;
+ }
+ print $fh $path;
+ print $fh "]\n";
+
+ # Get the values.
+ my @values = $h->node_values ($node);
+
+ foreach (@values) {
+ use bytes;
+
+ my $key = $h->value_key ($_);
+ my ($type, $data) = $h->value_value ($_);
+ $_ = { key => $key, type => $type, data => $data }
+ }
+
+ @values = sort { $a->{key} cmp $b->{key} } @values;
+
+ # Print the values.
+ foreach (@values) {
+ my $key = $_->{key};
+ my $type = $_->{type};
+ my $data = $_->{data};
+
+ if ($key eq "") {
+ print $fh '@=' # default key
+ } else {
+ print $fh '"', _escape_quotes ($key), '"='
+ }
+
+ if ($type eq 4 && length ($data) == 4) { # only handle dword specially
+ my $dword = unpack ("V", $data);
+ printf $fh "dword:%08x\n", $dword
+ } else {
+ # Encode everything else as hex, see encoding section below.
+ printf $fh "hex(%x):", $type;
+ my $hex = join (",", map { sprintf "%02x", ord } split (//, $data));
+ print $fh "$hex\n"
+ }
+ }
+ print $fh "\n";
+
+ my @children = $h->node_children ($node);
+ @children = sort { $h->node_name ($a) cmp $h->node_name ($b) } @children;
+ reg_export_node ($h, $_, $fh, @_) foreach @children;
+}
+
+# Escape " and \ when printing keys.
+sub _escape_quotes
+{
+ local $_ = shift;
+ s/\\/\\\\/g;
+ s/"/\\"/g;
+ $_;
+}
+
+# Look up a node in the registry starting from the path.
+# Return undef if it doesn't exist.
+
+sub _node_lookup
+{
+ local $_;
+ my $h = shift;
+ my $path = shift;
+
+ my @path = split /\\/, $path;
+ shift @path if @path > 0 && $path[0] eq "";
+
+ my $node = $h->root ();
+ foreach (@path) {
+ $node = $h->node_get_child ($node, $_);
+ return undef unless defined $node;
+ }
+
+ return $node;
+}
+
+# Return the canonical path of node in the hive.
+
+sub _node_canonical_path
+{
+ local $_;
+ my $h = shift;
+ my $node = shift;
+
+ return "\\" if $node == $h->root ();
+ $_ = $h->node_name ($node);
+ my $parent = $h->node_parent ($node);
+ my $path = _node_canonical_path ($h, $parent);
+ if ($path eq "\\") {
+ return "$path$_"
+ } else {
+ return "$path\\$_"
+ }
+}
+
+=head1 ENCODING STRINGS
+
+The situation with encoding strings in the Registry on Windows is very
+confused. There are two main encodings that you would find in the
+binary (hive) file, 7 bit ASCII and UTF-16LE. (Other encodings are
+possible, it's also possible to have arbitrary binary data incorrectly
+marked with a string type).
+
+The hive file itself doesn't contain any indication of string
+encoding. Windows probably guesses the encoding.
+
+We think that regedit probably either guesses which encoding to use
+based on the file encoding, or else has different defaults for
+different versions of Windows. Neither choice is appropriate for a
+tool used in a real operating system.
+
+When using L</reg_import>, you should specify the default encoding for
+strings using the C<encoding> parameter. If not specified, it
+defaults to UTF-16LE.
+
+The file itself that is imported should be in the local encoding for
+files (usually UTF-8 on modern Linux systems). This means if you
+receive a regedit file from a Windows system, you may sometimes have
+to reencode it:
+
+ iconv -f utf-16le -t utf-8 < input.reg | dos2unix > output.reg
+
+When writing regedit files (L</reg_export>) we bypass this madness
+completely. I<All> strings (even pure ASCII) are written as hex bytes
+so there is no doubt about how they should be encoded when they are
+read back in.
+
+=cut
+
+1;
+
+=head1 COPYRIGHT
+
+Copyright (C) 2010 Red Hat Inc.
+
+=head1 LICENSE
+
+Please see the file COPYING.LIB for the full license.
+
+=head1 SEE ALSO
+
+L<Win::Hivex(3)>,
+L<hivexreg(1)>,
+L<virt-win-reg(1)>,
+L<iconv(1)>,
+L<dos2unix(1)>,
+L<unix2dos(1)>,
+L<hivex(3)>,
+L<hivexsh(1)>,
+L<http://libguestfs.org>,
+L<Sys::Guestfs(3)>.
+
+=cut
diff --git a/perl/t/510-regedit-load.t b/perl/t/510-regedit-load.t
new file mode 100644
index 0000000..feebe42
--- /dev/null
+++ b/perl/t/510-regedit-load.t
@@ -0,0 +1,24 @@
+# Win::Hivex::Regedit tests -*- perl -*-
+# Copyright (C) 2010 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., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+use strict;
+use warnings;
+use Test::More tests => 1;
+
+BEGIN {
+ use_ok ("Win::Hivex::Regedit");
+}
diff --git a/perl/t/550-regedit-export.t b/perl/t/550-regedit-export.t
new file mode 100644
index 0000000..2099157
--- /dev/null
+++ b/perl/t/550-regedit-export.t
@@ -0,0 +1,102 @@
+# Win::Hivex::Regedit test -*- perl -*-
+# Copyright (C) 2010 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., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+use strict;
+use warnings;
+
+use Encode qw(from_to);
+use IO::Scalar;
+
+use Test::More tests => 8;
+
+use Win::Hivex;
+use Win::Hivex::Regedit qw(reg_export);
+
+my $srcdir = $ENV{srcdir} || ".";
+
+my $h = Win::Hivex->open ("$srcdir/../images/minimal", write => 1);
+ok ($h);
+
+my $root = $h->root ();
+ok ($root);
+
+$h->node_add_child ($root, "B");
+ok (1);
+
+$h->node_add_child ($root, "A");
+ok (1);
+
+my $b = $h->node_get_child ($root, "B");
+ok ($b);
+
+# Encode a string as UTF16-LE.
+sub utf16le
+{
+ my $s = shift;
+ from_to ($s, "ascii", "utf-16le");
+ $s;
+}
+
+# Convert a 32 bit integer to a little endian 4 byte data field.
+sub dwordle
+{
+ pack ("V", $_[0]);
+}
+
+my @values = (
+ # Values are entered in a random order here, but they should be
+ # sorted on export.
+ { key => "Key2", t => 2, value => utf16le ("DEF") },
+ { key => "", t => 1, value => "Default" },
+ { key => "Key3", t => 4, value => dwordle (0xff876543) },
+ { key => "Key1", t => 1, value => "ABC" },
+ );
+$h->node_set_values ($b, \@values);
+ok (1);
+
+my $fh = new IO::Scalar;
+reg_export ($h, "\\", $fh, prefix => "HKEY_LOCAL_MACHINE\\SOFTWARE\\");
+
+my $expected = '[HKEY_LOCAL_MACHINE\\SOFTWARE\\]
+
+[HKEY_LOCAL_MACHINE\\SOFTWARE\\A]
+
+[HKEY_LOCAL_MACHINE\\SOFTWARE\\B]
+@=hex(1):44,65,66,61,75,6c,74
+"Key1"=hex(1):41,42,43
+"Key2"=hex(2):44,00,45,00,46,00
+"Key3"=dword:ff876543
+
+';
+
+ok (${$fh->sref} eq $expected);
+
+$fh = new IO::Scalar;
+reg_export ($h, "\\B", $fh);
+
+$expected = '[\\B]
+@=hex(1):44,65,66,61,75,6c,74
+"Key1"=hex(1):41,42,43
+"Key2"=hex(2):44,00,45,00,46,00
+"Key3"=dword:ff876543
+
+';
+
+ok (${$fh->sref} eq $expected);
+
+# don't commit because that would overwrite the original file
+# $h->commit ();
diff --git a/perl/t/560-regedit-import.t b/perl/t/560-regedit-import.t
new file mode 100644
index 0000000..86127a8
--- /dev/null
+++ b/perl/t/560-regedit-import.t
@@ -0,0 +1,154 @@
+# Win::Hivex::Regedit test -*- perl -*-
+# Copyright (C) 2010 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., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+use strict;
+use warnings;
+
+use Encode qw(from_to);
+use IO::Scalar;
+
+use Test::More tests => 16;
+
+use Win::Hivex;
+use Win::Hivex::Regedit qw(reg_import reg_export);
+
+my $srcdir = $ENV{srcdir} || ".";
+
+my $h = Win::Hivex->open ("$srcdir/../images/minimal", write => 1);
+ok ($h);
+
+my ($data, $expected);
+
+# Note that we don't clear the hive between tests, so results of
+# next test depend on the previous test.
+
+$data = '
+[\A]
+
+[\B]
+
+[\C]
+"Key1"=hex(2):48,00,65,00,6c,00,6c,00,6f,00
+"Key2"=str(2):"Hello"
+"Key3"=hex:48,00,65,00,6c,00,6c,00,6f,00,\
+ 48,00,65,00,6c,00,6c,00,6f,00
+"Key4"=dword:ff123456';
+$expected = '[\]
+
+[\A]
+
+[\B]
+
+[\C]
+"Key1"=hex(2):48,00,65,00,6c,00,6c,00,6f,00
+"Key2"=hex(2):48,00,65,00,6c,00,6c,00,6f,00
+"Key3"=hex(3):48,00,65,00,6c,00,6c,00,6f,00,48,00,65,00,6c,00,6c,00,6f,00
+"Key4"=dword:ff123456
+
+';
+
+run_test ($data, $expected);
+
+$data = '
+[\A]
+@="Hello"
+
+-[\B]
+';
+$expected = '[\]
+
+[\A]
+@=hex(1):48,00,65,00,6c,00,6c,00,6f,00
+
+[\C]
+"Key1"=hex(2):48,00,65,00,6c,00,6c,00,6f,00
+"Key2"=hex(2):48,00,65,00,6c,00,6c,00,6f,00
+"Key3"=hex(3):48,00,65,00,6c,00,6c,00,6f,00,48,00,65,00,6c,00,6c,00,6f,00
+"Key4"=dword:ff123456
+
+';
+
+run_test ($data, $expected);
+
+$data = '
+[\A]
+@=-
+
+-[\C]
+
+[\A\B]
+';
+$expected = '[\]
+
+[\A]
+
+[\A\B]
+
+';
+
+run_test ($data, $expected);
+
+$data = '
+[\A]
+"NotExistant"=-
+
+[\A\B]
+"Key\"Containing\"Quotes"=hex(0):
+';
+$expected = '[\]
+
+[\A]
+
+[\A\B]
+"Key\"Containing\"Quotes"=hex(0):
+
+';
+
+run_test ($data, $expected);
+
+$data = '
+[\A\B]
+"Key\"Containing\"Quotes"=-
+
+-[\A]
+';
+$expected = '[\]
+
+';
+
+run_test ($data, $expected);
+
+#----------------------------------------------------------------------
+
+sub run_test {
+ my $data = shift;
+ my $expected = shift;
+
+ my $fh = new IO::Scalar \$data;
+ reg_import ($h, $fh);
+ ok (1);
+
+ $fh = new IO::Scalar;
+ reg_export ($h, "\\", $fh);
+ ok (1);
+
+ my $actual = ${$fh->sref};
+ warn "\n\n----- ACTUAL -----\n$actual\n----- EXPECTED -----\n$expected\n\n"
+ if $actual ne $expected;
+
+ ok ($actual eq $expected)
+}
diff --git a/perl/t/570-regedit-import2.t b/perl/t/570-regedit-import2.t
new file mode 100644
index 0000000..a952fb0
--- /dev/null
+++ b/perl/t/570-regedit-import2.t
@@ -0,0 +1,82 @@
+# Win::Hivex::Regedit test -*- perl -*-
+# Copyright (C) 2010 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., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+use strict;
+use warnings;
+
+use Encode qw(from_to);
+use IO::Scalar;
+
+use Test::More tests => 6;
+
+use Win::Hivex;
+use Win::Hivex::Regedit qw(reg_import reg_export);
+
+my $srcdir = $ENV{srcdir} || ".";
+
+my $h = Win::Hivex->open ("$srcdir/../images/minimal", write => 1);
+ok ($h);
+
+my $data;
+
+# Note: These tests are supposed to fail.
+
+# Need a blank line between sections.
+$data = '
+[A]
+[B]';
+run_test ($data);
+
+# Invalid header.
+$data = '
+[A]B';
+run_test ($data);
+
+# Must create intermediate nodes first.
+$data = '
+[A\B\C\D]';
+run_test ($data);
+
+# Invalid quoting.
+$data = '
+[A]
+"Quote"it"="Hello"';
+run_test ($data);
+
+$data = '
+[A]
+"Quote it\"="Hello"';
+run_test ($data);
+
+# Invalid hex -- fails, 'pack' processes it anyway.
+#$data = '
+#[A]
+#"Key"=hex(1):xy';
+#run_test ($data);
+
+#----------------------------------------------------------------------
+
+sub run_test {
+ my $data = shift;
+
+ eval {
+ my $fh = new IO::Scalar \$data;
+ reg_import ($h, $fh);
+ };
+ #warn "$@\n";
+ ok ($@);
+}
diff --git a/po/POTFILES.in b/po/POTFILES.in
index f806581..6ad1bcb 100644
--- a/po/POTFILES.in
+++ b/po/POTFILES.in
@@ -3,5 +3,6 @@ lib/hivex.c
ocaml/hivex_c.c
perl/Hivex.c
perl/lib/Win/Hivex.pm
+perl/lib/Win/Hivex/Regedit.pm
sh/hivexsh.c
xml/hivexml.c
--
1.6.6.1
More information about the Libguestfs
mailing list