Parse-Win32Registry-1.0/0000755000175000017500000000000011747225756014143 5ustar ownerownerParse-Win32Registry-1.0/META.yml0000644000175000017500000000122011747225756015407 0ustar ownerowner--- #YAML:1.0 name: Parse-Win32Registry version: 1.0 abstract: Parse Windows Registry Files author: - James Macfarlane license: perl distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: Carp: 0 Data::Dumper: 0 Encode: 0 File::Basename: 0 Test::More: 0 Time::Local: 0 no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.55_02 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Parse-Win32Registry-1.0/README0000644000175000017500000000165511747213110015007 0ustar ownerownerParse::Win32Registry ==================== Parse::Win32Registry is a module for parsing Windows Registry files, allowing you to read the keys and values of a registry file without going through the Windows API. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install On Win32 systems, you can use Microsoft's nmake. DEPENDENCIES Requires Perl 5.8.1 and the Carp, Encode, File::Basename and Time::Local modules. These are all core modules in 5.8.1. The tests require the Test::More and Data::Dumper modules. COPYRIGHT AND LICENCE Copyright (C) 2006-2012 by James Macfarlane This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Parse-Win32Registry-1.0/bin/0000755000175000017500000000000011747225756014713 5ustar ownerownerParse-Win32Registry-1.0/bin/regfind.pl0000755000175000017500000001011411747213110016643 0ustar ownerowner#!/usr/bin/perl use strict; use warnings; use Encode; use File::Basename; use Getopt::Long; use Parse::Win32Registry qw(:REG_ hexdump); binmode(STDOUT, ':utf8'); Getopt::Long::Configure('bundling'); GetOptions('key|k' => \my $search_keys, 'value|v' => \my $search_values, 'data|d' => \my $search_data, 'type|t' => \my $search_type, 'hexdump|x' => \my $show_hexdump); my $filename = shift or die usage(); my $regexp = shift or die usage(); if (!$search_keys && !$search_values && !$search_data && !$search_type) { warn usage(); die "\nYou need to specify at least one of -k, -v, -d, or -t\n"; } my $registry = Parse::Win32Registry->new($filename) or die "'$filename' is not a registry file\n"; my $root_key = $registry->get_root_key or die "Could not get root key of '$filename'\n"; traverse($root_key); sub traverse { my $key = shift; my $matching_key = ""; my %matching_values = (); if ($search_keys && $key->get_name =~ /$regexp/oi) { $matching_key = $key; } if ($search_values || $search_data || $search_type) { foreach my $value ($key->get_list_of_values) { if ($search_type && $value->get_type_as_string =~ /$regexp/oi) { $matching_key = $key; $matching_values{$value->get_name} = $value; } if ($search_values && $value->get_name =~ /$regexp/oi) { $matching_key = $key; $matching_values{$value->get_name} = $value; } if ($search_data && defined($value->get_data)) { if ($value->get_type_as_string =~ /SZ$/) { { no warnings; # hide malformed UTF-8 warnings if ($value->get_data =~ /$regexp/oi) { $matching_key = $key; $matching_values{$value->get_name} = $value; } } } elsif ($value->get_type == REG_DWORD) { if ($value->get_data_as_string =~ /$regexp/oi) { $matching_key = $key; $matching_values{$value->get_name} = $value; } } else { if ($value->get_data =~ /$regexp/o) { $matching_key = $key; $matching_values{$value->get_name} = $value; } no warnings; # hide malformed UTF-8 warnings if (decode("UCS-2LE", $value->get_raw_data) =~ /$regexp/oi) { $matching_key = $key; $matching_values{$value->get_name} = $value; } } } } } if ($matching_key) { print $matching_key->get_path, "\n"; foreach my $name (keys %matching_values) { my $value = $matching_values{$name}; if (!$show_hexdump) { print $value->as_string, "\n"; } else { my $value_name = $value->get_name; $value_name = "(Default)" if $value_name eq ""; my $value_type = $value->get_type_as_string; print "$value_name ($value_type):\n"; print hexdump($value->get_raw_data); } } print "\n" if $search_values || $search_type || $search_data; } foreach my $subkey ($key->get_list_of_subkeys) { traverse($subkey); } } sub usage { my $script_name = basename $0; return < [-k] [-v] [-d] [-t] [-x] -k or --key search key names for a match -v or --value search value names for a match -d or --data search value data for a match -t or --type search value types for a match -x or --hexdump display value data as a hex dump USAGE } Parse-Win32Registry-1.0/bin/regclassnames.pl0000755000175000017500000000220311747213110020054 0ustar ownerowner#!/usr/bin/perl use strict; use warnings; use File::Basename; use Parse::Win32Registry 0.41; binmode(STDOUT, ':utf8'); my $filename = shift or die usage(); my $initial_key_path = shift; my $registry = Parse::Win32Registry->new($filename) or die "'$filename' is not a registry file\n"; my $root_key = $registry->get_root_key or die "Could not get root key of '$filename'\n"; if (defined($initial_key_path)) { $root_key = $root_key->get_subkey($initial_key_path); if (!defined($root_key)) { die "Could not locate the key '$initial_key_path' in '$filename'\n"; } } traverse($root_key); sub traverse { my $key = shift; if (my $class_name = $key->get_class_name) { print $key->get_path, " \"$class_name\"\n"; } foreach my $subkey ($key->get_list_of_subkeys) { traverse($subkey); } } sub usage { my $script_name = basename $0; return < [subkey] USAGE } Parse-Win32Registry-1.0/bin/gtkregscope.pl0000755000175000017500000004051711747213110017554 0ustar ownerowner#!/usr/bin/perl use strict; use warnings; use Glib ':constants'; use Gtk2 -init; my $window_width = 600; my $window_height = 400; use Encode; use File::Basename; use Parse::Win32Registry 0.60 qw(:REG_); binmode(STDOUT, ':utf8'); my $script_name = basename $0; ### LIST VIEW FOR BLOCK use constant { COLUMN_BLOCK_OFFSET => 0, COLUMN_BLOCK_LENGTH => 1, COLUMN_BLOCK_TAG => 2, COLUMN_BLOCK_OBJECT => 3, }; my $block_store = Gtk2::ListStore->new( 'Glib::String','Glib::String', 'Glib::String', 'Glib::Scalar', ); my $block_view = Gtk2::TreeView->new($block_store); my $hbin_column1 = Gtk2::TreeViewColumn->new_with_attributes( 'Block', Gtk2::CellRendererText->new, 'text', COLUMN_BLOCK_OFFSET, ); $block_view->append_column($hbin_column1); $hbin_column1->set_resizable(TRUE); my $hbin_column2 = Gtk2::TreeViewColumn->new_with_attributes( 'Length', Gtk2::CellRendererText->new, 'text', COLUMN_BLOCK_LENGTH, ); $block_view->append_column($hbin_column2); $hbin_column2->set_resizable(TRUE); my $hbin_column3 = Gtk2::TreeViewColumn->new_with_attributes( 'Tag', Gtk2::CellRendererText->new, 'text', COLUMN_BLOCK_TAG, ); $block_view->append_column($hbin_column3); $hbin_column3->set_resizable(TRUE); my $block_selection = $block_view->get_selection; $block_selection->set_mode('browse'); $block_selection->signal_connect('changed' => \&block_selection_changed); my $scrolled_block_view = Gtk2::ScrolledWindow->new; $scrolled_block_view->set_policy('automatic', 'automatic'); $scrolled_block_view->set_shadow_type('in'); $scrolled_block_view->add($block_view); ### LIST VIEW FOR ENTRY use constant { COLUMN_ENTRY_OFFSET => 0, COLUMN_ENTRY_LENGTH => 1, COLUMN_ENTRY_TAG => 2, COLUMN_ENTRY_NAME => 3, COLUMN_ENTRY_ALLOC => 4, COLUMN_ENTRY_COLOR => 5, COLUMN_ENTRY_OBJECT => 6, }; my $entry_store = Gtk2::ListStore->new( 'Glib::String', 'Glib::String', 'Glib::String', 'Glib::String', 'Glib::String', 'Glib::String', 'Glib::Scalar', 'Glib::String', ); my $entry_view = Gtk2::TreeView->new($entry_store); my $entry_column0 = Gtk2::TreeViewColumn->new_with_attributes( 'Entry', my $entry_cell0 = Gtk2::CellRendererText->new, 'text', COLUMN_ENTRY_OFFSET, 'background', COLUMN_ENTRY_COLOR, ); $entry_view->append_column($entry_column0); $entry_column0->set_resizable(TRUE); my $entry_column1 = Gtk2::TreeViewColumn->new_with_attributes( 'Length', Gtk2::CellRendererText->new, 'text', COLUMN_ENTRY_LENGTH, 'background', COLUMN_ENTRY_COLOR, ); $entry_view->append_column($entry_column1); $entry_column1->set_resizable(TRUE); my $entry_column2 = Gtk2::TreeViewColumn->new_with_attributes( 'Alloc.', Gtk2::CellRendererText->new, 'text', COLUMN_ENTRY_ALLOC, 'background', COLUMN_ENTRY_COLOR, ); $entry_view->append_column($entry_column2); $entry_column2->set_resizable(TRUE); my $entry_column3 = Gtk2::TreeViewColumn->new_with_attributes( 'Tag', Gtk2::CellRendererText->new, 'text', COLUMN_ENTRY_TAG, 'background', COLUMN_ENTRY_COLOR, ); $entry_view->append_column($entry_column3); $entry_column3->set_resizable(TRUE); my $entry_column4 = Gtk2::TreeViewColumn->new_with_attributes( 'Name', Gtk2::CellRendererText->new, 'text', COLUMN_ENTRY_NAME, 'background', COLUMN_ENTRY_COLOR, ); $entry_view->append_column($entry_column4); $entry_column4->set_resizable(TRUE); my $entry_selection = $entry_view->get_selection; $entry_selection->set_mode('browse'); $entry_selection->signal_connect('changed' => \&entry_selection_changed); my $scrolled_entry_view = Gtk2::ScrolledWindow->new; $scrolled_entry_view->set_policy('automatic', 'automatic'); $scrolled_entry_view->set_shadow_type('in'); $scrolled_entry_view->add($entry_view); ### TEXT VIEW my $text_view = Gtk2::TextView->new; $text_view->set_editable(FALSE); $text_view->modify_font(Gtk2::Pango::FontDescription->from_string('monospace')); my $text_buffer = $text_view->get_buffer; my $scrolled_text_view = Gtk2::ScrolledWindow->new; $scrolled_text_view->set_policy('automatic', 'automatic'); $scrolled_text_view->set_shadow_type('in'); $scrolled_text_view->add($text_view); ### HPANED my $hpaned = Gtk2::HPaned->new; $hpaned->pack1($scrolled_block_view, FALSE, FALSE); $hpaned->pack2($scrolled_entry_view, TRUE, FALSE); $hpaned->set_position($window_width / 3); ### VPANED my $vpaned = Gtk2::VPaned->new; $vpaned->pack1($hpaned, FALSE, FALSE); $vpaned->pack2($scrolled_text_view, FALSE, FALSE); ### UIMANAGER my $uimanager = Gtk2::UIManager->new; my @actions = ( # name, stock id, label ['FileMenu', undef, '_File'], ['SearchMenu', undef, '_Search'], ['ViewMenu', undef, '_View'], ['HelpMenu', undef, '_Help'], # name, stock-id, label, accelerator, tooltip, callback ['Open', 'gtk-open', '_Open...', 'O', undef, \&open_file], ['Close', 'gtk-close', '_Close', 'W', undef, \&close_file], ['Quit', 'gtk-quit', '_Quit', 'Q', undef, \&quit], ['Find', 'gtk-find', '_Find...', 'F', undef, \&find], ['FindNext', undef, 'Find _Next', 'G', undef, \&find_next], ['FindNext2', undef, undef, 'F3', undef, \&find_next], ['GoTo', 'gtk-index', '_Go To Offset...', 'I', undef, \&go_to_offset], ['About', 'gtk-about', '_About...', undef, undef, \&about], ); my $default_actions = Gtk2::ActionGroup->new('actions'); $default_actions->add_actions(\@actions, undef); $uimanager->insert_action_group($default_actions, 0); my $ui_info = < END_OF_UI $uimanager->add_ui_from_string($ui_info); my $menubar = $uimanager->get_widget('/MenuBar'); ### STATUSBAR my $statusbar = Gtk2::Statusbar->new; ### VBOX my $main_vbox = Gtk2::VBox->new(FALSE, 0); $main_vbox->pack_start($menubar, FALSE, FALSE, 0); $main_vbox->pack_start($vpaned, TRUE, TRUE, 0); $main_vbox->pack_start($statusbar, FALSE, FALSE, 0); ### WINDOW my $window = Gtk2::Window->new; $window->set_default_size($window_width, $window_height); $window->set_position('center'); $window->signal_connect(destroy => sub { Gtk2->main_quit }); $window->add($main_vbox); $window->add_accel_group($uimanager->get_accel_group); $window->set_title($script_name); $window->show_all; ### GLOBALS my $registry; my $last_dir; my $find_param = ''; my $find_iter; my $filename = shift; if (defined $filename && -r $filename) { load_file($filename); } Gtk2->main; ############################################################################### sub load_entries { my $block = shift; $entry_store->clear; my $entry_iter = $block->get_entry_iterator; while (my $entry = $entry_iter->get_next) { my $iter = $entry_store->append; my $tag = $entry->get_tag; my $offset = $entry->get_offset; # colorize each row according to its tag my $color; if ($tag eq 'nk' || $tag eq 'rgkn key' || $tag eq 'rgdb key') { $color = '#ffb0b0'; # red } elsif ($tag eq 'sk') { $color = '#b0ffff'; # cyan } elsif ($tag eq 'vk' || $tag eq 'rgdb value') { $color = '#b0ffb0'; # green } elsif ($tag eq 'lh' || $tag eq 'lf' || $tag eq 'li' || $tag eq 'ri') { $color = '#ffb0ff'; # magenta } else { $color = '#f0f0f0'; # grey } my $name = $entry->can('get_name') ? $entry->get_name : ''; $name =~ s/\0/[NUL]/g; $entry_store->set($iter, COLUMN_ENTRY_OFFSET, sprintf("0x%x", $offset), COLUMN_ENTRY_LENGTH, sprintf("0x%x", $entry->get_length), COLUMN_ENTRY_TAG, $tag, COLUMN_ENTRY_ALLOC, $entry->is_allocated, COLUMN_ENTRY_NAME, $name, COLUMN_ENTRY_COLOR, $color, COLUMN_ENTRY_OBJECT, $entry); } } sub block_selection_changed { my ($model, $iter) = $block_selection->get_selected; if (!defined $model || !defined $iter) { return; } my $block = $model->get($iter, COLUMN_BLOCK_OBJECT); my $parse_info = $block->parse_info; my $str = $parse_info . "\n" . $block->unparsed; $text_buffer->set_text($str); my $status = sprintf "Block Offset: 0x%x", $block->get_offset; $statusbar->pop(0); $statusbar->push(0, $status); load_entries($block); } sub entry_selection_changed { my ($model, $iter) = $entry_selection->get_selected; if (!defined $model || !defined $iter) { return; } my $entry = $model->get($iter, COLUMN_ENTRY_OBJECT); my $parse_info = $entry->parse_info; $parse_info =~ s/\0/[NUL]/g; my $str = $parse_info . "\n" . $entry->unparsed; $text_buffer->set_text($str); my $status = sprintf "Entry Offset: 0x%x", $entry->get_offset; $statusbar->pop(0); $statusbar->push(0, $status); } sub show_message { my $type = shift; my $message = shift; my $dialog = Gtk2::MessageDialog->new( $window, 'destroy-with-parent', $type, 'ok', $message, ); $dialog->set_title(ucfirst $type); $dialog->run; $dialog->destroy; } sub load_file { my $filename = shift; my ($name, $path) = fileparse($filename); close_file(); if (!-r $filename) { show_message('error', "Unable to open '$name'."); } elsif ($registry = Parse::Win32Registry->new($filename)) { if (my $root_key = $registry->get_root_key) { $window->set_title("$name - $script_name"); my $block_iter = $registry->get_block_iterator; while (my $block = $block_iter->get_next) { my $iter = $block_store->append; $block_store->set($iter, COLUMN_BLOCK_OFFSET, sprintf("0x%x", $block->{_offset}), COLUMN_BLOCK_LENGTH, sprintf("0x%x", $block->get_length), COLUMN_BLOCK_TAG, $block->get_tag, COLUMN_BLOCK_OBJECT, $block); } } } else { show_message('error', "'$name' is not a registry file."); } } sub choose_file { my ($title, $type, $suggested_name) = @_; my $file_chooser = Gtk2::FileChooserDialog->new( $title, undef, $type, 'gtk-cancel' => 'cancel', 'gtk-ok' => 'ok', ); if ($type eq 'save') { $file_chooser->set_current_name($suggested_name); } if (defined $last_dir) { $file_chooser->set_current_folder($last_dir); } my $response = $file_chooser->run; my $filename; if ($response eq 'ok') { $filename = $file_chooser->get_filename; } $last_dir = $file_chooser->get_current_folder; $file_chooser->destroy; return $filename; } sub open_file { my $filename = choose_file('Select Registry File', 'open'); if (defined $filename) { load_file($filename); } } sub close_file { $block_store->clear; $entry_store->clear; $registry = undef; $text_buffer->set_text(''); $statusbar->pop(0); } sub quit { $window->destroy; } sub about { Gtk2->show_about_dialog(undef, 'program-name' => $script_name, 'version' => $Parse::Win32Registry::VERSION, 'copyright' => 'Copyright (c) 2009-2012 James Macfarlane', 'comments' => 'GTK2 Registry Scope for the Parse::Win32Registry module', ); } sub go_to_block { my ($offset) = @_; my $iter = $block_store->get_iter_first; while (defined $iter) { my $block = $block_store->get($iter, COLUMN_BLOCK_OBJECT); my $block_start = $block->get_offset; my $block_end = $block_start + $block->get_length; if ($offset >= $block_start && $offset < $block_end) { my $tree_path = $block_store->get_path($iter); $block_view->expand_to_path($tree_path); $block_view->scroll_to_cell($tree_path); $block_view->set_cursor($tree_path); $window->set_focus($block_view); return; } $iter = $block_store->iter_next($iter); } } sub go_to_entry { my ($offset) = @_; my $iter = $entry_store->get_iter_first; while (defined $iter) { my $entry = $entry_store->get($iter, COLUMN_ENTRY_OBJECT); my $entry_start = $entry->get_offset; my $entry_end = $entry_start + $entry->get_length; if ($offset >= $entry_start && $offset < $entry_end) { my $tree_path = $entry_store->get_path($iter); $entry_view->expand_to_path($tree_path); $entry_view->scroll_to_cell($tree_path); $entry_view->set_cursor($tree_path); $window->set_focus($entry_view); return; } $iter = $entry_store->iter_next($iter); } } sub find_next { if (!defined $find_param || !defined $find_iter) { return; } # Build find next dialog my $label = Gtk2::Label->new; $label->set_text("Searching registry entries..."); my $dialog = Gtk2::Dialog->new('Find', $window, 'modal', 'gtk-cancel' => 'cancel', ); $dialog->vbox->pack_start($label, TRUE, TRUE, 5); $dialog->set_default_response('cancel'); $dialog->show_all; my $id = Glib::Idle->add(sub { my $entry = $find_iter->get_next; if (defined $entry) { my $found = 0; if (index(lc $entry->get_raw_bytes, lc $find_param) > -1) { $found = 1; } else { my $uni_find_param = encode("UCS-2LE", $find_param); if (index(lc $entry->get_raw_bytes, lc $uni_find_param) > -1) { $found = 1; } } if ($found) { go_to_block($entry->get_offset); go_to_entry($entry->get_offset); $dialog->response(50); return FALSE; } return TRUE; # continue searching... } $dialog->response('ok'); return FALSE; }); my $response = $dialog->run; $dialog->destroy; if ($response eq 'cancel' || $response eq 'delete-event') { Glib::Source->remove($id); } elsif ($response eq 'ok') { show_message('info', 'Finished searching.'); } } sub find { return if !defined $registry; my $label = Gtk2::Label->new('Enter text to search for:'); $label->set_alignment(0, 0); my $entry = Gtk2::Entry->new; $entry->set_text($find_param); $entry->set_activates_default(TRUE); my $dialog = Gtk2::Dialog->new('Find', $window, 'modal', 'gtk-cancel' => 'cancel', 'gtk-ok' => 'ok', ); $dialog->vbox->set_spacing(5); $dialog->vbox->pack_start($label, FALSE, TRUE, 0); $dialog->vbox->pack_start($entry, FALSE, TRUE, 0); $dialog->set_default_response('ok'); $dialog->show_all; my $response = $dialog->run; if ($response eq 'ok') { $find_param = $entry->get_text; $dialog->destroy; $find_iter = undef; if ($find_param ne '') { $find_iter = $registry->get_entry_iterator; find_next; } } else { $dialog->destroy; } } sub go_to_offset { return if !defined $registry; my $entry = Gtk2::Entry->new; $entry->set_activates_default(TRUE); my $dialog = Gtk2::Dialog->new('Go To Offset', $window, 'modal', 'gtk-cancel' => 'cancel', 'gtk-ok' => 'ok', ); $dialog->vbox->pack_start($entry, TRUE, TRUE, 5); $dialog->set_default_response('ok'); $dialog->show_all; $entry->prepend_text("0x"); $entry->set_position(-1); my $response = $dialog->run; my $answer = $entry->get_text; $dialog->destroy; if ($response ne 'ok') { return; } my $offset; eval { if ($answer =~ m/^\s*0x[\da-fA-F]+\s*$/ || $answer =~ m/^\s*\d+\s*$/) { $offset = int(eval $answer); } }; if (defined $offset && $offset < $registry->get_length) { go_to_block($offset); go_to_entry($offset); } } Parse-Win32Registry-1.0/bin/regsecurity.pl0000755000175000017500000000256211747213110017602 0ustar ownerowner#!/usr/bin/perl use strict; use warnings; use File::Basename; use Parse::Win32Registry 0.50; binmode(STDOUT, ':utf8'); my $filename = shift or die usage(); my $registry = Parse::Win32Registry->new($filename) or die "'$filename' is not a registry file\n"; my $root_key = $registry->get_root_key or die "Could not get root key of '$filename'\n"; # Use the root key to get the first security entry my $security = $root_key->get_security or die "Root key of '$filename' does not have any security information\n"; my %offsets_seen = (); my $offset = $security->get_offset; while (!exists $offsets_seen{$offset}) { $offsets_seen{$offset} = undef; # value not required printf "Security at offset 0x%x, %d references\n", $offset, $security->get_reference_count; my $sd = $security->get_security_descriptor; print $sd->as_stanza; print "\n"; $security = $security->get_next; if (!defined $security) { die "Unable to get next security entry\n"; } $offset = $security->get_offset; } sub usage { my $script_name = basename $0; return < USAGE } Parse-Win32Registry-1.0/bin/gtkregview.pl0000755000175000017500000005630411747213110017416 0ustar ownerowner#!/usr/bin/perl use strict; use warnings; use Glib ':constants'; use Gtk2 -init; my $window_width = 600; my $window_height = 400; use File::Basename; use File::Spec; use Parse::Win32Registry 0.51 qw(hexdump); binmode(STDOUT, ':utf8'); my $script_name = basename $0; ### LIST VIEW my $list_store = Gtk2::ListStore->new( 'Glib::String', 'Glib::String', 'Glib::String', 'Glib::Scalar', ); # 0 = list store name (value name) # 1 = list store type (value timestamp) # 2 = list store data (value class name) # 3 = list store value (value object) my $list_view = Gtk2::TreeView->new($list_store); my @list_column_names = qw(Name Type Data); for (my $col = 0; $col < @list_column_names; $col++) { my $text_cell = Gtk2::CellRendererText->new; if ($col == 2) { $text_cell->set('ellipsize', 'end'); } my $column = Gtk2::TreeViewColumn->new_with_attributes( $list_column_names[$col], $text_cell, 'text', $col); $list_view->append_column($column); $column->set_resizable(TRUE); $list_store->set_sort_func($col, sub { my ($model, $itera, $iterb, $col) = @_; my $a = $model->get($itera, $col); my $b = $model->get($iterb, $col); $a = '' if !defined $a; $b = '' if !defined $b; return $a cmp $b; }, $col); $column->set_sort_column_id($col); } $list_view->set_rules_hint(TRUE); my $list_selection = $list_view->get_selection; $list_selection->set_mode('browse'); $list_selection->signal_connect('changed' => \&value_selected); my $scrolled_list_view = Gtk2::ScrolledWindow->new; $scrolled_list_view->set_policy('automatic', 'automatic'); $scrolled_list_view->set_shadow_type('in'); $scrolled_list_view->add($list_view); ### TEXT VIEW my $text_view = Gtk2::TextView->new; $text_view->set_editable(FALSE); $text_view->modify_font(Gtk2::Pango::FontDescription->from_string('monospace')); my $text_buffer = $text_view->get_buffer; my $scrolled_text_view = Gtk2::ScrolledWindow->new; $scrolled_text_view->set_policy('automatic', 'automatic'); $scrolled_text_view->set_shadow_type('in'); $scrolled_text_view->add($text_view); ### VPANED my $vpaned = Gtk2::VPaned->new; $vpaned->pack1($scrolled_list_view, FALSE, FALSE); $vpaned->pack2($scrolled_text_view, FALSE, FALSE); ### TREE VIEW my $tree_store = Gtk2::TreeStore->new( 'Glib::String', 'Glib::String', 'Glib::String', 'Glib::Scalar', ); # 0 = tree store name (key name) # 1 = tree store timestamp (key timestamp) # 2 = tree store class name (key class name) # 3 = tree store key (key object) my $tree_view = Gtk2::TreeView->new($tree_store); my @tree_columns; my @tree_column_names = ('Name', 'Timestamp', 'Class Name'); for (my $col = 0; $col < @tree_column_names; $col++) { my $column = Gtk2::TreeViewColumn->new; if ($col == 0) { my $icon_cell = Gtk2::CellRendererPixbuf->new; $icon_cell->set('stock-id', 'gtk-directory'); $column->pack_start($icon_cell, FALSE); } my $text_cell = Gtk2::CellRendererText->new; $column->pack_start($text_cell, TRUE); $column->set_attributes($text_cell, 'text', $col); $column->set_title($tree_column_names[$col]); $column->set_resizable(TRUE); $tree_view->append_column($column); push @tree_columns, $column; $tree_store->set_sort_func($col, sub { my ($model, $itera, $iterb, $col) = @_; my $a = $model->get($itera, $col); my $b = $model->get($iterb, $col); $a = '' if !defined $a; $b = '' if !defined $b; return $a cmp $b; }, $col); $column->set_sort_column_id($col); } $tree_view->set_rules_hint(TRUE); # row-expanded when row is expanded (e.g. after user clicks on arrow) $tree_view->signal_connect('row-expanded' => \&expand_row); $tree_view->signal_connect('row-collapsed' => \&collapse_row); # row-activated when user double clicks on row $tree_view->signal_connect('row-activated' => \&activate_row); my $tree_selection = $tree_view->get_selection; $tree_selection->set_mode('browse'); $tree_selection->signal_connect('changed' => \&key_selected); my $scrolled_tree_view = Gtk2::ScrolledWindow->new; $scrolled_tree_view->set_policy('automatic', 'automatic'); $scrolled_tree_view->set_shadow_type('in'); $scrolled_tree_view->add($tree_view); ### HPANED my $hpaned = Gtk2::HPaned->new; $hpaned->pack1($scrolled_tree_view, FALSE, FALSE); $hpaned->pack2($vpaned, TRUE, FALSE); $hpaned->set_position($window_width * 0.3); ### MENU use Gtk2::Gdk::Keysyms; my $menubar = Gtk2::MenuBar->new; my $accel_group = Gtk2::AccelGroup->new; # File Menu my $open_menuitem = Gtk2::MenuItem->new('_Open...'); $open_menuitem->signal_connect('activate' => \&open_file); $open_menuitem->add_accelerator('activate', $accel_group, $Gtk2::Gdk::Keysyms{O}, ['control-mask'], ['visible', 'locked']); my $close_menuitem = Gtk2::MenuItem->new('_Close'); $close_menuitem->signal_connect('activate' => \&close_file); $close_menuitem->add_accelerator('activate', $accel_group, $Gtk2::Gdk::Keysyms{W}, ['control-mask'], ['visible', 'locked']); my $quit_menuitem = Gtk2::MenuItem->new('_Quit'); $quit_menuitem->signal_connect('activate' => \&quit); $quit_menuitem->add_accelerator('activate', $accel_group, $Gtk2::Gdk::Keysyms{Q}, ['control-mask'], ['visible', 'locked']); my $file_menu = Gtk2::Menu->new; $file_menu->append($open_menuitem); $file_menu->append($close_menuitem); $file_menu->append(Gtk2::SeparatorMenuItem->new); $file_menu->append($quit_menuitem); $file_menu->set_accel_group($accel_group); # Edit Menu my $copy_menuitem = Gtk2::MenuItem->new('_Copy Key Path'); $copy_menuitem->signal_connect('activate' => \©_key_path); $copy_menuitem->add_accelerator('activate', $accel_group, $Gtk2::Gdk::Keysyms{C}, ['control-mask'], ['visible', 'locked']); my $edit_menu = Gtk2::Menu->new; $edit_menu->append($copy_menuitem); # Search Menu my $find_menuitem = Gtk2::MenuItem->new('_Find...'); $find_menuitem->signal_connect('activate' => \&find); $find_menuitem->add_accelerator('activate', $accel_group, $Gtk2::Gdk::Keysyms{F}, ['control-mask'], ['visible', 'locked']); my $find_next_menuitem = Gtk2::MenuItem->new('Find _Next'); $find_next_menuitem->signal_connect('activate' => \&find_next); $find_next_menuitem->add_accelerator('activate', $accel_group, $Gtk2::Gdk::Keysyms{G}, ['control-mask'], ['visible', 'locked']); $find_next_menuitem->add_accelerator('activate', $accel_group, $Gtk2::Gdk::Keysyms{F3}, [], ['visible', 'locked']); my $search_menu = Gtk2::Menu->new; $search_menu->append($find_menuitem); $search_menu->append($find_next_menuitem); # Help Menu my $about_menuitem = Gtk2::MenuItem->new('_About...'); $about_menuitem->signal_connect('activate' => \&about); my $help_menu = Gtk2::Menu->new; $help_menu->append($about_menuitem); # Menu Bar my $file_menuitem = Gtk2::MenuItem->new('_File'); $file_menuitem->set_submenu($file_menu); $menubar->append($file_menuitem); my $edit_menuitem = Gtk2::MenuItem->new('_Edit'); $edit_menuitem->set_submenu($edit_menu); $menubar->append($edit_menuitem); my $search_menuitem = Gtk2::MenuItem->new('_Search'); $search_menuitem->set_submenu($search_menu); $menubar->append($search_menuitem); my $help_menuitem = Gtk2::MenuItem->new('_Help'); $help_menuitem->set_submenu($help_menu); $menubar->append($help_menuitem); ### STATUSBAR my $statusbar = Gtk2::Statusbar->new; ### VBOX my $main_vbox = Gtk2::VBox->new(FALSE, 0); $main_vbox->pack_start($menubar, FALSE, FALSE, 0); $main_vbox->pack_start($hpaned, TRUE, TRUE, 0); $main_vbox->pack_start($statusbar, FALSE, FALSE, 0); ### WINDOW my $window = Gtk2::Window->new; $window->set_default_size($window_width, $window_height); $window->set_position('center'); $window->signal_connect(destroy => sub { Gtk2->main_quit }); $window->add($main_vbox); $window->add_accel_group($accel_group); $window->set_title($script_name); $window->show_all; ### GLOBALS my $search_keys = TRUE; my $search_values = TRUE; my $search_selected = 0; my $find_param = ''; my $find_iter; my $last_dir; my $filename = shift; if (defined $filename && -r $filename) { $filename = File::Spec->rel2abs($filename); load_file($filename); } Gtk2->main; ############################################################################### sub key_selected { my ($model, $iter) = $tree_selection->get_selected; if (!defined $model || !defined $iter) { return; } my $key = $model->get($iter, 3); # Fill list with the values of this key $list_store->clear; my @values = $key->get_list_of_values; foreach my $value (@values) { my $name = $value->get_name; $name = '(Default)' if $name eq ''; $name =~ s/\0/[NUL]/g; my $type = $value->get_type_as_string; my $data = $value->get_data_as_string; $data =~ s/\0/[NUL]/g; # Abbreviate very long data to avoid a performance hit # from loading large strings into the model $data = substr($data, 0, 500); my $iter = $list_store->append; $list_store->set($iter, 0, $name, 1, $type, 2, $data, 3, $value); } my $clipboard = Gtk2::Clipboard->get(Gtk2::Gdk->SELECTION_PRIMARY); $clipboard->set_text($key->get_path); # Display key information: my $str = ''; my $security = $key->get_security; if (defined $security) { my $sd = $security->get_security_descriptor; $str .= $sd->as_stanza; } my $text_buffer = $text_view->get_buffer; $text_buffer->set_text($str); $statusbar->pop(0); my $key_path = $key->get_path; $key_path =~ s/\0/[NUL]/g; $statusbar->push(0, $key_path); } sub value_selected { my ($model, $iter) = $list_selection->get_selected; if (!defined $model || !defined $iter) { return; } my $value = $model->get($iter, 3); my $name = $value->get_name; $name = '(Default)' if $name eq ''; my $type = $value->get_type_as_string; my $clipboard = Gtk2::Clipboard->get(Gtk2::Gdk->SELECTION_PRIMARY); $clipboard->set_text($name); # Display value information: my $str = hexdump($value->get_raw_data); my $text_buffer = $text_view->get_buffer; $text_buffer->set_text($str); } sub add_root { my ($key, $model, undef) = @_; my $iter = $model->append(undef); my $name = $key->get_name; $name =~ s/\0/[NUL]/g; my $timestamp = defined($key->get_timestamp) ? $key->get_timestamp_as_string : ''; my $class_name = defined($key->get_class_name) ? $key->get_class_name : ''; $class_name =~ s/\0/[NUL]/g; $model->set($iter, 0, $name, 1, $timestamp, 2, $class_name, 3, $key, ); my $dummy = $model->append($iter); } sub add_children { my ($key, $model, $iter) = @_; # my @subkeys = defined $iter ? $key->get_list_of_subkeys : ($key); my @subkeys = $key->get_list_of_subkeys; foreach my $subkey (@subkeys) { my $child_iter = $model->append($iter); my $name = $subkey->get_name; $name =~ s/\0/[NUL]/g; my $timestamp = defined($subkey->get_timestamp) ? $subkey->get_timestamp_as_string : ''; my $class_name = defined($subkey->get_class_name) ? $subkey->get_class_name : ''; $class_name =~ s/\0/[NUL]/g; $model->set($child_iter, 0, $name, 1, $timestamp, 2, $class_name, 3, $subkey, ); my $dummy = $model->append($child_iter); ### load gradually #add_children($subkey, $model, $child_iter); ### load everything } } sub expand_row { my ($view, $iter, $path) = @_; my $model = $view->get_model; my $key = $model->get($iter, 3); my $first_child_iter = $model->iter_nth_child($iter, 0); if (!defined $model->get($first_child_iter, 0)) { add_children($key, $model, $iter); $model->remove($first_child_iter); } } sub collapse_row { my ($view, $iter, $path) = @_; return; # uncomment to remove children when collapsing my $model = $view->get_model; my $child_iter = $model->iter_nth_child($iter, 0); if (!defined $child_iter) { # this key has no children return; } my @child_iters = (); while (defined $child_iter) { if (defined $model->get($child_iter, 0)) { push @child_iters, $child_iter; } $child_iter = $tree_store->iter_next($child_iter); } foreach my $child_iter (@child_iters) { $tree_store->remove($child_iter); } my $dummy = $tree_store->append($iter); } sub activate_row { my ($view, $path, $column) = @_; if ($view->row_expanded($path)) { $view->collapse_row($path); } else { # only rows with children will actually be expanded $view->expand_row($path, FALSE); } } sub load_file { my $filename = shift; my ($name, $path) = fileparse($filename); close_file(); if (!-r $filename) { show_message('error', "Unable to open '$name'."); } elsif (my $registry = Parse::Win32Registry->new($filename)) { if (my $root_key = $registry->get_root_key) { add_root($root_key, $tree_store, undef); $window->set_title("$name - $script_name"); if (defined $root_key->get_timestamp) { $tree_columns[1]->set_visible(TRUE); $tree_columns[2]->set_visible(TRUE); } else { $tree_columns[1]->set_visible(FALSE); $tree_columns[2]->set_visible(FALSE); } } } else { show_message('error', "'$name' is not a registry file."); } } sub choose_file { my ($title, $type, $suggested_name) = @_; my $file_chooser = Gtk2::FileChooserDialog->new( $title, undef, $type, 'gtk-cancel' => 'cancel', 'gtk-ok' => 'ok', ); if ($type eq 'save') { $file_chooser->set_current_name($suggested_name); } if (defined $last_dir) { $file_chooser->set_current_folder($last_dir); } my $response = $file_chooser->run; my $filename; if ($response eq 'ok') { $filename = $file_chooser->get_filename; } $last_dir = $file_chooser->get_current_folder; $file_chooser->destroy; return $filename; } sub open_file { my $filename = choose_file('Select Registry File', 'open'); if ($filename) { load_file($filename); } } sub close_file { $tree_store->clear; $list_store->clear; $text_buffer->set_text(''); $find_param = ''; $find_iter = undef; $statusbar->pop(0); } sub quit { $window->destroy; } sub about { Gtk2->show_about_dialog(undef, 'program-name' => $script_name, 'version' => $Parse::Win32Registry::VERSION, 'copyright' => 'Copyright (c) 2008-2012 James Macfarlane', 'comments' => 'GTK2 Registry Viewer for the Parse::Win32Registry module', ); } sub show_message { my $type = shift; my $message = shift; my $dialog = Gtk2::MessageDialog->new( $window, 'destroy-with-parent', $type, 'ok', $message, ); $dialog->set_title(ucfirst $type); $dialog->run; $dialog->destroy; } sub copy_key_path { my $tree_iter = $tree_selection->get_selected; my $clip = ''; if (defined $tree_iter) { my $key = $tree_store->get($tree_iter, 3); $clip = $key->get_path; } my $clipboard = Gtk2::Clipboard->get(Gtk2::Gdk->SELECTION_CLIPBOARD); $clipboard->set_text($clip); } sub go_to_value { my $value_name = shift; my $iter = $list_store->get_iter_first; while (defined $iter) { my $name = $list_store->get($iter, 0); my $value = $list_store->get($iter, 3); if ($value_name eq $value->get_name) { my $tree_path = $list_store->get_path($iter); $list_view->expand_to_path($tree_path); $list_view->scroll_to_cell($tree_path); $list_view->set_cursor($tree_path); $window->set_focus($list_view); return; } $iter = $list_store->iter_next($iter); } } sub find_matching_child_iter { my ($iter, $subkey_name) = @_; my $child_iter = $tree_store->iter_nth_child($iter, 0); if (!defined $child_iter) { # iter has already been expanded and has no children return; } # Check iter's children are real if (!defined $tree_store->get($child_iter, 0)) { my $key = $tree_store->get($iter, 3); add_children($key, $tree_store, $iter); $tree_store->remove($child_iter); # (Need to refetch the first child iter after removing it.) $child_iter = $tree_store->iter_nth_child($iter, 0); } while (defined $child_iter) { my $child_key = $tree_store->get($child_iter, 3); # $tree_store->get($child_iter, 0) contains the displayed name, # $child_key->get_name is the actual name if ($child_key->get_name eq $subkey_name) { return $child_iter; # match found } $child_iter = $tree_store->iter_next($child_iter); } return; # no match found } sub go_to_subkey { my $subkey_path = shift; my @path_components = index($subkey_path, "\\") == -1 ? ($subkey_path) : split(/\\/, $subkey_path, -1); my $iter = $tree_store->get_iter_first; return if !defined $iter; # no registry loaded while (defined(my $subkey_name = shift @path_components)) { $iter = find_matching_child_iter($iter, $subkey_name); if (!defined $iter) { return; # subkey cannot be found in/added to the tree store } if (@path_components == 0) { my $parent_iter = $tree_store->iter_parent($iter); my $parent_path = $tree_store->get_path($parent_iter); $tree_view->expand_to_path($parent_path); my $tree_path = $tree_store->get_path($iter); $tree_view->scroll_to_cell($tree_path); $tree_view->set_cursor($tree_path); $window->set_focus($tree_view); return; # skip remaining search } } } sub get_search_message { my $message; if ($search_keys && $search_values) { $message = "Searching registry keys and values..."; } elsif ($search_keys) { $message = "Searching registry keys..."; } elsif ($search_values) { $message = "Searching registry values..."; } return $message; } sub find_next { if (!defined $find_param || !defined $find_iter) { return; } my $label = Gtk2::Label->new; $label->set_text(get_search_message); my $dialog = Gtk2::Dialog->new('Find', $window, 'modal', 'gtk-cancel' => 'cancel', ); $dialog->vbox->pack_start($label, TRUE, TRUE, 5); $dialog->set_default_response('cancel'); $dialog->show_all; my $id = Glib::Idle->add(sub { my ($key, $value) = $find_iter->get_next; if (!defined $key) { $dialog->response('ok'); return FALSE; # stop searching } # Remove root key name to get subkey path my $subkey_path = (split(/\\/, $key->get_path, 2))[1]; if (!defined $subkey_path) { # go_to_subkey locates keys based on the subkey path # and does not support going to the root key. # Therefore if the subkey path is not defined, # the subtree iterator has returned the root key, # so searching it should be skipped. return TRUE; # continue searching } # Check value (if defined) for a match if (defined $value) { if ($search_values) { my $value_name = $value->get_name; if (index(lc $value_name, lc $find_param) >= 0) { go_to_subkey($subkey_path); go_to_value($value_name); $dialog->response(50); return FALSE; # stop searching } } return TRUE; # continue searching } # Check key for a match if ($search_keys) { my $key_name = $key->get_name; if (index(lc $key_name, lc $find_param) >= 0) { go_to_subkey($subkey_path); $dialog->response(50); return FALSE; # stop searching } } return TRUE; # continue searching }); my $response = $dialog->run; $dialog->destroy; if ($response eq 'cancel' || $response eq 'delete-event') { Glib::Source->remove($id); } elsif ($response eq 'ok') { show_message('info', 'Finished searching.'); } } sub find { return if !defined $tree_store->get_iter_first; my $root_iter = $tree_store->get_iter_first; return if !defined $root_iter; my $root_key = $tree_store->get($root_iter, 3); return if !defined $root_key; my $selected_key; my $iter = $tree_selection->get_selected; if (defined $iter) { $selected_key = $tree_store->get($iter, 3); } my $label = Gtk2::Label->new('Enter text to search for:'); $label->set_alignment(0, 0); my $entry = Gtk2::Entry->new; $entry->set_text($find_param); $entry->set_activates_default(TRUE); my $check1 = Gtk2::CheckButton->new('Search _keys'); $check1->set_active($search_keys); my $check2 = Gtk2::CheckButton->new('Search _values'); $check2->set_active($search_values); $check1->signal_connect(toggled => sub { if (!$check1->get_active && !$check2->get_active) { $check2->set_active(TRUE); } }); $check2->signal_connect(toggled => sub { if (!$check1->get_active && !$check2->get_active) { $check1->set_active(TRUE); } }); my $frame = Gtk2::Frame->new('Start searching'); my $vbox = Gtk2::VBox->new(FALSE, 0); $frame->add($vbox); my $radio1 = Gtk2::RadioButton->new(undef, 'from _root key'); my $radio2 = Gtk2::RadioButton->new($radio1, 'from c_urrent key'); if (!defined $selected_key) { $radio2->set_sensitive(FALSE); } elsif ($search_selected) { $radio2->set_active(TRUE); } $vbox->pack_start($radio1, TRUE, TRUE, 0); $vbox->pack_start($radio2, TRUE, TRUE, 0); my $dialog = Gtk2::Dialog->new('Find', $window, 'modal', 'gtk-cancel' => 'cancel', 'gtk-ok' => 'ok', ); $dialog->vbox->set_spacing(5); $dialog->vbox->pack_start($label, FALSE, TRUE, 0); $dialog->vbox->pack_start($entry, FALSE, TRUE, 0); $dialog->vbox->pack_start($check1, FALSE, TRUE, 0); $dialog->vbox->pack_start($check2, FALSE, TRUE, 0); $dialog->vbox->pack_start($frame, FALSE, TRUE, 0); $dialog->set_default_response('ok'); $dialog->show_all; my $response = $dialog->run; if ($response eq 'ok') { $search_keys = $check1->get_active; $search_values = $check2->get_active; $search_selected = $radio2->get_active; $find_param = $entry->get_text; $dialog->destroy; $find_iter = undef; if ($find_param ne '') { $find_iter = $search_selected ? $selected_key->get_subtree_iterator : $root_key->get_subtree_iterator; find_next; } } else { $dialog->destroy; } } Parse-Win32Registry-1.0/bin/regml.pl0000755000175000017500000000257511747213110016347 0ustar ownerowner#!/usr/bin/perl use strict; use warnings; use File::Basename; use Parse::Win32Registry 0.60; binmode(STDOUT, ':utf8'); my $filename = shift or die usage(); my $registry = Parse::Win32Registry->new($filename) or die "'$filename' is not a registry file\n"; my $root_key = $registry->get_root_key or die "Could not get root key of '$filename'\n"; my $security = $root_key->get_security or die "Root key of '$filename' does not have any security information\n"; traverse($root_key); sub traverse { my $key = shift; my $security = $key->get_security; if (defined $security) { my $sd = $security->get_security_descriptor; my $sacl = $sd->get_sacl; if (defined $sacl) { foreach my $ace ($sacl->get_list_of_aces) { if ($ace->get_type == 0x11) { print $key->as_string, "\n"; print "ACE: ", $ace->as_string, "\n\n"; } } } } foreach my $subkey ($key->get_list_of_subkeys) { traverse($subkey); } } sub usage { my $script_name = basename $0; return < USAGE } Parse-Win32Registry-1.0/bin/wxregcompare.pl0000755000175000017500000012471611747213110017746 0ustar ownerowner#!/usr/bin/perl use strict; use warnings; binmode STDOUT, ':utf8'; use Parse::Win32Registry 0.51; package EntryTreeCtrl; use Parse::Win32Registry qw(make_multiple_subkey_iterator make_multiple_value_iterator compare_multiple_keys compare_multiple_values); use Wx qw(:everything); use Wx::ArtProvider qw(:artid :clientid); use Wx::Event qw(:everything); use base qw(Wx::TreeCtrl); sub new { my ($class, $parent) = @_; my $self = $class->SUPER::new($parent, -1, wxDefaultPosition, wxDefaultSize, wxTR_DEFAULT_STYLE|wxBORDER_SUNKEN); bless $self, $class; EVT_TREE_ITEM_EXPANDING($self, $self, \&OnTreeItemExpanding); my $imagelist = Wx::ImageList->new(16, 16, 1); $imagelist->Add(Wx::ArtProvider::GetIcon(wxART_FOLDER, wxART_MENU, [16, 16])); $imagelist->Add(Wx::ArtProvider::GetIcon(wxART_NORMAL_FILE, wxART_MENU, [16, 16])); $self->AssignImageList($imagelist); return $self; } sub Clear { my ($self) = @_; $self->DeleteAllItems; } sub SetRootKeys { my ($self, $root_keys) = @_; return if !defined $root_keys || @$root_keys == 0; my $any_root_key = (grep { defined } @$root_keys)[0]; my $name = $any_root_key->get_name; $name =~ s/\0/[NUL]/g; $name =~ s/\n/[LF]/g; $name =~ s/\r/[CR]/g; my @changes = compare_multiple_keys(@$root_keys); my $num_changes = grep { $_ } @changes; $name .= " ($num_changes)" if $num_changes > 0; my $root_item = $self->AddRoot($name, 0, -1); $self->SetItemBold($root_item, $num_changes); # bold if $num_changes > 0 $self->SetPlData($root_item, [\@changes, $root_keys]); $self->AddChildren($root_item, $root_keys); } sub AddChildren { my ($self, $item, $keys) = @_; my $any_key = (grep { defined } @$keys)[0]; my $subkey_count = 0; my $subkeys_iter = make_multiple_subkey_iterator(@$keys); while (defined(my $subkeys = $subkeys_iter->get_next)) { my $any_subkey = (grep { defined } @$subkeys)[0]; my $name = $any_subkey->get_name; $name =~ s/\0/[NUL]/g; $name =~ s/\n/[LF]/g; $name =~ s/\r/[CR]/g; my @changes = compare_multiple_keys(@$subkeys); my $num_changes = grep { $_ } @changes; $name .= " ($num_changes)" if $num_changes > 0; my $child_item = $self->AppendItem($item, $name, 0, -1); $self->SetPlData($child_item, [\@changes, $subkeys]); $self->SetItemBold($child_item, $num_changes); $self->SetItemHasChildren($child_item, 1); $subkey_count++; } my $value_count = 0; my $values_iter = make_multiple_value_iterator(@$keys); while (defined(my $values = $values_iter->get_next)) { my $any_value = (grep { defined } @$values)[0]; my $name = $any_value->get_name; $name = "(Default)" if $name eq ''; $name =~ s/\0/[NUL]/g; $name =~ s/\n/[LF]/g; $name =~ s/\r/[CR]/g; my @changes = compare_multiple_values(@$values); my $num_changes = grep { $_ } @changes; $name .= " ($num_changes)" if $num_changes > 0; my $child_item = $self->AppendItem($item, $name, 1, -1); $self->SetPlData($child_item, [\@changes, $keys, $values]); $self->SetItemBold($child_item, $num_changes); $value_count++; } return $subkey_count + $value_count; } sub OnTreeItemExpanding { my ($self, $event) = @_; my $item = $event->GetItem; my ($child_item, $cookie) = $self->GetFirstChild($item); if ($child_item->IsOk) { return; } my ($changes, $keys) = @{$self->GetPlData($item)}; if (!$self->AddChildren($item, $keys)) { $self->SetItemHasChildren($item, 0); } } sub FindMatchingKey { my ($self, $item, $key_name) = @_; return if !$self->ItemHasChildren($item); # Make any virtual children real before proceeding my ($child_item, $cookie) = $self->GetFirstChild($item); if (!$child_item->IsOk) { # children still virtual my $data = $self->GetPlData($item); my ($changes, $keys, $values) = @$data; if (!$self->AddChildren($item, $keys)) { $self->SetItemHasChildren($item, 0); } } # Look through the children for a match ($child_item, $cookie) = $self->GetFirstChild($item); while ($child_item->IsOk) { my $data = $self->GetPlData($child_item); my ($changes, $keys, $values) = @$data; if (!defined $values) { # only keys my $any_key = (grep { defined } @$keys)[0]; if ($key_name eq $any_key->get_name) { return $child_item; # found a match } } ($child_item, $cookie) = $self->GetNextChild($item, $cookie); } return; # no match } sub FindMatchingValue { my ($self, $item, $value_name) = @_; return if !$self->ItemHasChildren($item); # Make any virtual children real before proceeding my ($child_item, $cookie) = $self->GetFirstChild($item); if (!$child_item->IsOk) { # children still virtual my $data = $self->GetPlData($item); my ($changes, $keys, $values) = @$data; if (!$self->AddChildren($item, $keys)) { $self->SetItemHasChildren($item, 0); } } # Look through the children for a match ($child_item, $cookie) = $self->GetFirstChild($item); while ($child_item->IsOk) { my $data = $self->GetPlData($child_item); my ($changes, $keys, $values) = @$data; if (defined $values) { # only values my $any_value = (grep { defined } @$values)[0]; if ($value_name eq $any_value->get_name) { return $child_item; # found a match } } ($child_item, $cookie) = $self->GetNextChild($item, $cookie); } return; # no match } sub GoToEntry { my ($self, $subkey_path, $value_name) = @_; my $item = $self->GetRootItem; if (defined $subkey_path) { my @key_names = split(/\\/, $subkey_path); while (@key_names) { my $key_name = shift @key_names; $item = $self->FindMatchingKey($item, $key_name); if (!defined $item) { return; # no match found } } } if (defined $value_name) { $item = $self->FindMatchingValue($item, $value_name); if (!defined $item) { return; # no match found } } $self->EnsureVisible($item); $self->SelectItem($item); } sub GetSelectedEntry { my ($self) = @_; my $item = $self->GetSelection; if ($item->IsOk) { my $data = $self->GetPlData($item); my ($changes, $keys, $values) = @$data; return ($changes, $keys, $values); } return; } package EntryListCtrl; use Wx qw(:everything); use base qw(Wx::ListCtrl); # Colors used for highlighting changes: use constant COLOR_ADDED => Wx::Colour->new('#b0ffb0'); # green use constant COLOR_CHANGED => Wx::Colour->new('#ffffb0'); # yellow use constant COLOR_DELETED => Wx::Colour->new('#ffb0b0'); # red sub new { my ($class, $parent) = @_; my $self = $class->SUPER::new($parent, -1, wxDefaultPosition, wxDefaultSize, wxLC_REPORT|wxLC_SINGLE_SEL|wxBORDER_SUNKEN); bless $self, $class; $self->InsertColumn(0, '', wxLIST_FORMAT_LEFT); $self->InsertColumn(1, 'Change', wxLIST_FORMAT_LEFT); $self->InsertColumn(2, 'Timestamp/Type', wxLIST_FORMAT_LEFT); $self->InsertColumn(3, 'Class/Data', wxLIST_FORMAT_LEFT); $self->SetColumnWidth(0, 40); $self->SetColumnWidth(1, 100); $self->SetColumnWidth(2, 200); $self->SetColumnWidth(3, 200); return $self; } sub SetEntries { my ($self, $changes, $keys, $values) = @_; if (defined $values) { # change first column title my $column = $self->GetColumn(2); $column->SetText('Type'); $column->SetWidth($column->GetWidth); $column->SetImage(-1); $self->SetColumn(2, $column); # change second column title $column = $self->GetColumn(3); $column->SetText('Data'); $column->SetWidth($self->GetColumnWidth(3)); $column->SetImage(-1); $self->SetColumn(3, $column); } else { # change first column title my $column = $self->GetColumn(2); $column->SetText('Timestamp'); $column->SetWidth($column->GetWidth); $column->SetImage(-1); $self->SetColumn(2, $column); # change second column title $column = $self->GetColumn(3); $column->SetText('Class Name'); $column->SetWidth($self->GetColumnWidth(3)); $column->SetImage(-1); $self->SetColumn(3, $column); } $self->DeleteAllItems; my $index = 0; for (my $i = 0; $i < @$changes; $i++) { my $change = $changes->[$i]; my $key = $keys->[$i]; my $column1 = ''; my $column2 = ''; if (defined $values) { my $value = $values->[$i]; if (defined $value) { $column1 = $value->get_type_as_string; $column2 = substr($value->get_data_as_string, 0, 200); } } else { if (defined $key) { if (defined $key->get_timestamp) { $column1 = $key->get_timestamp_as_string; } if (defined $key->get_class_name) { $column2 = $key->get_class_name; } } } # Only the data or the class name needs checking $column2 =~ s/\0/[NUL]/g; $column2 =~ s/\n/[LF]/g; $column2 =~ s/\r/[CR]/g; $index = $self->InsertStringItem($index+1, "[$i]"); $self->SetItem($index, 1, $change); $self->SetItem($index, 2, $column1); $self->SetItem($index, 3, $column2); # Color item if ($change eq 'NEWER' || $change eq 'ADDED') { $self->SetItemBackgroundColour($index, COLOR_ADDED); } elsif ($change eq 'CHANGED') { $self->SetItemBackgroundColour($index, COLOR_CHANGED); } elsif ($change eq 'OLDER' || $change eq 'DELETED') { $self->SetItemBackgroundColour($index, COLOR_DELETED); } } $self->{_changes} = $changes; $self->{_keys} = $keys; $self->{_values} = $values; } sub GetEntry { my ($self, $index) = @_; my $change = $self->{_changes}[$index]; my $key = $self->{_keys}[$index]; if (defined $self->{_values}) { my $value = $self->{_values}[$index]; if (defined $value) { return ($change, $key, $value); } else { # No $key is returned when there is no $value to make # the recipient realise that this is a list of $value changes. # This does require that the recipient anticipates receiving # neither a $key nor a $value. return ($change); } } else { return ($change, $key); } } package CompareFrame; use File::Basename; use FindBin; use Parse::Win32Registry qw(make_multiple_subtree_iterator compare_multiple_keys compare_multiple_values hexdump); use Wx qw(:everything); use Wx::DND; # required for copying to clipboard use Wx::Event qw(:everything); use base qw(Wx::Frame); use constant ID_DUMP_ENTRIES => Wx::NewId; use constant ID_FIND_NEXT => Wx::NewId; use constant ID_FIND_CHANGE => Wx::NewId; use constant ID_FIND_NEXT_CHANGE => Wx::NewId; use constant ID_SELECT_FONT => Wx::NewId; sub new { my ($class, $parent) = @_; my $self = $class->SUPER::new($parent, -1, "Registry Compare", wxDefaultPosition, [600, 400]); bless $self, $class; $self->SetMinSize([600, 400]); my $menu1 = Wx::Menu->new; $menu1->Append(wxID_OPEN, "&Select Files...\tCtrl+O"); $menu1->Append(wxID_CLOSE, "&Close Files\tCtrl+W"); $menu1->AppendSeparator; $menu1->Append(wxID_EXIT, "E&xit\tAlt+F4"); my $menu2 = Wx::Menu->new; $menu2->Append(wxID_COPY, "&Copy Path\tCtrl+C"); my $menu3 = Wx::Menu->new; $menu3->Append(wxID_FIND, "&Find...\tCtrl+F"); $menu3->Append(ID_FIND_NEXT, "Find &Next...\tF3"); $menu3->AppendSeparator; $menu3->Append(wxID_REPLACE, "Find &Change...\tCtrl+N"); $menu3->Append(ID_FIND_NEXT_CHANGE, "Find N&ext Change...\tF4"); my $menu4 = Wx::Menu->new; $menu4->Append(ID_SELECT_FONT, "Select &Font..."); my $menu5 = Wx::Menu->new; $menu5->Append(wxID_ABOUT, "&About..."); my $menubar = Wx::MenuBar->new; $menubar->Append($menu1, "&File"); $menubar->Append($menu2, "&Edit"); $menubar->Append($menu3, "&Search"); $menubar->Append($menu4, "&View"); $menubar->Append($menu5, "&Help"); $self->SetMenuBar($menubar); my $statusbar = Wx::StatusBar->new($self, -1); $self->SetStatusBar($statusbar); EVT_MENU($self, wxID_OPEN, \&OnOpenFiles); EVT_MENU($self, wxID_CLOSE, \&OnCloseFiles); EVT_MENU($self, wxID_EXIT, \&OnQuit); EVT_MENU($self, wxID_COPY, \&OnCopy); EVT_MENU($self, wxID_FIND, \&OnFind); EVT_MENU($self, ID_FIND_NEXT, \&FindNext); EVT_MENU($self, wxID_REPLACE, \&OnFindChange); EVT_MENU($self, ID_FIND_NEXT_CHANGE, \&FindNextChange); EVT_MENU($self, ID_SELECT_FONT, \&OnSelectFont); EVT_MENU($self, wxID_ABOUT, \&OnAbout); my $hsplitter = Wx::SplitterWindow->new($self, -1, wxDefaultPosition, wxDefaultSize, wxSP_NOBORDER); my $tree = EntryTreeCtrl->new($hsplitter); my $vsplitter = Wx::SplitterWindow->new($hsplitter, -1, wxDefaultPosition, wxDefaultSize, wxSP_NOBORDER); $hsplitter->SplitVertically($tree, $vsplitter); $hsplitter->SetMinimumPaneSize(10); my $list = EntryListCtrl->new($vsplitter); my $text = Wx::TextCtrl->new($vsplitter, -1, '', wxDefaultPosition, wxDefaultSize, wxTE_MULTILINE|wxTE_DONTWRAP|wxTE_READONLY); $text->SetFont(Wx::Font->new(10, wxMODERN, wxNORMAL, wxNORMAL)); $vsplitter->SplitHorizontally($list, $text); $vsplitter->SetMinimumPaneSize(10); $self->{_tree} = $tree; $self->{_list} = $list; $self->{_text} = $text; $self->{_statusbar} = $statusbar; EVT_SPLITTER_DCLICK($self, $hsplitter, \&OnSplitterDClick); EVT_SPLITTER_DCLICK($self, $vsplitter, \&OnSplitterDClick); EVT_TREE_SEL_CHANGED($self, $tree, \&OnEntryTreeSelChanged); EVT_LIST_ITEM_SELECTED($self, $list, \&OnEntryListItemSelected); $self->SetIcon(Wx::GetWxPerlIcon()); my $accelerators = Wx::AcceleratorTable->new( [wxACCEL_CTRL, ord('Q'), wxID_EXIT], ); $self->SetAcceleratorTable($accelerators); if (@ARGV) { $self->LoadFiles(@ARGV); } else { $self->{_registries} = []; } return $self; } sub OnSelectFont { my ($self, $event) = @_; my $text = $self->{_text}; my $font = $text->GetFont; $font = Wx::GetFontFromUser($self, $font); if ($font->IsOk) { $text->SetFont($font); } } sub OnCopy { my ($self, $event) = @_; my ($changes, $keys, $values) = $self->{_tree}->GetSelectedEntry; my $clip = ''; if (defined $keys) { my $any_key = (grep { defined } @$keys)[0]; if (defined $values) { my $any_value = (grep { defined } @$values)[0]; $clip = $any_key->get_path . ", " . $any_value->get_name; } else { $clip = $any_key->get_path; } } wxTheClipboard->Open; wxTheClipboard->SetData(Wx::TextDataObject->new($clip)); wxTheClipboard->Close; } sub OnSplitterDClick { my ($self, $event) = @_; $event->Veto; } sub OnEntryTreeSelChanged { my ($self, $event) = @_; my $item = $event->GetItem; my ($changes, $keys, $values) = @{$self->{_tree}->GetPlData($item)}; my $any_key = (grep { defined } @$keys)[0]; my $key_path = $any_key->get_path; $key_path =~ s/\0/[NUL]/g; $key_path =~ s/\n/[LF]/g; $key_path =~ s/\r/[CR]/g; # find currently selected item in entry list $item = $self->{_list}->GetNextItem(-1, wxLIST_NEXT_ALL, wxLIST_STATE_SELECTED); $item = 0 if $item == -1; if (defined $values) { my $any_value = (grep { defined } @$values)[0]; my $name = $any_value->get_name; $name = "(Default)" if $name eq ''; $name =~ s/\0/[NUL]/g; $name =~ s/\n/[LF]/g; $name =~ s/\r/[CR]/g; $self->{_list}->SetEntries($changes, $keys, $values); $self->{_statusbar}->SetStatusText("$key_path, $name"); } else { $self->{_list}->SetEntries($changes, $keys); $self->{_statusbar}->SetStatusText($key_path); } $self->{_text}->ChangeValue(''); $self->{_list}->SetItemState($item, wxLIST_STATE_SELECTED, wxLIST_STATE_SELECTED); } sub OnEntryListItemSelected { my ($self, $event) = @_; my ($change, $key, $value) = $self->{_list}->GetEntry($event->GetIndex); my $details = ''; if (defined $value) { $details = hexdump($value->get_raw_data); } elsif (defined $key) { if (defined $key->get_timestamp) { $details .= "Timestamp: " . $key->get_timestamp_as_string . "\n"; } my $class_name = $key->get_class_name; if (defined $class_name) { $class_name =~ s/\0/[NUL]/g; $class_name =~ s/\n/[NL]/g; $class_name =~ s/\r/[CR]/g; $details .= "Class Name: $class_name\n"; } my $security = $key->get_security; if (defined $security) { my $sd = $security->get_security_descriptor; $details .= $sd->as_stanza; } } $self->{_text}->ChangeValue($details); } sub OnAbout { my ($self, $event) = @_; my $info = Wx::AboutDialogInfo->new; $info->SetName($FindBin::Script); $info->SetVersion($Parse::Win32Registry::VERSION); $info->SetCopyright("Copyright (c) 2010-2012 James Macfarlane"); $info->SetDescription("wxWidgets Registry Compare for the Parse::Win32Registry module"); Wx::AboutBox($info); } sub FindNext { my ($self) = @_; my $find_param = $self->{_find_param}; my $find_iter = $self->{_find_iter}; my $search_keys = $self->{_search_keys}; my $search_values = $self->{_search_values}; return if !defined $find_param || $find_param eq ''; return if !defined $find_iter; my $start = time; my $max = 0; my $progress_dialog; my $iter_finished = 1; while (my ($keys, $values) = $find_iter->get_next) { my $any_key = (grep { defined } @$keys)[0]; my $key_name = $any_key->get_name; my $key_path = $any_key->get_path; # strip root key name from path to get subkey path my $subkey_path = (split(/\\/, $key_path, 2))[1]; if (defined $values) { if ($search_values) { # check value for match my $any_value = (grep { defined } @$values)[0]; my $value_name = $any_value->get_name; if (index(lc $value_name, lc $find_param) >= 0) { $self->{_tree}->GoToEntry($subkey_path, $value_name); $iter_finished = 0; last; } } } elsif ($search_keys) { # check key for match if (index(lc $key_name, lc $find_param) >= 0) { $self->{_tree}->GoToEntry($subkey_path); $iter_finished = 0; last; } } if (defined $progress_dialog) { if (!$progress_dialog->Update) { # Cancelled! $iter_finished = 0; last; } } else { # display progress dialog if search is slow if (time - $start >= 1) { $progress_dialog = Wx::ProgressDialog->new('Find', 'Searching registry...', $max, $self, wxPD_CAN_ABORT|wxPD_AUTO_HIDE); } } } if (defined $progress_dialog) { $progress_dialog->Destroy; } if ($iter_finished) { my $dialog = Wx::MessageDialog->new($self, 'Finished searching', 'Find', wxICON_EXCLAMATION|wxOK); $dialog->ShowModal; $dialog->Destroy; } $self->{_tree}->SetFocus; $self->SetFocus; } sub OnFind { my ($self, $event) = @_; my $root_keys = $self->{_root_keys}; return if !defined $root_keys || @$root_keys == 0; my $dialog = FindDialog->new($self); $dialog->SetText($self->{_find_param}); $dialog->SetSearchKeys($self->{_search_keys}); $dialog->SetSearchValues($self->{_search_values}); $dialog->SetSearchSelected($self->{_search_selected}); if ($dialog->ShowModal == wxID_OK) { $self->{_find_param} = $dialog->GetText; $self->{_search_keys} = $dialog->GetSearchKeys; $self->{_search_values} = $dialog->GetSearchValues; if (!$self->{_search_keys} && !$self->{_search_values}) { $self->{_search_keys} = $self->{_search_values} = 1; } my ($changes, $keys, $values) = $self->{_tree}->GetSelectedEntry; my $search_selected = $self->{_search_selected} = $dialog->GetSearchSelected; $self->{_find_iter} = $search_selected ? make_multiple_subtree_iterator(@$keys) : make_multiple_subtree_iterator(@$root_keys); $self->FindNext; } $dialog->Destroy; } sub FindNextChange { my ($self) = @_; my $change_iter = $self->{_change_iter}; my $search_keys = $self->{_search_keys}; my $search_values = $self->{_search_values}; return if !defined $change_iter; my $start = time; my $max = 0; my $progress_dialog; my $iter_finished = 1; while (my ($keys, $values) = $change_iter->get_next) { my $any_key = (grep { defined } @$keys)[0]; my $key_name = $any_key->get_name; my $key_path = $any_key->get_path; # strip root key name from path to get subkey path my $subkey_path = (split(/\\/, $key_path, 2))[1]; if (defined $values) { if ($search_values) { # check value for match my $any_value = (grep { defined } @$values)[0]; my $value_name = $any_value->get_name; my @changes = compare_multiple_values(@$values); my $num_changes = grep { $_ } @changes; if ($num_changes > 0) { $self->{_tree}->GoToEntry($subkey_path, $value_name); $iter_finished = 0; last; } } } elsif ($search_keys) { # check key for match my @changes = compare_multiple_keys(@$keys); my $num_changes = grep { $_ } @changes; if ($num_changes > 0) { $self->{_tree}->GoToEntry($subkey_path); $iter_finished = 0; last; } } if (defined $progress_dialog) { if (!$progress_dialog->Update) { # Cancelled! $iter_finished = 0; last; } } else { # display progress dialog if search is slow if (time - $start >= 1) { $progress_dialog = Wx::ProgressDialog->new('Find', 'Searching registry...', $max, $self, wxPD_CAN_ABORT|wxPD_AUTO_HIDE); } } } if (defined $progress_dialog) { $progress_dialog->Destroy; } if ($iter_finished) { my $dialog = Wx::MessageDialog->new($self, 'Finished searching', 'Find', wxICON_EXCLAMATION|wxOK); $dialog->ShowModal; $dialog->Destroy; } $self->{_tree}->SetFocus; $self->SetFocus; } sub OnFindChange { my ($self, $event) = @_; my $root_keys = $self->{_root_keys}; return if !defined $root_keys || @$root_keys == 0; my $dialog = FindChangeDialog->new($self); $dialog->SetSearchKeys($self->{_search_keys}); $dialog->SetSearchValues($self->{_search_values}); $dialog->SetSearchSelected($self->{_search_selected}); if ($dialog->ShowModal == wxID_OK) { $self->{_search_keys} = $dialog->GetSearchKeys; $self->{_search_values} = $dialog->GetSearchValues; if (!$self->{_search_keys} && !$self->{_search_values}) { $self->{_search_keys} = $self->{_search_values} = 1; } my ($changes, $keys, $values) = $self->{_tree}->GetSelectedEntry; my $search_selected = $self->{_search_selected} = $dialog->GetSearchSelected; $self->{_change_iter} = $search_selected ? make_multiple_subtree_iterator(@$keys) : make_multiple_subtree_iterator(@$root_keys); $self->{_change_iter}->get_next; # skip the starting key $self->FindNextChange; } $dialog->Destroy; } sub LoadFiles { my ($self, @filenames) = @_; my @registries; my @root_keys; foreach my $filename (@filenames) { if (!-r $filename) { my $dialog = Wx::MessageDialog->new($self, "'$filename' cannot be read", 'Error', wxICON_ERROR|wxOK); $dialog->ShowModal; $dialog->Destroy; next; } my $basename = basename($filename); my $registry = Parse::Win32Registry->new($filename); if (!defined $registry) { my $dialog = Wx::MessageDialog->new($self, "'$basename' is not a registry file", 'Error', wxICON_ERROR|wxOK); $dialog->ShowModal; $dialog->Destroy; next; } my $root_key = $registry->get_root_key; if (!defined $registry) { my $dialog = Wx::MessageDialog->new($self, "'$basename' has no root key", 'Error', wxICON_ERROR|wxOK); $dialog->ShowModal; $dialog->Destroy; next; } push @registries, $registry; push @root_keys, $root_key; } $self->LoadRegistries(\@registries); } sub LoadRegistries { my ($self, $registries) = @_; my @root_keys = map { $_->get_root_key } @$registries; $self->{_registries} = $registries; $self->{_tree}->SetRootKeys(\@root_keys); $self->{_tree}->SetFocus; $self->{_root_keys} = \@root_keys; if (@$registries) { my $filename = $registries->[0]->get_filename; $filename = basename($filename); if (@$registries > 1) { $filename .= " (+" . (@$registries - 1) . ")"; } $self->SetTitle("$filename - Registry Compare"); } else { $self->SetTitle("Registry Compare"); } } sub OnOpenFiles { my ($self, $event) = @_; my $dialog = $self->{_files_dialog}; if (!defined $dialog) { $dialog = $self->{_files_dialog} = FilesDialog->new($self); } # The original list of registries is not passed by reference # (as any changes would immediately affect the original). my @registries = @{$self->{_registries}}; $dialog->SetRegistries(\@registries); my $result = $dialog->ShowModal; $dialog->Hide; return if $result != wxID_OK; my $registries = $dialog->GetRegistries; # clear $self->OnCloseFiles; # set up $self->LoadRegistries($registries); } sub OnCloseFiles { my ($self, $event) = @_; $self->{_tree}->Clear; $self->{_list}->SetEntries([]); $self->{_text}->Clear; $self->{_statusbar}->SetStatusText(''); # $self->{_registries} is not cleared to retain currently selected files $self->{_root_keys} = undef; $self->{_find_iter} = undef; $self->{_changed_entries} = undef; $self->SetTitle("Registry Compare"); if (defined $self->{_change_list_dialog}) { $self->{_change_list_dialog}->SetChangedEntries([]); $self->{_change_list_dialog}->Hide; } } sub OnQuit { my ($self) = @_; $self->Close; } package FindDialog; use Wx qw(:everything); use Wx::Event qw(:everything); use base qw(Wx::Dialog); sub new { my ($class, $parent) = @_; my $self = $class->SUPER::new($parent, -1, "Find", wxDefaultPosition, wxDefaultSize, wxDEFAULT_DIALOG_STYLE); bless $self, $class; my $static = Wx::StaticText->new($self, -1, 'Enter text to &search for:'); my $text = Wx::TextCtrl->new($self, -1, ''); my $check1 = Wx::CheckBox->new($self, -1, 'Search &keys'); my $check2 = Wx::CheckBox->new($self, -1, 'Search &values'); my $radio = Wx::RadioBox->new($self, -1, 'Start searching', wxDefaultPosition, wxDefaultSize, ['from root key', 'from current key'], 1); my $sizer = Wx::BoxSizer->new(wxVERTICAL); $sizer->Add($static, 0, wxEXPAND|wxALL, 5); $sizer->Add($text, 0, wxEXPAND|wxALL, 5); $sizer->Add($check1, 0, wxALL, 5); $sizer->Add($check2, 0, wxALL, 5); $sizer->Add($radio, 0, wxALL, 5); my $hsizer = Wx::BoxSizer->new(wxHORIZONTAL); my $button_sizer = $self->CreateSeparatedButtonSizer(wxOK|wxCANCEL); $sizer->Add($button_sizer, 0, wxEXPAND|wxALL, 5); $self->SetSizer($sizer); $self->{_text} = $text; $self->{_check1} = $check1; $self->{_check2} = $check2; $self->{_radio} = $radio; $self->Fit; # resize dialog to best fit child windows $self->{_text}->SetFocus; $self->SetFocus; EVT_CHECKBOX($self, $check1, sub { if (!$check1->GetValue && !$check2->GetValue) { $check2->SetValue(1); } }); EVT_CHECKBOX($self, $check2, sub { if (!$check1->GetValue && !$check2->GetValue) { $check1->SetValue(1); } }); return $self; } sub GetSearchKeys { my ($self) = @_; return $self->{_check1}->GetValue; } sub GetSearchValues { my ($self) = @_; return $self->{_check2}->GetValue; } sub GetText { my ($self) = @_; return $self->{_text}->GetValue; } sub GetSearchSelected { my ($self) = @_; return $self->{_radio}->GetSelection; } sub SetSearchKeys { my ($self, $state) = @_; $state = 1 if !defined $state; $self->{_check1}->SetValue($state); } sub SetSearchValues { my ($self, $state) = @_; $state = 1 if !defined $state; $self->{_check2}->SetValue($state); } sub SetText { my ($self, $value) = @_; $value = '' if !defined $value; $self->{_text}->ChangeValue($value); $self->{_text}->SetSelection(-1, -1); } sub SetSearchSelected { my ($self, $n) = @_; $n = 0 if !defined $n; $self->{_radio}->SetSelection($n); } package FindChangeDialog; use Wx qw(:everything); use Wx::Event qw(:everything); use base qw(Wx::Dialog); sub new { my ($class, $parent) = @_; my $self = $class->SUPER::new($parent, -1, "Find", wxDefaultPosition, wxDefaultSize, wxDEFAULT_DIALOG_STYLE); bless $self, $class; my $static = Wx::StaticText->new($self, -1, 'Search for a change:'); my $check1 = Wx::CheckBox->new($self, -1, 'Search &keys'); my $check2 = Wx::CheckBox->new($self, -1, 'Search &values'); my $radio = Wx::RadioBox->new($self, -1, 'Start searching', wxDefaultPosition, wxDefaultSize, ['from root key', 'from current key'], 1); my $sizer = Wx::BoxSizer->new(wxVERTICAL); $sizer->Add($static, 0, wxEXPAND|wxALL, 5); $sizer->Add($check1, 0, wxALL, 5); $sizer->Add($check2, 0, wxALL, 5); $sizer->Add($radio, 0, wxALL, 5); my $hsizer = Wx::BoxSizer->new(wxHORIZONTAL); my $button_sizer = $self->CreateSeparatedButtonSizer(wxOK|wxCANCEL); $sizer->Add($button_sizer, 0, wxEXPAND|wxALL, 5); $self->SetSizer($sizer); $self->{_check1} = $check1; $self->{_check2} = $check2; $self->{_radio} = $radio; $self->Fit; # resize dialog to best fit child windows $self->{_radio}->SetFocus; $self->SetFocus; EVT_CHECKBOX($self, $check1, sub { if (!$check1->GetValue && !$check2->GetValue) { $check2->SetValue(1); } }); EVT_CHECKBOX($self, $check2, sub { if (!$check1->GetValue && !$check2->GetValue) { $check1->SetValue(1); } }); return $self; } sub GetSearchKeys { my ($self) = @_; return $self->{_check1}->GetValue; } sub GetSearchValues { my ($self) = @_; return $self->{_check2}->GetValue; } sub GetSearchSelected { my ($self) = @_; return $self->{_radio}->GetSelection; } sub SetSearchKeys { my ($self, $state) = @_; $state = 1 if !defined $state; $self->{_check1}->SetValue($state); } sub SetSearchValues { my ($self, $state) = @_; $state = 1 if !defined $state; $self->{_check2}->SetValue($state); } sub SetSearchSelected { my ($self, $n) = @_; $n = 0 if !defined $n; $self->{_radio}->SetSelection($n); } package FileListCtrl; use File::Basename; use Parse::Win32Registry qw(iso8601); use Wx qw(:everything); use Wx::ArtProvider qw(:artid :clientid); use Wx::Event qw(:everything); use base qw(Wx::ListCtrl); sub new { my ($class, $parent) = @_; my $self = $class->SUPER::new($parent, -1, wxDefaultPosition, wxDefaultSize, wxLC_REPORT|wxLC_VIRTUAL|wxBORDER_SUNKEN); bless $self, $class; $self->InsertColumn(0, "Filename", wxLIST_FORMAT_LEFT); $self->InsertColumn(1, "Embedded Filename", wxLIST_FORMAT_LEFT); $self->InsertColumn(2, "Embedded Timestamp", wxLIST_FORMAT_LEFT); $self->InsertColumn(3, "Directory", wxLIST_FORMAT_LEFT); $self->SetColumnWidth(0, 200); $self->SetColumnWidth(1, 200); $self->SetColumnWidth(2, 200); $self->SetColumnWidth(3, 200); my $imagelist = Wx::ImageList->new(16, 16, 1); $imagelist->Add(Wx::ArtProvider::GetIcon(wxART_NORMAL_FILE, wxART_MENU, [16, 16])); $self->AssignImageList($imagelist, wxIMAGE_LIST_SMALL); $self->{_registries} = []; return $self; } sub MoveItems { my ($self, $source_items, $target_item) = @_; # build list of items to move my @items; foreach my $source_item (@$source_items) { push @items, @{$self->{_registries}}[$source_item]; } # delete originals foreach my $source_item (reverse @$source_items) { if ($source_item < $target_item) { $target_item--; } splice @{$self->{_registries}}, $source_item, 1; } # insert moved items if ($target_item == -1 || $target_item > @{$self->{_registries}}) { push @{$self->{_registries}}, @items; } else { splice @{$self->{_registries}}, $target_item, 0, @items; } $self->Refresh; # deselect my $item = -1; while (1) { $item = $self->GetNextItem($item, wxLIST_NEXT_ALL, wxLIST_STATE_SELECTED); last if $item == -1; $self->SetItemState($item, 0, wxLIST_STATE_SELECTED); } # reselect if ($target_item == -1 || $target_item > (@{$self->{_registries}} - @items)) { $target_item = @{$self->{_registries}} - @items; } for (my $item = 0; $item < @items; $item++) { $self->SetItemState($target_item + $item, wxLIST_STATE_SELECTED, wxLIST_STATE_SELECTED); } } sub MoveSelectedItemsToTop { my ($self) = @_; # iterate selected items in list: my @items; my $item = -1; while (1) { $item = $self->GetNextItem($item, wxLIST_NEXT_ALL, wxLIST_STATE_SELECTED); last if $item == -1; push @items, $item; } return if @items == 0; $self->MoveItems(\@items, 0); $self->EnsureVisible(0); } sub MoveSelectedItemsToBottom { my ($self) = @_; # iterate selected items in list: my @items; my $item = -1; while (1) { $item = $self->GetNextItem($item, wxLIST_NEXT_ALL, wxLIST_STATE_SELECTED); last if $item == -1; push @items, $item; } return if @items == 0; $self->MoveItems(\@items, -1); $self->EnsureVisible(scalar @{$self->{_registries}} - 1); } sub MoveSelectedItemsUp { my ($self) = @_; # iterate selected items in list: my @items; my $item = -1; while (1) { $item = $self->GetNextItem($item, wxLIST_NEXT_ALL, wxLIST_STATE_SELECTED); last if $item == -1; push @items, $item; } return if @items == 0; my $target_item = $items[0] - 1; $target_item = 0 if $target_item < 0; $self->MoveItems(\@items, $target_item); $self->EnsureVisible($target_item); } sub MoveSelectedItemsDown { my ($self) = @_; # iterate selected items in list: my @items; my $item = -1; while (1) { $item = $self->GetNextItem($item, wxLIST_NEXT_ALL, wxLIST_STATE_SELECTED); last if $item == -1; push @items, $item; } return if @items == 0; my $target_item = $items[-1] + 2; $self->MoveItems(\@items, $target_item); $self->EnsureVisible($target_item - 1); } sub GetRegistries { my ($self) = @_; return $self->{_registries}; } sub SetRegistries { my ($self, $registries) = @_; $self->{_registries} = $registries; $self->SetItemCount(scalar @$registries); $self->Refresh; } sub AddRegistries { my ($self, $registries) = @_; push @{$self->{_registries}}, @$registries; $self->SetItemCount(scalar @{$self->{_registries}}); $self->Refresh; } sub RemoveSelectedRegistries { my ($self) = @_; # iterate items in list: my @items; my $item = -1; while (1) { $item = $self->GetNextItem($item, wxLIST_NEXT_ALL, wxLIST_STATE_SELECTED); last if $item == -1; push @items, $item; } # delete items foreach my $item (reverse @items) { splice @{$self->{_registries}}, $item, 1; } $self->SetItemCount(scalar @{$self->{_registries}}); $self->Refresh; # deselect $item = -1; while (1) { $item = $self->GetNextItem($item, wxLIST_NEXT_ALL, wxLIST_STATE_SELECTED); last if $item == -1; $self->SetItemState($item, 0, wxLIST_STATE_SELECTED); } } sub OnGetItemText { my ($self, $index, $column) = @_; my $registry = $self->{_registries}[$index]; if ($column == 0) { return basename $registry->get_filename; } elsif ($column == 1) { my $embedded_filename = $registry->get_embedded_filename; return defined $embedded_filename ? $embedded_filename : ''; } elsif ($column == 2) { my $embedded_timestamp = $registry->get_timestamp; return defined $embedded_timestamp ? iso8601($embedded_timestamp) : ''; } elsif ($column == 3) { return dirname $registry->get_filename; } else { return '?'; } } sub OnGetItemImage { return 0; } package FilesDialog; use File::Basename; use Wx qw(:everything); use Wx::Event qw(:everything); use Wx::ArtProvider qw(:artid :clientid); use base qw(Wx::Dialog); sub new { my ($class, $parent) = @_; my $self = $class->SUPER::new($parent, -1, "Select Registry Files", wxDefaultPosition, [600, 400], wxDEFAULT_FRAME_STYLE); bless $self, $class; $self->SetMinSize([600, 400]); my $static1 = Wx::StaticText->new($self, -1, 'Select files to compare:'); my $button1 = Wx::Button->new($self, wxID_CLEAR, 'Clear'); my $button2 = Wx::Button->new($self, wxID_ADD, 'Add'); my $button3 = Wx::Button->new($self, wxID_REMOVE, 'Remove'); my $button4 = Wx::Button->new($self, -1, 'Move &Up'); my $button5 = Wx::Button->new($self, -1, 'Move &Down'); my $button6 = Wx::Button->new($self, -1, 'Move To &Top'); my $button7 = Wx::Button->new($self, -1, 'Move To &Bottom'); my $list = FileListCtrl->new($self); my $hsizer1 = Wx::BoxSizer->new(wxHORIZONTAL); $hsizer1->Add($button1, 0, wxEXPAND|wxALL, 5); $hsizer1->Add($button2, 0, wxEXPAND|wxALL, 5); $hsizer1->Add($button3, 0, wxEXPAND|wxALL, 5); my $hsizer2 = Wx::BoxSizer->new(wxHORIZONTAL); $hsizer2->Add($button4, 0, wxEXPAND|wxALL, 5); $hsizer2->Add($button5, 0, wxEXPAND|wxALL, 5); $hsizer2->Add($button6, 0, wxEXPAND|wxALL, 5); $hsizer2->Add($button7, 0, wxEXPAND|wxALL, 5); my $sizer = Wx::BoxSizer->new(wxVERTICAL); $sizer->Add($static1, 0, wxEXPAND|wxALL, 5); $sizer->Add($hsizer1, 0, wxEXPAND); $sizer->Add($list, 1, wxEXPAND); $sizer->Add($hsizer2, 0, wxEXPAND); my $button_sizer = $self->CreateButtonSizer(wxOK|wxCANCEL); $sizer->Add($button_sizer, 0, wxEXPAND|wxALL, 5); EVT_CLOSE($self, \&OnClose); $self->SetSizer($sizer); $self->{_list} = $list; EVT_BUTTON($self, $button1, \&OnClear); EVT_BUTTON($self, $button2, \&OnAdd); EVT_BUTTON($self, $button3, \&OnRemove); EVT_BUTTON($self, $button4, sub { $list->MoveSelectedItemsUp; }); EVT_BUTTON($self, $button5, sub { $list->MoveSelectedItemsDown; }); EVT_BUTTON($self, $button6, sub { $list->MoveSelectedItemsToTop; }); EVT_BUTTON($self, $button7, sub { $list->MoveSelectedItemsToBottom; }); $self->SetFocus; return $self; } sub OnAdd { my ($self, $event) = @_; my $dialog = Wx::FileDialog->new($self, "Select Registry File(s)", $self->{_directory} || '', '', '*', wxFD_OPEN|wxFD_MULTIPLE); if ($dialog->ShowModal != wxID_OK) { return; } $self->{_directory} = $dialog->GetDirectory; my @registries = (); foreach my $filename ($dialog->GetPaths) { if (!-r $filename) { my $dialog = Wx::MessageDialog->new($self, "'$filename' cannot be read", 'Error', wxICON_ERROR|wxOK); $dialog->ShowModal; $dialog->Destroy; next; } my $basename = basename($filename); my $registry = Parse::Win32Registry->new($filename); if (!defined $registry) { my $dialog = Wx::MessageDialog->new($self, "'$basename' is not a registry file", 'Error', wxICON_ERROR|wxOK); $dialog->ShowModal; $dialog->Destroy; next; } my $root_key = $registry->get_root_key; if (!defined $registry) { my $dialog = Wx::MessageDialog->new($self, "'$basename' has no root key", 'Error', wxICON_ERROR|wxOK); $dialog->ShowModal; $dialog->Destroy; next; } push @registries, $registry; } $self->{_list}->AddRegistries(\@registries); } sub OnRemove { my ($self, $event) = @_; $self->{_list}->RemoveSelectedRegistries; } sub OnClear { my ($self) = @_; $self->{_list}->SetRegistries([]); } sub SetRegistries { my ($self, $registries) = @_; $registries = [] if !defined $registries; $self->{_list}->SetRegistries($registries); } sub OnClose { my ($self, $event) = @_; $self->EndModal(wxID_CANCEL); } sub GetRegistries { my ($self) = @_; return $self->{_list}->GetRegistries; } package CompareApp; use Wx qw(:everything); use base qw(Wx::App); sub OnInit { my $self = shift; my $frame = CompareFrame->new(undef); $frame->Show; return 1; } package main; my $app = CompareApp->new; $app->MainLoop; Parse-Win32Registry-1.0/bin/wxregview.pl0000755000175000017500000006457111747213110017274 0ustar ownerowner#!/usr/bin/perl use strict; use warnings; binmode STDOUT, ':utf8'; use Parse::Win32Registry 0.51; package KeyTreeCtrl; use Wx qw(:everything); use Wx::ArtProvider qw(:artid :clientid); use Wx::Event qw(:everything); use base qw(Wx::TreeCtrl); sub new { my ($class, $parent) = @_; my $self = $class->SUPER::new($parent, -1, wxDefaultPosition, wxDefaultSize, wxTR_DEFAULT_STYLE|wxBORDER_SUNKEN); bless $self, $class; my $imagelist = Wx::ImageList->new(16, 16, 1); $imagelist->Add(Wx::ArtProvider::GetIcon(wxART_FOLDER, wxART_MENU, [16, 16])); $imagelist->Add(Wx::ArtProvider::GetIcon(wxART_NORMAL_FILE, wxART_MENU, [16, 16])); $self->AssignImageList($imagelist); EVT_TREE_ITEM_EXPANDING($self, $self, \&OnTreeItemExpanding); return $self; } sub Clear { my ($self) = @_; $self->DeleteAllItems; } sub SetRootKey { my ($self, $root_key) = @_; my $name = $root_key->get_name; $name =~ s/\0/[NUL]/g; $name =~ s/\n/[LF]/g; $name =~ s/\r/[CR]/g; my $root_item = $self->AddRoot($name, 0, -1); $self->SetPlData($root_item, $root_key); $self->AddChildren($root_item, $root_key); } sub AddChildren { my ($self, $item, $key) = @_; my @subkeys = $key->get_list_of_subkeys; foreach my $subkey (@subkeys) { my $name = $subkey->get_name; $name =~ s/\0/[NUL]/g; $name =~ s/\n/[LF]/g; $name =~ s/\r/[CR]/g; my $child_item = $self->AppendItem($item, $name, 0, -1); $self->SetPlData($child_item, $subkey); $self->SetItemHasChildren($child_item, 1); } return scalar @subkeys; } sub OnTreeItemExpanding { my ($self, $event) = @_; my $item = $event->GetItem; my ($child_item, $cookie) = $self->GetFirstChild($item); if ($child_item->IsOk) { return; # already populated } my $key = $self->GetPlData($item); if (!$self->AddChildren($item, $key)) { $self->SetItemHasChildren($item, 0); } } sub FindMatchingItem { my ($self, $key_name, $item) = @_; return if !$self->ItemHasChildren($item); # Make any virtual children real before proceeding my ($child_item, $cookie) = $self->GetFirstChild($item); if (!$child_item->IsOk) { # children still virtual my $key = $self->GetPlData($item); if (!$self->AddChildren($item, $key)) { $self->SetItemHasChildren($item, 0); } } # Look through the children for a match ($child_item, $cookie) = $self->GetFirstChild($item); while ($child_item->IsOk) { my $key = $self->GetPlData($child_item); if ($key_name eq $key->get_name) { return $child_item; # found a match } ($child_item, $cookie) = $self->GetNextChild($item, $cookie); } return; # no match } sub GoToSubkey { my ($self, $subkey_path) = @_; my $item = $self->GetRootItem; my @key_names = split(/\\/, $subkey_path, -1); # my @key_names = index($subkey_path, "\\") == -1 # ? ($subkey_path) # : split(/\\/, $subkey_path, -1); # If the first method is chosen, it is possible to go to the root key, # but a first-level subkey with no name will be inaccessible. # This is because an empty string will produce an empty array, # causing the following while loop to be skipped, # leaving $item set to the root. # If the second method is chosen, it is possible to go to a first-level # subkey with no name, but the root key will be inaccessible. # This is because an array with at least one string in it is produced, # causing the following while loop to be entered, and either # the first-level subkey will be found and $item will be set to it, # or it will not be found, and the subroutine will return # without going to any item. while (@key_names) { my $key_name = shift @key_names; $item = $self->FindMatchingItem($key_name, $item); if (!defined $item) { return; # no match found } } # match found, in $item $self->EnsureVisible($item); $self->SelectItem($item); } sub GetSelectedKey { my ($self) = @_; my $item = $self->GetSelection; if ($item->IsOk) { my $key = $self->GetPlData($item); return $key; } return; } package ValueListCtrl; use Wx qw(:everything); use Wx::ArtProvider qw(:artid :clientid); use base qw(Wx::ListCtrl); sub new { my ($class, $parent) = @_; my $self = $class->SUPER::new($parent, -1, wxDefaultPosition, wxDefaultSize, wxLC_REPORT|wxLC_SINGLE_SEL|wxBORDER_SUNKEN); bless $self, $class; $self->InsertColumn(0, "Name", wxLIST_FORMAT_LEFT); $self->InsertColumn(1, "Type", wxLIST_FORMAT_LEFT); $self->InsertColumn(2, "Data", wxLIST_FORMAT_LEFT); $self->SetColumnWidth(0, 150); $self->SetColumnWidth(1, 100); $self->SetColumnWidth(2, 150); my $imagelist = Wx::ImageList->new(16, 16, 1); $imagelist->Add(Wx::ArtProvider::GetIcon(wxART_NORMAL_FILE, wxART_MENU, [16, 16])); $self->AssignImageList($imagelist, wxIMAGE_LIST_SMALL); return $self; } sub SetKey { my ($self, $key) = @_; return unless $key->can('get_list_of_values'); my @values = $key->get_list_of_values; $self->DeleteAllItems; my $index = 0; foreach my $value (@values) { my $name = $value->get_name; $name = "(Default)" if $name eq ''; $name =~ s/\0/[NUL]/g; $name =~ s/\n/[LF]/g; $name =~ s/\r/[CR]/g; my $type = $value->get_type_as_string; my $data = substr($value->get_data_as_string, 0, 200); $data =~ s/\0/[NUL]/g; $data =~ s/\n/[LF]/g; $data =~ s/\r/[CR]/g; $index = $self->InsertImageStringItem($index+1, $name, 0); $self->SetItem($index, 1, $type); $self->SetItem($index, 2, $data); } $self->{_key} = $key; $self->{_values} = \@values; } sub GetValue { my ($self, $index) = @_; return $self->{_values}[$index]; } sub Clear { my ($self) = @_; $self->DeleteAllItems; $self->{_key} = undef; $self->{_values} = undef; } sub GoToValue { my ($self, $value_name) = @_; for (my $index = 0; $index < @{$self->{_values}}; $index++) { if ($value_name eq $self->{_values}[$index]->get_name) { $self->EnsureVisible($index); $self->SetItemState($index, wxLIST_STATE_SELECTED, wxLIST_STATE_SELECTED); } } } package ViewFrame; use File::Basename; use FindBin; use Parse::Win32Registry qw(hexdump); use Wx qw(:everything); use Wx::DND; # required for copying to clipboard use Wx::Event qw(:everything); use base qw(Wx::Frame); use constant ID_DUMP_KEYS => Wx::NewId; use constant ID_FIND_NEXT => Wx::NewId; use constant ID_TIMELINE => Wx::NewId; use constant ID_SELECT_FONT => Wx::NewId; sub new { my ($class, $parent) = @_; my $self = $class->SUPER::new($parent, -1, "Registry Viewer", wxDefaultPosition, [600, 400]); bless $self, $class; $self->SetMinSize([600, 400]); my $menu1 = Wx::Menu->new; $menu1->Append(wxID_OPEN, "&Open...\tCtrl+O"); $menu1->Append(wxID_CLOSE, "&Close\tCtrl+W"); $menu1->AppendSeparator; $menu1->Append(wxID_EXIT, "E&xit\tAlt+F4"); my $menu2 = Wx::Menu->new; $menu2->Append(wxID_COPY, "&Copy Key Path\tCtrl+C"); my $menu3 = Wx::Menu->new; $menu3->Append(wxID_FIND, "&Find...\tCtrl+F"); $menu3->Append(ID_FIND_NEXT, "Find &Next\tF3"); $menu3->AppendSeparator; $menu3->Append(ID_TIMELINE, "Show &Timeline..."); my $menu4 = Wx::Menu->new; $menu4->Append(ID_SELECT_FONT, "Select &Font..."); my $menu5 = Wx::Menu->new; $menu5->Append(wxID_ABOUT, "&About..."); my $menubar = Wx::MenuBar->new; $menubar->Append($menu1, "&File"); $menubar->Append($menu2, "&Edit"); $menubar->Append($menu3, "&Search"); $menubar->Append($menu4, "&View"); $menubar->Append($menu5, "&Help"); $self->SetMenuBar($menubar); my $statusbar = Wx::StatusBar->new($self, -1); $self->SetStatusBar($statusbar); EVT_MENU($self, wxID_OPEN, \&OnOpenFile); EVT_MENU($self, wxID_CLOSE, \&OnCloseFile); EVT_MENU($self, wxID_EXIT, \&OnQuit); EVT_MENU($self, wxID_COPY, \&OnCopy); EVT_MENU($self, wxID_FIND, \&OnFind); EVT_MENU($self, ID_FIND_NEXT, \&FindNext); EVT_MENU($self, ID_TIMELINE, \&ShowTimeline); EVT_MENU($self, wxID_ABOUT, \&OnAbout); EVT_MENU($self, ID_SELECT_FONT, \&OnSelectFont); my $hsplitter = Wx::SplitterWindow->new($self, -1, wxDefaultPosition, wxDefaultSize, wxSP_NOBORDER); my $tree = KeyTreeCtrl->new($hsplitter); my $vsplitter = Wx::SplitterWindow->new($hsplitter, -1, wxDefaultPosition, wxDefaultSize, wxSP_NOBORDER); $hsplitter->SplitVertically($tree, $vsplitter); $hsplitter->SetMinimumPaneSize(10); my $list = ValueListCtrl->new($vsplitter); my $text = Wx::TextCtrl->new($vsplitter, -1, '', wxDefaultPosition, wxDefaultSize, wxTE_MULTILINE|wxTE_DONTWRAP|wxTE_READONLY); # Set a monospaced font $text->SetFont(Wx::Font->new(10, wxMODERN, wxNORMAL, wxNORMAL)); $vsplitter->SplitHorizontally($list, $text); $vsplitter->SetMinimumPaneSize(10); $self->{_tree} = $tree; $self->{_list} = $list; $self->{_text} = $text; $self->{_statusbar} = $statusbar; EVT_SPLITTER_DCLICK($self, $hsplitter, \&OnSplitterDClick); EVT_SPLITTER_DCLICK($self, $vsplitter, \&OnSplitterDClick); EVT_TREE_SEL_CHANGED($self, $tree, \&OnKeyTreeSelChanged); EVT_LIST_ITEM_SELECTED($self, $list, \&OnValueListItemSelected); $self->SetIcon(Wx::GetWxPerlIcon()); my $accelerators = Wx::AcceleratorTable->new( [wxACCEL_CTRL, ord('Q'), wxID_EXIT], ); $self->SetAcceleratorTable($accelerators); my $filename = shift @ARGV; if (defined $filename) { $self->LoadFile($filename); } return $self; } sub OnSelectFont { my ($self, $event) = @_; my $text = $self->{_text}; my $font = $text->GetFont; $font = Wx::GetFontFromUser($self, $font); if ($font->IsOk) { $text->SetFont($font); } } sub OnSplitterDClick { my ($self, $event) = @_; $event->Veto; } sub ShowTimeline { my ($self, $event) = @_; return if !defined $self->{_root_key}; my $dialog = $self->{_timeline_dialog}; if (!defined $dialog) { $dialog = $self->{_timeline_dialog} = TimelineDialog->new($self); # OnKeyListItemSelected EVT_LIST_ITEM_SELECTED($self, $dialog->{_list2}, sub { my ($self, $event) = @_; my $index = $event->GetIndex; my $key = $dialog->{_list2}->GetKey($index); if (defined $key) { my $subkey_path = (split(/\\/, $key->get_path, 2))[1]; $self->{_tree}->GoToSubkey($subkey_path); } }); # OnKeyListItemActivated EVT_LIST_ITEM_ACTIVATED($self, $dialog->{_list2}, sub { my ($self, $event) = @_; $self->Raise; }); my $font = $self->{_tree}->GetFont; $dialog->{_list1}->SetFont($font); $dialog->{_list2}->SetFont($font); } if (!defined $self->{_keys_by_time}) { $self->BuildTimeline; return if !defined $self->{_keys_by_time}; # build was cancelled $dialog->SetTimeline($self->{_keys_by_time}); } if (scalar keys %{$self->{_keys_by_time}} == 0) { my $dialog = Wx::MessageDialog->new($self, 'No keys have timestamps!', 'Timeline', wxICON_ERROR|wxOK); $dialog->ShowModal; $dialog->Destroy; return; } $dialog->Show; $dialog->Raise; $dialog->{_list1}->SetFocus; } sub BuildTimeline { my ($self) = @_; return if defined $self->{_keys_by_time}; my $root_key = $self->{_root_key}; return if !defined $root_key; my $subtree_iter = $root_key->get_subtree_iterator; my %keys_by_time = (); my $max = 0; my $progress_dialog = Wx::ProgressDialog->new('Building Timeline', 'Ordering registry keys...', $max, $self, wxPD_CAN_ABORT|wxPD_AUTO_HIDE); $progress_dialog->Update; while (my $key = $subtree_iter->get_next) { my $time = $key->get_timestamp; push @{$keys_by_time{$time}}, $key if defined $time; if (!$progress_dialog->Update) { # Cancelled! $progress_dialog->Destroy; return; } } $self->{_keys_by_time} = \%keys_by_time; $progress_dialog->Destroy; } sub OnCopy { my ($self, $event) = @_; my $key = $self->{_tree}->GetSelectedKey; my $clip = ''; if (defined $key) { $clip = $key->get_path; } wxTheClipboard->Open; wxTheClipboard->SetData(Wx::TextDataObject->new($clip)); wxTheClipboard->Close; } sub OnKeyTreeSelChanged { my ($self, $event) = @_; my $item = $event->GetItem; my $key = $self->{_tree}->GetPlData($item); $self->{_list}->SetKey($key); return if !$key->can('get_list_of_values'); my $details = ''; if (defined $key->get_timestamp) { $details .= "Timestamp: " . $key->get_timestamp_as_string . "\n"; } my $class_name = $key->get_class_name; if (defined $class_name) { $class_name =~ s/\0/[NUL]/g; $class_name =~ s/\n/[LF]/g; $class_name =~ s/\r/[CR]/g; $details .= "Class Name: $class_name\n"; } my $security = $key->get_security; if (defined $security) { my $sd = $security->get_security_descriptor; $details .= $sd->as_stanza; } $self->{_text}->ChangeValue($details); my $key_str = $key->as_string; $key_str =~ s/\0/[NUL]/g; $key_str =~ s/\n/[LF]/g; $key_str =~ s/\r/[CR]/g; $self->{_statusbar}->SetStatusText($key_str); } sub OnValueListItemSelected { my ($self, $event) = @_; my $value = $self->{_list}->GetValue($event->GetIndex); my $details = hexdump($value->get_raw_data); $self->{_text}->ChangeValue($details); } sub OnAbout { my ($self, $event) = @_; my $info = Wx::AboutDialogInfo->new; $info->SetName($FindBin::Script); $info->SetVersion($Parse::Win32Registry::VERSION); $info->SetCopyright('Copyright (c) 2010-2012 James Macfarlane'); $info->SetDescription('wxWidgets Registry Viewer for the Parse::Win32Registry module'); Wx::AboutBox($info); } sub FindNext { my ($self) = @_; my $find_param = $self->{_find_param}; my $find_iter = $self->{_find_iter}; my $search_keys = $self->{_search_keys}; my $search_values = $self->{_search_values}; return if !defined $find_param || $find_param eq ''; return if !defined $find_iter; my $start = time; my $max = 0; my $progress_dialog; my $iter_finished = 1; while (my ($key, $value) = $find_iter->get_next) { my $key_name = $key->get_name; my $key_path = $key->get_path; # strip root key name from path to get subkey path my $subkey_path = (split(/\\/, $key_path, 2))[1]; if (defined $value) { # check value for match if ($search_values) { my $value_name = $value->get_name; if (index(lc $value_name, lc $find_param) >= 0) { $self->{_tree}->GoToSubkey($subkey_path); $self->{_list}->GoToValue($value_name); $self->{_list}->SetFocus; $self->SetFocus; $iter_finished = 0; last; } } } elsif ($search_keys) { # check key for match if (index(lc $key_name, lc $find_param) >= 0) { $self->{_tree}->GoToSubkey($subkey_path); $self->{_tree}->SetFocus; $self->SetFocus; $iter_finished = 0; last; } } if (defined $progress_dialog) { if (!$progress_dialog->Update) { # Cancelled! $iter_finished = 0; last; } } else { # display progress dialog if search is slow if (time - $start >= 1) { $progress_dialog = Wx::ProgressDialog->new('Find', 'Searching registry...', $max, $self, wxPD_CAN_ABORT|wxPD_AUTO_HIDE); } } } if (defined $progress_dialog) { $progress_dialog->Destroy; } if ($iter_finished) { my $dialog = Wx::MessageDialog->new($self, 'Finished searching', 'Find', wxICON_EXCLAMATION|wxOK); $dialog->ShowModal; $dialog->Destroy; } } sub OnFind { my ($self, $event) = @_; my $root_key = $self->{_root_key}; return if !defined $root_key; my $dialog = FindDialog->new($self); $dialog->SetText($self->{_find_param}); $dialog->SetSearchKeys($self->{_search_keys}); $dialog->SetSearchValues($self->{_search_values}); $dialog->SetSearchSelected($self->{_search_selected}); if ($dialog->ShowModal == wxID_OK) { $self->{_find_param} = $dialog->GetText; $self->{_search_keys} = $dialog->GetSearchKeys; $self->{_search_values} = $dialog->GetSearchValues; if (!$self->{_search_keys} && !$self->{_search_values}) { $self->{_search_keys} = $self->{_search_values} = 1; } my $selected_key = $self->{_tree}->GetSelectedKey; my $search_selected = $self->{_search_selected} = $dialog->GetSearchSelected; $self->{_find_iter} = $search_selected ? $selected_key->get_subtree_iterator : $root_key->get_subtree_iterator; $self->FindNext; } $dialog->Destroy; } sub LoadFile { my ($self, $filename) = @_; if (!-r $filename) { my $dialog = Wx::MessageDialog->new($self, "'$filename' cannot be read", 'Error', wxICON_ERROR|wxOK); $dialog->ShowModal; $dialog->Destroy; return } my $basename = basename($filename); my $registry = Parse::Win32Registry->new($filename); if (!defined $registry) { my $dialog = Wx::MessageDialog->new($self, "'$basename' is not a registry file", 'Error', wxICON_ERROR|wxOK); $dialog->ShowModal; $dialog->Destroy; return } my $root_key = $registry->get_root_key; if (!defined $registry) { my $dialog = Wx::MessageDialog->new($self, "'$basename' has no root key", 'Error', wxICON_ERROR|wxOK); $dialog->ShowModal; $dialog->Destroy; return; } # clear $self->OnCloseFile; # set up $self->{_root_key} = $root_key; $self->{_tree}->SetRootKey($root_key); $self->{_tree}->SetFocus; $self->SetTitle("$basename - Registry Viewer"); } sub OnOpenFile { my ($self, $event) = @_; my $dialog = Wx::FileDialog->new($self, 'Select Registry File', $self->{_directory} || ''); if ($dialog->ShowModal != wxID_OK) { return; } my $filename = $dialog->GetPath; $self->{_directory} = $dialog->GetDirectory; $self->LoadFile($filename); } sub OnCloseFile { my ($self, $event) = @_; $self->{_tree}->Clear; $self->{_list}->Clear; $self->{_text}->Clear; $self->{_statusbar}->SetStatusText(''); $self->{_root_key} = undef; $self->{_find_iter} = undef; $self->{_keys_by_time} = undef; $self->SetTitle("Registry Viewer"); if (defined $self->{_timeline_dialog}) { $self->{_timeline_dialog}->SetTimeline({}); $self->{_timeline_dialog}->Hide; } } sub OnQuit { my ($self) = @_; $self->Close; } package FindDialog; use Wx qw(:everything); use Wx::Event qw(:everything); use base qw(Wx::Dialog); sub new { my ($class, $parent) = @_; my $self = $class->SUPER::new($parent, -1, "Find", wxDefaultPosition, wxDefaultSize, wxDEFAULT_DIALOG_STYLE); bless $self, $class; my $static = Wx::StaticText->new($self, -1, 'Enter text to &search for:'); my $text = Wx::TextCtrl->new($self, -1, ''); my $check1 = Wx::CheckBox->new($self, -1, 'Search &keys'); my $check2 = Wx::CheckBox->new($self, -1, 'Search &values'); my $radio = Wx::RadioBox->new($self, -1, 'Start searching', wxDefaultPosition, wxDefaultSize, ['from root key', 'from current key'], 1); my $sizer = Wx::BoxSizer->new(wxVERTICAL); $sizer->Add($static, 0, wxEXPAND|wxALL, 5); $sizer->Add($text, 0, wxEXPAND|wxALL, 5); $sizer->Add($check1, 0, wxALL, 5); $sizer->Add($check2, 0, wxALL, 5); $sizer->Add($radio, 0, wxALL, 5); my $button_sizer = $self->CreateSeparatedButtonSizer(wxOK|wxCANCEL); $sizer->Add($button_sizer, 0, wxEXPAND|wxALL, 5); $self->SetSizer($sizer); $self->{_text} = $text; $self->{_check1} = $check1; $self->{_check2} = $check2; $self->{_radio} = $radio; $self->Fit; # resize dialog to best fit child windows $self->{_text}->SetFocus; $self->SetFocus; EVT_CHECKBOX($self, $check1, sub { if (!$check1->GetValue && !$check2->GetValue) { $check2->SetValue(1); } }); EVT_CHECKBOX($self, $check2, sub { if (!$check1->GetValue && !$check2->GetValue) { $check1->SetValue(1); } }); return $self; } sub GetSearchKeys { my ($self) = @_; return $self->{_check1}->GetValue; } sub GetSearchValues { my ($self) = @_; return $self->{_check2}->GetValue; } sub GetText { my ($self) = @_; return $self->{_text}->GetValue; } sub GetSearchSelected { my ($self) = @_; return $self->{_radio}->GetSelection; } sub SetSearchKeys { my ($self, $state) = @_; $state = 1 if !defined $state; $self->{_check1}->SetValue($state); } sub SetSearchValues { my ($self, $state) = @_; $state = 1 if !defined $state; $self->{_check2}->SetValue($state); } sub SetText { my ($self, $value) = @_; $value = '' if !defined $value; $self->{_text}->ChangeValue($value); $self->{_text}->SetSelection(-1, -1); } sub SetSearchSelected { my ($self, $n) = @_; $n = 0 if !defined $n; $self->{_radio}->SetSelection($n); } package TimeListCtrl; use Parse::Win32Registry qw(iso8601); use Wx qw(:everything); use base qw(Wx::ListCtrl); sub new { my ($class, $parent) = @_; my $self = $class->SUPER::new($parent, -1, wxDefaultPosition, [200, -1], wxLC_REPORT|wxLC_SINGLE_SEL|wxLC_VIRTUAL|wxBORDER_SUNKEN); bless $self, $class; $self->InsertColumn(0, "Time"); $self->InsertColumn(1, "Count"); $self->SetColumnWidth(0, 200); $self->{_times} = []; $self->{_key_counts} = []; return $self; } sub OnGetItemText { my ($self, $index, $column) = @_; if ($column == 0) { return iso8601($self->{_times}[$index]); } elsif ($column == 1) { return $self->{_key_counts}[$index]; } else { return "?"; } } sub SetTimes { my ($self, $times, $key_counts) = @_; $self->{_times} = $times; $self->{_key_counts} = $key_counts; $self->SetItemCount(scalar @$times); $self->Refresh; $self->SetItemState(0, wxLIST_STATE_FOCUSED, wxLIST_STATE_FOCUSED); } sub GetTime { my ($self, $index) = @_; return $self->{_times}[$index]; } package KeyListCtrl; use Wx qw(:everything); use Wx::ArtProvider qw(:artid :clientid); use base qw(Wx::ListCtrl); sub new { my ($class, $parent) = @_; my $self = $class->SUPER::new($parent, -1, wxDefaultPosition, [200, -1], wxLC_REPORT|wxLC_SINGLE_SEL|wxLC_VIRTUAL|wxBORDER_SUNKEN); bless $self, $class; my $imagelist = Wx::ImageList->new(16, 16, 1); $imagelist->Add(Wx::ArtProvider::GetIcon(wxART_FOLDER, wxART_MENU, [16, 16])); $self->AssignImageList($imagelist, wxIMAGE_LIST_SMALL); $self->InsertColumn(0, "Key"); $self->SetColumnWidth(0, 280); return $self; } sub OnGetItemText { my ($self, $index, $column) = @_; my $key = $self->{_keys}[$index]; return if !defined $key; if ($column == 0) { my $key_path = $key->get_path; $key_path =~ s/\0/[NUL]/g; $key_path =~ s/\n/[LF]/g; $key_path =~ s/\r/[CR]/g; return $key_path; } else { return "?"; } } sub OnGetItemImage { my ($self, $index) = @_; return 0; } sub SetKeys { my ($self, $keys) = @_; $self->{_keys} = $keys; $self->SetItemCount(scalar @$keys); $self->Refresh; $self->SetItemState(0, wxLIST_STATE_FOCUSED, wxLIST_STATE_FOCUSED); } sub GetKey { my ($self, $index) = @_; return $self->{_keys}[$index]; } package TimelineDialog; use Wx qw(:everything); use Wx::Event qw(:everything); use base qw(Wx::Frame); use constant ID_CLOSE_DIALOG => Wx::NewId; sub new { my ($class, $parent) = @_; my $self = $class->SUPER::new($parent, -1, "Timeline", wxDefaultPosition, [600, 300]); bless $self, $class; $self->SetMinSize([600, 300]); my $hsplitter = Wx::SplitterWindow->new($self, -1, wxDefaultPosition, wxDefaultSize, wxSP_NOBORDER); my $list1 = TimeListCtrl->new($hsplitter); my $list2 = KeyListCtrl->new($hsplitter); $hsplitter->SplitVertically($list1, $list2); $hsplitter->SetMinimumPaneSize(10); $self->{_list1} = $list1; $self->{_list2} = $list2; my $accelerators = Wx::AcceleratorTable->new( [0, WXK_ESCAPE, ID_CLOSE_DIALOG], [wxACCEL_CTRL, ord('W'), ID_CLOSE_DIALOG], ); $self->SetAcceleratorTable($accelerators); EVT_MENU($self, ID_CLOSE_DIALOG, \&OnClose); EVT_SPLITTER_DCLICK($self, $hsplitter, \&OnSplitterDClick); EVT_LIST_ITEM_SELECTED($self, $list1, \&OnTimeListItemSelected); EVT_CLOSE($self, \&OnClose); $self->SetIcon(Wx::GetWxPerlIcon()); return $self; } sub OnSplitterDClick { my ($self, $event) = @_; $event->Veto; } sub OnTimeListItemSelected { my ($self, $event) = @_; my $index = $event->GetIndex; my $time = $self->{_list1}->GetTime($index); $self->{_list2}->SetKeys($self->{_keys_by_time}{$time}); } sub OnKeyListItemActivated { my ($self, $event) = @_; $self->Close; } sub SetTimeline { my ($self, $keys_by_time) = @_; my @times = sort keys %$keys_by_time; my @key_counts = map { scalar @{$keys_by_time->{$_}} } @times; my $list1 = $self->{_list1}; $list1->SetTimes(\@times, \@key_counts); my $list2 = $self->{_list2}; $list2->SetKeys([]); $self->{_times} = \@times; $self->{_keys_by_time} = $keys_by_time; } sub OnClose { my ($self, $event) = @_; $self->Hide; } package ViewApp; use Wx qw(:everything); use base qw(Wx::App); sub OnInit { my ($self) = @_; my $frame = ViewFrame->new(undef); $frame->Show; return 1; } package main; my $app = ViewApp->new; $app->MainLoop; Parse-Win32Registry-1.0/bin/regdiff.pl0000755000175000017500000001367611747213110016653 0ustar ownerowner#!/usr/bin/perl use strict; use warnings; use File::Basename; use Getopt::Long; use Parse::Win32Registry; binmode(STDOUT, ':utf8'); Getopt::Long::Configure('bundling'); GetOptions('previous|p' => \my $show_previous, 'values|v' => \my $show_values); my $left_filename = shift or die usage(); my $right_filename = shift or die usage(); my $initial_key_path = shift; my $left_registry = Parse::Win32Registry->new($left_filename) or die "'$left_filename' is not a registry file\n"; my $right_registry = Parse::Win32Registry->new($right_filename) or die "'$right_filename' is not a registry file\n"; my $left_root_key = $left_registry->get_root_key or die "Could not get root key of '$left_filename'\n"; my $right_root_key = $right_registry->get_root_key or die "Could not get root key of '$right_filename'\n"; if (defined($initial_key_path)) { $left_root_key = $left_root_key->get_subkey($initial_key_path); if (!defined($left_root_key)) { die "Could not find the key '$initial_key_path' in '$left_filename'\n"; } $right_root_key = $right_root_key->get_subkey($initial_key_path); if (!defined($right_root_key)) { die "Could not find the key '$initial_key_path' in '$right_filename'\n"; } } # Descend both registry trees together traverse_together($left_root_key, $right_root_key); sub traverse_together { my $left_key = shift; my $right_key =shift; # Build a combined list of 'left' and 'right' values my %values = (); if (defined($left_key)) { foreach my $left_value ($left_key->get_list_of_values) { $values{$left_value->get_name}{left} = $left_value; } } if (defined($right_key)) { foreach my $right_value ($right_key->get_list_of_values) { $values{$right_value->get_name}{right} = $right_value; } } # Count the number of changed values my $changed = 0; foreach my $value_name (keys %values) { if (defined $values{$value_name}{left} && defined $values{$value_name}{right}) { if ($values{$value_name}{left}->get_data ne $values{$value_name}{right}->get_data) { # value has been changed $changed++; } } else { # Value has been deleted or inserted $changed++; } } if (defined($left_key) && !defined($right_key)) { # Right key has been deleted print "DELETED\t", $left_key->as_string, "\n"; } elsif (!defined($left_key) && defined($right_key)) { # Right key has been inserted print "ADDED\t", $right_key->as_string, "\n"; } else { # If both keys are present, compare timestamps # to see if there have been any changes. # If the keys do not have timestamps, use the count of changed values # to determine if the key should be displayed or not. my $left_timestamp = $left_key->get_timestamp; my $right_timestamp = $right_key->get_timestamp; my $is_winnt = defined($left_timestamp) && defined($right_timestamp); if ($is_winnt && $left_timestamp < $right_timestamp) { # Right key is newer print "NEWER\t", $right_key->as_string, "\n"; if ($show_previous) { print "WAS\t", $left_key->as_string, "\n"; } } elsif ($is_winnt && $left_timestamp > $right_timestamp) { # Right key is older print "OLDER\t", $right_key->as_string, "\n"; if ($show_previous) { print "WAS\t", $left_key->as_string, "\n"; } } else { # There are no differences between the timestamps # or neither key has a valid timestamp. if ($show_values) { if ($changed > 0) { #print "\t$changed VALUES CHANGED IN\n"; if (defined($left_key)) { print "\t", $left_key->as_string, "\n"; } else { print "\t", $right_key->as_string, "\n"; } } } } } if ($show_values) { # Print out changed values foreach my $value_name (keys %values) { my $left_value = $values{$value_name}{left}; my $right_value = $values{$value_name}{right}; if (defined($left_value) && !defined($right_value)) { print "DELETED\t", $left_value->as_string, "\n"; } elsif (!defined($left_value) && defined($right_value)) { print "ADDED\t", $right_value->as_string, "\n"; } else { if ($left_value->get_data ne $right_value->get_data) { print "CHANGED\t", $right_value->as_string, "\n"; if ($show_previous) { print "WAS\t", $left_value->as_string, "\n"; } } } } } # Build a combined list of 'left' and 'right' subkeys my %subkeys = (); if (defined($left_key)) { foreach my $left_subkey ($left_key->get_list_of_subkeys) { $subkeys{$left_subkey->get_name}{left} = $left_subkey; } } if (defined($right_key)) { foreach my $right_subkey ($right_key->get_list_of_subkeys) { $subkeys{$right_subkey->get_name}{right} = $right_subkey; } } foreach my $key_name (keys %subkeys) { traverse_together($subkeys{$key_name}{left}, $subkeys{$key_name}{right}); } } sub usage { my $script_name = basename $0; return < [subkey] [-p] [-v] -p or --previous show the previous key or value (this is not normally shown) -v or --values display values USAGE } Parse-Win32Registry-1.0/bin/regstats.pl0000755000175000017500000000317211747213110017067 0ustar ownerowner#!/usr/bin/perl use strict; use warnings; use File::Basename; use Getopt::Long; use Parse::Win32Registry 0.40; binmode(STDOUT, ':utf8'); Getopt::Long::Configure('bundling'); GetOptions('types|t' => \my $count_types); my $filename = shift or die usage(); my $registry = Parse::Win32Registry->new($filename) or die "'$filename' is not a registry file\n"; my $root_key = $registry->get_root_key or die "Could not get root key of '$filename'\n"; warn "Counting keys and values...\n"; my $total_keys = 0; my $total_values = 0; my %type_count = (); traverse($root_key); print "Filename: $filename\n"; if (defined $registry->get_timestamp) { print "Registry Timestamp: ", $registry->get_timestamp_as_string, "\n"; } if (defined $registry->get_embedded_filename) { print "Embedded Filename: ", $registry->get_embedded_filename, "\n"; } print "Root Key Name: ", $root_key->get_name, "\n"; print "Keys: $total_keys\n"; print "Values: $total_values\n"; if ($count_types) { foreach my $type_as_string (sort keys %type_count) { print "$type_as_string: $type_count{$type_as_string}\n"; } } sub traverse { my $key = shift; $total_keys++; foreach my $value ($key->get_list_of_values) { $type_count{$value->get_type_as_string}++; $total_values++; } foreach my $subkey ($key->get_list_of_subkeys) { traverse($subkey); } } sub usage { my $script_name = basename $0; return < [-t] -t or --types count value types USAGE } Parse-Win32Registry-1.0/bin/regexport.pl0000755000175000017500000000311411747213110017246 0ustar ownerowner#!/usr/bin/perl use strict; use warnings; use File::Basename; use Getopt::Long; use Parse::Win32Registry 0.40; binmode(STDOUT, ":utf8"); Getopt::Long::Configure('bundling'); GetOptions('recurse|r' => \my $recurse); my $filename = shift or die usage(); my $initial_key_path = shift; my $registry = Parse::Win32Registry->new($filename) or die "'$filename' is not a registry file\n"; my $root_key = $registry->get_virtual_root_key or die "Could not get root key of '$filename'\n"; if (defined($initial_key_path)) { $root_key = $root_key->get_subkey($initial_key_path); if (!defined($root_key)) { die "Could not locate the key '$initial_key_path' in '$filename'\n"; } } print "Windows Registry Editor Version 5.00\n"; traverse($root_key); sub traverse { my $key = shift; print "\n"; print $key->as_regedit_export; foreach my $value ($key->get_list_of_values) { print $value->as_regedit_export; } if ($recurse) { foreach my $subkey ($key->get_list_of_subkeys) { traverse($subkey); } } else { print "\n"; foreach my $subkey ($key->get_list_of_subkeys) { print "; SUBKEY ", $subkey->get_name, "\n"; } } } sub usage { my $script_name = basename $0; return < [subkey] [-r] -r or --recurse traverse all child keys from the root key or the subkey specified USAGE } Parse-Win32Registry-1.0/bin/regtree.pl0000755000175000017500000000410711747213110016667 0ustar ownerowner#!/usr/bin/perl use strict; use warnings; use File::Basename; use Getopt::Long; use Parse::Win32Registry; binmode(STDOUT, ':utf8'); Getopt::Long::Configure('bundling'); GetOptions('values|v' => \my $show_values); my $filename = shift or die usage(); my $initial_key_path = shift; my $registry = Parse::Win32Registry->new($filename) or die "'$filename' is not a registry file\n"; my $root_key = $registry->get_root_key or die "Could not get root key of '$filename'\n"; if (defined($initial_key_path)) { $root_key = $root_key->get_subkey($initial_key_path); if (!defined($root_key)) { die "Could not locate the key '$initial_key_path' in '$filename'\n"; } } traverse($root_key); sub traverse { my $key = shift; my @siblings = @_; # @siblings tracks the number of remaining keys at each level of depth # $siblings[0] = count of remaining sibling keys at level 0 # $siblings[1] = count of remaining sibling keys at level 1 # etc. if (@siblings) { foreach my $remaining (@siblings[0..$#siblings-1]) { print $remaining > 0 ? "| " : " "; } print $siblings[-1] > 0 ? "+-" : "`-"; } print $key->get_name; if (defined($key->get_timestamp)) { print " [", $key->get_timestamp_as_string, "]" } print "\n"; # initialize the count of remaining sibling keys for this depth push @siblings, scalar $key->get_list_of_subkeys; if ($show_values) { foreach my $value ($key->get_list_of_values) { foreach my $remaining (@siblings) { print $remaining > 0 ? "| " : " "; } print $value->as_string, "\n"; } } foreach my $subkey ($key->get_list_of_subkeys) { $siblings[-1]--; traverse($subkey, @siblings); } } sub usage { my $script_name = basename $0; return < [subkey] [-v] -v or --values display values USAGE } Parse-Win32Registry-1.0/bin/gtkregcompare.pl0000755000175000017500000011140211747213110020061 0ustar ownerowner#!/usr/bin/perl use strict; use warnings; use Glib ':constants'; use Gtk2 -init; my $window_width = 600; my $window_height = 400; use File::Basename; use File::Spec; use Parse::Win32Registry 0.51 qw( make_multiple_subtree_iterator make_multiple_subkey_iterator make_multiple_value_iterator compare_multiple_keys compare_multiple_values hexdump ); binmode(STDOUT, ':utf8'); my $script_name = basename $0; ### REGISTRY FILE STORE use constant { REGCOL_FILENAME => 0, REGCOL_EMBEDDED_FILENAME => 1, REGCOL_TIMESTAMP => 2, REGCOL_DIRECTORY => 3, REGCOL_REGISTRY => 4, }; my $registry_store = Gtk2::ListStore->new( 'Glib::String', 'Glib::String', 'Glib::String', 'Glib::String', 'Glib::Scalar', ); ### TREE STORE use constant { TREECOL_NAME => 0, TREECOL_CHANGES => 1, TREECOL_KEYS => 2, TREECOL_VALUES => 3, TREECOL_ICON => 4, }; my $tree_store = Gtk2::TreeStore->new( 'Glib::String', 'Glib::Scalar', 'Glib::Scalar', 'Glib::Scalar', 'Glib::String', ); my $tree_view = Gtk2::TreeView->new($tree_store); my $icon_cell = Gtk2::CellRendererPixbuf->new; my $name_cell = Gtk2::CellRendererText->new; my $tree_column0 = Gtk2::TreeViewColumn->new; $tree_column0->set_title('Name'); $tree_column0->pack_start($icon_cell, FALSE); $tree_column0->pack_start($name_cell, TRUE); $tree_column0->set_attributes($icon_cell, 'stock-id', TREECOL_ICON); $tree_column0->set_attributes($name_cell, 'text', TREECOL_NAME); $tree_view->append_column($tree_column0); $tree_column0->set_resizable(TRUE); $tree_view->set_rules_hint(TRUE); # row-expanded when row is expanded (e.g. after user clicks on arrow) $tree_view->signal_connect('row-expanded' => \&expand_row); $tree_view->signal_connect('row-collapsed' => \&collapse_row); # row-activated when user double clicks on row $tree_view->signal_connect('row-activated' => \&activate_row); my $tree_selection = $tree_view->get_selection; $tree_selection->set_mode('browse'); $tree_selection->signal_connect('changed' => \&tree_item_selected); my $scrolled_tree_view = Gtk2::ScrolledWindow->new; $scrolled_tree_view->set_policy('automatic', 'automatic'); $scrolled_tree_view->set_shadow_type('in'); $scrolled_tree_view->add($tree_view); ### LIST STORE use constant { LISTCOL_FILENUM => 0, LISTCOL_CHANGE => 1, LISTCOL_ITEM_STRING => 2, LISTCOL_ITEM => 3, LISTCOL_ICON => 4, }; my $list_store = Gtk2::ListStore->new( 'Glib::String', 'Glib::String', 'Glib::String', 'Glib::Scalar', 'Glib::String', ); my $list_view = Gtk2::TreeView->new($list_store); my $list_cell0 = Gtk2::CellRendererText->new; my $list_column0 = Gtk2::TreeViewColumn->new_with_attributes( '', $list_cell0, 'text', LISTCOL_FILENUM); $list_view->append_column($list_column0); my $list_cell2 = Gtk2::CellRendererText->new; my $list_column2 = Gtk2::TreeViewColumn->new_with_attributes( 'Change', $list_cell2, 'text', LISTCOL_CHANGE); $list_view->append_column($list_column2); $list_column2->set_resizable(TRUE); my $list_icon_cell = Gtk2::CellRendererPixbuf->new; my $list_item_cell = Gtk2::CellRendererText->new; my $list_column3 = Gtk2::TreeViewColumn->new; $list_column3->pack_start($list_icon_cell, FALSE); $list_column3->pack_start($list_item_cell, TRUE); $list_column3->set_attributes($list_icon_cell, 'stock-id', LISTCOL_ICON); $list_column3->set_attributes($list_item_cell, 'text', LISTCOL_ITEM_STRING); $list_view->append_column($list_column3); $list_column3->set_resizable(TRUE); $list_item_cell->set('ellipsize', 'end'); $list_view->set_rules_hint(TRUE); $list_view->set_headers_visible(FALSE); my $list_selection = $list_view->get_selection; $list_selection->set_mode('browse'); $list_selection->signal_connect('changed' => \&list_item_selected); my $scrolled_list_view = Gtk2::ScrolledWindow->new; $scrolled_list_view->set_policy('automatic', 'automatic'); $scrolled_list_view->set_shadow_type('in'); $scrolled_list_view->add($list_view); ### TEXT VIEW my $text_view = Gtk2::TextView->new; $text_view->set_editable(FALSE); $text_view->modify_font(Gtk2::Pango::FontDescription->from_string('monospace')); my $text_buffer = $text_view->get_buffer; my $scrolled_text_view = Gtk2::ScrolledWindow->new; $scrolled_text_view->set_policy('automatic', 'automatic'); $scrolled_text_view->set_shadow_type('in'); $scrolled_text_view->add($text_view); ### VPANED my $vpaned2 = Gtk2::VPaned->new; $vpaned2->pack1($scrolled_list_view, FALSE, FALSE); $vpaned2->pack2($scrolled_text_view, FALSE, FALSE); ### VPANED my $vpaned1 = Gtk2::VPaned->new; $vpaned1->pack1($scrolled_tree_view, FALSE, FALSE); $vpaned1->pack2($vpaned2, FALSE, FALSE); ### UIMANAGER my $uimanager = Gtk2::UIManager->new; my @actions = ( # name, stock id, label ['FileMenu', undef, '_File'], ['EditMenu', undef, '_Edit'], ['SearchMenu', undef, '_Search'], ['ViewMenu', undef, '_View'], ['HelpMenu', undef, '_Help'], # name, stock-id, label, accelerator, tooltip, callback ['Open', 'gtk-open', '_Select Files...', 'O', undef, \&open_files], ['Close', 'gtk-close', '_Close Files', 'W', undef, \&close_files], ['Quit', 'gtk-quit', '_Quit', 'Q', undef, \&quit], ['Copy', 'gtk-copy', '_Copy Path', 'C', undef, \©_path], ['Find', 'gtk-find', '_Find...', 'F', undef, \&find], ['FindNext', undef, 'Find _Next', 'G', undef, \&find_next], ['FindNext2', undef, 'Find Next', 'F3', undef, \&find_next], ['FindChange', 'gtk-find-and-replace', 'Find _Change...', 'N', undef, \&find_change], ['FindNextChange', undef, 'Find N_ext Change', 'M', undef, \&find_next_change], ['FindNextChange2', undef, 'Find Next Change', 'F4', undef, \&find_next_change], ['About', 'gtk-about', '_About...', undef, undef, \&about], ); my $default_actions = Gtk2::ActionGroup->new('actions'); $default_actions->add_actions(\@actions, undef); my @toggle_actions = ( # name, stock id, label, accelerator, tooltip, callback, active ['ShowDetail', 'gtk-edit', 'Show _Detail', 'D', undef, \&toggle_item_detail, TRUE], ); $default_actions->add_toggle_actions(\@toggle_actions, undef); $uimanager->insert_action_group($default_actions, 0); my $ui_info = < END_OF_UI $uimanager->add_ui_from_string($ui_info); my $menubar = $uimanager->get_widget('/MenuBar'); ### STATUSBAR my $statusbar = Gtk2::Statusbar->new; ### VBOX my $main_vbox = Gtk2::VBox->new(FALSE, 0); $main_vbox->pack_start($menubar, FALSE, FALSE, 0); $main_vbox->pack_start($vpaned1, TRUE, TRUE, 0); $main_vbox->pack_start($statusbar, FALSE, FALSE, 0); ### WINDOW my $window = Gtk2::Window->new; $window->set_default_size($window_width, $window_height); $window->set_position('center'); $window->signal_connect(destroy => sub { Gtk2->main_quit }); $window->add($main_vbox); $window->add_accel_group($uimanager->get_accel_group); $window->set_title($script_name); $window->show_all; ############################################################################### sub build_open_files_dialog { my $registry_view = Gtk2::TreeView->new($registry_store); $registry_view->set_reorderable(TRUE); my $registry_column0 = Gtk2::TreeViewColumn->new_with_attributes( 'Filename', Gtk2::CellRendererText->new, 'text', REGCOL_FILENAME); $registry_view->append_column($registry_column0); $registry_column0->set_resizable(TRUE); my $registry_column1 = Gtk2::TreeViewColumn->new_with_attributes( 'Embedded Filename', Gtk2::CellRendererText->new, 'text', REGCOL_EMBEDDED_FILENAME); $registry_view->append_column($registry_column1); $registry_column1->set_resizable(TRUE); my $registry_column2 = Gtk2::TreeViewColumn->new_with_attributes( 'Embedded Timestamp', Gtk2::CellRendererText->new, 'text', REGCOL_TIMESTAMP); $registry_view->append_column($registry_column2); $registry_column2->set_resizable(TRUE); my $registry_column3 = Gtk2::TreeViewColumn->new_with_attributes( 'Directory', Gtk2::CellRendererText->new, 'text', REGCOL_DIRECTORY); $registry_view->append_column($registry_column3); $registry_column3->set_resizable(TRUE); my $scrolled_registry_view = Gtk2::ScrolledWindow->new; $scrolled_registry_view->set_policy('automatic', 'automatic'); $scrolled_registry_view->set_shadow_type('in'); $scrolled_registry_view->add($registry_view); my $selection = $registry_view->get_selection; $selection->set_mode('multiple'); my $label = Gtk2::Label->new; $label->set_markup('Drag files to reorder them'); my $dialog = Gtk2::Dialog->new('Select Registry Files', $window, 'modal', 'gtk-clear' => 70, 'gtk-add' => 60, 'gtk-remove' => 50, 'gtk-cancel' => 'cancel', 'gtk-ok' => 'ok', ); $dialog->set_size_request($window_width * 1, $window_height * 0.8); $dialog->vbox->pack_start($scrolled_registry_view, TRUE, TRUE, 0); $dialog->vbox->pack_start($label, FALSE, FALSE, 5); $dialog->set_default_response('ok'); $dialog->signal_connect(delete_event => sub { $dialog->hide; return TRUE; }); $dialog->signal_connect(response => sub { my ($dialog, $response) = @_; if ($response eq '70') { $registry_store->clear; } elsif ($response eq '60') { my @filenames = choose_files(); foreach my $filename (@filenames) { my ($name, $path) = fileparse($filename); if (my $registry = Parse::Win32Registry->new($filename)) { if (my $root_key = $registry->get_root_key) { add_registry($registry); } } else { show_message('error', "'$name' is not a registry file."); } } } elsif ($response eq '50') { my $selection = $registry_view->get_selection; my @paths = $selection->get_selected_rows; my @iters = map { $registry_store->get_iter($_) } @paths; foreach my $iter (@iters) { $registry_store->remove($iter); } } elsif ($response eq 'ok') { $dialog->hide; compare_files(); } else { $dialog->hide; } }); return $dialog; } my $open_files_dialog = build_open_files_dialog; ######################## GLOBAL SETUP my @registries = (); my @root_keys = (); my $last_dir; my $search_keys = TRUE; my $search_values = TRUE; my $search_selected = 0; my $find_param = ''; my $find_iter; my $change_iter; if (@ARGV) { my @filenames = (); while (my $filename = shift) { push @filenames, $filename if -r $filename; } @filenames = map { File::Spec->rel2abs($_) } @filenames; foreach my $filename (@filenames) { if (my $registry = Parse::Win32Registry->new($filename)) { if (my $root_key = $registry->get_root_key) { add_registry($registry); } } } } compare_files(); Gtk2->main; ############################################################################### sub expand_row { my ($view, $iter, $path) = @_; my $model = $view->get_model; # check that this is a key my $icon = $model->get($iter, TREECOL_ICON); if ($icon eq 'gtk-file') { return; } my $keys = $model->get($iter, TREECOL_KEYS); my $first_child_iter = $model->iter_nth_child($iter, 0); # add children if not already present if (!defined $model->get($first_child_iter, 0)) { add_children($keys, $model, $iter); $model->remove($first_child_iter); } } sub collapse_row { my ($view, $iter, $path) = @_; } sub activate_row { my ($view, $path, $column) = @_; if ($view->row_expanded($path)) { $view->collapse_row($path); } else { $view->expand_row($path, FALSE); } } sub toggle_item_detail { my ($toggle_action) = @_; if ($toggle_action->get_active) { $scrolled_text_view->show; } else { $scrolled_text_view->hide; } } sub tree_item_selected { my ($tree_selection) = @_; my ($model, $iter) = $tree_selection->get_selected; if (!defined $model || !defined $iter) { return; } my $changes = $model->get($iter, TREECOL_CHANGES); my $keys = $model->get($iter, TREECOL_KEYS); my $values = $model->get($iter, TREECOL_VALUES); $list_store->clear; $text_buffer->set_text(''); my $batch_size = @root_keys; if (defined $changes) { for (my $num = 0; $num < $batch_size; $num++) { my $item_as_string = ''; my $item = ''; my $icon = ''; if (defined $values) { # values my $key = $keys->[$num]; my $value = $values->[$num]; if (defined $value) { $item_as_string = $value->as_string; $item = $value; $icon = 'gtk-file'; } } else { # keys my $key = $keys->[$num]; if (defined $key) { $item_as_string = $key->as_string; $item = $key; $icon = 'gtk-directory'; } } $item_as_string = substr($item_as_string, 0, 500); $item_as_string =~ s/\0/[NUL]/g; my $iter = $list_store->append; $list_store->set($iter, LISTCOL_FILENUM, "[$num]", LISTCOL_CHANGE, $changes->[$num], LISTCOL_ITEM_STRING, $item_as_string, LISTCOL_ITEM, $item, LISTCOL_ICON, $icon); } } else { my $item_as_string = ''; my $item = ''; my $icon = ''; if (defined $values) { # values my $any_value = (grep { defined } @$values)[0]; $item_as_string = $any_value->as_string; $item = $any_value; $icon = 'gtk-file'; } else { # keys my $any_key = (grep { defined } @$keys)[0]; $item_as_string = $any_key->as_string; $item = $any_key; $icon = 'gtk-directory'; } $item_as_string = substr($item_as_string, 0, 500); $item_as_string =~ s/\0/[NUL]/g; my $iter = $list_store->append; $list_store->set($iter, LISTCOL_FILENUM, "[*]", LISTCOL_CHANGE, "", LISTCOL_ITEM_STRING, $item_as_string, LISTCOL_ITEM, $item, LISTCOL_ICON, $icon); } my $status = ''; my $any_key = (grep { defined } @$keys)[0]; my $key_path = $any_key->get_path; if (defined $values) { my $any_value = (grep { defined } @$values)[0]; my $name = $any_value->get_name; $name = "(Default)" if $name eq ''; $status = "$key_path, $name"; } else { $status = $key_path; } $status =~ s/\0/[NUL]/g; $statusbar->pop(0); $statusbar->push(0, $status); } sub list_item_selected { my ($list_selection) = @_; my ($model, $iter) = $list_selection->get_selected; if (!defined $model || !defined $iter) { return; } my $item = $model->get($iter, LISTCOL_ITEM); my $icon = $model->get($iter, LISTCOL_ICON); # there will be no item/icon for deleted items my $str = ''; if (defined $item) { if ($icon eq 'gtk-file') { # item is a value $str .= hexdump($item->get_raw_data); } elsif ($icon eq 'gtk-directory') { # item is a key my $security = $item->get_security; if (defined $security) { my $sd = $security->get_security_descriptor; $str .= $sd->as_stanza; } } } $text_buffer->set_text($str); } sub compare_files { close_files(); # will clear @root_keys # Set up global variables: @registries, @root_keys @registries = (); my $iter = $registry_store->get_iter_first; while (defined $iter) { my $registry = $registry_store->get($iter, REGCOL_REGISTRY); push @registries, $registry; $iter = $registry_store->iter_next($iter); } @root_keys = map { $_->get_root_key } @registries; if (@registries > 0) { my $filename = $registries[0]->get_filename; my $basename = basename($filename); $basename .= ',...' if @registries > 1; $window->set_title("$basename - $script_name"); } else { $window->set_title($script_name); } my $batch_size = @root_keys; # Create columns with a custom function to display changes for (my $num = 0; $num < $batch_size; $num++) { $tree_view->insert_column_with_data_func( $num + 1, "[$num]", Gtk2::CellRendererText->new, sub { my ($column, $cell, $model, $iter, $num) = @_; my $changes = $model->get($iter, TREECOL_CHANGES); if (defined $changes) { my $diff = substr($changes->[$num], 0, 1); $cell->set('text', $diff || "\x{00bb}"); } else { $cell->set('text', "\x{00b7}"); } }, $num, # additional data is passed to callback ); } add_root(\@root_keys, $tree_store, undef); } sub add_root { my ($items, $model, $parent_iter) = @_; my @root_keys = @$items; return if @root_keys == 0; my $any_root_key = (grep { defined } @root_keys)[0]; my $key_name = $any_root_key->get_name; $key_name =~ s/\0/[NUL]/g; my @changes = compare_multiple_keys(@root_keys); my $num_changes = grep { $_ } @changes; my $iter = $model->append($parent_iter); if ($num_changes > 0) { $model->set($iter, TREECOL_NAME, $key_name, TREECOL_CHANGES, \@changes, TREECOL_KEYS, \@root_keys, TREECOL_ICON, 'gtk-directory'); } else { $model->set($iter, TREECOL_NAME, $key_name, #TREECOL_CHANGES, \@changes, TREECOL_KEYS, \@root_keys, TREECOL_ICON, 'gtk-directory'); } my $dummy = $model->append($iter); # placeholder for children } sub add_children { my ($keys, $model, $parent_iter) = @_; my @keys = @$keys; my $subkeys_iter = make_multiple_subkey_iterator(@keys); while (defined(my $subkeys = $subkeys_iter->get_next)) { my @changes = compare_multiple_keys(@$subkeys); my $num_changes = grep { $_ } @changes; # insert a 'blank' change for missing subkeys for (my $i = 0; $i < @changes; $i++) { if ($changes[$i] eq '' && !defined $subkeys->[$i]) { $changes[$i] = ' '; } } my $any_subkey = (grep { defined } @$subkeys)[0]; my $key_name = $any_subkey->get_name; $key_name =~ s/\0/[NUL]/g; my $iter = $model->append($parent_iter); if ($num_changes > 0) { $model->set($iter, TREECOL_NAME, $key_name, TREECOL_CHANGES, \@changes, TREECOL_KEYS, $subkeys, TREECOL_ICON, 'gtk-directory'); } else { $model->set($iter, TREECOL_NAME, $key_name, #TREECOL_CHANGES, \@changes, TREECOL_KEYS, $subkeys, TREECOL_ICON, 'gtk-directory'); } my $dummy = $model->append($iter); # placeholder for children } my $values_iter = make_multiple_value_iterator(@keys); while (defined(my $values = $values_iter->get_next)) { my @changes = compare_multiple_values(@$values); my $num_changes = grep { $_ } @changes; # insert a 'blank' change for missing values for (my $i = 0; $i < @changes; $i++) { if ($changes[$i] eq '' && !defined $values->[$i]) { $changes[$i] = ' '; } } my $any_value = (grep { defined } @$values)[0]; my $value_name = $any_value->get_name; $value_name = "(Default)" if $value_name eq ''; $value_name =~ s/\0/[NUL]/g; my $iter = $model->append($parent_iter); if ($num_changes > 0) { $model->set($iter, TREECOL_NAME, $value_name, TREECOL_CHANGES, \@changes, TREECOL_KEYS, $keys, TREECOL_VALUES, $values, TREECOL_ICON, 'gtk-file'); } else { $model->set($iter, TREECOL_NAME, $value_name, #TREECOL_CHANGES, \@changes, TREECOL_KEYS, $keys, TREECOL_VALUES, $values, TREECOL_ICON, 'gtk-file'); } } } sub add_registry { my $registry = shift; my $filename = $registry->get_filename; my $embedded_filename = $registry->get_embedded_filename; $embedded_filename = '' if !defined $embedded_filename; my $timestamp = $registry->get_timestamp; $timestamp = defined $timestamp ? $registry->get_timestamp_as_string : ''; my $iter = $registry_store->append; $registry_store->set($iter, REGCOL_FILENAME, basename($filename), REGCOL_EMBEDDED_FILENAME, $embedded_filename, REGCOL_TIMESTAMP, $timestamp, REGCOL_DIRECTORY, dirname($filename), REGCOL_REGISTRY, $registry, ); } sub choose_files { my $file_chooser = Gtk2::FileChooserDialog->new( 'Select Registry File(s)', undef, 'open', 'gtk-cancel' => 'cancel', 'gtk-ok' => 'ok', ); $file_chooser->set_select_multiple(TRUE); if (defined $last_dir) { $file_chooser->set_current_folder($last_dir); } my @filenames = (); my $response = $file_chooser->run; if ($response eq 'ok') { @filenames = $file_chooser->get_filenames; } $last_dir = $file_chooser->get_current_folder; $file_chooser->destroy; return @filenames; } sub open_files { # refresh $registry_store with contents of @registries... $registry_store->clear; foreach my $registry (@registries) { add_registry($registry); } $open_files_dialog->show_all; } sub close_files { @root_keys = (); # @registries is not cleared to retain currently selected files $find_param = ''; $find_iter = undef; $change_iter = undef; $tree_store->clear; $list_store->clear; $text_buffer->set_text(''); $statusbar->pop(0); my @columns = $tree_view->get_columns; shift @columns; foreach my $column (@columns) { $tree_view->remove_column($column); } } sub quit { $window->destroy; } sub about { Gtk2->show_about_dialog(undef, 'program-name' => $script_name, 'version' => $Parse::Win32Registry::VERSION, 'copyright' => 'Copyright (c) 2008-2012 James Macfarlane', 'comments' => 'GTK2 Registry Compare for the Parse::Win32Registry module', ); } sub show_message { my $type = shift; my $message = shift; my $dialog = Gtk2::MessageDialog->new( $window, 'destroy-with-parent', $type, 'ok', $message, ); $dialog->set_title(ucfirst $type); $dialog->run; $dialog->destroy; } sub get_location { my ($model, $iter) = $tree_selection->get_selected; if (defined $model && defined $iter) { my $keys = $model->get($iter, TREECOL_KEYS); my $values = $model->get($iter, TREECOL_VALUES); return ($keys, $values); } else { return (); } } sub copy_path { my ($keys, $values) = get_location; my $clip = ''; if (defined $keys) { my $any_key = (grep { defined } @$keys)[0]; if (defined $values) { # only values my $any_value = (grep { defined } @$values)[0]; $clip = $any_key->get_path . ", " . $any_value->get_name; } else { $clip = $any_key->get_path; } } my $clipboard = Gtk2::Clipboard->get(Gtk2::Gdk->SELECTION_CLIPBOARD); $clipboard->set_text($clip); } sub find_matching_child_iter { my ($iter, $name, $icon) = @_; return if !defined $iter; my $child_iter = $tree_store->iter_nth_child($iter, 0); if (!defined $child_iter) { return; } # Make sure children are real if (!defined $tree_store->get($child_iter, 0)) { my $keys = $tree_store->get($iter, TREECOL_KEYS); add_children($keys, $tree_store, $iter); $tree_store->remove($child_iter); # remove dummy items $child_iter = $tree_store->iter_nth_child($iter, 0); # refetch items } while (defined $child_iter) { my $child_icon = $tree_store->get($child_iter, TREECOL_ICON); if ($icon eq 'gtk-directory') { my $child_keys = $tree_store->get($child_iter, TREECOL_KEYS); my $any_child_key = (grep { defined } @$child_keys)[0]; if ($any_child_key->get_name eq $name) { return $child_iter; # match found } } else { my $child_values = $tree_store->get($child_iter, TREECOL_VALUES); if (defined $child_values) { my $any_child_value = (grep { defined } @$child_values)[0]; if ($any_child_value->get_name eq $name) { return $child_iter; # match found } } } $child_iter = $tree_store->iter_next($child_iter); } return; # no match found } sub go_to_subkey_and_value { my $subkey_path = shift; my $value_name = shift; my @path_components = index($subkey_path, "\\") == -1 ? ($subkey_path) : split(/\\/, $subkey_path, -1); my $iter = $tree_store->get_iter_first; return if !defined $iter; # no registry loaded while (defined(my $subkey_name = shift @path_components)) { my $keys = $tree_store->get($iter, TREECOL_KEYS); if (@$keys == 0) { return; } $iter = find_matching_child_iter($iter, $subkey_name, 'gtk-directory'); if (!defined $iter) { return; # no matching child iter } if (@path_components == 0) { # Look for a value if a value name has been supplied if (defined $value_name) { $iter = find_matching_child_iter($iter, $value_name, 'gtk-file'); if (!defined $iter) { return; # no matching child iter } } my $parent_iter = $tree_store->iter_parent($iter); my $parent_path = $tree_store->get_path($parent_iter); $tree_view->expand_to_path($parent_path); my $tree_path = $tree_store->get_path($iter); $tree_view->scroll_to_cell($tree_path); $tree_view->set_cursor($tree_path); $window->set_focus($tree_view); return; # match found } } } sub get_search_message { my $message; if ($search_keys && $search_values) { $message = "Searching registry keys and values..."; } elsif ($search_keys) { $message = "Searching registry keys..."; } elsif ($search_values) { $message = "Searching registry values..."; } return $message; } sub find_next { if (!defined $find_param || !defined $find_iter) { return; } my $label = Gtk2::Label->new; $label->set_text(get_search_message); my $dialog = Gtk2::Dialog->new('Find', $window, 'modal', 'gtk-cancel' => 'cancel', ); $dialog->vbox->pack_start($label, TRUE, TRUE, 5); $dialog->set_default_response('cancel'); $dialog->show_all; my $id = Glib::Idle->add(sub { my ($keys, $values) = $find_iter->get_next; if (!defined $keys) { $dialog->response('ok'); return FALSE; # stop searching } # Obtain the name and path from the first defined key my $any_key = (grep { defined } @$keys)[0]; my $subkey_path = (split(/\\/, $any_key->get_path, 2))[1]; if (!defined $subkey_path) { return TRUE; } # Check values (if defined) for a match if (defined $values) { if ($search_values) { my $any_value = (grep { defined } @$values)[0]; my $value_name = $any_value->get_name; if (index(lc $value_name, lc $find_param) >= 0) { go_to_subkey_and_value($subkey_path, $value_name); $dialog->response(50); return FALSE; # stop searching } } return TRUE; # continue searching } # Check keys for a match if ($search_keys) { my $key_name = $any_key->get_name; if (index(lc $key_name, lc $find_param) >= 0) { go_to_subkey_and_value($subkey_path); $dialog->response(50); return FALSE; # stop searching } } return TRUE; # continue searching }); my $response = $dialog->run; $dialog->destroy; if ($response eq 'cancel' || $response eq 'delete-event') { Glib::Source->remove($id); } elsif ($response eq 'ok') { show_message('info', 'Finished searching.'); } } sub find { return if @root_keys == 0; my ($selected_keys, $selected_values) = get_location; my $label = Gtk2::Label->new('Enter text to search for:'); $label->set_alignment(0, 0); my $entry = Gtk2::Entry->new; $entry->set_text($find_param); $entry->set_activates_default(TRUE); my $check1 = Gtk2::CheckButton->new('Search _keys'); $check1->set_active($search_keys); my $check2 = Gtk2::CheckButton->new('Search _values'); $check2->set_active($search_values); $check1->signal_connect(toggled => sub { if (!$check1->get_active && !$check2->get_active) { $check2->set_active(TRUE); } }); $check2->signal_connect(toggled => sub { if (!$check1->get_active && !$check2->get_active) { $check1->set_active(TRUE); } }); my $frame = Gtk2::Frame->new('Start searching'); my $vbox = Gtk2::VBox->new(FALSE, 0); $frame->add($vbox); my $radio1 = Gtk2::RadioButton->new(undef, 'from _root key'); my $radio2 = Gtk2::RadioButton->new($radio1, 'from c_urrent key'); if (!defined $selected_keys) { $radio2->set_sensitive(FALSE); } elsif ($search_selected) { $radio2->set_active(TRUE); } $vbox->pack_start($radio1, TRUE, TRUE, 0); $vbox->pack_start($radio2, TRUE, TRUE, 0); my $dialog = Gtk2::Dialog->new('Find', $window, 'modal', 'gtk-cancel' => 'cancel', 'gtk-ok' => 'ok', ); $dialog->vbox->set_spacing(5); $dialog->vbox->pack_start($label, FALSE, TRUE, 0); $dialog->vbox->pack_start($entry, FALSE, TRUE, 0); $dialog->vbox->pack_start($check1, FALSE, TRUE, 0); $dialog->vbox->pack_start($check2, FALSE, TRUE, 0); $dialog->vbox->pack_start($frame, FALSE, TRUE, 0); $dialog->set_default_response('ok'); $dialog->show_all; my $response = $dialog->run; if ($response eq 'ok' && @root_keys > 0) { $search_keys = $check1->get_active; $search_values = $check2->get_active; $search_selected = $radio2->get_active; $find_param = $entry->get_text; $dialog->destroy; $find_iter = undef; if ($find_param ne '') { $find_iter = $search_selected ? make_multiple_subtree_iterator(@$selected_keys) : make_multiple_subtree_iterator(@root_keys); find_next; } } else { $dialog->destroy; } } sub find_next_change { if (!defined $change_iter) { return; } my $label = Gtk2::Label->new; $label->set_text(get_search_message); my $dialog = Gtk2::Dialog->new('Find Change', $window, 'modal', 'gtk-cancel' => 'cancel', ); $dialog->vbox->pack_start($label, TRUE, TRUE, 5); $dialog->set_default_response('cancel'); $dialog->show_all; my $id = Glib::Idle->add(sub { my ($keys, $values) = $change_iter->get_next; if (!defined $keys) { $dialog->response('ok'); return FALSE; # stop searching } # Obtain the name and path from the first defined key my $any_key = (grep { defined } @$keys)[0]; my $subkey_path = (split(/\\/, $any_key->get_path, 2))[1]; if (!defined $subkey_path) { return TRUE; } # Check values (if defined) for changes if (defined $values) { if ($search_values) { my $any_value = (grep { defined } @$values)[0]; my $value_name = $any_value->get_name; my @changes = compare_multiple_values(@$values); my $num_changes = grep { $_ } @changes; if ($num_changes > 0) { go_to_subkey_and_value($subkey_path, $value_name); $dialog->response(50); return FALSE; # stop searching } } return TRUE; # continue searching } if ($search_keys) { my $key_name = $any_key->get_name; my @changes = compare_multiple_keys(@$keys); my $num_changes = grep { $_ } @changes; if ($num_changes > 0) { go_to_subkey_and_value($subkey_path); $dialog->response(50); return FALSE; # stop searching } } return TRUE; # continue searching }); my $response = $dialog->run; $dialog->destroy; if ($response eq 'cancel' || $response eq 'delete-event') { Glib::Source->remove($id); } elsif ($response eq 'ok') { show_message('info', 'Finished searching.'); } } sub find_change { return if @root_keys == 0; my ($selected_keys, $selected_values) = get_location; my $label = Gtk2::Label->new('Search for a change:'); $label->set_alignment(0, 0); my $check1 = Gtk2::CheckButton->new('Search _keys'); $check1->set_active($search_keys); my $check2 = Gtk2::CheckButton->new('Search _values'); $check2->set_active($search_values); $check1->signal_connect(toggled => sub { if (!$check1->get_active && !$check2->get_active) { $check2->set_active(TRUE); } }); $check2->signal_connect(toggled => sub { if (!$check1->get_active && !$check2->get_active) { $check1->set_active(TRUE); } }); my $frame = Gtk2::Frame->new('Start searching'); my $vbox = Gtk2::VBox->new(FALSE, 0); $frame->add($vbox); my $radio1 = Gtk2::RadioButton->new(undef, 'from _root key'); my $radio2 = Gtk2::RadioButton->new($radio1, 'from c_urrent key'); if (!defined $selected_keys) { $radio2->set_sensitive(FALSE); } elsif ($search_selected) { $radio2->set_active(TRUE); } $vbox->pack_start($radio1, TRUE, TRUE, 0); $vbox->pack_start($radio2, TRUE, TRUE, 0); my $dialog = Gtk2::Dialog->new('Find', $window, 'modal', 'gtk-cancel' => 'cancel', 'gtk-ok' => 'ok', ); $dialog->vbox->set_spacing(5); $dialog->vbox->pack_start($label, FALSE, TRUE, 0); $dialog->vbox->pack_start($check1, FALSE, TRUE, 0); $dialog->vbox->pack_start($check2, FALSE, TRUE, 0); $dialog->vbox->pack_start($frame, FALSE, TRUE, 0); $dialog->set_default_response('ok'); $dialog->show_all; my $response = $dialog->run; if ($response eq 'ok') { $search_keys = $check1->get_active; $search_values = $check2->get_active; $search_selected = $radio2->get_active; $dialog->destroy; $change_iter = $search_selected ? make_multiple_subtree_iterator(@$selected_keys) : make_multiple_subtree_iterator(@root_keys); $change_iter->get_next; # skip the starting key find_next_change; } else { $dialog->destroy; } } Parse-Win32Registry-1.0/bin/regscan.pl0000755000175000017500000000420711747213110016655 0ustar ownerowner#!/usr/bin/perl use strict; use warnings; use File::Basename; use Getopt::Long; use Parse::Win32Registry 0.50; binmode(STDOUT, ':utf8'); Getopt::Long::Configure('bundling'); GetOptions('parse-info|p' => \my $show_parse_info, 'unparsed|u' => \my $show_unparsed, 'allocated|a' => \my $list_allocated, 'keys|k' => \my $list_keys, 'values|v' => \my $list_values, 'security|s' => \my $list_security); my $filename = shift or die usage(); my $registry = Parse::Win32Registry->new($filename) or die "'$filename' is not a registry file\n"; my $entry_iter = $registry->get_entry_iterator; while (defined(my $entry = $entry_iter->get_next)) { next if $list_allocated && !$entry->is_allocated; next if !((!$list_keys && !$list_values && !$list_security) || ($list_keys && $entry->can('get_subkey')) || ($list_values && $entry->can('get_data')) || ($list_security && $entry->can('get_security_descriptor'))); if ($show_parse_info) { print $entry->parse_info, "\n"; } else { printf "0x%x ", $entry->get_offset; print $entry->as_string, "\n"; } print $entry->unparsed if $show_unparsed; } sub usage { my $script_name = basename $0; return < [-k] [-v] [-s] [-a] [-p] [-u] -k or --keys list only 'key' entries -v or --values list only 'value' entries -s or --security list only 'security' entries -a or --allocated list only 'allocated' entries -p or --parse-info show the technical information for an entry instead of the string representation -u or --unparsed show the unparsed on-disk entries as a hex dump USAGE } Parse-Win32Registry-1.0/bin/regdump.pl0000755000175000017500000000675711747213110016712 0ustar ownerowner#!/usr/bin/perl use strict; use warnings; use File::Basename; use Getopt::Long; use Parse::Win32Registry 0.50 qw(hexdump); binmode(STDOUT, ':utf8'); Getopt::Long::Configure('bundling'); GetOptions('recurse|r' => \my $recurse, 'values|v' => \my $show_values, 'hexdump|x' => \my $show_hexdump, 'class-name|c' => \my $show_class_name, 'security|s' => \my $show_security, 'owner|o' => \my $show_owner); my $filename = shift or die usage(); my $initial_key_path = shift; my $registry = Parse::Win32Registry->new($filename) or die "'$filename' is not a registry file\n"; my $root_key = $registry->get_root_key or die "Could not get root key of '$filename'\n"; if (defined($initial_key_path)) { $root_key = $root_key->get_subkey($initial_key_path); if (!defined($root_key)) { die "Could not locate the key '$initial_key_path' in '$filename'\n"; } } traverse($root_key); sub traverse { my $key = shift; print $key->as_string; if ($show_class_name) { my $class_name = $key->get_class_name; if (defined $class_name) { print " '$class_name'"; } } if ($show_owner) { my $security = $key->get_security; if (defined $security) { my $sd = $security->get_security_descriptor; if (defined $sd) { my $owner = $sd->get_owner; if (defined $owner) { print " ", $owner->as_string; } } } } print "\n"; if ($show_security) { my $security = $key->get_security; if (defined $security) { my $sd = $security->get_security_descriptor; if (defined $sd) { print $sd->as_stanza; } } } # Display names of subkeys if we are not descending the tree if (!$recurse) { foreach my $subkey ($key->get_list_of_subkeys) { print "..\\", $subkey->get_name, "\n"; } } if ($show_values) { foreach my $value ($key->get_list_of_values) { if (!$show_hexdump) { print $value->as_string, "\n"; } else { my $value_name = $value->get_name; $value_name = "(Default)" if $value_name eq ""; my $value_type = $value->get_type_as_string; print "$value_name ($value_type):\n"; print hexdump($value->get_raw_data); } } } if ($show_security || $show_values) { print "\n"; } if ($recurse) { foreach my $subkey ($key->get_list_of_subkeys) { traverse($subkey); } } } sub usage { my $script_name = basename $0; return < [subkey] [-r] [-v] [-x] [-c] [-s] [-o] -r or --recurse traverse all child keys from the root key or the subkey specified -v or --values display values -x or --hexdump display value data as a hex dump -c or --class-name display the class name for the key (if present) -s or --security display the security information for the key, including the owner and group SIDs, and the system and discretionary ACLs (if present) -o or --owner display the owner SID for the key (if present) USAGE } Parse-Win32Registry-1.0/bin/regshell.pl0000755000175000017500000001735411747213110017047 0ustar ownerowner#!/usr/bin/perl use strict; use warnings; binmode(STDOUT, ':utf8'); use File::Basename; use Parse::Win32Registry 0.50 qw(hexdump); use Term::ReadLine; Parse::Win32Registry->disable_warnings; my $filename = shift or die usage(); my $initial_key_path = shift; my $registry = Parse::Win32Registry->new($filename) or die "'$filename' is not a registry file\n"; my $root_key = $registry->get_root_key or die "Could not get root key of '$filename'\n"; my $key = $root_key; # location as we navigate the registry tree my $term = Term::ReadLine->new("regshell"); my $attribs = $term->Attribs; $attribs->{completion_function} = sub { my ($text, $line, $start) = @_; my $preceding_text = substr($line, 0, $start); if ($preceding_text =~ /^\s*$/) { # first word = command completion return grep /^\Q$text/, qw(help cd pwd ls dir cat type xxd hexdump find next exit quit); } else { # second word = parameter completion if ($preceding_text =~ /\b(cd)\b/) { # subkey path completion if ($text =~ /^(.*)\\[^\\]*$/) { my $path = $1; if (my $subkey = $key->get_subkey($path)) { my @subkeys = $subkey->get_list_of_subkeys; my @names = map { "$path\\" . $_->get_name } @subkeys; return grep /^\Q$text/, @names; } else { return; } } my @names = map { $_->get_name } $key->get_list_of_subkeys; return grep /^\Q$text/, @names; } elsif ($preceding_text =~ /\b(cat|type|xxd|hexdump)\b/) { # value name completion my @names = map { $_->get_name } $key->get_list_of_values; return grep /^\Q$text/, @names; } else { return; } } }; $attribs->{completer_word_break_characters} = ' '; $attribs->{completer_quote_characters} = '"'; my $find_iter; my $find_param; my $prompt = $key->get_path; while (defined(my $line = $term->readline("$prompt> "))) { # trim white space from line $line =~ s/^\s+//; $line =~ s/\s+$//; my ($cmd, $param) = split /\s+/, $line, 2; # strip quotes around $param if present if (defined $param && $param =~ /^"(.*)"$/) { $param = $1; } if ($cmd) { if ($cmd eq 'help') { print < Change to the specified subkey. Specify '..' to change to the parent key. Omit the subkey name to change to the root key. ls | dir List the subkeys and values of the current key. cat | type Display the specified value. Omit the value name to display the default value. xxd | hexdump Display the specified value in hex. Omit the value name to display the default value. find Start a search for a key or value matching the supplied string. The search is not case sensitive. next | n Search for the next matching key or value. exit | quit Exit the program. HELP } elsif ($cmd eq 'cd') { if (!defined $param) { $key = $root_key; # go to root key if no param supplied } elsif ($param =~ /\.\.(\\\.\.)*/) { my $count = ($param =~ tr/\\//); my $new_key = $key; for (my $i = 0; $i <= $count; $i++) { $new_key = $new_key->get_parent; if (!defined $new_key) { last; } } if (defined $new_key) { print $new_key->as_string, "\n"; $key = $new_key; } else { print "Invalid parent key\n"; } } else { if (my $new_key = $key->get_subkey($param)) { $key = $new_key; } else { print "No subkey named '$param'\n"; } } } elsif ($cmd eq 'pwd') { print $key->get_path, "\n"; } elsif ($cmd eq 'ls' || $cmd eq 'dir') { foreach my $subkey ($key->get_list_of_subkeys) { if ($cmd eq 'ls') { print $subkey->get_name, "\n"; } else { print "[", $subkey->get_name, "]\n"; } } foreach my $value ($key->get_list_of_values) { if ($cmd eq 'ls') { print $value->as_string, "\n"; } else { print $value->as_regedit_export; } } } elsif ($cmd eq 'cat' || $cmd eq 'type') { if (!defined $param) { $param = ''; # assume default value if no param supplied } if (my $value = $key->get_value($param)) { if ($cmd eq 'cat') { print $value->as_string, "\n"; } else { print $value->as_regedit_export; } } else { print "No value named '$param'\n"; } } elsif ($cmd eq 'xxd' | $cmd eq 'hexdump') { if (!defined $param) { $param = ''; # assume default value if no param supplied } if (my $value = $key->get_value($param)) { print hexdump($value->get_raw_data); } else { print "No value named '$param'\n"; } } elsif ($cmd eq 'exit' || $cmd eq 'quit') { last; } elsif ($cmd eq 'find') { if (!defined $param) { if (defined $find_param) { print "Currently searching for '$find_param'\n"; } print "Specify a search term to start a new search\n"; } else { $find_param = $param; $find_iter = $root_key->get_subtree_iterator; find_next(); } } elsif ($cmd eq 'next' || $cmd eq 'n') { find_next(); } else { print "Unrecognised command '$cmd'\n"; } } $prompt = $key->get_path; } print "\nGoodbye...\n"; sub usage { my $script_name = basename $0; return < USAGE } sub find_next { if (!defined $find_param || !defined $find_iter) { print "No search started...\n"; return; } while (my ($next_key, $next_value) = $find_iter->get_next) { my $key_name = $next_key->get_name; if (defined $next_value) { my $value_name = $next_value->get_name; if (index(lc $value_name, lc $find_param) > -1) { print "Found value '$value_name' in key '$key_name'\n"; $key = $next_key; return; } else { next; } } if (index(lc $key_name, lc $find_param) > -1) { print "Found key '$key_name'\n"; $key = $next_key; return; } else { next; } } print "No (more) matches found\n"; } Parse-Win32Registry-1.0/bin/wxregscope.pl0000755000175000017500000003772711747213110017436 0ustar ownerowner#!/usr/bin/perl use strict; use warnings; binmode STDOUT, ':utf8'; use Parse::Win32Registry 0.60; package BlockListCtrl; use Wx qw(:everything); use base qw(Wx::ListCtrl); sub new { my ($class, $parent) = @_; my $self = $class->SUPER::new($parent, -1, wxDefaultPosition, wxDefaultSize, wxLC_REPORT|wxLC_SINGLE_SEL|wxLC_VIRTUAL|wxBORDER_SUNKEN); bless $self, $class; $self->InsertColumn(0, "Block"); $self->InsertColumn(1, "Length"); $self->InsertColumn(2, "Tag"); $self->SetColumnWidth(0, 100); $self->SetColumnWidth(2, 100); return $self; } sub Clear { my ($self) = @_; $self->{_blocks} = []; $self->SetItemCount(0); $self->Refresh; } sub OnGetItemText { my ($self, $index, $column) = @_; my $block = $self->{_blocks}[$index]; return if !defined $block; if ($column == 0) { return sprintf '0x%x', $block->get_offset; } elsif ($column == 1) { return sprintf '0x%x', $block->get_length; } elsif ($column == 2) { return sprintf '%s', $block->get_tag; } else { return "?"; } } sub SetRegistry { my ($self, $registry) = @_; $self->{_blocks} = []; my $block_iter = $registry->get_block_iterator; while (my $block = $block_iter->get_next) { push @{$self->{_blocks}}, $block; } $self->SetItemCount(scalar @{$self->{_blocks}}); $self->Refresh; $self->SetItemState(0, wxLIST_STATE_FOCUSED, wxLIST_STATE_FOCUSED); } sub GetBlock { my ($self, $index) = @_; return $self->{_blocks}[$index]; } sub GoToBlock { my ($self, $offset) = @_; my $index = 0; foreach my $block (@{$self->{_blocks}}) { my $block_start = $block->get_offset; my $block_end = $block_start + $block->get_length; if ($offset >= $block_start && $offset < $block_end) { $self->EnsureVisible($index); $self->SetItemState($index, wxLIST_STATE_SELECTED, wxLIST_STATE_SELECTED); return; } $index++; } } package EntryListCtrl; use Wx qw(:everything); use base qw(Wx::ListCtrl); use constant ATTR_KEY => Wx::ListItemAttr->new(Wx::Colour->new('#000000'), Wx::Colour->new('#ffb0b0'), wxNullFont); use constant ATTR_VALUE => Wx::ListItemAttr->new(Wx::Colour->new('#000000'), Wx::Colour->new('#b0ffb0'), wxNullFont); use constant ATTR_SECURITY => Wx::ListItemAttr->new(Wx::Colour->new('#000000'), Wx::Colour->new('#b0ffff'), wxNullFont); use constant ATTR_SUBKEY_LIST => Wx::ListItemAttr->new(Wx::Colour->new('#000000'), Wx::Colour->new('#ffb0ff'), wxNullFont); use constant ATTR_OTHER => Wx::ListItemAttr->new(Wx::Colour->new('#000000'), Wx::Colour->new('#f0f0f0'), wxNullFont); #use constant ATTR_OTHER => # Wx::ListItemAttr->new(wxNullColour, wxNullColour, wxNullFont); sub new { my ($class, $parent) = @_; my $self = $class->SUPER::new($parent, -1, wxDefaultPosition, wxDefaultSize, wxLC_REPORT|wxLC_SINGLE_SEL|wxLC_VIRTUAL|wxBORDER_SUNKEN); bless $self, $class; $self->InsertColumn(0, "Entry"); $self->InsertColumn(1, "Length"); $self->InsertColumn(2, "Alloc."); $self->InsertColumn(3, "Tag"); $self->InsertColumn(4, "Name"); $self->SetColumnWidth(0, 100); $self->SetColumnWidth(3, 100); $self->SetColumnWidth(4, 200); return $self; } sub Clear { my ($self) = @_; $self->{_entries} = []; $self->SetItemCount(0); $self->Refresh; } sub OnGetItemText { my ($self, $index, $column) = @_; my $entry = $self->{_entries}[$index]; return if !defined $entry; if ($column == 0) { return sprintf '0x%x', $entry->get_offset; } elsif ($column == 1) { return sprintf '0x%x', $entry->get_length; } elsif ($column == 2) { return $entry->is_allocated; } elsif ($column == 3) { return $entry->get_tag; } elsif ($column == 4) { my $name = ''; if ($entry->can('get_name')) { $name = $entry->get_name; $name =~ s/\0/[NUL]/g; $name =~ s/\n/[LF]/g; $name =~ s/\r/[CR]/g; } return $name; } else { return "?"; } } sub OnGetItemAttr { my ($self, $index) = @_; my $entry = $self->{_entries}[$index]; return if !defined $entry; my $tag = $entry->get_tag; if ($tag eq 'nk' || $tag eq 'rgkn key' || $tag eq 'rgdb key') { return ATTR_KEY; } elsif ($tag eq 'vk' || $tag eq 'rgdb value') { return ATTR_VALUE; } elsif ($tag eq 'sk') { return ATTR_SECURITY; } elsif ($tag eq 'lh' || $tag eq 'lf' || $tag eq 'li' || $tag eq 'ri') { return ATTR_SUBKEY_LIST; } else { return ATTR_OTHER; } } sub SetBlock { my ($self, $block) = @_; $self->{_entries} = []; my $entry_iter = $block->get_entry_iterator; while (my $entry = $entry_iter->get_next) { push @{$self->{_entries}}, $entry; } $self->SetItemCount(scalar @{$self->{_entries}}); $self->Refresh; $self->SetItemState(0, wxLIST_STATE_FOCUSED, wxLIST_STATE_FOCUSED); } sub GetEntry { my ($self, $index) = @_; return $self->{_entries}[$index]; } sub GoToEntry { my ($self, $offset) = @_; my $index = 0; foreach my $entry (@{$self->{_entries}}) { my $entry_start = $entry->get_offset; my $entry_end = $entry_start + $entry->get_length; if ($offset >= $entry_start && $offset < $entry_end) { $self->EnsureVisible($index); $self->SetItemState($index, wxLIST_STATE_SELECTED, wxLIST_STATE_SELECTED); return; } $index++; } } package FindDialog; use Wx qw(:everything); use Wx::Event qw(:everything); use base qw(Wx::Dialog); sub new { my ($class, $parent) = @_; my $self = $class->SUPER::new($parent, -1, "Find", wxDefaultPosition, wxDefaultSize, wxDEFAULT_DIALOG_STYLE); bless $self, $class; my $static = Wx::StaticText->new($self, -1, 'Enter text to &search for:'); my $text = Wx::TextCtrl->new($self, -1, ''); my $sizer = Wx::BoxSizer->new(wxVERTICAL); $sizer->Add($static, 0, wxEXPAND|wxALL, 5); $sizer->Add($text, 0, wxEXPAND|wxALL, 5); my $button_sizer = $self->CreateSeparatedButtonSizer(wxOK|wxCANCEL); $sizer->Add($button_sizer, 0, wxEXPAND|wxALL, 5); $self->SetSizer($sizer); $self->{_text} = $text; $self->Fit; # resizes dialog to best fit child windows $self->{_text}->SetFocus; $self->SetFocus; return $self; } sub GetText { my ($self) = @_; return $self->{_text}->GetValue; } sub SetText { my ($self, $value) = @_; $value = '' if !defined $value; $self->{_text}->ChangeValue($value); $self->{_text}->SetSelection(-1, -1); } package ScopeFrame; use Encode; use File::Basename; use FindBin; use Parse::Win32Registry; use Wx qw(:everything); use Wx::Event qw(:everything); use base qw(Wx::Frame); use constant ID_FIND_NEXT => Wx::NewId; use constant ID_SELECT_FONT => Wx::NewId; use constant ID_GO_TO => Wx::NewId; sub new { my ($class, $parent) = @_; my $self = $class->SUPER::new($parent, -1, "Registry Scope", wxDefaultPosition, [600, 400]); bless $self, $class; $self->SetMinSize([600, 400]); my $menu1 = Wx::Menu->new; $menu1->Append(wxID_OPEN, "&Open...\tCtrl+O"); $menu1->Append(wxID_CLOSE, "&Close\tCtrl+W"); $menu1->AppendSeparator; $menu1->Append(wxID_EXIT, "E&xit\tAlt+F4"); my $menu2 = Wx::Menu->new; $menu2->Append(wxID_FIND, "&Find...\tCtrl+F"); $menu2->Append(ID_FIND_NEXT, "Find &Next\tF3"); $menu2->AppendSeparator; $menu2->Append(ID_GO_TO, "&Go To Offset...\tCtrl+G"); my $menu3 = Wx::Menu->new; $menu3->Append(ID_SELECT_FONT, "Select &Font..."); my $menu4 = Wx::Menu->new; $menu4->Append(wxID_ABOUT, "&About..."); my $menubar = Wx::MenuBar->new; $menubar->Append($menu1, "&File"); $menubar->Append($menu2, "&Search"); $menubar->Append($menu3, "&View"); $menubar->Append($menu4, "&Help"); $self->SetMenuBar($menubar); my $statusbar = Wx::StatusBar->new($self, -1); $self->SetStatusBar($statusbar); EVT_MENU($self, wxID_OPEN, \&OnOpenFile); EVT_MENU($self, wxID_CLOSE, \&OnCloseFile); EVT_MENU($self, wxID_EXIT, \&OnQuit); EVT_MENU($self, wxID_FIND, \&OnFind); EVT_MENU($self, ID_FIND_NEXT, \&FindNext); EVT_MENU($self, ID_GO_TO, \&GoToOffset); EVT_MENU($self, wxID_ABOUT, \&OnAbout); EVT_MENU($self, ID_SELECT_FONT, \&OnSelectFont); my $vsplitter = Wx::SplitterWindow->new($self, -1, wxDefaultPosition, wxDefaultSize, wxSP_NOBORDER); my $text = Wx::TextCtrl->new($vsplitter, -1, '', wxDefaultPosition, wxDefaultSize, wxTE_MULTILINE|wxTE_DONTWRAP|wxTE_READONLY); $text->SetFont(Wx::Font->new(10, wxMODERN, wxNORMAL, wxNORMAL)); my $hsplitter = Wx::SplitterWindow->new($vsplitter, -1, wxDefaultPosition, wxDefaultSize, wxSP_NOBORDER); $vsplitter->SplitHorizontally($hsplitter, $text); $vsplitter->SetMinimumPaneSize(10); my $list1 = BlockListCtrl->new($hsplitter); my $list2 = EntryListCtrl->new($hsplitter); $hsplitter->SplitVertically($list1, $list2); $hsplitter->SetMinimumPaneSize(10); $self->{_list1} = $list1; $self->{_list2} = $list2; $self->{_vsplitter} = $vsplitter; $self->{_text} = $text; $self->{_statusbar} = $statusbar; EVT_SPLITTER_DCLICK($self, $hsplitter, \&OnSplitterDClick); EVT_SPLITTER_DCLICK($self, $vsplitter, \&OnSplitterDClick); EVT_LIST_ITEM_SELECTED($self, $list1, \&OnBlockSelected); EVT_LIST_ITEM_SELECTED($self, $list2, \&OnEntrySelected); $self->SetIcon(Wx::GetWxPerlIcon()); my $accelerators = Wx::AcceleratorTable->new( [wxACCEL_CTRL, ord('Q'), wxID_EXIT], ); $self->SetAcceleratorTable($accelerators); my $filename = shift @ARGV; if (defined $filename) { $self->LoadFile($filename); } return $self; } sub GoToOffset { my ($self, $event) = @_; return if !defined $self->{_registry}; my $dialog = Wx::TextEntryDialog->new($self, 'Enter the offset below:', 'Go To Offset', '0x'); if ($dialog->ShowModal != wxID_OK) { return; } my $offset; eval { my $answer = $dialog->GetValue; if ($answer =~ m/^\s*0x[\da-fA-F]+\s*$/ || $answer =~ m/^\s*\d+\s*$/) { $offset = int(eval $answer); } }; $dialog->Destroy; if (defined $offset) { $self->{_list1}->GoToBlock($offset); $self->{_list2}->GoToEntry($offset); } $self->{_list2}->SetFocus; $self->SetFocus; } sub OnSelectFont { my ($self, $event) = @_; my $text = $self->{_text}; my $font = $text->GetFont; $font = Wx::GetFontFromUser($self, $font); if ($font->IsOk) { $text->SetFont($font); } } sub OnSplitterDClick { my ($self, $event) = @_; $event->Veto; } sub OnBlockSelected { my ($self, $event) = @_; my $index = $event->GetIndex; my $block = $self->{_list1}->GetBlock($index); $self->{_list2}->SetBlock($block); my $parse_info = $block->parse_info; $parse_info =~ s/\0/[NUL]/g; $parse_info =~ s/\n/[LF]/g; $parse_info =~ s/\r/[CR]/g; my $details = $parse_info . "\n" . $block->unparsed; $self->{_text}->ChangeValue($details); my $status = sprintf "Block Offset: 0x%x", $block->get_offset; $self->{_statusbar}->SetStatusText($status); } sub OnEntrySelected { my ($self, $event) = @_; my $index = $event->GetIndex; my $entry = $self->{_list2}->GetEntry($index); my $parse_info = $entry->parse_info; $parse_info =~ s/\0/[NUL]/g; $parse_info =~ s/\n/[LF]/g; $parse_info =~ s/\r/[CR]/g; my $details = $parse_info . "\n" . $entry->unparsed; $self->{_text}->ChangeValue($details); my $status = sprintf "Entry Offset: 0x%x", $entry->get_offset; $self->{_statusbar}->SetStatusText($status); } sub OnAbout { my ($self, $event) = @_; my $info = Wx::AboutDialogInfo->new; $info->SetName($FindBin::Script); $info->SetVersion($Parse::Win32Registry::VERSION); $info->SetCopyright('Copyright (c) 2010-2012 James Macfarlane'); $info->SetDescription('wxWidgets Registry Scope for the Parse::Win32Registry module'); Wx::AboutBox($info); } sub OnFind { my ($self, $event) = @_; return if !defined $self->{_registry}; my $dialog = FindDialog->new($self); $dialog->SetText($self->{_find_param}); if ($dialog->ShowModal == wxID_OK) { my $registry = $self->{_registry}; my $find_iter = $registry->get_entry_iterator; $self->{_find_param} = $dialog->GetText; $self->{_find_iter} = $find_iter; $self->FindNext; } $dialog->Destroy; } sub FindNext { my ($self) = @_; my $find_param = $self->{_find_param}; my $find_iter = $self->{_find_iter}; return if !defined $find_param || $find_param eq ''; return if !defined $find_iter; my $start = time; my $max = 0; my $progress_dialog; my $iter_finished = 1; while (my $entry = $find_iter->get_next) { my $found = 0; if (index(lc $entry->get_raw_bytes, lc $find_param) > -1) { $found = 1; } else { my $uni_find_param = encode("UCS-2LE", $find_param); if (index(lc $entry->get_raw_bytes, lc $uni_find_param) > -1) { $found = 1; } } if ($found) { $self->{_list1}->GoToBlock($entry->get_offset); $self->{_list2}->GoToEntry($entry->get_offset); $iter_finished = 0; last; } if (defined $progress_dialog) { if (!$progress_dialog->Update) { # Cancelled! $iter_finished = 0; last; } } else { if (time - $start >= 1) { $progress_dialog = Wx::ProgressDialog->new('Find', 'Searching registry...', $max, $self, wxPD_CAN_ABORT|wxPD_AUTO_HIDE); } } } if (defined $progress_dialog) { $progress_dialog->Destroy; } if ($iter_finished) { my $dialog = Wx::MessageDialog->new($self, 'Finished searching', 'Find', wxICON_EXCLAMATION|wxOK); $dialog->ShowModal; $dialog->Destroy; } $self->{_list1}->SetFocus; $self->SetFocus; } sub LoadFile { my ($self, $filename) = @_; if (!-r $filename) { my $dialog = Wx::MessageDialog->new($self, "'$filename' cannot be read", 'Error', wxICON_ERROR|wxOK); $dialog->ShowModal; $dialog->Destroy; return } my $basename = basename($filename); my $registry = Parse::Win32Registry->new($filename); if (!defined $registry) { my $dialog = Wx::MessageDialog->new($self, "'$basename' is not a registry file", 'Error', wxICON_ERROR|wxOK); $dialog->ShowModal; $dialog->Destroy; return } # clear $self->OnCloseFile; # set up $self->{_registry} = $registry; $self->{_list1}->SetRegistry($registry); $self->{_list1}->SetFocus; $self->SetTitle("$basename - Registry Scope"); } sub OnOpenFile { my ($self, $event) = @_; my $dialog = Wx::FileDialog->new($self, 'Select Registry File', $self->{_directory} || ''); if ($dialog->ShowModal != wxID_OK) { return; } my $filename = $dialog->GetPath; $self->{_directory} = $dialog->GetDirectory; $self->LoadFile($filename); } sub OnCloseFile { my ($self, $event) = @_; $self->{_list1}->Clear; $self->{_list2}->Clear; $self->{_text}->Clear; $self->{_registry} = undef; $self->{_find_iter} = undef; $self->SetTitle("Registry Scope"); } sub OnQuit { my ($self) = @_; $self->Close; } package ScopeApp; use Wx qw(:everything); use base qw(Wx::App); sub OnInit { my ($self) = @_; my $frame = ScopeFrame->new(undef); $frame->Show; return 1; } package main; my $app = ScopeApp->new; $app->MainLoop; Parse-Win32Registry-1.0/bin/regtimeline.pl0000755000175000017500000000531311747213110017536 0ustar ownerowner#!/usr/bin/perl use strict; use warnings; use File::Basename; use Getopt::Long; use Parse::Win32Registry qw(iso8601 hexdump); binmode(STDOUT, ":utf8"); Getopt::Long::Configure('bundling'); GetOptions('last|l=f' => \my $period, 'values|v' => \my $show_values, 'hexdump|x' => \my $show_hexdump); my $filename = shift or die usage(); my $initial_key_path = shift; my $registry = Parse::Win32Registry->new($filename) or die "'$filename' is not a registry file\n"; my $root_key = $registry->get_root_key or die "Could not get root key of '$filename'\n"; if (!defined($root_key->get_timestamp)) { die "'$filename' needs to be an NT-based registry file\n" } if (defined($initial_key_path)) { $root_key = $root_key->get_subkey($initial_key_path); if (!defined($root_key)) { die "Could not locate the key '$initial_key_path' in '$filename'\n"; } } warn "Ordering keys...\n"; my $first_timestamp = 0; my $last_timestamp = 0; my %keys_by_timestamp = (); traverse($root_key); sub traverse { my $key = shift; my $timestamp = $key->get_timestamp; push @{$keys_by_timestamp{$timestamp}}, $key; $first_timestamp = $timestamp if $timestamp < $first_timestamp; $last_timestamp = $timestamp if $timestamp > $last_timestamp; foreach my $subkey ($key->get_list_of_subkeys) { traverse($subkey); } } if ($period) { $first_timestamp = $last_timestamp - $period * 86400; } foreach my $timestamp (sort { $a <=> $b } keys %keys_by_timestamp) { next if $timestamp < $first_timestamp; foreach my $key (@{$keys_by_timestamp{$timestamp}}) { print iso8601($timestamp), "\t", $key->get_path, "\n"; if ($show_values) { foreach my $value ($key->get_list_of_values) { if (!$show_hexdump) { print "\t", $value->as_string, "\n"; } else { my $value_name = $value->get_name; $value_name = "(Default)" if $value_name eq ""; my $value_type = $value->get_type_as_string; print "\t$value_name ($value_type):\n"; print hexdump($value->get_raw_data); } } print "\n"; } } } sub usage { my $script_name = basename $0; return < [subkey] [-l ] [-v] [-x] -l or --last display only the last days of registry activity -v or --values display values -x or --hexdump display value data as a hex dump USAGE } Parse-Win32Registry-1.0/bin/regmultidiff.pl0000755000175000017500000001451511747213110017717 0ustar ownerowner#!/usr/bin/perl use strict; use warnings; use File::Basename; use Getopt::Long; use Parse::Win32Registry 0.51 qw( make_multiple_subtree_iterator compare_multiple_keys compare_multiple_values hexdump ); binmode(STDOUT, ':utf8'); Getopt::Long::Configure('bundling'); GetOptions('values|v' => \my $show_values, 'hexdump|x' => \my $show_hexdump, 'long|l' => \my $show_long, 'all|a' => \my $show_all); my $show_keys = 1; my @filenames = (); my @root_keys = (); my @start_keys = (); my $initial_key_path; if (@ARGV) { while (my $filename = shift) { if (-r $filename) { my $registry = Parse::Win32Registry->new($filename); if (defined $registry) { my $root_key = $registry->get_root_key; if (defined $root_key) { push @root_keys, $root_key; push @filenames, $filename; } } } else { # If $filename is not a readable file, assume it is a key path: $initial_key_path = $filename; } } } else { die usage(); } if (@root_keys < 2) { die "Specify two or more filenames\n"; } @start_keys = @root_keys; if ($initial_key_path) { @start_keys = map { $_->get_subkey($initial_key_path) || undef } @root_keys; } my $num_start_keys = grep { defined } @start_keys; if ($num_start_keys < 1) { die "Could not locate the key '$initial_key_path' in any file\n"; } my $subtree_iter = make_multiple_subtree_iterator(@start_keys); my $batch_size = @start_keys; if ($show_long) { for (my $num = 0; $num < $batch_size; $num++) { print "[$num]:\tFILE\t'$filenames[$num]'\n"; } } my $last_key_shown; while (my ($keys_ref, $values_ref) = $subtree_iter->get_next) { my @keys = @$keys_ref; my $any_key = (grep { defined } @keys)[0]; die "Unexpected error: no keys!" if !defined $any_key; if (defined $values_ref) { my @values = @$values_ref; my $any_value = (grep { defined } @values)[0]; die "Unexpected error: no values!" if !defined $any_value; my @changes = compare_multiple_values(@values); my $num_changes = grep { $_ } @changes; if ($num_changes > 0 && $show_values) { if (!defined $last_key_shown || $last_key_shown ne $any_key->get_path) { print "-" x $batch_size, "\t", $any_key->get_path, "\n"; $last_key_shown = $any_key->get_path; } if (!$show_long) { for (my $num = 0; $num < $batch_size; $num++) { my $diff = substr($changes[$num], 0, 1) || (defined $values[$num] ? '.' : ' '); print $diff; } print "\t", $any_value->get_name, "\n"; } else { for (my $num = 0; $num < $batch_size; $num++) { my $next_change = $changes[$num + 1]; if ($changes[$num] || $show_all || defined $next_change && $next_change eq 'DELETED') { print "[$num]:\t$changes[$num]\t"; if (defined $values[$num]) { if (!$show_hexdump) { print $values[$num]->as_string, "\n"; } else { my $value_name = $values[$num]->get_name; $value_name = "(Default)" if $value_name eq ""; my $value_type = $values[$num]->get_type_as_string; print "$value_name ($value_type):\n"; print hexdump($values[$num]->get_raw_data); } } else { print "\n"; } } } } } } else { my @changes = compare_multiple_keys(@keys); my $num_changes = grep { $_ } @changes; if ($num_changes > 0 && $show_keys) { if (!$show_long) { for (my $num = 0; $num < $batch_size; $num++) { my $diff = substr($changes[$num], 0, 1) || (defined $keys[$num] ? '.' : ' '); print $diff; } print "\t", $any_key->get_path, "\n"; } else { for (my $num = 0; $num < $batch_size; $num++) { my $next_change = $changes[$num+1]; if ($changes[$num] || $show_all || defined $next_change && $next_change eq 'DELETED') { print "[$num]:\t$changes[$num]\t"; if (defined $keys[$num]) { print $keys[$num]->as_string; $last_key_shown = $keys[$num]->get_path; } elsif ($changes[$num] eq 'DELETED') { print $keys[$num-1]->as_string; $last_key_shown = $keys[$num-1]->get_path; } print "\n"; } } } $last_key_shown = $any_key->get_path; } } } sub usage { my $script_name = basename $0; return < ... [] [-v] [-x] [-l] [-a] -v or --values display values -x or --hexdump display value data as a hex dump -l or --long show each changed key or value instead of a summary -a or --all show all keys and values before and after a change USAGE } Parse-Win32Registry-1.0/MANIFEST0000644000175000017500000000337211747213110015256 0ustar ownerownerChanges Makefile.PL MANIFEST README bin/gtkregcompare.pl bin/gtkregscope.pl bin/gtkregview.pl bin/regclassnames.pl bin/regdiff.pl bin/regdump.pl bin/regexport.pl bin/regfind.pl bin/regml.pl bin/regmultidiff.pl bin/regscan.pl bin/regsecurity.pl bin/regshell.pl bin/regstats.pl bin/regtimeline.pl bin/regtree.pl bin/wxregcompare.pl bin/wxregscope.pl bin/wxregview.pl lib/Parse/Win32Registry.pm lib/Parse/Win32Registry/Base.pm lib/Parse/Win32Registry/Entry.pm lib/Parse/Win32Registry/File.pm lib/Parse/Win32Registry/Key.pm lib/Parse/Win32Registry/Value.pm lib/Parse/Win32Registry/Win95/File.pm lib/Parse/Win32Registry/Win95/Key.pm lib/Parse/Win32Registry/Win95/Value.pm lib/Parse/Win32Registry/WinNT/Entry.pm lib/Parse/Win32Registry/WinNT/File.pm lib/Parse/Win32Registry/WinNT/Key.pm lib/Parse/Win32Registry/WinNT/Security.pm lib/Parse/Win32Registry/WinNT/Value.pm t/compare.t t/constants.t t/entry.t t/errors.t t/file.t t/iterator.t t/key.t t/misc.t t/security.t t/use.t t/value.t t/virtual_root.t t/walk.t t/empty_file.rf t/fake_ntuser_dat.rf t/fake_sam.rf t/fake_security.rf t/fake_software.rf t/fake_system.rf t/fake_system_dat.rf t/fake_user_dat.rf t/fake_usrclass_dat.rf t/invalid_creg_header.rf t/invalid_regf_checksum.rf t/invalid_regf_header.rf t/invalid_rgkn_header.rf t/missing_rgkn_header.rf t/win95_compare_tests1.rf t/win95_compare_tests2.rf t/win95_compare_tests3.rf t/win95_entry_tests.rf t/win95_error_tests.rf t/win95_iter_tests.rf t/win95_key_tests.rf t/win95_value_tests.rf t/winnt_compare_tests1.rf t/winnt_compare_tests2.rf t/winnt_compare_tests3.rf t/winnt_entry_tests.rf t/winnt_error_tests.rf t/winnt_iter_tests.rf t/winnt_key_tests.rf t/winnt_security_tests.rf t/winnt_value_tests.rf META.yml Module meta-data (added by MakeMaker) Parse-Win32Registry-1.0/Makefile.PL0000644000175000017500000000213211747213110016070 0ustar ownerowneruse 5.008_001; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Parse::Win32Registry', VERSION_FROM => 'lib/Parse/Win32Registry.pm', PREREQ_PM => { 'Carp' => 0, 'Data::Dumper' => 0, 'Encode' => 0, 'File::Basename' => 0, 'Time::Local' => 0, 'Test::More' => 0, }, ABSTRACT_FROM => 'lib/Parse/Win32Registry.pm', AUTHOR => 'James Macfarlane', EXE_FILES => [ 'bin/gtkregcompare.pl', 'bin/gtkregscope.pl', 'bin/gtkregview.pl', 'bin/regclassnames.pl', 'bin/regdiff.pl', 'bin/regdump.pl', 'bin/regexport.pl', 'bin/regfind.pl', 'bin/regml.pl', 'bin/regmultidiff.pl', 'bin/regscan.pl', 'bin/regsecurity.pl', 'bin/regshell.pl', 'bin/regstats.pl', 'bin/regtimeline.pl', 'bin/regtree.pl', 'bin/wxregcompare.pl', 'bin/wxregscope.pl', 'bin/wxregview.pl', ], ($ExtUtils::MakeMaker::VERSION > 6.30 ? (LICENSE => 'perl') : ()), ); Parse-Win32Registry-1.0/Changes0000644000175000017500000002467211747213110015426 0ustar ownerownerRevision history for Perl extension Parse::Win32Registry. ** 1.0 2012-04-29 Added support for decoding System Mandatory Label ACEs (a feature introduced with Windows Vista) and added the command line script regml.pl for listing keys with explicit System Mandatory Label ACEs set. Improved handling of security descriptors. Tidied up various aspects of the wxWidgets and GTK applications, and harmonised functionality between the various pairs of equivalent programs, with a minor difference being the wxWidgets applications following Windows keyboard shortcut conventions while the GTK applications following Linux keyboard shortcut conventions. The get_data method of Value objects now returns the unpacked integer value for REG_DWORD_BIG_ENDIAN value types instead of the original packed binary data. Added support for values with 'big data'. Thanks to Harlan Carvey for all his help with this. ** 0.60 2010-08-15 Parse::Win32Registry now requires Perl 5.8.1. Implemented new RGKN and RGDB Block objects for Windows 95 registry files. Now both Windows 95 and Windows NT registry files have a get_block_iterator method, which replaces the get_hbin_iterator previously provided for Windows NT registry files. (For backwards compatibility, calling the get_hbin_iterator method will call the get_block_iterator method.) Some performance improvements have been made to the processing of REG_MULTI_SZ value data (in the get_data method of Value objects), to the generation of hexdumps (in the hexdump function and the unparsed method of Entry objects), and to the generation of REGEDIT-style octet strings (in the as_regedit_export method of Value objects). Uncompressed (Unicode) key and value names are now correctly read from Windows NT registry files. The following new scripts have been added: wxregcompare.pl, wxregscope.pl, and wxregview.pl. The existing regcompare.pl, regscope.pl, and regview.pl scripts have been renamed to gtkregcompare.pl, gtkregscope.pl, and gtkregview.pl respectively. The wx scripts require Mattia Barbon's wxPerl library and the gtk scripts require Gtk-Perl. (Binary versions of wxPerl are currently available in ActivePerl.) gtkregscope.pl and wxregscope.pl use the new get_block_iterator method, so can read both Windows 95 or Windows NT registry files. gtkregcompare.pl and wxregcompare.pl allow the Select Files dialog to be cancelled to make it possible to review the currently selected files. regmultidiff.pl now displays changes in a summary mode. The previous format is available by specifying the -l or --long option. ** 0.51 2009-10-04 Added new regscope.pl script, a GTK+ registry entry viewer that uses color to highlight different types of registry entries. Documented the get_name method of SID objects and the get_value_data method of Key objects. The as_string method of the ACE object and the as_stanza method of the SecurityDescriptor object now include the well known SID names (as returned by each SID object's get_name method). Updated the regview.pl and regcompare.pl scripts: regview.pl and regcompare.pl can now select keys and/or values when searching, regview.pl can now sort columns (e.g. keys can be sorted by timestamp, values by type, etc), regcompare.pl can now bookmark keys or values, and regview.pl now has a basic report view. Fixed the get_subtree_iter and make_multiple_subtree_iterator methods to return the root key(s) of the subtree(s) as the documentation indicates. regview.pl, regmultidiff.pl, and regcompare.pl amended to accommodate these changes. Fixed redisplay problem closing dialogs using Escape in regview.pl and regcompare.pl. Makefile.pl now includes all scripts as exe_files. ** 0.50 2009-07-19 Security information is now extracted from Windows NT registry files. Key objects now provide a get_security method which returns a new Security object. The various methods of a Security object will return Security Descriptor, ACL, ACE, and SID objects. The support functions unpack_sid, unpack_ace, unpack_acl, and unpack_security_descriptor have been added to allow the manual extraction of security information from value data. The support functions compare_multiple_keys and compare_multiple_values have been added for comparing keys and values. Updated scripts: regview.pl now provides searches and displays security information for keys. regtree.pl now draws lines connecting subkeys to their parent keys. regdump.pl can now display class names and security information. regfind.pl and regtimeline.pl can now display value data as a hexdump, and regfind.pl now searches raw data for unicode matches. New scripts: regmultidiff.pl is a command line program for comparing multiple registry files, and replaces regdiff.pl. regcompare.pl is a GTK+ Registry Compare program, and also provides searches. regsecurity.pl displays registry security entries. regshell.pl is a interactive console program for browsing registry files that offers tab completion of key and value names if Term::Readline is available. Iterators for processing keys and values have now been added, mainly to support GUI programs (see regview.pl and regcompare.pl). Key objects now offer the get_subkey_iterator, get_value_iterator, and get_subtree_iterator methods. The support functions make_multiple_subkey_iterator, make_multiple_value_iterator, and make_multiple_subtree_iterator have been added for processing multiple registry files simultaneously. Similarly, iterators have been added for scanning registry files entry by entry. The new Hbin object has been created to represent the individual hbins that make up Windows NT registry files. Now you can either iterate through all the entries in a registry file, or iterate through all the hbins in a registry file and through each entry of each hbin. The as_hexdump method provided by Entry, Key, and Value objects has been renamed to unparsed to more accurately reflect what it shows. The Entry, Key, and Value objects now provide the following methods: get_length, get_tag, is_allocated, get_raw_bytes, looks_like_key, looks_like_value, and looks_like_security. Warnings generated by parse errors are now disabled by default. ** 0.41 2008-12-14 Added the new get_class_name function for Windows NT registry keys. Added the regclassnames.pl script to demonstrate finding keys that have class names, and updated regview.pl to display the timestamp and class names of keys in additional columns. ** 0.40 2008-09-28 Added new scripts: regexport.pl for exporting keys and values using the Windows Registry Editor Version 5.00 format, regscan.pl for dumping all the entries in a registry file, regstats.pl for providing basic statistics, regtimeline.pl for listing keys and values in date order, regtree.pl for dumping a registry file as an intended tree, and regview.pl, a GTK+ Registry Viewer. Updated regdump.pl and regfind.pl to provide new options. Changed parse errors to generate warnings instead of croaking. Documented this in the Handling Invalid Data section. The get_data method of Value objects now handles REG_MULTI_SZ data by returning a list of its elements in an array context, and a string in a scalar context. The output of get_data_as_string is unaffected. Added new Registry object methods: get_virtual_root_key, get_timestamp, get_timestamp_as_string, and get_embedded_filename. Added new Key object methods: as_regedit_export, get_parent, and is_root. Added new Value object methods: as_regedit_export, and get_raw_data. Added the get_next_entry and move_to_first_entry methods to the Registry object for iterating through all the entries in a registry file. Added the Entry object class as a generic object to represent these entries. Added the methods parse_info and as_hexdump to Entry, Key, and Value objects. Support function convert_filetime_to_epoch_time renamed to unpack_windows_time, added the function unpack_unicode_string, and documented hexdump. ** 0.30 2007-07-01 Added two new scripts: regfind.pl for searching keys, values, and data for a search string, and regdiff.pl for comparing two registry files and displaying the differences. dumpreg.pl renamed to regdump.pl and command line options simplified. Introduced the as_string method for Key and Value objects. This is intended to be a more usable replacement for the print_summary method. The get_data_as_string method changed to return REG_DWORD values as a hexadecimal number followed by its decimal equivalent. Clarified that REG_DWORD values are returned as unsigned integers. Support functions convert_filetime_to_epoch_time and iso8601 documented. Fixed bugs handling unusual key names in the get_subkey method. ** 0.25 2006-11-12 Fixed a bug with new WinNT key objects incorrectly setting the offsets to subkey lists and value lists when the offset to the parent key had a particular value. ** 0.24 2006-10-29 Key objects now have a get_path method, which returns the path to that key from the root key of a registry file. Documentation updated to describe the new method. dumpreg.pl updated to use get_path. Dropped the prefix_pattern and long_prefix_pattern configuration options from Getopt::Long. (which required an unnecessarily recent version of Getopt::Long) ** 0.23 2006-08-13 Key objects now have the get_timestamp and get_timestamp_as_string methods, although only Windows NT registry keys will return valid values. print_summary nows also displays the timestamp for Windows NT registry keys. Documentation updated to reflect this. Makefile.PL now installs the dumpreg.pl script. ** 0.22 2006-08-06 Included the script dumpreg.pl as both a tool for examining registry files, and as an example. Offsets that require adjustment by fixed amounts (this applies to entries in the RGKN block of Windows 95 registry files and to all entries in the hbin blocks of Windows NT registry files) are now amended before being stored, rather than at seek time. Troubleshooting section added to the documentation. ** 0.21 2006-07-30 Checks added after every sysread, and improvements attempted for the error messages presented. Internal error messages have been made distinct from parse errors. The code that looks up the RGDB entry for Win95 keys has been revised to remove some duplicate code. It's still too long. Reading REG_DWORD values which are not the expected four bytes in length no longer results in an exception. get_data now returns undef for these values instead of failing. get_data_as_string updated to return (no data) when get_data returns an empty string, and (invalid data) when get_data returns undef (which should only occur for invalid REG_DWORD values). ** 0.20 2006-07-23 Released to CPAN. Parse-Win32Registry-1.0/t/0000755000175000017500000000000011747225756014406 5ustar ownerownerParse-Win32Registry-1.0/t/misc.t0000644000175000017500000005316411747213110015514 0ustar ownerowneruse strict; use warnings; use Test::More 'no_plan'; use Encode; use Time::Local qw(timegm); use Parse::Win32Registry 0.60 qw( hexdump format_octets convert_filetime_to_epoch_time iso8601 unpack_windows_time unpack_string unpack_unicode_string unpack_guid ); # hexdump and format_octets tests my $small_text = 'Perl'; my $medium_text = 'This library is free software.'; my $large_text = <? 40 40 41 42 43 44 45 46 47 48 49 4a 4b 4c 4d 4e 4f \@ABCDEFGHIJKLMNO 50 50 51 52 53 54 55 56 57 58 59 5a 5b 5c 5d 5e 5f PQRSTUVWXYZ[\\]^_ 60 60 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f `abcdefghijklmno 70 70 71 72 73 74 75 76 77 78 79 7a 7b 7c 7d 7e 7f pqrstuvwxyz{|}~. 80 80 81 82 83 84 85 86 87 88 89 8a 8b 8c 8d 8e 8f ................ 90 90 91 92 93 94 95 96 97 98 99 9a 9b 9c 9d 9e 9f ................ a0 a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 aa ab ac ad ae af ................ b0 b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf ................ c0 c0 c1 c2 c3 c4 c5 c6 c7 c8 c9 ca cb cc cd ce cf ................ d0 d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 da db dc dd de df ................ e0 e0 e1 e2 e3 e4 e5 e6 e7 e8 e9 ea eb ec ed ee ef ................ f0 f0 f1 f2 f3 f4 f5 f6 f7 f8 f9 fa fb fc fd fe ff ................ EOT # format_octets tests is(format_octets(undef), "\n", 'format_octets undef'); is(format_octets(''), "\n", 'format_octets empty string'); is(format_octets($small_text), <as_string, $expected_guid, "$desc as_string"); } foreach my $guid_test (@guid_tests) { my ($desc, $data, $guid, $len) = @$guid_test; my $unpacked_guid1 = unpack_guid($data); my ($unpacked_guid2, $len2) = unpack_guid($data); if (defined($guid)) { check_guid($unpacked_guid1, $guid, "$desc (scalar) unpack_guid"); check_guid($unpacked_guid2, $guid, "$desc (list) unpack_guid"); is($len2, 16, "$desc (list) unpack_guid length"); } else { ok(!defined($unpacked_guid1), "$desc (scalar) unpack_guid undefined (invalid guid)"); ok(!defined($unpacked_guid2), "$desc (list) unpack_guid undefined (invalid guid)"); } } Parse-Win32Registry-1.0/t/entry.t0000644000175000017500000002414111747213110015713 0ustar ownerowneruse strict; use warnings; use Test::More 'no_plan'; use Parse::Win32Registry 0.60; sub find_file { my $filename = shift; return -d 't' ? "t/$filename" : $filename; } sub run_entry_tests { my $registry = shift; my @tests = @_; my ($os) = ref($registry) =~ /Win(NT|95)/; foreach my $loop (1..2) { $registry->move_to_first_entry if $loop > 1; # check reset works my $entry_num = 0; foreach my $test (@tests) { my $offset = $test->{offset}; my $length = $test->{length}; my $tag = $test->{tag}; my $allocated = $test->{allocated}; my $as_string = $test->{as_string}; $entry_num++; my $desc = sprintf "(pass $loop) $os entry at 0x%x", $offset; my $entry = $registry->get_next_entry; ok(defined($entry), "$desc defined (valid entry)"); is($entry->get_offset, $offset, "$desc get_offset"); is($entry->get_length, $length, "$desc get_length"); is($entry->get_tag, $tag, "$desc get_tag"); is($entry->is_allocated, $allocated, "$desc is_allocated"); is($entry->as_string, $as_string, "$desc as_string"); } # check iterator is empty my $entry = $registry->get_next_entry; my $desc = "(pass $loop) $os"; ok(!defined $entry, "$desc entry undefined (iterator finished)"); } } { my $filename = find_file('win95_entry_tests.rf'); my $registry = Parse::Win32Registry->new($filename); ok(defined($registry), 'registry defined'); isa_ok($registry, 'Parse::Win32Registry::Win95::File'); my @tests = ( { offset => 0x40, length => 28, tag => "rgkn key", allocated => 1, as_string => "", }, { offset => 0x5c, length => 28, tag => "rgkn key", allocated => 1, as_string => "\\key1", }, { offset => 0x78, length => 28, tag => "rgkn key", allocated => 1, as_string => "\\key2", }, { offset => 0xb4, length => 68, tag => "rgdb key", allocated => 1, as_string => "(rgdb key)", }, { offset => 0xcc, length => 22, tag => "rgdb value", allocated => 1, as_string => "value1 (REG_DWORD) = 0x00000000 (0)", }, { offset => 0xe2, length => 22, tag => "rgdb value", allocated => 1, as_string => "value2 (REG_DWORD) = 0x00000000 (0)", }, { offset => 0xf8, length => 68, tag => "rgdb key", allocated => 1, as_string => "(rgdb key)", }, { offset => 0x110, length => 22, tag => "rgdb value", allocated => 1, as_string => "value3 (REG_DWORD) = 0x00000000 (0)", }, { offset => 0x126, length => 22, tag => "rgdb value", allocated => 1, as_string => "value4 (REG_DWORD) = 0x00000000 (0)", }, ); run_entry_tests($registry, @tests); } { my $filename = find_file('winnt_entry_tests.rf'); my $registry = Parse::Win32Registry->new($filename); ok(defined($registry), 'registry defined'); isa_ok($registry, 'Parse::Win32Registry::WinNT::File'); my @tests = ( { offset => 0x1020, length => 96, tag => "nk", allocated => 1, as_string => "\$\$\$PROTO.HIV [2000-08-06T23:42:36Z]", }, { offset => 0x1080, length => 104, tag => "sk", allocated => 1, as_string => "(security entry)", }, { offset => 0x10e8, length => 88, tag => "nk", allocated => 1, as_string => "\$\$\$PROTO.HIV\\key1 [2001-06-28T18:27:34Z]", }, { offset => 0x1140, length => 16, tag => "", allocated => 1, as_string => "(unidentified entry)", }, { offset => 0x1150, length => 88, tag => "nk", allocated => 1, as_string => "\$\$\$PROTO.HIV\\key2 [2002-05-20T13:12:31Z]", }, { offset => 0x11a8, length => 16, tag => "", allocated => 1, as_string => "(unidentified entry)", }, { offset => 0x11b8, length => 24, tag => "lf", allocated => 1, as_string => "(subkey list entry)", }, { offset => 0x11d0, length => 88, tag => "nk", allocated => 1, as_string => "\$\$\$PROTO.HIV\\key1\\key3 [2003-04-11T07:57:29Z]", }, { offset => 0x1228, length => 88, tag => "nk", allocated => 1, as_string => "\$\$\$PROTO.HIV\\key1\\key4 [2004-03-02T02:42:27Z]", }, { offset => 0x1280, length => 88, tag => "nk", allocated => 1, as_string => "\$\$\$PROTO.HIV\\key1\\key5 [2005-01-21T21:27:24Z]", }, { offset => 0x12d8, length => 32, tag => "lh", allocated => 1, as_string => "(subkey list entry)", }, { offset => 0x12f8, length => 32, tag => "", allocated => 0, as_string => "(unidentified entry)", }, { offset => 0x1318, length => 32, tag => "vk", allocated => 1, as_string => "sz1 (REG_SZ) = www.perl.org", }, { offset => 0x1338, length => 32, tag => "", allocated => 1, as_string => "(unidentified entry)", }, { offset => 0x1358, length => 32, tag => "vk", allocated => 1, as_string => "binary1 (REG_BINARY) = 01 02 03 04 05 06 07 08", }, { offset => 0x1378, length => 16, tag => "", allocated => 1, as_string => "(unidentified entry)", }, { offset => 0x1388, length => 32, tag => "vk", allocated => 1, as_string => "dword1 (REG_DWORD) = 0x04030201 (67305985)", }, { offset => 0x13a8, length => 40, tag => "vk", allocated => 1, as_string => "multi_sz1 (REG_MULTI_SZ) = [0] abcde [1] fghij [2] klmno", }, { offset => 0x13d0, length => 48, tag => "", allocated => 1, as_string => "(unidentified entry)", }, { offset => 0x1400, length => 32, tag => "vk", allocated => 1, as_string => "type500 (REG_500) = 01 02 03 04", }, { offset => 0x1420, length => 8, tag => "", allocated => 1, as_string => "(unidentified entry)", }, { offset => 0x1428, length => 24, tag => "", allocated => 1, as_string => "(unidentified entry)", }, { offset => 0x1440, length => 88, tag => "nk", allocated => 1, as_string => "\$\$\$PROTO.HIV\\key2\\key6 [2005-12-13T16:12:22Z]", }, { offset => 0x1498, length => 88, tag => "nk", allocated => 1, as_string => "\$\$\$PROTO.HIV\\key2\\key7 [2006-11-04T10:57:20Z]", }, { offset => 0x14f0, length => 88, tag => "nk", allocated => 1, as_string => "\$\$\$PROTO.HIV\\key2\\key8 [2007-09-26T05:42:18Z]", }, { offset => 0x1548, length => 88, tag => "nk", allocated => 1, as_string => "\$\$\$PROTO.HIV\\key2\\key9 [2008-08-17T00:27:15Z]", }, { offset => 0x15a0, length => 88, tag => "nk", allocated => 1, as_string => "\$\$\$PROTO.HIV\\key2\\key10 [2009-07-08T19:12:13Z]", }, { offset => 0x15f8, length => 88, tag => "nk", allocated => 1, as_string => "\$\$\$PROTO.HIV\\key2\\key11 [2010-05-30T13:57:11Z]", }, { offset => 0x1650, length => 20, tag => "li", allocated => 1, as_string => "(subkey list entry)", }, { offset => 0x1664, length => 48, tag => "", allocated => 0, as_string => "(unidentified entry)", }, { offset => 0x1694, length => 20, tag => "li", allocated => 1, as_string => "(subkey list entry)", }, { offset => 0x16a8, length => 48, tag => "", allocated => 0, as_string => "(unidentified entry)", }, { offset => 0x16d8, length => 16, tag => "ri", allocated => 1, as_string => "(subkey list entry)", }, { offset => 0x16e8, length => 48, tag => "", allocated => 0, as_string => "(unidentified entry)", }, { offset => 0x1718, length => 2280, tag => "", allocated => 0, as_string => "(unidentified entry)", }, ); run_entry_tests($registry, @tests); } Parse-Win32Registry-1.0/t/win95_compare_tests3.rf0000644000175000017500000000067411747213110020711 0ustar ownerownerCREGÌRGKN¬ ÿÿÿÿ<ÿÿÿÿÿÿÿÿ ÿÿÿÿX<tÿÿÿÿ<ÿÿÿÿ<ÿÿÿÿÿÿÿÿRGDBðppkey1value1value2value3value5key2key3key4key5Parse-Win32Registry-1.0/t/fake_system_dat.rf0000644000175000017500000000035211747213110020056 0ustar ownerownerCREG”RGKNt ÿÿÿÿ<ÿÿÿÿÿÿÿÿ ÿÿÿÿX ÿÿÿÿÿÿÿÿRGDBVîîîîSoftwareîîîîSystemParse-Win32Registry-1.0/t/invalid_regf_checksum.rf0000644000175000017500000000100011747213110021216 0ustar ownerownerregfÇ ttings\Administrator\ntuser.datParse-Win32Registry-1.0/t/win95_error_tests.rf0000644000175000017500000000077611747213110020334 0ustar ownerownerCREGèRGKNÈ ÿÿÿÿ<ÿÿÿÿÿÿÿÿ ÿÿÿÿXè ÿÿÿÿt ÿÿÿÿ ÿÿÿÿ¬ ÿÿÿÿÎîîîRGDB4key1TTkey2 value1www.perl.com value2www.perl.comTTkey3 value3www.perl.com  value4www.perl.comTTkey4 value5www.perl.comParse-Win32Registry-1.0/t/constants.t0000644000175000017500000000156511747213110016573 0ustar ownerowneruse strict; use warnings; use Test::More 'no_plan'; use Parse::Win32Registry 0.60 qw( REG_NONE REG_SZ REG_EXPAND_SZ REG_BINARY REG_DWORD REG_DWORD_BIG_ENDIAN REG_LINK REG_MULTI_SZ REG_RESOURCE_LIST REG_FULL_RESOURCE_DESCRIPTOR REG_RESOURCE_REQUIREMENTS_LIST REG_QWORD ); { my @tests = ( ['REG_NONE' => 0], ['REG_SZ' => 1], ['REG_EXPAND_SZ' => 2], ['REG_BINARY' => 3], ['REG_DWORD' => 4], ['REG_DWORD_BIG_ENDIAN' => 5], ['REG_LINK' => 6], ['REG_MULTI_SZ' => 7], ['REG_RESOURCE_LIST' => 8], ['REG_FULL_RESOURCE_DESCRIPTOR' => 9], ['REG_RESOURCE_REQUIREMENTS_LIST' => 10], ['REG_QWORD' => 11], ); foreach my $test (@tests) { my ($name, $constant) = @{ $test }; cmp_ok(eval $name, '==', $constant, $name); } } Parse-Win32Registry-1.0/t/empty_file.rf0000644000175000017500000000000011747213110017037 0ustar ownerownerParse-Win32Registry-1.0/t/security.t0000644000175000017500000011711511747213110016425 0ustar ownerowneruse strict; use warnings; use Test::More 'no_plan'; use Parse::Win32Registry 0.60 qw( unpack_sid unpack_ace unpack_acl unpack_security_descriptor ); sub find_file { my $filename = shift; return -d 't' ? "t/$filename" : $filename; } # unpack_sid tests my @sid_tests = ( [ "SID1", "\x01\x01\x00\x00\x00\x00\x00\x05\x0c\x00\x00\x00", "S-1-5-12", 12, ], [ "SID2", "\x01\x02\x00\x00\x00\x00\x00\x05\x20\x00\x00\x00\x20\x02\x00\x00", "S-1-5-32-544", 16, ], [ "SID3", "\x01\x05\x00\x00\x00\x00\x00\x05\x15\x00\x00\x00\x40\x42\x0f\x00". "\x80\x84\x1e\x00\xc0\xc6\x2d\x00\xf4\x01\x00\x00", "S-1-5-21-1000000-2000000-3000000-500", 28, ], [ "SID4", # extra data "\x01\x05\x00\x00\x00\x00\x00\x05\x15\x00\x00\x00\x40\x42\x0f\x00". "\x80\x84\x1e\x00\xc0\xc6\x2d\x00\xf4\x01\x00\x00\xee\xee\xee\xee", "S-1-5-21-1000000-2000000-3000000-500", 28, ], [ "SID5", # no data "", undef, ], [ "SID6", # data too short (or num_sub_auths too large) "\x01\x05\x00\x00\x00\x00\x00\x05\x15\x00\x00\x00\x40\x42\x0f\x00". "\x80\x84\x1e\x00\xc0\xc6\x2d\x00", undef, ], [ "SID7", # num_sub_auths invalid "\x01\x00\x00\x00\x00\x00\x00\x05", undef, ], ); sub check_sid { my ($actual_sid, $expected_sid, $desc) = @_; ok(defined($actual_sid), "$desc defined") or return; is($actual_sid->as_string, $expected_sid, "$desc as_string"); } foreach my $sid_test (@sid_tests) { my ($desc, $data, $sid, $len) = @$sid_test; my $unpacked_sid1 = unpack_sid($data); my ($unpacked_sid2, $len2) = unpack_sid($data); if (defined($sid)) { check_sid($unpacked_sid1, $sid, "$desc (scalar) unpack_sid"); check_sid($unpacked_sid2, $sid, "$desc (list) unpack_sid"); is($len2, $len, "$desc (list) unpack_sid length"); } else { ok(!defined($unpacked_sid1), "$desc (scalar) unpack_sid undefined (invalid sid)"); ok(!defined($unpacked_sid2), "$desc (list) unpack_sid undefined (invalid sid)"); } } # unpack_ace tests my @ace_tests = ( [ "ACE1", "\x00\x00\x14\x00\x00\x00\x00\x80". "\x01\x01\x00\x00\x00\x00\x00\x05\x0c\x00\x00\x00", { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x00, mask => 0x80000000, trustee => "S-1-5-12", }, 20, ], [ "ACE2", "\x01\x00\x18\x00\x00\x00\x00\x80". "\x01\x02\x00\x00\x00\x00\x00\x05\x20\x00\x00\x00\x20\x02\x00\x00", { type => 1, type_as_string => 'ACCESS_DENIED', flags => 0x00, mask => 0x80000000, trustee => "S-1-5-32-544", }, 24, ], [ "ACE3", "\x02\x00\x14\x00\x00\x00\x00\x80". "\x01\x01\x00\x00\x00\x00\x00\x05\x0c\x00\x00\x00", { type => 2, type_as_string => 'SYSTEM_AUDIT', flags => 0x00, mask => 0x80000000, trustee => "S-1-5-12", }, 20, ], [ "ACE4", # extra data "\x02\x00\x18\x00\x00\x00\x00\x80". "\x01\x02\x00\x00\x00\x00\x00\x05\x20\x00\x00\x00\x20\x02\x00\x00". "\xee\xee\xee\xee", { type => 2, type_as_string => 'SYSTEM_AUDIT', flags => 0x00, mask => 0x80000000, trustee => "S-1-5-32-544", }, 24, ], [ "ACE5", # invalid length too short "\x00\x00\x00\x00\x00\x00\x00\x80". "\x01\x01\x00\x00\x00\x00\x00\x05\x0c\x00\x00\x00", undef, ], [ "ACE6", # invalid length too long "\x00\x00\xff\x00\x00\x00\x00\x80". "\x01\x01\x00\x00\x00\x00\x00\x05\x0c\x00\x00\x00", undef, ], [ "ACE7", # invalid type "\x03\x00\x14\x00\x00\x00\x00\x80". "\x01\x01\x00\x00\x00\x00\x00\x05\x0c\x00\x00\x00", undef, ], [ "ACE8", # no data "", undef, ], [ "ACE9", # data too short "\x00\x0b\x14\x00\x00\x00\x00\x80", undef, ], [ "ACE10", # invalid sid (number of sub auths > data) "\x00\x0b\x14\x00\x00\x00\x00\x80". "\x01\xff\x00\x00\x00\x00\x00\x05\x0c\x00\x00\x00", undef, ], [ "ACE11", "\x11\x00\x14\x00\x01\x00\x00\x00". "\x01\x01\x00\x00\x00\x00\x00\x10\x00\x10\x00\x00", { type => 17, type_as_string => 'SYSTEM_MANDATORY_LABEL', flags => 0x00, mask => 0x00000001, trustee => "S-1-16-4096", }, 20, ], ); sub check_ace { my ($actual_ace, $expected_ace, $desc) = @_; ok(defined($actual_ace), "$desc defined") or return; is($actual_ace->get_type, $expected_ace->{type}, "$desc get_type"); is($actual_ace->get_type_as_string, $expected_ace->{type_as_string}, "$desc get_type_as_string"); is($actual_ace->get_flags, $expected_ace->{flags}, "$desc get_flags"); is($actual_ace->get_access_mask, $expected_ace->{mask}, "$desc get_access_mask"); check_sid($actual_ace->get_trustee, $expected_ace->{trustee}, "$desc get_trustee"); } foreach my $ace_test (@ace_tests) { my ($desc, $data, $ace, $len) = @$ace_test; my $unpacked_ace1 = unpack_ace($data); my ($unpacked_ace2, $len2) = unpack_ace($data); if (defined($ace)) { check_ace($unpacked_ace1, $ace, "$desc (scalar) unpack_ace"); check_ace($unpacked_ace2, $ace, "$desc (list) unpack_ace"); is($len2, $len, "$desc (list) unpack_ace length"); } else { ok(!defined($unpacked_ace1), "$desc (scalar) unpack_ace undefined (invalid ace)"); ok(!defined($unpacked_ace2), "$desc (list) unpack_ace undefined (invalid ace)"); } } # unpack_acl tests my @acl_tests = ( [ "ACL1", # 0 aces "\x02\x00\x08\x00\x00\x00\x00\x00", [ ], 8, ], [ "ACL2", # 1 ace "\x02\x00\x1c\x00\x01\x00\x00\x00". # ace1 "\x00\x00\x14\x00\x3f\x00\x0f\x00". "\x01\x01\x00\x00\x00\x00\x00\x05\x12\x00\x00\x00", [ { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x00, mask => 0x000f003f, trustee => "S-1-5-18", }, ], 28, ], [ "ACL3", # 4 aces "\x02\x00\x6c\x00\x04\x00\x00\x00". # ace1 "\x00\x00\x24\x00\x3f\x00\x0f\x00". "\x01\x05\x00\x00\x00\x00\x00\x05\x15\x00\x00\x00\x40\x42\x0f\x00". "\x80\x84\x1e\x00\xc0\xc6\x2d\x00\xf4\x01\x00\x00". # ace2 "\x00\x00\x14\x00\x3f\x00\x0f\x00". "\x01\x01\x00\x00\x00\x00\x00\x05\x12\x00\x00\x00". # ace3 "\x00\x00\x18\x00\x3f\x00\x0f\x00". "\x01\x02\x00\x00\x00\x00\x00\x05\x20\x00\x00\x00\x20\x02\x00\x00". # ace4 "\x00\x00\x14\x00\x3f\x00\x0f\x00". "\x01\x01\x00\x00\x00\x00\x00\x05\x0c\x00\x00\x00", [ { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x00, mask => 0x000f003f, trustee => "S-1-5-21-1000000-2000000-3000000-500", }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x00, mask => 0x000f003f, trustee => "S-1-5-18", }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x00, mask => 0x000f003f, trustee => "S-1-5-32-544", }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x00, mask => 0x000f003f, trustee => "S-1-5-12", }, ], 108, ], [ "ACL4", "", undef, ], [ "ACL5", # too short "\x02\x00\x2c\x00\x01\x00\x00\x00". # ace1 "\x00\x00\x24\x00\x3f\x00\x0f\x00". "\x01\x05\x00\x00\x00\x00\x00\x05\x15\x00\x00\x00\x40\x42\x0f\x00". "\x80\x84\x1e\x00\xc0\xc6\x2d\x00", undef, ], [ "ACL6", # extra data "\x02\x00\x2c\x00\x01\x00\x00\x00". # ace1 "\x00\x00\x24\x00\x3f\x00\x0f\x00". "\x01\x05\x00\x00\x00\x00\x00\x05\x15\x00\x00\x00\x40\x42\x0f\x00". "\x80\x84\x1e\x00\xc0\xc6\x2d\x00\xf4\x01\x00\x00\xee\xee\xee\xee", [ { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x00, mask => 0x000f003f, trustee => "S-1-5-21-1000000-2000000-3000000-500", }, ], 44, ], [ "ACL7", # invalid acl length too short "\x02\x00\x28\x00\x01\x00\x00\x00". # ace1 "\x00\x00\x24\x00\x3f\x00\x0f\x00". "\x01\x05\x00\x00\x00\x00\x00\x05\x15\x00\x00\x00\x40\x42\x0f\x00". "\x80\x84\x1e\x00\xc0\xc6\x2d\x00\xf4\x01\x00\x00", undef, ], [ "ACL8", # acl contains unused space "\x02\x00\x30\x00\x01\x00\x00\x00". # ace1 "\x00\x00\x24\x00\x3f\x00\x0f\x00". "\x01\x05\x00\x00\x00\x00\x00\x05\x15\x00\x00\x00\x40\x42\x0f\x00". "\x80\x84\x1e\x00\xc0\xc6\x2d\x00\xf4\x01\x00\x00\xee\xee\xee\xee", [ { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x00, mask => 0x000f003f, trustee => "S-1-5-21-1000000-2000000-3000000-500", }, ], 48, ], [ "ACL9", # invalid acl length too long "\x02\x00\xff\x00\x01\x00\x00\x00". # ace1 "\x00\x00\x24\x00\x3f\x00\x0f\x00". "\x01\x05\x00\x00\x00\x00\x00\x05\x15\x00\x00\x00\x40\x42\x0f\x00". "\x80\x84\x1e\x00\xc0\xc6\x2d\x00\xf4\x01\x00\x00", undef, ], [ "ACL10", # invalid (ace1 undefined) "\x02\x00\x2c\x00\x01\x00\x00\x00". # ace1 (invalid type) "\x03\x00\x24\x00\x3f\x00\x0f\x00". "\x01\x05\x00\x00\x00\x00\x00\x05\x15\x00\x00\x00\x40\x42\x0f\x00". "\x80\x84\x1e\x00\xc0\xc6\x2d\x00\xf4\x01\x00\x00", undef, ], [ "ACL11", # invalid (ace2 undefined) "\x02\x00\x6c\x00\x04\x00\x00\x00". # ace1 "\x00\x00\x24\x00\x3f\x00\x0f\x00". "\x01\x05\x00\x00\x00\x00\x00\x05\x15\x00\x00\x00\x40\x42\x0f\x00". "\x80\x84\x1e\x00\xc0\xc6\x2d\x00\xf4\x01\x00\x00". # ace2 (invalid length too long) "\x00\x00\x18\x00\x3f\x00\x0f\x00". "\x01\x01\x00\x00\x00\x00\x00\x05\x12\x00\x00\x00". # ace3 "\x00\x00\x18\x00\x3f\x00\x0f\x00". "\x01\x02\x00\x00\x00\x00\x00\x05\x20\x00\x00\x00\x20\x02\x00\x00". # ace4 "\x00\x00\x14\x00\x3f\x00\x0f\x00". "\x01\x01\x00\x00\x00\x00\x00\x05\x0c\x00\x00\x00", undef, ], ); sub check_acl { my ($actual_acl, $expected_acl, $desc) = @_; ok(defined($actual_acl), "$desc defined") or return; my @actual_aces = $actual_acl->get_list_of_aces; my @expected_aces = @$expected_acl; is(@actual_aces, @expected_aces, "$desc ace count"); foreach (my $num = 0; $num < @actual_aces; $num++) { check_ace($actual_aces[$num], $expected_aces[$num], "$desc ace[$num]"); } } foreach my $acl_test (@acl_tests) { my ($desc, $data, $acl, $len) = @$acl_test; my $unpacked_acl1 = unpack_acl($data); my ($unpacked_acl2, $len2) = unpack_acl($data); if (defined($acl)) { check_acl($unpacked_acl1, $acl, "$desc (scalar) unpack_acl"); check_acl($unpacked_acl2, $acl, "$desc (list) unpack_acl"); is($len2, $len, "$desc (list) unpack_acl length"); } else { ok(!defined($unpacked_acl1), "$desc (scalar) unpack_acl undefined (invalid acl)"); ok(!defined($unpacked_acl2), "$desc (list) unpack_acl undefined (invalid acl)"); } } # unpack_sd tests my @sd_tests = ( [ "SD1", "\x01\x00\x04\x80". "\xe4\x00\x00\x00\xf4\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00". # dacl "\x02\x00\xd0\x00\x08\x00\x00\x00". # ace1 "\x00\x00\x24\x00\x3f\x00\x0f\x00". "\x01\x05\x00\x00\x00\x00\x00\x05\x15\x00\x00\x00\x40\x42\x0f\x00". "\x80\x84\x1e\x00\xc0\xc6\x2d\x00\xf4\x01\x00\x00". # ace2 "\x00\x00\x14\x00\x3f\x00\x0f\x00". "\x01\x01\x00\x00\x00\x00\x00\x05\x12\x00\x00\x00". # ace3 "\x00\x00\x18\x00\x3f\x00\x0f\x00". "\x01\x02\x00\x00\x00\x00\x00\x05\x20\x00\x00\x00\x20\x02\x00\x00". # ace4 "\x00\x00\x14\x00\x19\x00\x02\x00". "\x01\x01\x00\x00\x00\x00\x00\x05\x0c\x00\x00\x00". # ace5 "\x00\x0b\x24\x00\x00\x00\x00\x10". "\x01\x05\x00\x00\x00\x00\x00\x05\x15\x00\x00\x00\x40\x42\x0f\x00". "\x80\x84\x1e\x00\xc0\xc6\x2d\x00\xf4\x01\x00\x00". # ace6 "\x00\x0b\x14\x00\x00\x00\x00\x10". "\x01\x01\x00\x00\x00\x00\x00\x05\x12\x00\x00\x00". # ace7 "\x00\x0b\x18\x00\x00\x00\x00\x10". "\x01\x02\x00\x00\x00\x00\x00\x05\x20\x00\x00\x00\x20\x02\x00\x00". # ace8 "\x00\x0b\x14\x00\x00\x00\x00\x80". "\x01\x01\x00\x00\x00\x00\x00\x05\x0c\x00\x00\x00". # owner sid "\x01\x02\x00\x00\x00\x00\x00\x05\x20\x00\x00\x00\x20\x02\x00\x00". # group sid "\x01\x01\x00\x00\x00\x00\x00\x05\x12\x00\x00\x00", { owner => "S-1-5-32-544", group => "S-1-5-18", sacl => undef, dacl => [ { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x00, mask => 0x000f003f, trustee => "S-1-5-21-1000000-2000000-3000000-500", }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x00, mask => 0x000f003f, trustee => "S-1-5-18", }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x00, mask => 0x000f003f, trustee => "S-1-5-32-544", }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x00, mask => 0x00020019, trustee => "S-1-5-12", }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x0b, mask => 0x10000000, trustee => "S-1-5-21-1000000-2000000-3000000-500", }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x0b, mask => 0x10000000, trustee => "S-1-5-18", }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x0b, mask => 0x10000000, trustee => "S-1-5-32-544", }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x0b, mask => 0x80000000, trustee => "S-1-5-12", }, ], }, 256, ], [ "SD2", "\x01\x00\x14\x8c". "\x4c\x01\x00\x00\x68\x01\x00\x00\x14\x00\x00\x00\x58\x00\x00\x00". # sacl "\x02\x00\x44\x00\x02\x00\x00\x00". # ace1 "\x02\x52\x18\x00\x26\x00\x0d\x00". "\x01\x02\x00\x00\x00\x00\x00\x05\x20\x00\x00\x00\x20\x02\x00\x00". # ace2 "\x02\x52\x24\x00\x3f\x00\x0f\x00". "\x01\x05\x00\x00\x00\x00\x00\x05\x15\x00\x00\x00\x40\x42\x0f\x00". "\x80\x84\x1e\x00\xc0\xc6\x2d\x00\xeb\x03\x00\x00". # dacl "\x02\x00\xf4\x00\x09\x00\x00\x00". # ace1 "\x01\x12\x24\x00\x3f\x00\x0f\x00". "\x01\x05\x00\x00\x00\x00\x00\x05\x15\x00\x00\x00\x40\x42\x0f\x00". "\x80\x84\x1e\x00\xc0\xc6\x2d\x00\xeb\x03\x00\x00". # ace2 "\x00\x10\x24\x00\x3f\x00\x0f\x00". "\x01\x05\x00\x00\x00\x00\x00\x05\x15\x00\x00\x00\x40\x42\x0f\x00". "\x80\x84\x1e\x00\xc0\xc6\x2d\x00\xf4\x01\x00\x00". # ace3 "\x00\x1b\x24\x00\x00\x00\x00\x10". "\x01\x05\x00\x00\x00\x00\x00\x05\x15\x00\x00\x00\x40\x42\x0f\x00". "\x80\x84\x1e\x00\xc0\xc6\x2d\x00\xf4\x01\x00\x00". # ace4 "\x00\x10\x14\x00\x3f\x00\x0f\x00". "\x01\x01\x00\x00\x00\x00\x00\x05\x12\x00\x00\x00". # ace5 "\x00\x1b\x14\x00\x00\x00\x00\x10". "\x01\x01\x00\x00\x00\x00\x00\x05\x12\x00\x00\x00". # ace6 "\x00\x10\x18\x00\x3f\x00\x0f\x00". "\x01\x02\x00\x00\x00\x00\x00\x05\x20\x00\x00\x00\x20\x02\x00\x00". # ace7 "\x00\x1b\x18\x00\x00\x00\x00\x10". "\x01\x02\x00\x00\x00\x00\x00\x05\x20\x00\x00\x00\x20\x02\x00\x00". # ace8 "\x00\x10\x14\x00\x19\x00\x02\x00". "\x01\x01\x00\x00\x00\x00\x00\x05\x0c\x00\x00\x00". # ace9 "\x00\x1b\x14\x00\x00\x00\x00\x80". "\x01\x01\x00\x00\x00\x00\x00\x05\x0c\x00\x00\x00". # owner "\x01\x05\x00\x00\x00\x00\x00\x05\x15\x00\x00\x00\x40\x42\x0f\x00". "\x80\x84\x1e\x00\xc0\xc6\x2d\x00\xf4\x01\x00\x00". # group "\x01\x05\x00\x00\x00\x00\x00\x05\x15\x00\x00\x00\x40\x42\x0f\x00". "\x80\x84\x1e\x00\xc0\xc6\x2d\x00\x01\x02\x00\x00", { owner => "S-1-5-21-1000000-2000000-3000000-500", group => "S-1-5-21-1000000-2000000-3000000-513", sacl => [ { type => 2, type_as_string => 'SYSTEM_AUDIT', flags => 0x52, mask => 0x000d0026, trustee => "S-1-5-32-544", }, { type => 2, type_as_string => 'SYSTEM_AUDIT', flags => 0x52, mask => 0x000f003f, trustee => "S-1-5-21-1000000-2000000-3000000-1003", }, ], dacl => [ { type => 1, type_as_string => 'ACCESS_DENIED', flags => 0x12, mask => 0x000f003f, trustee => "S-1-5-21-1000000-2000000-3000000-1003", }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x10, mask => 0x000f003f, trustee => "S-1-5-21-1000000-2000000-3000000-500", }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x1b, mask => 0x10000000, trustee => "S-1-5-21-1000000-2000000-3000000-500", }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x10, mask => 0x000f003f, trustee => "S-1-5-18", }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x1b, mask => 0x10000000, trustee => "S-1-5-18", }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x10, mask => 0x000f003f, trustee => "S-1-5-32-544", }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x1b, mask => 0x10000000, trustee => "S-1-5-32-544", }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x10, mask => 0x00020019, trustee => "S-1-5-12", }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x1b, mask => 0x80000000, trustee => "S-1-5-12", }, ], }, 388, ], [ "SD3", "\x01\x00\x00\x80". "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", { owner => undef, group => undef, sacl => undef, dacl => undef, }, 20, ], [ "SD4", "\x01\x00\x00\x80". "\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00". "\x01\x02\x00\x00\x00\x00\x00\x05\x20\x00\x00\x00\x20\x02\x00\x00", { owner => "S-1-5-32-544", group => undef, sacl => undef, dacl => undef, }, 36, ], [ "SD5", "\x01\x00\x00\x80". "\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00". "\x01\x01\x00\x00\x00\x00\x00\x05\x12\x00\x00\x00", { owner => undef, group => "S-1-5-18", sacl => undef, dacl => undef, }, 32, ], [ "SD6", "\x01\x00\x08\x80". "\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00". "\x02\x00\x1c\x00\x01\x00\x00\x00". "\x02\x52\x14\x00\x3f\x00\x0f\x00". "\x01\x01\x00\x00\x00\x00\x00\x05\x0c\x00\x00\x00", { owner => undef, group => undef, sacl => [ { type => 2, type_as_string => 'SYSTEM_AUDIT', flags => 0x52, mask => 0x000f003f, trustee => 'S-1-5-12', }, ], dacl => undef, }, 48, ], [ "SD7", "\x01\x00\x04\x80". "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00". "\x02\x00\x1c\x00\x01\x00\x00\x00". "\x00\x12\x14\x00\x3f\x00\x0f\x00". "\x01\x01\x00\x00\x00\x00\x00\x05\x0c\x00\x00\x00", { owner => undef, group => undef, sacl => undef, dacl => [ { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x12, mask => 0x000f003f, trustee => 'S-1-5-12', }, ], }, 48, ], [ "SD8", "", undef, ], [ "SD9", "\x01\x00\x04\x80". "\x74\x00\x00\x00\x84\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00". # dacl (contains unused space) "\x02\x00\x60\x00\x03\x00\x00\x00". "\x00\x02\x14\x00\x3f\x00\x0f\x00". "\x01\x01\x00\x00\x00\x00\x00\x05\x12\x00\x00\x00". "\x00\x02\x14\x00\x19\x00\x02\x00". "\x01\x01\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00". "\x00\x02\x18\x00\x3f\x00\x0f\x00". "\x01\x02\x00\x00\x00\x00\x00\x05\x20\x00\x00\x00\x20\x02\x00\x00". "\xee\xee\xee\xee\xee\xee\xee\xee\xee\xee\xee\xee\xee\xee\xee\xee". "\xee\xee\xee\xee\xee\xee\xee\xee". # owner "\x01\x02\x00\x00\x00\x00\x00\x05\x20\x00\x00\x00\x20\x02\x00\x00". # group "\x01\x01\x00\x00\x00\x00\x00\x05\x12\x00\x00\x00", { owner => "S-1-5-32-544", group => "S-1-5-18", dacl => [ { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 2, mask => 983103, trustee => "S-1-5-18", }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 2, mask => 131097, trustee => "S-1-1-0", }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 2, mask => 983103, trustee => "S-1-5-32-544", }, ], sacl => undef, }, 144, ], [ "SD10", "\x01\x00\x0c\x80". "\x4c\x00\x00\x00\x5c\x00\x00\x00\x14\x00\x00\x00\x30\x00\x00\x00". # sacl "\x02\x00\x1c\x00\x01\x00\x00\x00". "\x02\x52\x14\x00\x3f\x00\x0f\x00". "\x01\x01\x00\x00\x00\x00\x00\x05\x0c\x00\x00\x00". # dacl "\x02\x00\x1c\x00\x01\x00\x00\x00". "\x00\x12\x14\x00\x3f\x00\x0f\x00". "\x01\x01\x00\x00\x00\x00\x00\x05\x0c\x00\x00\x00". # owner "\x01\x02\x00\x00\x00\x00\x00\x05\x20\x00\x00\x00\x20\x02\x00\x00". # group "\x01\x01\x00\x00\x00\x00\x00\x05\x12\x00\x00\x00", { owner => "S-1-5-32-544", group => "S-1-5-18", sacl => [ { type => 2, type_as_string => 'SYSTEM_AUDIT', flags => 0x52, mask => 0x000f003f, trustee => 'S-1-5-12', }, ], dacl => [ { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x12, mask => 0x000f003f, trustee => 'S-1-5-12', }, ], }, 104, ], [ "SD11", "\x01\x00\x0c\x80". "\x4c\x00\x00\x00\x5c\x00\x00\x00\x14\x00\x00\x00\x30\x00\x00\x00". # sacl (invalid) "\x02\x00\x1c\x00\x02\x00\x00\x00". "\x02\x52\x14\x00\x3f\x00\x0f\x00". "\x01\x01\x00\x00\x00\x00\x00\x05\x0c\x00\x00\x00". # dacl "\x02\x00\x1c\x00\x01\x00\x00\x00". "\x00\x12\x14\x00\x3f\x00\x0f\x00". "\x01\x01\x00\x00\x00\x00\x00\x05\x0c\x00\x00\x00". # owner "\x01\x02\x00\x00\x00\x00\x00\x05\x20\x00\x00\x00\x20\x02\x00\x00". # group "\x01\x01\x00\x00\x00\x00\x00\x05\x12\x00\x00\x00", undef, ], [ "SD12", "\x01\x00\x0c\x80". "\x4c\x00\x00\x00\x5c\x00\x00\x00\x14\x00\x00\x00\x30\x00\x00\x00". # sacl "\x02\x00\x1c\x00\x01\x00\x00\x00". "\x02\x52\x14\x00\x3f\x00\x0f\x00". "\x01\x01\x00\x00\x00\x00\x00\x05\x0c\x00\x00\x00". # dacl (invalid) "\x02\x00\x1c\x00\x02\x00\x00\x00". "\x00\x12\x14\x00\x3f\x00\x0f\x00". "\x01\x01\x00\x00\x00\x00\x00\x05\x0c\x00\x00\x00". # owner "\x01\x02\x00\x00\x00\x00\x00\x05\x20\x00\x00\x00\x20\x02\x00\x00". # group "\x01\x01\x00\x00\x00\x00\x00\x05\x12\x00\x00\x00", undef, ], [ "SD13", "\x01\x00\x0c\x80". "\x4c\x00\x00\x00\x5c\x00\x00\x00\x14\x00\x00\x00\x30\x00\x00\x00". # sacl "\x02\x00\x1c\x00\x01\x00\x00\x00". "\x02\x52\x14\x00\x3f\x00\x0f\x00". "\x01\x01\x00\x00\x00\x00\x00\x05\x0c\x00\x00\x00". # dacl "\x02\x00\x1c\x00\x01\x00\x00\x00". "\x00\x12\x14\x00\x3f\x00\x0f\x00". "\x01\x01\x00\x00\x00\x00\x00\x05\x0c\x00\x00\x00". # owner (invalid) "\x01\xff\x00\x00\x00\x00\x00\x05\x20\x00\x00\x00\x20\x02\x00\x00". # group "\x01\x01\x00\x00\x00\x00\x00\x05\x12\x00\x00\x00", undef, ], [ "SD14", "\x01\x00\x0c\x80". "\x4c\x00\x00\x00\x5c\x00\x00\x00\x14\x00\x00\x00\x30\x00\x00\x00". # sacl "\x02\x00\x1c\x00\x01\x00\x00\x00". "\x02\x52\x14\x00\x3f\x00\x0f\x00". "\x01\x01\x00\x00\x00\x00\x00\x05\x0c\x00\x00\x00". # dacl "\x02\x00\x1c\x00\x01\x00\x00\x00". "\x00\x12\x14\x00\x3f\x00\x0f\x00". "\x01\x01\x00\x00\x00\x00\x00\x05\x0c\x00\x00\x00". # owner "\x01\x02\x00\x00\x00\x00\x00\x05\x20\x00\x00\x00\x20\x02\x00\x00". # group (invalid) "\x01\x02\x00\x00\x00\x00\x00\x05\x12\x00\x00\x00", undef, ], ); sub check_sd { my ($actual_sd, $expected_sd, $desc) = @_; ok(defined($actual_sd), "$desc defined") or return; if (defined($expected_sd->{owner})) { check_sid($actual_sd->get_owner, $expected_sd->{owner}, "$desc get_owner"); } else { ok(!defined($actual_sd->get_owner), "$desc get_owner undefined (no owner)"); } if (defined($expected_sd->{group})) { check_sid($actual_sd->get_group, $expected_sd->{group}, "$desc get_group"); } else { ok(!defined($actual_sd->get_group), "$desc get_owner undefined (no group)"); } if (defined($expected_sd->{sacl})) { check_acl($actual_sd->get_sacl, $expected_sd->{sacl}, "$desc get_sacl"); } else { ok(!defined($actual_sd->get_sacl), "$desc get_sacl undefined (no sacl)"); } if (defined($expected_sd->{dacl})) { check_acl($actual_sd->get_dacl, $expected_sd->{dacl}, "$desc get_dacl"); } else { ok(!defined($actual_sd->get_dacl), "$desc get_dacl undefined (no dacl)"); } } foreach my $sd_test (@sd_tests) { my ($desc, $data, $sd, $len) = @$sd_test; my $unpacked_sd1 = unpack_security_descriptor($data); my ($unpacked_sd2, $len2) = unpack_security_descriptor($data); if (defined($sd)) { check_sd($unpacked_sd1, $sd, "$desc (scalar) unpack_security_descriptor"); check_sd($unpacked_sd2, $sd, "$desc (list) unpack_security_descriptor"); is($len2, $len, "$desc (list) unpack_security_descriptor length"); } else { ok(!defined($unpacked_sd1), "$desc (scalar) unpack_security_descriptor undefined (invalid sd)"); ok(!defined($unpacked_sd2), "$desc (list) unpack_security_descriptor undefined (invalid sd)"); } } { my $filename = find_file('winnt_security_tests.rf'); my $registry = Parse::Win32Registry->new($filename); ok(defined($registry), 'registry defined'); isa_ok($registry, 'Parse::Win32Registry::WinNT::File'); my $root_key = $registry->get_root_key; ok(defined($registry), 'root key defined'); isa_ok($root_key, 'Parse::Win32Registry::WinNT::Key'); my @tests = ( { offset => 0x1080, offset_to_previous => 0x1080, offset_to_next => 0x10b0, security_descriptor => { owner => undef, group => undef, sacl => undef, dacl => undef, }, }, { offset => 0x10b0, offset_to_previous => 0x10b0, offset_to_next => 0x10f0, security_descriptor => { owner => 'S-1-5-32-544', group => undef, sacl => undef, dacl => undef, }, }, { offset => 0x10f0, offset_to_previous => 0x10f0, offset_to_next => 0x1128, security_descriptor => { owner => undef, group => 'S-1-5-18', sacl => undef, dacl => undef, }, }, { offset => 0x1128, offset_to_previous => 0x1128, offset_to_next => 0x1170, security_descriptor => { owner => undef, group => undef, sacl => [ { type => 2, type_as_string => 'SYSTEM_AUDIT', flags => 0x52, mask => 0x000f003f, trustee => 'S-1-5-12', }, ], dacl => undef, }, }, { offset => 0x1170, offset_to_previous => 0x1170, offset_to_next => 0x11b8, security_descriptor => { owner => undef, group => undef, sacl => undef, dacl => [ { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x12, mask => 0x000f003f, trustee => 'S-1-5-12', }, ], }, }, { offset => 0x11b8, offset_to_previous => 0x11b8, offset_to_next => 0x12d0, security_descriptor => { owner => 'S-1-5-32-544', group => 'S-1-5-18', sacl => undef, dacl => [ { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x00, mask => 0x000f003f, trustee => 'S-1-5-21-1000000-2000000-3000000-500', }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x00, mask => 0x000f003f, trustee => 'S-1-5-18', }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x00, mask => 0x000f003f, trustee => 'S-1-5-32-544', }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x00, mask => 0x00020019, trustee => 'S-1-5-12', }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x0b, mask => 0x10000000, trustee => 'S-1-5-21-1000000-2000000-3000000-500', }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x0b, mask => 0x10000000, trustee => 'S-1-5-18', }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x0b, mask => 0x10000000, trustee => 'S-1-5-32-544', }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x0b, mask => 0x80000000, trustee => 'S-1-5-12', }, ], }, }, { offset => 0x12d0, offset_to_previous => 0x12d0, offset_to_next => 0x1080, security_descriptor => { owner => 'S-1-5-21-1000000-2000000-3000000-500', group => 'S-1-5-21-1000000-2000000-3000000-513', sacl => [ { type => 2, type_as_string => 'SYSTEM_AUDIT', flags => 0x52, mask => 0x000d0026, trustee => 'S-1-5-32-544', }, { type => 2, type_as_string => 'SYSTEM_AUDIT', flags => 0x52, mask => 0x000f003f, trustee => 'S-1-5-21-1000000-2000000-3000000-1000', }, ], dacl => [ { type => 1, type_as_string => 'ACCESS_DENIED', flags => 0x12, mask => 0x000f003f, trustee => 'S-1-5-21-1000000-2000000-3000000-1001', }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x10, mask => 0x000f003f, trustee => 'S-1-5-21-1000000-2000000-3000000-500', }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x1b, mask => 0x10000000, trustee => 'S-1-5-21-1000000-2000000-3000000-500', }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x10, mask => 0x000f003f, trustee => 'S-1-5-18', }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x1b, mask => 0x10000000, trustee => 'S-1-5-18', }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x10, mask => 0x000f003f, trustee => 'S-1-5-32-544', }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x1b, mask => 0x10000000, trustee => 'S-1-5-32-544', }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x10, mask => 0x00020019, trustee => 'S-1-5-12', }, { type => 0, type_as_string => 'ACCESS_ALLOWED', flags => 0x1b, mask => 0x80000000, trustee => 'S-1-5-12', }, ], }, }, ); my $security = $root_key->get_security; foreach my $test (@tests) { my $offset = $test->{offset}; my $offset_to_previous = $test->{offset_to_previous}; my $offset_to_next = $test->{offset_to_next}; my $sd = $test->{security_descriptor}; my $desc = sprintf "security at 0x%x", $offset; ok(defined($security), "$desc defined (valid security)"); is($security->get_offset, $offset, "$desc get_offset"); check_sd($security->get_security_descriptor, $sd, "$desc get_security_descriptor"); $security = $security->get_next; } } Parse-Win32Registry-1.0/t/errors.t0000644000175000017500000003032211747213110016064 0ustar ownerowneruse strict; use warnings; use Test::More 'no_plan'; use Parse::Win32Registry 0.60 qw(:functions); Parse::Win32Registry::enable_warnings; my @tests = ( ### WIN32REGISTRY ERROR MESSAGES { class => 'Parse::Win32Registry', fatal_error => 'No filename specified', }, { filename => 'invalid_creg_header.rf', class => 'Parse::Win32Registry', warning => 'Invalid registry file header', }, { filename => 'invalid_regf_header.rf', class => 'Parse::Win32Registry', warning => 'Invalid registry file header', }, ### SUPPORT FUNCTION ERROR MESSAGES { method => 'make_multiple_subkey_iterator()', fatal_error => 'Usage: make_multiple_subkey_iterator', }, { method => 'make_multiple_subtree_iterator()', fatal_error => 'Usage: make_multiple_subtree_iterator', }, { method => 'make_multiple_value_iterator()', fatal_error => 'Usage: make_multiple_value_iterator', }, { method => 'compare_multiple_keys()', fatal_error => 'Usage: compare_multiple_keys', }, { method => 'compare_multiple_values()', fatal_error => 'Usage: compare_multiple_values', }, ### WIN95::FILE ERROR MESSAGES { class => 'Parse::Win32Registry::Win95::File', fatal_error => 'No filename specified', }, { filename => 'nonexistent_file', class => 'Parse::Win32Registry::Win95::File', fatal_error => 'Unable to open', }, { filename => 'empty_file.rf', class => 'Parse::Win32Registry::Win95::File', warning => 'Could not read registry file header', }, { filename => 'invalid_creg_header.rf', class => 'Parse::Win32Registry::Win95::File', warning => 'Invalid registry file signature', }, { filename => 'missing_rgkn_header.rf', class => 'Parse::Win32Registry::Win95::File', warning => 'Could not read RGKN header at 0x', }, { filename => 'invalid_rgkn_header.rf', class => 'Parse::Win32Registry::Win95::File', warning => 'Invalid RGKN block signature at 0x', }, ### WIN95::KEY ERROR MESSAGES { filename => 'win95_error_tests.rf', class => 'Parse::Win32Registry::Win95::Key', offset => 0xeeeeeeee, warning => 'Could not read RGKN key at 0x', }, { filename => 'win95_error_tests.rf', class => 'Parse::Win32Registry::Win95::Key', offset => 0x5c, warning => 'Could not find RGDB entry for RGKN key at 0x', further_tests => [ ['defined($object)'], ['$object->get_name', ''], ['$object->get_path', ''], ['$object->get_list_of_values', '==', 0], ], }, ### WIN95::VALUE ERROR MESSAGES { filename => 'win95_error_tests.rf', class => 'Parse::Win32Registry::Win95::Value', offset => 0x1fe, warning => 'Could not read RGDB value at 0x', }, { filename => 'win95_error_tests.rf', class => 'Parse::Win32Registry::Win95::Value', offset => 0x1aa, warning => 'Could not read name for RGDB value at 0x', }, { filename => 'win95_error_tests.rf', class => 'Parse::Win32Registry::Win95::Value', offset => 0x156, warning => 'Could not read data for RGDB value at 0x', }, ### WINNT::FILE ERROR MESSAGES { class => 'Parse::Win32Registry::WinNT::File', fatal_error => 'No filename specified', }, { filename => 'nonexistent_file', class => 'Parse::Win32Registry::WinNT::File', fatal_error => 'Unable to open', }, { filename => 'empty_file.rf', class => 'Parse::Win32Registry::WinNT::File', warning => 'Could not read registry file header', }, { filename => 'invalid_regf_header.rf', class => 'Parse::Win32Registry::WinNT::File', warning => 'Invalid registry file signature', }, { filename => 'invalid_regf_checksum.rf', class => 'Parse::Win32Registry::WinNT::File', warning => 'Invalid checksum for registry file header', further_tests => [ ['defined($object)'], ['$object->get_embedded_filename', 'ttings\\Administrator\\ntuser.dat'], ], }, ### WINNT::KEY ERROR MESSAGES { filename => 'winnt_error_tests.rf', class => 'Parse::Win32Registry::WinNT::Key', offset => 0xeeeeeeee, warning => 'Could not read key at 0x', }, { filename => 'winnt_error_tests.rf', class => 'Parse::Win32Registry::WinNT::Key', offset => 0x1080, warning => 'Invalid signature for key at 0x', }, { filename => 'winnt_error_tests.rf', class => 'Parse::Win32Registry::WinNT::Key', offset => 0x10d8, warning => 'Could not read name for key at 0x', }, { filename => 'winnt_error_tests.rf', class => 'Parse::Win32Registry::WinNT::Key', offset => 0x1130, warning => 'Could not read class name at 0x', further_tests => [ ['defined($object)'], ['$object->get_name', 'key4'], ['!defined($object->get_class_name)'], ], }, { filename => 'winnt_error_tests.rf', class => 'Parse::Win32Registry::WinNT::Key', offset => 0x1198, method => '@result = $object->get_list_of_subkeys', warning => 'Could not read subkey list header at 0x', }, { filename => 'winnt_error_tests.rf', class => 'Parse::Win32Registry::WinNT::Key', offset => 0x11f0, method => '@result = $object->get_list_of_subkeys', warning => 'Invalid signature for subkey list at 0x', }, { filename => 'winnt_error_tests.rf', class => 'Parse::Win32Registry::WinNT::Key', offset => 0x1248, method => '@result = $object->get_list_of_subkeys', warning => 'Could not read subkey list at 0x', }, { filename => 'winnt_error_tests.rf', class => 'Parse::Win32Registry::WinNT::Key', offset => 0x12a0, method => '@result = $object->get_list_of_values', warning => 'Could not read value list at 0x', }, ### USAGE ERRORS { filename => 'winnt_error_tests.rf', class => 'Parse::Win32Registry::WinNT::Key', offset => 0x1020, method => '$result = $object->get_subkey(undef)', fatal_error => q{Usage: get_subkey\('key name'\)}, }, { filename => 'winnt_error_tests.rf', class => 'Parse::Win32Registry::WinNT::Key', offset => 0x1020, method => '$result = $object->get_value(undef)', fatal_error => q{Usage: get_value\('value name'\)}, }, ### WINNT::SECURITY ERROR MESSAGES { filename => 'winnt_error_tests.rf', class => 'Parse::Win32Registry::WinNT::Security', offset => 0xeeeeeeee, warning => 'Could not read security at 0x', }, { filename => 'winnt_error_tests.rf', class => 'Parse::Win32Registry::WinNT::Security', offset => 0x1828, warning => 'Invalid signature for security at 0x', }, { filename => 'winnt_error_tests.rf', class => 'Parse::Win32Registry::WinNT::Security', offset => 0x1890, warning => 'Could not read security descriptor for security at 0x', }, { filename => 'winnt_error_tests.rf', class => 'Parse::Win32Registry::WinNT::Security', offset => 0x18f8, warning => 'Invalid security descriptor for security at 0x', }, ### WINNT::VALUE ERROR MESSAGES { filename => 'winnt_error_tests.rf', class => 'Parse::Win32Registry::WinNT::Value', offset => 0xeeeeeeee, warning => 'Could not read value at 0x', }, { filename => 'winnt_error_tests.rf', class => 'Parse::Win32Registry::WinNT::Value', offset => 0x1960, warning => 'Invalid signature for value at 0x', }, { filename => 'winnt_error_tests.rf', class => 'Parse::Win32Registry::WinNT::Value', offset => 0x1980, warning => 'Could not read name for value at 0x', }, { filename => 'winnt_error_tests.rf', class => 'Parse::Win32Registry::WinNT::Value', offset => 0x19a0, warning => 'Invalid inline data length for value \'.*\' at 0x', further_tests => [ ['defined($object)'], ['$object->get_name', 'value4'], ['!defined($object->get_data)'], ], }, { filename => 'winnt_error_tests.rf', class => 'Parse::Win32Registry::WinNT::Value', offset => 0x19c0, warning => 'Invalid offset to data for value \'.*\' at 0x', further_tests => [ ['defined($object)'], ['$object->get_name', 'value5'], ['!defined($object->get_data)'], ], }, ); foreach my $test (@tests) { my $filename = $test->{filename}; my $class = $test->{class}; my $offset = $test->{offset}; my $method_test = $test->{method}; my $fatal_error = $test->{fatal_error}; my $warning = $test->{warning}; my $list_of_warnings = $test->{list_of_warnings}; my $further_tests = $test->{further_tests}; if (defined $filename) { $filename = -d 't' ? 't/'.$filename : $filename; die "Missing test data file '$filename'" if !-f $filename && $filename !~ m/nonexistent/; } # declare variables used in tests my $regfile; my $object; my $result; my @result; my $setup = ""; my $setup_desc = ""; if (defined $class) { if (defined $filename) { if (defined $offset) { $regfile = Parse::Win32Registry->new($filename); $setup = "\$object = $class->new(\$regfile, \$offset)"; $setup_desc = sprintf("\$object = $class->new(<$filename>, 0x%x)", $offset); } else { $setup = "\$object = $class->new(\$filename)"; $setup_desc = "\$object = $class->new(<$filename>)"; } } else { $setup = "\$object = $class->new"; $setup_desc = $setup; } } # If a method test is not specified, # then the setup becomes the test my $eval; my $eval_desc; if (defined $method_test) { if ($setup) { # eval $setup # ok defined $object or diag $@ ok(eval $setup, "$setup_desc should succeed") or diag $@; } $eval = $method_test; $eval_desc = $method_test; } else { $eval = $setup; $eval_desc = $setup_desc; } my @caught_warnings = (); local $SIG{__WARN__} = sub { push @caught_warnings, shift; }; if ($further_tests) { ok(eval $eval, "$eval_desc should succeed"); } else { ok(!eval $eval, "$eval_desc should fail"); } if ($fatal_error) { like($@, qr/$fatal_error/, qq{...with fatal error "$fatal_error..."}); } elsif ($warning) { my $num_caught = @caught_warnings; cmp_ok($num_caught, '==', 1, "...with only one warning"); my $caught_warning = $caught_warnings[0]; $caught_warning = '' if !defined $caught_warning; like($caught_warning, qr/$warning/, qq{...warning "$warning"}); } if (defined $further_tests) { die if ref $further_tests ne 'ARRAY'; foreach my $further_test (@$further_tests) { my @params = @$further_test; if (@params == 1) { my $test_desc = "...and $params[0]"; ok(eval $params[0], $test_desc); } elsif (@params == 2) { my $test_desc = "...and $params[0] eq '$params[1]'"; is(eval $params[0], $params[1], $test_desc); } elsif (@params == 3) { my $test_desc = $params[1] eq '==' ? "...and $params[0] $params[1] $params[2]" : "...and $params[0] $params[1] '$params[2]'"; cmp_ok(eval $params[0], $params[1], $params[2], $test_desc); } } } } Parse-Win32Registry-1.0/t/win95_compare_tests2.rf0000644000175000017500000000061211747213110020700 0ustar ownerownerCREG°RGKN ÿÿÿÿ<ÿÿÿÿÿÿÿÿ ÿÿÿÿX<tÿÿÿÿ<ÿÿÿÿÿÿÿÿRGDBÚZZkey1value1value2value3key2key3key4key5Parse-Win32Registry-1.0/t/fake_software.rf0000644000175000017500000001053011747213110017533 0ustar ownerownerregfÇ Re ghbinÇ ÿÿÿnk,Àÿÿÿÿ€ÿÿÿÿ $$$PROTO.HIVàÿÿÿlf  ÿÿÿnk À ÿÿÿÿÿÿÿÿ Microsoft¨ÿÿÿnk À ÿÿÿÿÿÿÿÿPoliciesParse-Win32Registry-1.0/t/fake_ntuser_dat.rf0000644000175000017500000001067011747213110020056 0ustar ownerownerregfÇ Re ghbinÇ ÿÿÿnk,Àÿÿÿÿ€ÿÿÿÿ $$$PROTO.HIVàÿÿÿlf ` ÿÿÿnk À ÿÿÿÿÿÿÿÿ Control Panel ÿÿÿnk À ÿÿÿÿÿÿÿÿ Environment¨ÿÿÿnk À ÿÿÿÿÿÿÿÿSoftwareParse-Win32Registry-1.0/t/win95_iter_tests.rf0000644000175000017500000000121711747213110020135 0ustar ownerownerCREGRGKNä ÿÿÿÿ<ÿÿÿÿÿÿÿÿ tX ¬ÿÿÿÿ<ÿÿÿÿ<ÿÿÿÿÿÿÿÿXÿÿÿÿÈXÿÿÿÿÿÿÿÿRGDB‹<<key1value1value2<<key2value3value4<<key3value5value6<<key4value7value8==key5value9value10>>key6value11value12Parse-Win32Registry-1.0/t/compare.t0000644000175000017500000000760511747213110016206 0ustar ownerowneruse strict; use warnings; use Data::Dumper; use Test::More 'no_plan'; use Parse::Win32Registry 0.60 qw(make_multiple_subtree_iterator compare_multiple_keys compare_multiple_values); $Data::Dumper::Useqq = 1; $Data::Dumper::Terse = 1; $Data::Dumper::Indent = 0; sub find_file { my $filename = shift; return -d 't' ? "t/$filename" : $filename; } sub run_compare_tests { my @registries = @{shift @_}; my @tests = @_; my $any_registry = (grep { defined } @registries)[0]; my ($os) = ref($any_registry) =~ /Win(NT|95)/; my @root_keys = map { $_->get_root_key } @registries; my $subtree_iter = make_multiple_subtree_iterator(@root_keys); foreach my $test (@tests) { my $key_path = $test->[0]; my $value_name = $test->[1]; my @changes = @{$test->[2]}; my $changes_as_text = join ", ", map { "'$_'" } @changes; my $desc = "$os"; my ($keys_ref, $values_ref) = $subtree_iter->get_next; my @keys = @$keys_ref; my $any_key = (grep { defined } @keys)[0]; if (defined $values_ref) { my @values = @$values_ref; my $any_value = (grep { defined } @values)[0]; is($any_value->get_name, $value_name, "$desc comparing values " . Dumper($value_name)); is_deeply([compare_multiple_values(@values)], \@changes, "$desc ...changes are ($changes_as_text)"); } else { is($any_key->get_path, $key_path, "$desc comparing keys " . Dumper($key_path)); is_deeply([compare_multiple_keys(@keys)], \@changes, "$desc ...changes are ($changes_as_text)"); } } } { my @filenames = map { find_file($_) } qw(win95_compare_tests1.rf win95_compare_tests2.rf win95_compare_tests3.rf); my @registries = map { Parse::Win32Registry->new($_) } @filenames; my $num = 0; foreach my $registry (@registries) { ok(defined($registry), 'registry '.++$num.' defined'); isa_ok($registry, 'Parse::Win32Registry::Win95::File'); } my @tests = ( ['', '', ['', '', ''],], ['\key1', '', ['', '', ''],], ['\key1', 'value1', ['', '', ''],], ['\key1', 'value2', ['', '', ''],], ['\key1', 'value3', ['', '', ''],], ['\key1', 'value4', ['', 'DELETED', ''],], ['\key1', 'value5', ['', '', 'ADDED'],], ['\key2', '', ['', '', ''],], ['\key2\key3', '', ['', '', ''],], ['\key2\key4', '', ['', 'DELETED', ''],], ['\key2\key5', '', ['', '', 'ADDED'],], ); run_compare_tests(\@registries, @tests); } { my @filenames = map { find_file($_) } qw(winnt_compare_tests1.rf winnt_compare_tests2.rf winnt_compare_tests3.rf); my @registries = map { Parse::Win32Registry->new($_) } @filenames; my $num = 0; foreach my $registry (@registries) { ok(defined($registry), 'registry '.++$num.' defined'); isa_ok($registry, 'Parse::Win32Registry::WinNT::File'); } my @tests = ( ['$$$PROTO.HIV', '', ['', '', ''],], ['$$$PROTO.HIV\key1', '', ['', '', ''],], ['$$$PROTO.HIV\key1', 'value1', ['', '', ''],], ['$$$PROTO.HIV\key1', 'value2', ['', '', ''],], ['$$$PROTO.HIV\key1', 'value3', ['', '', ''],], ['$$$PROTO.HIV\key1', 'value4', ['', 'DELETED', ''],], ['$$$PROTO.HIV\key1', 'value5', ['', '', 'ADDED'],], ['$$$PROTO.HIV\key2', '', ['', '', ''],], ['$$$PROTO.HIV\key2\key3', '', ['', '', ''],], ['$$$PROTO.HIV\key2\key4', '', ['', 'DELETED', ''],], ['$$$PROTO.HIV\key2\key5', '', ['', '', 'ADDED'],], ); run_compare_tests(\@registries, @tests); } Parse-Win32Registry-1.0/t/value.t0000644000175000017500000010631011747213110015665 0ustar ownerowneruse strict; use warnings; use Test::More 'no_plan'; use Data::Dumper; use Parse::Win32Registry 0.60 qw(:REG_); Parse::Win32Registry::disable_warnings; $Data::Dumper::Useqq = 1; $Data::Dumper::Terse = 1; $Data::Dumper::Indent = 0; sub find_file { my $filename = shift; return -d 't' ? "t/$filename" : $filename; } sub run_value_tests { my $key = shift; my @tests = @_; my ($os) = ref($key) =~ /Win(NT|95)/; foreach my $test (@tests) { my $name = $test->{name}; my $type = $test->{type}; my $type_as_string = $test->{type_as_string}; my $data = $test->{data}; my $list_data = $test->{list_data}; my $raw_data = $test->{raw_data}; my $data_as_string = $test->{data_as_string}; my $as_regedit_export = $test->{as_regedit_export}; my $desc = "$os " . Dumper($name); my $value = $key->get_value($name); ok(defined($value), "$desc value defined (valid value)"); is($value->get_name, $name, "$desc get_name"); is($value->get_type, $type, "$desc get_type"); is($value->get_type_as_string, $type_as_string, "$desc get_type_as_string"); if (defined($data)) { if ($type == REG_DWORD) { cmp_ok($value->get_data, '==', $data, "$desc get_data"); cmp_ok($key->get_value_data($name), '==', $data, "$desc get_value_data"); } else { is($value->get_data, $data, "$desc get_data"); is($key->get_value_data($name), $data, "$desc get_value_data"); } } else { ok(!defined($value->get_data), "$desc get_data undefined (invalid data)"); ok(!defined($key->get_value_data($name)), "$desc get_value_data undefined (invalid data)"); } if (defined($raw_data)) { is($value->get_raw_data, $raw_data, "$desc get_raw_data") or diag Dumper($value->get_raw_data); } else { ok(!defined($value->get_raw_data), "$desc get_raw_data undefined (invalid data)") or diag Dumper($value->get_raw_data); } if (defined($list_data)) { is_deeply([$value->get_data], $list_data, "$desc (list) get_data") or diag Dumper([$value->get_data]); } is($value->get_data_as_string, $data_as_string, "$desc get_data_as_string"); my $name_or_default = $name eq '' ? '(Default)' : $name; my $value_as_string = "$name_or_default ($type_as_string) = $data_as_string"; is($value->as_string, $value_as_string, "$desc as_string"); is($value->as_regedit_export, $as_regedit_export, "$desc as_regedit_export"); } } { my $filename = find_file('win95_value_tests.rf'); my $registry = Parse::Win32Registry->new($filename); ok(defined($registry), 'registry defined'); isa_ok($registry, 'Parse::Win32Registry::Win95::File'); my $root_key = $registry->get_root_key; ok(defined($registry), 'root key defined'); isa_ok($root_key, 'Parse::Win32Registry::Win95::Key'); is($root_key->get_name, '', 'root key name'); my $key1 = $root_key->get_subkey('key1'); ok(defined($key1), 'key1 defined'); is($key1->get_name, 'key1', 'key1 name'); my @tests = ( { name => 'sz1', type => REG_SZ, type_as_string => 'REG_SZ', data => 'www.perl.org', data_as_string => 'www.perl.org', as_regedit_export => qq{"sz1"="www.perl.org"\n}, raw_data => "www.perl.org", }, { name => 'sz2', type => REG_SZ, type_as_string => 'REG_SZ', data => 'www.perl.org', data_as_string => 'www.perl.org', as_regedit_export => qq{"sz2"="www.perl.org"\n}, raw_data => "www.perl.org\0", }, { name => 'sz3', type => REG_SZ, type_as_string => 'REG_SZ', data => '', data_as_string => '(no data)', as_regedit_export => qq{"sz3"=""\n}, raw_data => "", }, { name => 'sz4', type => REG_SZ, type_as_string => 'REG_SZ', data => '', data_as_string => '(no data)', as_regedit_export => qq{"sz4"=""\n}, raw_data => "\0", }, { name => 'binary1', type => REG_BINARY, type_as_string => 'REG_BINARY', data => "\x01\x02\x03\x04\x05\x06\x07\x08", data_as_string => '01 02 03 04 05 06 07 08', as_regedit_export => qq{"binary1"=hex:01,02,03,04,05,06,07,08\n}, raw_data => "\x01\x02\x03\x04\x05\x06\x07\x08", }, { name => 'binary2', type => REG_BINARY, type_as_string => 'REG_BINARY', data => '', data_as_string => '(no data)', as_regedit_export => qq{"binary2"=hex:\n}, raw_data => "", }, { name => 'dword1', type => REG_DWORD, type_as_string => 'REG_DWORD', data => 67305985, data_as_string => '0x04030201 (67305985)', as_regedit_export => qq{"dword1"=dword:04030201\n}, raw_data => "\x01\x02\x03\x04", }, { name => 'dword2', type => REG_DWORD, type_as_string => 'REG_DWORD', data => undef, data_as_string => '(invalid data)', as_regedit_export => qq{"dword2"=dword:\n}, raw_data => "\x01\x02\x03\x04\x05\x06", }, { name => 'dword3', type => REG_DWORD, type_as_string => 'REG_DWORD', data => undef, data_as_string => '(invalid data)', as_regedit_export => qq{"dword3"=dword:\n}, raw_data => "\x01\x02", }, { name => 'dword4', type => REG_DWORD, type_as_string => 'REG_DWORD', data => undef, data_as_string => '(invalid data)', as_regedit_export => qq{"dword4"=dword:\n}, raw_data => "", }, { name => 'dword5', type => REG_DWORD, type_as_string => 'REG_DWORD', data => 0, data_as_string => '0x00000000 (0)', as_regedit_export => qq{"dword5"=dword:00000000\n}, raw_data => "\x00\x00\x00\x00", }, { name => 'dword6', type => REG_DWORD, type_as_string => 'REG_DWORD', data => 0x7fffffff, data_as_string => '0x7fffffff (2147483647)', as_regedit_export => qq{"dword6"=dword:7fffffff\n}, raw_data => "\xff\xff\xff\x7f", }, { name => 'dword7', type => REG_DWORD, type_as_string => 'REG_DWORD', data => 0x80000000, data_as_string => '0x80000000 (2147483648)', as_regedit_export => qq{"dword7"=dword:80000000\n}, raw_data => "\x00\x00\x00\x80", }, { name => 'dword8', type => REG_DWORD, type_as_string => 'REG_DWORD', data => 0xffffffff, data_as_string => '0xffffffff (4294967295)', as_regedit_export => qq{"dword8"=dword:ffffffff\n}, raw_data => "\xff\xff\xff\xff", }, { name => 'dword_big_endian1', type => REG_DWORD_BIG_ENDIAN, type_as_string => 'REG_DWORD_BIG_ENDIAN', data => 16909060, data_as_string => '0x01020304 (16909060)', as_regedit_export => qq{"dword_big_endian1"=hex(5):01,02,03,04\n}, raw_data => "\x01\x02\x03\x04", }, { name => 'dword_big_endian2', type => REG_DWORD_BIG_ENDIAN, type_as_string => 'REG_DWORD_BIG_ENDIAN', data => undef, data_as_string => '(invalid data)', as_regedit_export => qq{"dword_big_endian2"=hex(5):01,02,03,04,05,06\n}, raw_data => "\x01\x02\x03\x04\x05\x06", }, { name => 'dword_big_endian3', type => REG_DWORD_BIG_ENDIAN, type_as_string => 'REG_DWORD_BIG_ENDIAN', data => undef, data_as_string => '(invalid data)', as_regedit_export => qq{"dword_big_endian3"=hex(5):01,02\n}, raw_data => "\x01\x02", }, { name => 'dword_big_endian4', type => REG_DWORD_BIG_ENDIAN, type_as_string => 'REG_DWORD_BIG_ENDIAN', data => undef, data_as_string => '(invalid data)', as_regedit_export => qq{"dword_big_endian4"=hex(5):\n}, raw_data => "", }, { name => 'dword_big_endian5', type => REG_DWORD_BIG_ENDIAN, type_as_string => 'REG_DWORD_BIG_ENDIAN', data => 0, data_as_string => '0x00000000 (0)', as_regedit_export => qq{"dword_big_endian5"=hex(5):00,00,00,00\n}, raw_data => "\x00\x00\x00\x00", }, { name => 'dword_big_endian6', type => REG_DWORD_BIG_ENDIAN, type_as_string => 'REG_DWORD_BIG_ENDIAN', data => 0x7fffffff, data_as_string => '0x7fffffff (2147483647)', as_regedit_export => qq{"dword_big_endian6"=hex(5):7f,ff,ff,ff\n}, raw_data => "\x7f\xff\xff\xff", }, { name => 'dword_big_endian7', type => REG_DWORD_BIG_ENDIAN, type_as_string => 'REG_DWORD_BIG_ENDIAN', data => 0x80000000, data_as_string => '0x80000000 (2147483648)', as_regedit_export => qq{"dword_big_endian7"=hex(5):80,00,00,00\n}, raw_data => "\x80\x00\x00\x00", }, { name => 'dword_big_endian8', type => REG_DWORD_BIG_ENDIAN, type_as_string => 'REG_DWORD_BIG_ENDIAN', data => 0xffffffff, data_as_string => '0xffffffff (4294967295)', as_regedit_export => qq{"dword_big_endian8"=hex(5):ff,ff,ff,ff\n}, raw_data => "\xff\xff\xff\xff", }, { name => 'multi_sz1', type => REG_MULTI_SZ, type_as_string => 'REG_MULTI_SZ', data => "abcde fghij klmno", list_data => ['abcde', 'fghij', 'klmno'], data_as_string => '[0] abcde [1] fghij [2] klmno', as_regedit_export => qq{"multi_sz1"=hex(7):61,00,62,00,63,00,64,00,65,00,00,00,66,00,67,00,68,00,69,00,\\\n 6a,00,00,00,6b,00,6c,00,6d,00,6e,00,6f,00,00,00,00,00\n}, raw_data => "abcde\0fghij\0klmno\0\0", }, { name => 'multi_sz2', type => REG_MULTI_SZ, type_as_string => 'REG_MULTI_SZ', data => "abcde fghij klmno", list_data => ['abcde', 'fghij', 'klmno'], data_as_string => '[0] abcde [1] fghij [2] klmno', as_regedit_export => qq{"multi_sz2"=hex(7):61,00,62,00,63,00,64,00,65,00,00,00,66,00,67,00,68,00,69,00,\\\n 6a,00,00,00,6b,00,6c,00,6d,00,6e,00,6f,00,00,00\n}, raw_data => "abcde\0fghij\0klmno\0", }, { name => 'multi_sz3', type => REG_MULTI_SZ, type_as_string => 'REG_MULTI_SZ', data => "abcde fghij klmno", list_data => ['abcde', 'fghij', 'klmno'], data_as_string => '[0] abcde [1] fghij [2] klmno', as_regedit_export => qq{"multi_sz3"=hex(7):61,00,62,00,63,00,64,00,65,00,00,00,66,00,67,00,68,00,69,00,\\\n 6a,00,00,00,6b,00,6c,00,6d,00,6e,00,6f,00\n}, raw_data => "abcde\0fghij\0klmno", }, { name => 'multi_sz4', type => REG_MULTI_SZ, type_as_string => 'REG_MULTI_SZ', data => "abcde klmno", list_data => ['abcde', '', 'klmno'], data_as_string => '[0] abcde [1] [2] klmno', as_regedit_export => qq{"multi_sz4"=hex(7):61,00,62,00,63,00,64,00,65,00,00,00,00,00,6b,00,6c,00,6d,00,\\\n 6e,00,6f,00,00,00,00,00\n}, raw_data => "abcde\0\0klmno\0\0", }, { name => 'multi_sz5', type => REG_MULTI_SZ, type_as_string => 'REG_MULTI_SZ', data => "abcde klmno", list_data => ['abcde', '', 'klmno'], data_as_string => '[0] abcde [1] [2] klmno', as_regedit_export => qq{"multi_sz5"=hex(7):61,00,62,00,63,00,64,00,65,00,00,00,00,00,6b,00,6c,00,6d,00,\\\n 6e,00,6f,00,00,00\n}, raw_data => "abcde\0\0klmno\0", }, { name => 'multi_sz6', type => REG_MULTI_SZ, type_as_string => 'REG_MULTI_SZ', data => "abcde klmno", list_data => ['abcde', '', 'klmno'], data_as_string => '[0] abcde [1] [2] klmno', as_regedit_export => qq{"multi_sz6"=hex(7):61,00,62,00,63,00,64,00,65,00,00,00,00,00,6b,00,6c,00,6d,00,\\\n 6e,00,6f,00\n}, raw_data => "abcde\0\0klmno", }, { name => 'multi_sz7', type => REG_MULTI_SZ, type_as_string => 'REG_MULTI_SZ', data => "abcde", list_data => ['abcde'], data_as_string => '[0] abcde', as_regedit_export => qq{"multi_sz7"=hex(7):61,00,62,00,63,00,64,00,65,00,00,00,00,00\n}, raw_data => "abcde\0\0", }, { name => 'multi_sz8', type => REG_MULTI_SZ, type_as_string => 'REG_MULTI_SZ', data => "abcde", list_data => ['abcde'], data_as_string => '[0] abcde', as_regedit_export => qq{"multi_sz8"=hex(7):61,00,62,00,63,00,64,00,65,00,00,00\n}, raw_data => "abcde\0", }, { name => 'multi_sz9', type => REG_MULTI_SZ, type_as_string => 'REG_MULTI_SZ', data => "abcde", list_data => ['abcde'], data_as_string => '[0] abcde', as_regedit_export => qq{"multi_sz9"=hex(7):61,00,62,00,63,00,64,00,65,00\n}, raw_data => "abcde", }, { name => 'multi_sz10', type => REG_MULTI_SZ, type_as_string => 'REG_MULTI_SZ', data => "", list_data => [''], data_as_string => '(no data)', as_regedit_export => qq{"multi_sz10"=hex(7):00,00,00,00\n}, raw_data => "\0\0", }, { name => 'multi_sz11', type => REG_MULTI_SZ, type_as_string => 'REG_MULTI_SZ', data => "", list_data => [''], data_as_string => '(no data)', as_regedit_export => qq{"multi_sz11"=hex(7):00,00\n}, raw_data => "\0", }, { name => 'multi_sz12', type => REG_MULTI_SZ, type_as_string => 'REG_MULTI_SZ', data => "", list_data => [''], data_as_string => '(no data)', as_regedit_export => qq{"multi_sz12"=hex(7):\n}, raw_data => "", }, { name => 'type500', type => 500, type_as_string => 'REG_500', data => "\x01\x02\x03\x04\x05\x06\x07\x08", data_as_string => '01 02 03 04 05 06 07 08', as_regedit_export => qq{"type500"=hex(1f4):01,02,03,04,05,06,07,08\n}, raw_data => "\x01\x02\x03\x04\x05\x06\x07\x08", }, { name => '', type => REG_DWORD, type_as_string => 'REG_DWORD', data => 0, data_as_string => '0x00000000 (0)', as_regedit_export => qq{@=dword:00000000\n}, raw_data => "\x00\x00\x00\x00", }, { name => '0', type => REG_DWORD, type_as_string => 'REG_DWORD', data => 0, data_as_string => '0x00000000 (0)', as_regedit_export => qq{"0"=dword:00000000\n}, raw_data => "\x00\x00\x00\x00", }, { name => "\0", type => REG_DWORD, type_as_string => 'REG_DWORD', data => 0, data_as_string => '0x00000000 (0)', as_regedit_export => qq{"\0"=dword:00000000\n}, raw_data => "\x00\x00\x00\x00", }, { name => "\0name", type => REG_DWORD, type_as_string => 'REG_DWORD', data => 0, data_as_string => '0x00000000 (0)', as_regedit_export => qq{"\0name"=dword:00000000\n}, raw_data => "\x00\x00\x00\x00", }, ); run_value_tests($key1, @tests); } { my $filename = find_file('winnt_value_tests.rf'); my $registry = Parse::Win32Registry->new($filename); isa_ok($registry, 'Parse::Win32Registry::WinNT::File'); my $root_key = $registry->get_root_key; isa_ok($root_key, 'Parse::Win32Registry::WinNT::Key'); is($root_key->get_name, '$$$PROTO.HIV', 'Root Key name'); my $key1 = $root_key->get_subkey('key1'); ok(defined($key1), 'key1 defined'); is($key1->get_name, 'key1', 'key1 name'); my @tests = ( { name => 'sz1', type => REG_SZ, type_as_string => 'REG_SZ', data => 'www.perl.org', data_as_string => 'www.perl.org', as_regedit_export => qq{"sz1"="www.perl.org"\n}, raw_data => "w\0w\0w\0.\0p\0e\0r\0l\0.\0o\0r\0g\0", }, { name => 'sz2', type => REG_SZ, type_as_string => 'REG_SZ', data => 'www.perl.org', data_as_string => 'www.perl.org', as_regedit_export => qq{"sz2"="www.perl.org"\n}, raw_data => "w\0w\0w\0.\0p\0e\0r\0l\0.\0o\0r\0g\0\0\0", }, { name => 'sz3', type => REG_SZ, type_as_string => 'REG_SZ', data => '', data_as_string => '(no data)', as_regedit_export => qq{"sz3"=""\n}, raw_data => "", }, { name => 'sz4', type => REG_SZ, type_as_string => 'REG_SZ', data => '', data_as_string => '(no data)', as_regedit_export => qq{"sz4"=""\n}, raw_data => "\0\0", }, { name => 'sz5', type => REG_SZ, type_as_string => 'REG_SZ', data => 'ab', data_as_string => 'ab', as_regedit_export => qq{"sz5"="ab"\n}, raw_data => "a\0b\0", }, { name => 'sz6', type => REG_SZ, type_as_string => 'REG_SZ', data => 'a', data_as_string => 'a', as_regedit_export => qq{"sz6"="a"\n}, raw_data => "a\0\0\0", }, { name => 'sz7', type => REG_SZ, type_as_string => 'REG_SZ', data => '', data_as_string => '(no data)', as_regedit_export => qq{"sz7"=""\n}, raw_data => "", }, { name => 'sz8', type => REG_SZ, type_as_string => 'REG_SZ', data => '', data_as_string => '(no data)', as_regedit_export => qq{"sz8"=""\n}, raw_data => "\0\0", }, { name => 'binary1', type => REG_BINARY, type_as_string => 'REG_BINARY', data => "\x01\x02\x03\x04\x05\x06\x07\x08", data_as_string => '01 02 03 04 05 06 07 08', as_regedit_export => qq{"binary1"=hex:01,02,03,04,05,06,07,08\n}, raw_data => "\x01\x02\x03\x04\x05\x06\x07\x08", }, { name => 'binary2', type => REG_BINARY, type_as_string => 'REG_BINARY', data => '', data_as_string => '(no data)', as_regedit_export => qq{"binary2"=hex:\n}, raw_data => "", }, { name => 'binary3', type => REG_BINARY, type_as_string => 'REG_BINARY', data => "\x01\x02\x03\x04", data_as_string => '01 02 03 04', as_regedit_export => qq{"binary3"=hex:01,02,03,04\n}, raw_data => "\x01\x02\x03\x04", }, { name => 'binary4', type => REG_BINARY, type_as_string => 'REG_BINARY', data => '', data_as_string => '(no data)', as_regedit_export => qq{"binary4"=hex:\n}, raw_data => "", }, { name => 'dword1', type => REG_DWORD, type_as_string => 'REG_DWORD', data => 67305985, data_as_string => '0x04030201 (67305985)', as_regedit_export => qq{"dword1"=dword:04030201\n}, raw_data => "\x01\x02\x03\x04", }, { name => 'dword2', type => REG_DWORD, type_as_string => 'REG_DWORD', data => undef, data_as_string => '(invalid data)', as_regedit_export => qq{"dword2"=dword:\n}, raw_data => "\x01\x02\x03\x04\x05\x06", }, { name => 'dword3', type => REG_DWORD, type_as_string => 'REG_DWORD', data => undef, data_as_string => '(invalid data)', as_regedit_export => qq{"dword3"=dword:\n}, raw_data => "\x01\x02", }, { name => 'dword4', type => REG_DWORD, type_as_string => 'REG_DWORD', data => undef, data_as_string => '(invalid data)', as_regedit_export => qq{"dword4"=dword:\n}, raw_data => "", }, { name => 'dword5', type => REG_DWORD, type_as_string => 'REG_DWORD', data => 67305985, data_as_string => '0x04030201 (67305985)', as_regedit_export => qq{"dword5"=dword:04030201\n}, raw_data => "\x01\x02\x03\x04", }, { name => 'dword6', type => REG_DWORD, type_as_string => 'REG_DWORD', data => undef, data_as_string => '(invalid data)', as_regedit_export => qq{"dword6"=dword:\n}, raw_data => undef, }, { name => 'dword7', type => REG_DWORD, type_as_string => 'REG_DWORD', data => undef, data_as_string => '(invalid data)', as_regedit_export => qq{"dword7"=dword:\n}, raw_data => "\x01\x02", }, { name => 'dword8', type => REG_DWORD, type_as_string => 'REG_DWORD', data => undef, data_as_string => '(invalid data)', as_regedit_export => qq{"dword8"=dword:\n}, raw_data => "", }, { name => 'dword9', type => REG_DWORD, type_as_string => 'REG_DWORD', data => 0, data_as_string => '0x00000000 (0)', as_regedit_export => qq{"dword9"=dword:00000000\n}, raw_data => "\x00\x00\x00\x00", }, { name => 'dword10', type => REG_DWORD, type_as_string => 'REG_DWORD', data => 0x7fffffff, data_as_string => '0x7fffffff (2147483647)', as_regedit_export => qq{"dword10"=dword:7fffffff\n}, raw_data => "\xff\xff\xff\x7f", }, { name => 'dword11', type => REG_DWORD, type_as_string => 'REG_DWORD', data => 0x80000000, data_as_string => '0x80000000 (2147483648)', as_regedit_export => qq{"dword11"=dword:80000000\n}, raw_data => "\x00\x00\x00\x80", }, { name => 'dword12', type => REG_DWORD, type_as_string => 'REG_DWORD', data => 0xffffffff, data_as_string => '0xffffffff (4294967295)', as_regedit_export => qq{"dword12"=dword:ffffffff\n}, raw_data => "\xff\xff\xff\xff", }, { name => 'dword_big_endian1', type => REG_DWORD_BIG_ENDIAN, type_as_string => 'REG_DWORD_BIG_ENDIAN', data => 16909060, data_as_string => '0x01020304 (16909060)', as_regedit_export => qq{"dword_big_endian1"=hex(5):01,02,03,04\n}, raw_data => "\x01\x02\x03\x04", }, { name => 'dword_big_endian2', type => REG_DWORD_BIG_ENDIAN, type_as_string => 'REG_DWORD_BIG_ENDIAN', data => undef, data_as_string => '(invalid data)', as_regedit_export => qq{"dword_big_endian2"=hex(5):01,02,03,04,05,06\n}, raw_data => "\x01\x02\x03\x04\x05\x06", }, { name => 'dword_big_endian3', type => REG_DWORD_BIG_ENDIAN, type_as_string => 'REG_DWORD_BIG_ENDIAN', data => undef, data_as_string => '(invalid data)', as_regedit_export => qq{"dword_big_endian3"=hex(5):01,02\n}, raw_data => "\x01\x02", }, { name => 'dword_big_endian4', type => REG_DWORD_BIG_ENDIAN, type_as_string => 'REG_DWORD_BIG_ENDIAN', data => undef, data_as_string => '(invalid data)', as_regedit_export => qq{"dword_big_endian4"=hex(5):\n}, raw_data => "", }, { name => 'dword_big_endian5', type => REG_DWORD_BIG_ENDIAN, type_as_string => 'REG_DWORD_BIG_ENDIAN', data => 16909060, data_as_string => '0x01020304 (16909060)', as_regedit_export => qq{"dword_big_endian5"=hex(5):01,02,03,04\n}, raw_data => "\x01\x02\x03\x04", }, { name => 'dword_big_endian6', type => REG_DWORD_BIG_ENDIAN, type_as_string => 'REG_DWORD_BIG_ENDIAN', data => undef, data_as_string => '(invalid data)', as_regedit_export => qq{"dword_big_endian6"=hex(5):\n}, raw_data => undef, }, { name => 'dword_big_endian7', type => REG_DWORD_BIG_ENDIAN, type_as_string => 'REG_DWORD_BIG_ENDIAN', data => undef, data_as_string => '(invalid data)', as_regedit_export => qq{"dword_big_endian7"=hex(5):01,02\n}, raw_data => "\x01\x02", }, { name => 'dword_big_endian8', type => REG_DWORD_BIG_ENDIAN, type_as_string => 'REG_DWORD_BIG_ENDIAN', data => undef, data_as_string => '(invalid data)', as_regedit_export => qq{"dword_big_endian8"=hex(5):\n}, raw_data => "", }, { name => 'dword_big_endian9', type => REG_DWORD_BIG_ENDIAN, type_as_string => 'REG_DWORD_BIG_ENDIAN', data => 0, data_as_string => '0x00000000 (0)', as_regedit_export => qq{"dword_big_endian9"=hex(5):00,00,00,00\n}, raw_data => "\x00\x00\x00\x00", }, { name => 'dword_big_endian10', type => REG_DWORD_BIG_ENDIAN, type_as_string => 'REG_DWORD_BIG_ENDIAN', data => 0x7fffffff, data_as_string => '0x7fffffff (2147483647)', as_regedit_export => qq{"dword_big_endian10"=hex(5):7f,ff,ff,ff\n}, raw_data => "\x7f\xff\xff\xff", }, { name => 'dword_big_endian11', type => REG_DWORD_BIG_ENDIAN, type_as_string => 'REG_DWORD_BIG_ENDIAN', data => 0x80000000, data_as_string => '0x80000000 (2147483648)', as_regedit_export => qq{"dword_big_endian11"=hex(5):80,00,00,00\n}, raw_data => "\x80\x00\x00\x00", }, { name => 'dword_big_endian12', type => REG_DWORD_BIG_ENDIAN, type_as_string => 'REG_DWORD_BIG_ENDIAN', data => 0xffffffff, data_as_string => '0xffffffff (4294967295)', as_regedit_export => qq{"dword_big_endian12"=hex(5):ff,ff,ff,ff\n}, raw_data => "\xff\xff\xff\xff", }, { name => 'multi_sz1', type => REG_MULTI_SZ, type_as_string => 'REG_MULTI_SZ', data => "abcde fghij klmno", list_data => ['abcde', 'fghij', 'klmno'], data_as_string => '[0] abcde [1] fghij [2] klmno', as_regedit_export => qq{"multi_sz1"=hex(7):61,00,62,00,63,00,64,00,65,00,00,00,66,00,67,00,68,00,69,00,\\\n 6a,00,00,00,6b,00,6c,00,6d,00,6e,00,6f,00,00,00,00,00\n}, raw_data => "a\0b\0c\0d\0e\0\0\0f\0g\0h\0i\0j\0\0\0k\0l\0m\0n\0o\0\0\0\0\0", }, { name => 'multi_sz2', type => REG_MULTI_SZ, type_as_string => 'REG_MULTI_SZ', data => "abcde fghij klmno", list_data => ['abcde', 'fghij', 'klmno'], data_as_string => '[0] abcde [1] fghij [2] klmno', as_regedit_export => qq{"multi_sz2"=hex(7):61,00,62,00,63,00,64,00,65,00,00,00,66,00,67,00,68,00,69,00,\\\n 6a,00,00,00,6b,00,6c,00,6d,00,6e,00,6f,00,00,00\n}, raw_data => "a\0b\0c\0d\0e\0\0\0f\0g\0h\0i\0j\0\0\0k\0l\0m\0n\0o\0\0\0", }, { name => 'multi_sz3', type => REG_MULTI_SZ, type_as_string => 'REG_MULTI_SZ', data => "abcde fghij klmno", list_data => ['abcde', 'fghij', 'klmno'], data_as_string => '[0] abcde [1] fghij [2] klmno', as_regedit_export => qq{"multi_sz3"=hex(7):61,00,62,00,63,00,64,00,65,00,00,00,66,00,67,00,68,00,69,00,\\\n 6a,00,00,00,6b,00,6c,00,6d,00,6e,00,6f,00\n}, raw_data => "a\0b\0c\0d\0e\0\0\0f\0g\0h\0i\0j\0\0\0k\0l\0m\0n\0o\0", }, { name => 'multi_sz4', type => REG_MULTI_SZ, type_as_string => 'REG_MULTI_SZ', data => "abcde klmno", list_data => ['abcde', '', 'klmno'], data_as_string => '[0] abcde [1] [2] klmno', as_regedit_export => qq{"multi_sz4"=hex(7):61,00,62,00,63,00,64,00,65,00,00,00,00,00,6b,00,6c,00,6d,00,\\\n 6e,00,6f,00,00,00,00,00\n}, raw_data => "a\0b\0c\0d\0e\0\0\0\0\0k\0l\0m\0n\0o\0\0\0\0\0", }, { name => 'multi_sz5', type => REG_MULTI_SZ, type_as_string => 'REG_MULTI_SZ', data => "abcde klmno", list_data => ['abcde', '', 'klmno'], data_as_string => '[0] abcde [1] [2] klmno', as_regedit_export => qq{"multi_sz5"=hex(7):61,00,62,00,63,00,64,00,65,00,00,00,00,00,6b,00,6c,00,6d,00,\\\n 6e,00,6f,00,00,00\n}, raw_data => "a\0b\0c\0d\0e\0\0\0\0\0k\0l\0m\0n\0o\0\0\0", }, { name => 'multi_sz6', type => REG_MULTI_SZ, type_as_string => 'REG_MULTI_SZ', data => "abcde klmno", list_data => ['abcde', '', 'klmno'], data_as_string => '[0] abcde [1] [2] klmno', as_regedit_export => qq{"multi_sz6"=hex(7):61,00,62,00,63,00,64,00,65,00,00,00,00,00,6b,00,6c,00,6d,00,\\\n 6e,00,6f,00\n}, raw_data => "a\0b\0c\0d\0e\0\0\0\0\0k\0l\0m\0n\0o\0", }, { name => 'multi_sz7', type => REG_MULTI_SZ, type_as_string => 'REG_MULTI_SZ', data => "abcde", list_data => ['abcde'], data_as_string => '[0] abcde', as_regedit_export => qq{"multi_sz7"=hex(7):61,00,62,00,63,00,64,00,65,00,00,00,00,00\n}, raw_data => "a\0b\0c\0d\0e\0\0\0\0\0", }, { name => 'multi_sz8', type => REG_MULTI_SZ, type_as_string => 'REG_MULTI_SZ', data => "abcde", list_data => ['abcde'], data_as_string => '[0] abcde', as_regedit_export => qq{"multi_sz8"=hex(7):61,00,62,00,63,00,64,00,65,00,00,00\n}, raw_data => "a\0b\0c\0d\0e\0\0\0", }, { name => 'multi_sz9', type => REG_MULTI_SZ, type_as_string => 'REG_MULTI_SZ', data => "abcde", list_data => ['abcde'], data_as_string => '[0] abcde', as_regedit_export => qq{"multi_sz9"=hex(7):61,00,62,00,63,00,64,00,65,00\n}, raw_data => "a\0b\0c\0d\0e\0", }, { name => 'multi_sz10', type => REG_MULTI_SZ, type_as_string => 'REG_MULTI_SZ', data => "", list_data => [''], data_as_string => '(no data)', as_regedit_export => qq{"multi_sz10"=hex(7):00,00,00,00\n}, raw_data => "\0\0\0\0", }, { name => 'multi_sz11', type => REG_MULTI_SZ, type_as_string => 'REG_MULTI_SZ', data => "", list_data => [''], data_as_string => '(no data)', as_regedit_export => qq{"multi_sz11"=hex(7):00,00\n}, raw_data => "\0\0", }, { name => 'multi_sz12', type => REG_MULTI_SZ, type_as_string => 'REG_MULTI_SZ', data => "", list_data => [''], data_as_string => '(no data)', as_regedit_export => qq{"multi_sz12"=hex(7):\n}, raw_data => "", }, { name => 'type500', type => 500, type_as_string => 'REG_500', data => "\x01\x02\x03\x04\x05\x06\x07\x08", data_as_string => '01 02 03 04 05 06 07 08', as_regedit_export => qq{"type500"=hex(1f4):01,02,03,04,05,06,07,08\n}, raw_data => "\x01\x02\x03\x04\x05\x06\x07\x08", }, { name => '', type => REG_DWORD, type_as_string => 'REG_DWORD', data => 0, data_as_string => '0x00000000 (0)', as_regedit_export => qq{@=dword:00000000\n}, raw_data => "\x00\x00\x00\x00", }, { name => '0', type => REG_DWORD, type_as_string => 'REG_DWORD', data => 0, data_as_string => '0x00000000 (0)', as_regedit_export => qq{"0"=dword:00000000\n}, raw_data => "\x00\x00\x00\x00", }, { name => "\0", type => REG_DWORD, type_as_string => 'REG_DWORD', data => 0, data_as_string => '0x00000000 (0)', as_regedit_export => qq{"\0"=dword:00000000\n}, raw_data => "\x00\x00\x00\x00", }, { name => "\0name", type => REG_DWORD, type_as_string => 'REG_DWORD', data => 0, data_as_string => '0x00000000 (0)', as_regedit_export => qq{"\0name"=dword:00000000\n}, raw_data => "\x00\x00\x00\x00", }, ); run_value_tests($key1, @tests); } Parse-Win32Registry-1.0/t/winnt_security_tests.rf0000644000175000017500000001216011747213110021224 0ustar ownerownerregfÀ Pe§ghbinÀ ÿÿÿnk,Àÿÿÿÿÿÿÿÿÿÿÿÿ€ÿÿÿÿ $$$PROTO.HIVÐÿÿÿsk€°€Àÿÿÿsk°ð$€ Èÿÿÿskð( €¸ÿÿÿsk(p0€R? ¸ÿÿÿskp¸0€? èþÿÿsk¸Ð€äôÐ$?@B€„ÀÆ-ô??  $@B€„ÀÆ-ô    €  `þÿÿskЀ„ €LhXDR&  R$?@B€„ÀÆ-èô $?@B€„ÀÆ-é$?@B€„ÀÆ-ô$@B€„ÀÆ-ô??   € @B€„ÀÆ-ô@B€„ÀÆ-Parse-Win32Registry-1.0/t/use.t0000644000175000017500000000130711747213110015345 0ustar ownerowneruse strict; use warnings; use Test::More 'no_plan'; BEGIN { use_ok('Parse::Win32Registry') }; is($Parse::Win32Registry::VERSION, '1.0', 'correct version'); can_ok('Parse::Win32Registry', 'new'); can_ok('Parse::Win32Registry', 'convert_filetime_to_epoch_time'); can_ok('Parse::Win32Registry', 'iso8601'); can_ok('Parse::Win32Registry', 'hexdump'); can_ok('Parse::Win32Registry', 'unpack_windows_time'); can_ok('Parse::Win32Registry', 'unpack_string'); can_ok('Parse::Win32Registry', 'unpack_unicode_string'); can_ok('Parse::Win32Registry', 'unpack_sid'); can_ok('Parse::Win32Registry', 'unpack_ace'); can_ok('Parse::Win32Registry', 'unpack_acl'); can_ok('Parse::Win32Registry', 'unpack_security_descriptor'); Parse-Win32Registry-1.0/t/winnt_value_tests.rf0000644000175000017500000001604011747213110020472 0ustar ownerownerregfÀ Pe§ghbinÀ ÿÿÿnk,ÀÿÿÿÿØÿÿÿÿÿÿÿÿÿÿÿÿ $$$PROTO.HIV¨ÿÿÿnk À ÿÿÿÿ98 ÿÿÿÿÿÿÿÿkey1ðÿÿÿlf€àÿÿÿvksz1àÿÿÿwww.perl.orgàÿÿÿvkHsz2àÿÿÿwww.perl.orgàÿÿÿvkˆsz3àÿÿÿvk¨sz4øÿÿÿàÿÿÿvk€absz5àÿÿÿvk€asz6àÿÿÿvk€sz7àÿÿÿvk€sz8àÿÿÿvk€absz9àÿÿÿvkpbinary1ðÿÿÿàÿÿÿvk binary2àÿÿÿvk€binary3àÿÿÿvk€binary4àÿÿÿvk€binary5àÿÿÿvk dword1øÿÿÿàÿÿÿvkHdword2ðÿÿÿàÿÿÿvkxdword3øÿÿÿàÿÿÿvk dword4àÿÿÿvk€dword5àÿÿÿvk€dword6àÿÿÿvk€dword7àÿÿÿvk€dword8àÿÿÿvk€dword9àÿÿÿvk€ÿÿÿdword10àÿÿÿvk€€dword11àÿÿÿvk€ÿÿÿÿdword12ÐÿÿÿvkÐdword_big_endian1øÿÿÿÐÿÿÿvkdword_big_endian2ðÿÿÿÐÿÿÿvkHdword_big_endian3øÿÿÿÐÿÿÿvk€dword_big_endian4Ðÿÿÿvk€dword_big_endian5Ðÿÿÿvk€dword_big_endian6Ðÿÿÿvk€dword_big_endian7Ðÿÿÿvk€dword_big_endian8Ðÿÿÿvk€dword_big_endian9Ðÿÿÿvk€ÿÿÿdword_big_endian10Ðÿÿÿvk€€dword_big_endian11Ðÿÿÿvk€ÿÿÿÿdword_big_endian12Øÿÿÿvk &(multi_sz1ÐÿÿÿabcdefghijklmnoØÿÿÿvk $€multi_sz2ØÿÿÿabcdefghijklmnoØÿÿÿvk "Ðmulti_sz3ØÿÿÿabcdefghijklmnoØÿÿÿvk  multi_sz4àÿÿÿabcdeklmnoØÿÿÿvk hmulti_sz5àÿÿÿabcdeklmnoØÿÿÿvk °multi_sz6àÿÿÿabcdeklmnoØÿÿÿvk ømulti_sz7èÿÿÿabcdeØÿÿÿvk 8 multi_sz8ðÿÿÿabcdeØÿÿÿvk p multi_sz9ðÿÿÿabcdeØÿÿÿvk ¨ multi_sz10øÿÿÿØÿÿÿvk Ø multi_sz11øÿÿÿØÿÿÿvk  multi_sz12àÿÿÿvk( ôtype500ðÿÿÿèÿÿÿvk€àÿÿÿvk€0àÿÿÿvk€àÿÿÿvk€nameÈÿÿÿvk €àáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ°ÿÿÿvk2€±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÿÿÿè(hˆ°Ðð0P€ Àà(X€ Àà @`€ ØP€°à@p ÐX¨ø@ˆÐ H € ° à  8 P p ° è Parse-Win32Registry-1.0/t/win95_entry_tests.rf0000644000175000017500000000047411747213110020337 0ustar ownerownerCREG”RGKNt ÿÿÿÿ<ÿÿÿÿÿÿÿÿ ÿÿÿÿX ÿÿÿÿÿÿÿÿRGDB¨DDkey1value1value2DDkey2value3value4Parse-Win32Registry-1.0/t/key.t0000644000175000017500000003250011747213110015340 0ustar ownerowneruse strict; use warnings; use Data::Dumper; use Test::More 'no_plan'; use Parse::Win32Registry 0.60; $Data::Dumper::Useqq = 1; $Data::Dumper::Terse = 1; $Data::Dumper::Indent = 0; sub find_file { my $filename = shift; return -d 't' ? "t/$filename" : $filename; } sub run_key_tests { my $root_key = shift; my @tests = @_; my ($os) = ref($root_key) =~ /Win(NT|95)/; my $root_key_name = $root_key->get_name; # should already be tested foreach my $test (@tests) { my $path = $test->{path}; my $name = $test->{name}; my $num_subkeys = $test->{num_subkeys}; my $num_values = $test->{num_values}; my $timestamp = $test->{timestamp}; my $timestamp_as_string = $test->{timestamp_as_string}; my $class_name = $test->{class_name}; my $key_path = "$root_key_name\\$path"; my $desc = "$os " . Dumper($name); my $key = $root_key->get_subkey($path); ok(defined($key), "$desc key defined (valid key)") or diag Dumper $key_path; ok(!$key->is_root, "$desc key is not root"); is($key->get_name, $name, "$desc get_name"); is($key->get_path, $key_path, "$desc get_path"); my @subkeys = $key->get_list_of_subkeys; is(@subkeys, $num_subkeys, "$desc has $num_subkeys subkeys"); my @values = $key->get_list_of_values; is(@values, $num_values, "$desc has $num_values values"); if (defined($timestamp)) { cmp_ok($key->get_timestamp, '==', $timestamp, "$desc get_timestamp"); } else { ok(!defined($key->get_timestamp), "$desc get_timestamp undefined"); } is($key->get_timestamp_as_string, $timestamp_as_string, "$desc get_timestamp_as_string"); if (defined($class_name)) { is($key->get_class_name, $class_name, "$desc get_class_name"); } else { ok(!defined($key->get_class_name), "$desc get_class_name undefined (not present)"); } my $as_string = defined($timestamp) ? "$key_path [$timestamp_as_string]" : "$key_path"; is($key->as_string, $as_string, "$desc as_string"); is($key->as_regedit_export, "[$key_path]\n", "$desc as_regedit_export"); # parent key tests my $parent_key = $key->get_parent; ok(defined($parent_key), "$desc parent key defined (valid key)"); # $parent_key->get_subkey should be the same as key my $clone_key = $parent_key->get_subkey($name); ok(defined($clone_key), "$desc parent subkey defined (valid key)"); is($clone_key->get_path, "$key_path", "$desc parent subkey get_path"); is($clone_key->get_timestamp_as_string, $timestamp_as_string, "$desc parent subkey get_timestamp_as_string"); is($key->regenerate_path, $key_path, "$desc regenerate_path"); is($key->get_path, $key_path, "$desc get_path after regenerate_path"); } } { my $filename = find_file('win95_key_tests.rf'); my $registry = Parse::Win32Registry->new($filename); ok(defined($registry), 'registry defined'); isa_ok($registry, 'Parse::Win32Registry::Win95::File'); my $root_key = $registry->get_root_key; ok(defined($registry), 'root key defined'); isa_ok($root_key, 'Parse::Win32Registry::Win95::Key'); ok($root_key->is_root, 'root key is root'); is($root_key->get_name, '', 'root key name'); is($root_key->get_path, '', 'root key path'); is($root_key->as_regedit_export, "[]\n", 'root key as_regedit_export'); my @subkeys = $root_key->get_list_of_subkeys; is(@subkeys, 3, 'root key has 3 subkeys'); my @tests = ( { path => "key1", name => "key1", num_subkeys => 3, num_values => 0, timestamp => undef, timestamp_as_string => "(undefined)", }, { path => "key1\\key4", name => "key4", num_subkeys => 0, num_values => 0, timestamp => undef, timestamp_as_string => "(undefined)", }, { path => "key1\\key5", name => "key5", num_subkeys => 0, num_values => 0, timestamp => undef, timestamp_as_string => "(undefined)", }, { path => "key1\\key6", name => "key6", num_subkeys => 0, num_values => 0, timestamp => undef, timestamp_as_string => "(undefined)", }, { path => "key2", name => "key2", num_subkeys => 6, num_values => 0, timestamp => undef, timestamp_as_string => "(undefined)", }, { path => "key2\\key7", name => "key7", num_subkeys => 0, num_values => 0, timestamp => undef, timestamp_as_string => "(undefined)", }, { path => "key2\\key8", name => "key8", num_subkeys => 0, num_values => 0, timestamp => undef, timestamp_as_string => "(undefined)", }, { path => "key2\\key9", name => "key9", num_subkeys => 0, num_values => 0, timestamp => undef, timestamp_as_string => "(undefined)", }, { path => "key2\\key10", name => "key10", num_subkeys => 0, num_values => 0, timestamp => undef, timestamp_as_string => "(undefined)", }, { path => "key2\\key11", name => "key11", num_subkeys => 0, num_values => 0, timestamp => undef, timestamp_as_string => "(undefined)", }, { path => "key2\\key12", name => "key12", num_subkeys => 0, num_values => 0, timestamp => undef, timestamp_as_string => "(undefined)", }, { path => "key3", name => "key3", num_subkeys => 5, num_values => 0, timestamp => undef, timestamp_as_string => "(undefined)", }, { path => "key3\\", name => "", num_subkeys => 0, num_values => 0, timestamp => undef, timestamp_as_string => "(undefined)", }, { path => "key3\\0", name => "0", num_subkeys => 0, num_values => 0, timestamp => undef, timestamp_as_string => "(undefined)", }, { path => "key3\\\0", name => "\0", num_subkeys => 0, num_values => 0, timestamp => undef, timestamp_as_string => "(undefined)", }, { path => "key3\\\0name", name => "\0name", num_subkeys => 0, num_values => 0, timestamp => undef, timestamp_as_string => "(undefined)", }, { path => "key3\\" . pack("U*", 0xe0..0xff), name => pack("U*", 0xe0..0xff), num_subkeys => 0, num_values => 0, timestamp => undef, timestamp_as_string => "(undefined)", }, ); run_key_tests($root_key, @tests); } { my $filename = find_file('winnt_key_tests.rf'); my $registry = Parse::Win32Registry->new($filename); ok(defined($registry), 'registry defined'); isa_ok($registry, 'Parse::Win32Registry::WinNT::File'); my $root_key = $registry->get_root_key; ok(defined($registry), 'root key defined'); isa_ok($root_key, 'Parse::Win32Registry::WinNT::Key'); ok($root_key->is_root, 'root key is_root'); is($root_key->get_name, '$$$PROTO.HIV', 'root key name'); is($root_key->get_path, '$$$PROTO.HIV', 'root key path'); is($root_key->as_regedit_export, "[\$\$\$PROTO.HIV]\n", 'root key as_regedit_export'); my @subkeys = $root_key->get_list_of_subkeys; is(@subkeys, 3, 'root key has 3 subkeys'); my @tests = ( { path => "key1", name => "key1", flags => 0x20, num_subkeys => 3, num_values => 0, timestamp => 993752854, timestamp_as_string => "2001-06-28T18:27:34Z", class_name => "key1", }, { path => "key1\\key4", name => "key4", flags => 0x20, num_subkeys => 0, num_values => 0, timestamp => 1021900351, timestamp_as_string => "2002-05-20T13:12:31Z", }, { path => "key1\\key5", name => "key5", flags => 0x20, num_subkeys => 0, num_values => 0, timestamp => 1022010303, timestamp_as_string => "2002-05-21T19:45:03Z", }, { path => "key1\\key6", name => "key6", flags => 0x20, num_subkeys => 0, num_values => 0, timestamp => 1022120254, timestamp_as_string => "2002-05-23T02:17:34Z", }, { path => "key2", name => "key2", flags => 0x20, num_subkeys => 6, num_values => 0, timestamp => 993862805, timestamp_as_string => "2001-06-30T01:00:05Z", class_name => "key2", }, { path => "key2\\key7", name => "key7", flags => 0x20, num_subkeys => 0, num_values => 0, timestamp => 1050047849, timestamp_as_string => "2003-04-11T07:57:29Z", }, { path => "key2\\key8", name => "key8", flags => 0x20, num_subkeys => 0, num_values => 0, timestamp => 1050157800, timestamp_as_string => "2003-04-12T14:30:00Z", }, { path => "key2\\key9", name => "key9", flags => 0x20, num_subkeys => 0, num_values => 0, timestamp => 1050267751, timestamp_as_string => "2003-04-13T21:02:31Z", }, { path => "key2\\key10", name => "key10", flags => 0x20, num_subkeys => 0, num_values => 0, timestamp => 1050377703, timestamp_as_string => "2003-04-15T03:35:03Z", }, { path => "key2\\key11", name => "key11", flags => 0x20, num_subkeys => 0, num_values => 0, timestamp => 1050487654, timestamp_as_string => "2003-04-16T10:07:34Z", }, { path => "key2\\key12", name => "key12", flags => 0x20, num_subkeys => 0, num_values => 0, timestamp => 1050597605, timestamp_as_string => "2003-04-17T16:40:05Z", }, { path => "key3", name => "key3", flags => 0x20, num_subkeys => 6, num_values => 0, timestamp => 993972756, timestamp_as_string => "2001-07-01T07:32:36Z", class_name => "key3", }, { path => "key3\\", name => "", flags => 0x20, num_subkeys => 0, num_values => 0, timestamp => 1078195347, timestamp_as_string => "2004-03-02T02:42:27Z", class_name => "", }, { path => "key3\\0", name => "0", flags => 0x20, num_subkeys => 0, num_values => 0, timestamp => 1078305298, timestamp_as_string => "2004-03-03T09:14:58Z", class_name => "0", }, { path => "key3\\\0", name => "\0", flags => 0x20, num_subkeys => 0, num_values => 0, timestamp => 1078415249, timestamp_as_string => "2004-03-04T15:47:29Z", class_name => "\0", }, { path => "key3\\\0name", name => "\0name", flags => 0x20, num_subkeys => 0, num_values => 0, timestamp => 1078525200, timestamp_as_string => "2004-03-05T22:20:00Z", class_name => "\0name", }, { path => "key3\\" . pack("U*", 0xe0..0xff), name => pack("U*", 0xe0..0xff), flags => 0x20, num_subkeys => 0, num_values => 0, timestamp => 1078635151, timestamp_as_string => "2004-03-07T04:52:31Z", class_name => pack("U*", 0xe0..0xff), }, { path => "key3\\" . pack("U*", 0x3b1..0x3c9), name => pack("U*", 0x3b1..0x3c9), flags => 0x0, num_subkeys => 0, num_values => 0, timestamp => 1078745103, timestamp_as_string => "2004-03-08T11:25:03Z", class_name => pack("U*", 0x3b1..0x3c9), }, ); run_key_tests($root_key, @tests); } Parse-Win32Registry-1.0/t/fake_sam.rf0000644000175000017500000001034011747213110016460 0ustar ownerownerregfÇ Re ghbinǨÿÿÿnk,ÀÿÿÿÿxÿÿÿÿSAMðÿÿÿlfˆ¨ÿÿÿnk À ÿÿÿÿÿÿÿÿSAMParse-Win32Registry-1.0/t/missing_rgkn_header.rf0000644000175000017500000000004011747213110020710 0ustar ownerownerCREGîîîîParse-Win32Registry-1.0/t/fake_security.rf0000644000175000017500000001064011747213110017552 0ustar ownerownerregfÇ Re ghbinǨÿÿÿnk,ÀÿÿÿÿxÿÿÿÿSECURITYàÿÿÿlf˜ðH¨ÿÿÿnk À ÿÿÿÿÿÿÿÿCache¨ÿÿÿnk À ÿÿÿÿÿÿÿÿPolicy¨ÿÿÿnk À ÿÿÿÿÿÿÿÿRXACTParse-Win32Registry-1.0/t/file.t0000644000175000017500000000364211747213110015474 0ustar ownerowneruse strict; use warnings; use Test::More 'no_plan'; use Parse::Win32Registry 0.60; sub find_file { my $filename = shift; return -d 't' ? "t/$filename" : $filename; } { my $filename = find_file('win95_key_tests.rf'); my $registry = Parse::Win32Registry->new($filename); ok(defined($registry), 'registry defined'); isa_ok($registry, 'Parse::Win32Registry::Win95::File'); my $timestamp_as_string = '(undefined)'; my $desc = "95"; ok(fileno($registry->get_filehandle), "$desc get_filehandle"); is($registry->get_filename, $filename, "$desc get_filename"); cmp_ok($registry->get_length, '==', -s $filename, "$desc get_length"); ok(!defined($registry->get_timestamp), "$desc get_timestamp undefined (no timestamp)"); is($registry->get_timestamp_as_string, $timestamp_as_string, "$desc get_timestamp_as_string"); ok(!defined($registry->get_embedded_filename), "$desc get_embedded_filename undefined (no embedded filename)"); } { my $filename = find_file('winnt_key_tests.rf'); my $registry = Parse::Win32Registry->new($filename); ok(defined($registry), 'registry defined'); isa_ok($registry, 'Parse::Win32Registry::WinNT::File'); my $timestamp = 1162637840; my $timestamp_as_string = '2006-11-04T10:57:20Z'; my $embedded_filename = 'ttings\Administrator\ntuser.dat'; my $desc = "NT"; ok(fileno($registry->get_filehandle), "$desc get_filehandle"); is($registry->get_filename, $filename, "$desc get_filename"); cmp_ok($registry->get_length, '==', -s $filename, "$desc get_length"); cmp_ok($registry->get_timestamp, '==', $timestamp, "$desc get_timestamp"); is($registry->get_timestamp_as_string, $timestamp_as_string, "$desc get_timestamp_as_string"); is($registry->get_embedded_filename, $embedded_filename, "$desc get_embedded_filename"); } Parse-Win32Registry-1.0/t/fake_usrclass_dat.rf0000644000175000017500000001042011747213110020366 0ustar ownerownerregfÇ Re ghbinÇxÿÿÿnk,Àÿÿÿÿ¨ÿÿÿÿ3S-1-5-21-123456789-123456789-123456789-1000_Classesðÿÿÿlf¸¨ÿÿÿnk À ÿÿÿÿÿÿÿÿCLSIDParse-Win32Registry-1.0/t/invalid_regf_header.rf0000644000175000017500000000100011747213110020644 0ustar ownerownerreggÇ ttings\Administrator\ntuser.datParse-Win32Registry-1.0/t/winnt_iter_tests.rf0000644000175000017500000001240011747213110020315 0ustar ownerownerregfÀ Pe§ghbinÀ ÿÿÿnk,Àÿÿÿÿ0ˆÿÿÿÿÿÿÿÿ $$$PROTO.HIV¨ÿÿÿnk À H ÿÿÿÿÿÿÿÿkey1¨ÿÿÿnk À `°ÿÿÿÿÿÿÿÿkey2èÿÿÿlf€Øàÿÿÿvkhvalue1àÿÿÿvkˆvalue2ðÿÿÿHh¨ÿÿÿnk À€ÿÿÿÿÿÿÿÿÿÿÿÿkey3¨ÿÿÿnk À€ÿÿÿÿPÿÿÿÿÿÿÿÿkey4èÿÿÿlh˜ðàÿÿÿvk€value3àÿÿÿvk value4ðÿÿÿ`€¨ÿÿÿnk ÀØÿÿÿÿ ÿÿÿÿÿÿÿÿkey5¨ÿÿÿnk ÀØÿÿÿÿðÿÿÿÿÿÿÿÿkey6ðÿÿÿli°àÿÿÿvkvalue5àÿÿÿvk°value6ðÿÿÿpàÿÿÿvkàvalue7àÿÿÿvkvalue8ðÿÿÿÀààÿÿÿvk0value9àÿÿÿvkPvalue10ðÿÿÿ0àÿÿÿvk€value11àÿÿÿvk value12ðÿÿÿ`€àÿÿÿvkÐvalue13àÿÿÿvkðvalue14ðÿÿÿ°ÐParse-Win32Registry-1.0/t/winnt_compare_tests3.rf0000644000175000017500000001125011747213110021065 0ustar ownerownerregfÇ ttings\Administrator\ntuser.datQe½ghbinÀ ÿÿÿnk,Àÿÿÿÿ0ÿÿÿÿÿÿÿÿÿÿÿÿ $$$PROTO.HIV¨ÿÿÿnk Á ÿÿÿÿÈÿÿÿÿÿÿÿÿkey1¨ÿÿÿnk  ÿÿÿÿÿÿÿÿÿÿÿÿkey2èÿÿÿlf€Øàÿÿÿvk€value1àÿÿÿvk€value2àÿÿÿvk€value3àÿÿÿvk€value5èÿÿÿHhˆ¨¨ÿÿÿnk ÃØÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿkey3¨ÿÿÿnk ÅØÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿkey5èÿÿÿlhà8Parse-Win32Registry-1.0/t/winnt_entry_tests.rf0000644000175000017500000002000011747213110020506 0ustar ownerownerregfÇ ttings\Administrator\ntuser.datQe½ghbinÀ ÿÿÿnk,Àÿÿÿÿ¸ÿÿÿÿ€ÿÿÿÿ $$$PROTO.HIV˜ÿÿÿsk€€L€0@€  ¨ÿÿÿnk Á Ø(€@ key1ðÿÿÿClass¨ÿÿÿnk  Øÿÿÿÿ€¨ key2ðÿÿÿClassèÿÿÿlfèP¨ÿÿÿnk Ãèÿÿÿÿÿÿÿÿ€ÿÿÿÿkey3¨ÿÿÿnk Äèÿÿÿÿÿÿÿÿ€ÿÿÿÿkey4¨ÿÿÿnk Åèÿÿÿÿÿÿÿÿ€ÿÿÿÿkey5àÿÿÿlhÐ(€ àÿÿÿvk8sz1àÿÿÿwww.perl.orgàÿÿÿvkxbinary1ðÿÿÿàÿÿÿvk€dword1Øÿÿÿvk &Ðmulti_sz1Ðÿÿÿabcdefghijklmnoàÿÿÿvk ôtype500øÿÿÿèÿÿÿXˆ¨¨ÿÿÿnk ÆPÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿkey6¨ÿÿÿnk ÇPÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿkey7¨ÿÿÿnk ÈPÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿkey8¨ÿÿÿnk ÉPÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿkey9¨ÿÿÿnk ÊPÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿkey10¨ÿÿÿnk ËPÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿkey11ìÿÿÿli@˜ð0ìÿÿÿliH ø0ðÿÿÿriP”0èParse-Win32Registry-1.0/t/win95_key_tests.rf0000644000175000017500000000204611747213110017763 0ustar ownerownerCREG8RGKN ÿÿÿÿ<ÿÿÿÿÿÿÿÿ X ät Œÿÿÿÿ<ÿÿÿÿ¬<ÿÿÿÿÈ<ÿÿÿÿÿÿÿÿXÿÿÿÿXÿÿÿÿXÿÿÿÿ8XÿÿÿÿTXÿÿÿÿpXÿÿÿÿÿÿÿÿ tÿÿÿÿ¨ tÿÿÿÿÄ tÿÿÿÿà tÿÿÿÿü tÿÿÿÿÿÿÿÿRGDBhkey1key2key3RGDB†key4key5key6key7key8key9key10key11 key12  0  name44 àáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿParse-Win32Registry-1.0/t/invalid_rgkn_header.rf0000644000175000017500000000010011747213110020662 0ustar ownerownerCREGîîîîRGKO Parse-Win32Registry-1.0/t/win95_value_tests.rf0000644000175000017500000000234711747213110020313 0ustar ownerownerCREGxRGKNX ÿÿÿÿ<ÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿRGDBoOO(key1 sz1www.perl.org sz2www.perl.orgsz3sz4binary1binary2dword1dword2dword3dword4dword5dword6ÿÿÿdword7€dword8ÿÿÿÿdword_big_endian1dword_big_endian2dword_big_endian3dword_big_endian4dword_big_endian5dword_big_endian6ÿÿÿdword_big_endian7€dword_big_endian8ÿÿÿÿ multi_sz1abcdefghijklmno multi_sz2abcdefghijklmno multi_sz3abcdefghijklmno multi_sz4abcdeklmno multi_sz5abcdeklmno multi_sz6abcdeklmno multi_sz7abcde multi_sz8abcde multi_sz9abcde multi_sz10 multi_sz11 multi_sz12ôtype5000name àáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿParse-Win32Registry-1.0/t/invalid_creg_header.rf0000644000175000017500000000004011747213110020644 0ustar ownerownerCREHîîîîParse-Win32Registry-1.0/t/winnt_error_tests.rf0000644000175000017500000001503011747213110020505 0ustar ownerownerregfÀ Pe§ghbinÀ ÿÿÿnk,Àÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ $$$PROTO.HIV¨ÿÿÿNK À ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿkey2¨ÿÿÿnk À ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ key3¨ÿÿÿnk À ÿÿÿÿÿÿÿÿÿÿÿÿˆ key4ðÿÿÿClass¨ÿÿÿnk À îÞîîÿÿÿÿÿÿÿÿÿÿÿÿkey5¨ÿÿÿnk À øÿÿÿÿÿÿÿÿÿÿÿÿkey6¨ÿÿÿnk À Àÿÿÿÿÿÿÿÿÿÿÿÿkey7¨ÿÿÿnk Àÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿkey8¨ÿÿÿnk À ÿÿÿÿÿÿÿÿîÞîîÿÿÿÿkey9¨ÿÿÿnk À ÿÿÿÿÿÿÿÿ(ÿÿÿÿkey10¨ÿÿÿnk À ÿÿÿÿÿÿÿÿÿÿÿÿkey11¨ÿÿÿnk À ÿÿÿÿÿÿÿÿøÿÿÿÿkey12¨ÿÿÿnk Àÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿkey13¨ÿÿÿnk À ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿkey14ˆÿÿÿlfîÞîî€Ø0˜ðH øP¨X°¨ÿÿÿnk À˜ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿkey?¨ÿÿÿnk À˜ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿkey?èÿÿÿlf€Ø¨ÿÿÿnk Àðÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿkey?¨ÿÿÿnk Àðÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿkey?èÿÿÿLFH ¨ÿÿÿnk ÀHÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿkey?¨ÿÿÿnk ÀHÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿkey?èÿÿÿlf hàÿÿÿvk€value?àÿÿÿvk€value?ðÿÿÿØø˜ÿÿÿSK((L€0@?  ˜ÿÿÿsk €0@?  ˜ÿÿÿskøøL€0@?  àÿÿÿVK€value2àÿÿÿvk €value3àÿÿÿvk€value4àÿÿÿvk à value5àÿÿÿwww.perl.comèÿÿÿîÞîî` €   À Parse-Win32Registry-1.0/t/iterator.t0000644000175000017500000001712611747213110016410 0ustar ownerowneruse strict; use warnings; use Test::More 'no_plan'; use Data::Dumper; use Parse::Win32Registry 0.60 qw(:REG_ make_multiple_subtree_iterator); $Data::Dumper::Useqq = 1; $Data::Dumper::Terse = 1; $Data::Dumper::Indent = 0; sub find_file { my $filename = shift; return -d 't' ? "t/$filename" : $filename; } sub run_subtree_iterator_tests { my $key = shift; my @tests = @_; my ($os) = ref($key) =~ /Win(NT|95)/; # key+value tests my $subtree_iter = $key->get_subtree_iterator; ok(defined $subtree_iter, "$os get_subtree_iterator defined"); isa_ok($subtree_iter, "Parse::Win32Registry::Iterator"); for (my $i = 0; $i < @tests; $i++) { my ($key_path, $value_name) = @{$tests[$i]}; my ($key, $value) = $subtree_iter->get_next; my $desc = "$os (list) TEST" . ($i + 1); ok(defined $key, "$desc key defined (valid key)"); is($key->get_path, $key_path, "$desc key get_path"); if (defined $value_name) { ok(defined $value, "$desc value defined (valid value)"); is($value->get_name, $value_name, "$desc value get_name"); } else { ok(!defined $value, "$desc value undefined (no value)"); } } my @final = $subtree_iter->get_next; is(@final, 0, "$os (list) iterator empty"); # key tests @tests = grep { !defined $_->[1] } @tests; $subtree_iter = $key->get_subtree_iterator; ok(defined $subtree_iter, "$os get_subtree_iterator defined"); isa_ok($subtree_iter, "Parse::Win32Registry::Iterator"); for (my $i = 0; $i < @tests; $i++) { my ($key_path, $value_name) = @{$tests[$i]}; my $key = $subtree_iter->get_next; my $desc = "$os (scalar) TEST" . ($i + 1); ok(defined $key, "$desc key defined (valid key)"); is($key->get_path, $key_path, "$desc key get_path"); } my $final = $subtree_iter->get_next; ok(!defined $final, "$os (scalar) iterator empty"); } sub run_multiple_subtree_iterator_tests { my $key = shift; my @tests = @_; my ($os) = ref($key) =~ /Win(NT|95)/; # key+value tests my $subtree_iter = make_multiple_subtree_iterator($key); ok(defined $subtree_iter, "$os make_multiple_subtree_iterator defined"); isa_ok($subtree_iter, "Parse::Win32Registry::Iterator"); for (my $i = 0; $i < @tests; $i++) { my ($key_path, $value_name) = @{$tests[$i]}; my ($keys_ref, $values_ref) = $subtree_iter->get_next; my $desc = "$os (list) TEST" . ($i + 1); ok(defined $keys_ref, "$desc keys_ref defined (valid keys)"); is(ref $keys_ref, 'ARRAY', "$desc keys_ref array"); is($keys_ref->[0]->get_path, $key_path, "$desc keys_ref->[0] get_path"); if (defined $value_name) { ok(defined $values_ref, "$desc values_ref defined (valid values)"); is(ref $values_ref, 'ARRAY', "$desc values_ref array"); is($values_ref->[0]->get_name, $value_name, "$desc values_ref->[0] get_name"); } else { ok(!defined $values_ref, "$desc values_ref undefined (no values)"); } } my @final = $subtree_iter->get_next; is(@final, 0, "$os (list) iterator empty"); # key tests @tests = grep { !defined $_->[1] } @tests; $subtree_iter = make_multiple_subtree_iterator($key); ok(defined $subtree_iter, "$os make_multiple_subtree_iterator defined"); isa_ok($subtree_iter, "Parse::Win32Registry::Iterator"); for (my $i = 0; $i < @tests; $i++) { my ($key_path, $value_name) = @{$tests[$i]}; my $keys_ref = $subtree_iter->get_next; my $desc = "$os (scalar) TEST" . ($i + 1); ok(defined $keys_ref, "$desc keys_ref defined (valid keys)"); is(ref $keys_ref, 'ARRAY', "$desc keys_ref array"); is($keys_ref->[0]->get_path, $key_path, "$desc keys_ref->[0] get_path"); } my $final = $subtree_iter->get_next; ok(!defined $final, "$os (scalar) iterator empty"); } { my $filename = find_file('win95_iter_tests.rf'); my $registry = Parse::Win32Registry->new($filename); my $root_key = $registry->get_root_key; my @tests = ( [""], ["\\key1"], ["\\key1", "value1"], ["\\key1", "value2"], ["\\key1\\key3"], ["\\key1\\key3", "value5"], ["\\key1\\key3", "value6"], ["\\key1\\key4"], ["\\key1\\key4", "value7"], ["\\key1\\key4", "value8"], ["\\key2"], ["\\key2", "value3"], ["\\key2", "value4"], ["\\key2\\key5"], ["\\key2\\key5", "value9"], ["\\key2\\key5", "value10"], ["\\key2\\key6"], ["\\key2\\key6", "value11"], ["\\key2\\key6", "value12"], ); run_subtree_iterator_tests($root_key, @tests); @tests = ( [""], ["\\key1"], ["\\key1", "value1"], ["\\key1", "value2"], ["\\key1\\key3"], ["\\key1\\key3", "value5"], ["\\key1\\key3", "value6"], ["\\key1\\key4"], ["\\key1\\key4", "value7"], ["\\key1\\key4", "value8"], ["\\key2"], ["\\key2", "value3"], ["\\key2", "value4"], ["\\key2\\key5"], ["\\key2\\key5", "value10"], ["\\key2\\key5", "value9"], ["\\key2\\key6"], ["\\key2\\key6", "value11"], ["\\key2\\key6", "value12"], ); run_multiple_subtree_iterator_tests($root_key, @tests); } { my $filename = find_file('winnt_iter_tests.rf'); my $registry = Parse::Win32Registry->new($filename); my $root_key = $registry->get_root_key; my @tests = ( ["\$\$\$PROTO.HIV"], ["\$\$\$PROTO.HIV", "value1"], ["\$\$\$PROTO.HIV", "value2"], ["\$\$\$PROTO.HIV\\key1"], ["\$\$\$PROTO.HIV\\key1", "value3"], ["\$\$\$PROTO.HIV\\key1", "value4"], ["\$\$\$PROTO.HIV\\key1\\key3"], ["\$\$\$PROTO.HIV\\key1\\key3", "value7"], ["\$\$\$PROTO.HIV\\key1\\key3", "value8"], ["\$\$\$PROTO.HIV\\key1\\key4"], ["\$\$\$PROTO.HIV\\key1\\key4", "value9"], ["\$\$\$PROTO.HIV\\key1\\key4", "value10"], ["\$\$\$PROTO.HIV\\key2"], ["\$\$\$PROTO.HIV\\key2", "value5"], ["\$\$\$PROTO.HIV\\key2", "value6"], ["\$\$\$PROTO.HIV\\key2\\key5"], ["\$\$\$PROTO.HIV\\key2\\key5", "value11"], ["\$\$\$PROTO.HIV\\key2\\key5", "value12"], ["\$\$\$PROTO.HIV\\key2\\key6"], ["\$\$\$PROTO.HIV\\key2\\key6", "value13"], ["\$\$\$PROTO.HIV\\key2\\key6", "value14"], ); run_subtree_iterator_tests($root_key, @tests); @tests = ( ["\$\$\$PROTO.HIV"], ["\$\$\$PROTO.HIV", "value1"], ["\$\$\$PROTO.HIV", "value2"], ["\$\$\$PROTO.HIV\\key1"], ["\$\$\$PROTO.HIV\\key1", "value3"], ["\$\$\$PROTO.HIV\\key1", "value4"], ["\$\$\$PROTO.HIV\\key1\\key3"], ["\$\$\$PROTO.HIV\\key1\\key3", "value7"], ["\$\$\$PROTO.HIV\\key1\\key3", "value8"], ["\$\$\$PROTO.HIV\\key1\\key4"], ["\$\$\$PROTO.HIV\\key1\\key4", "value10"], ["\$\$\$PROTO.HIV\\key1\\key4", "value9"], ["\$\$\$PROTO.HIV\\key2"], ["\$\$\$PROTO.HIV\\key2", "value5"], ["\$\$\$PROTO.HIV\\key2", "value6"], ["\$\$\$PROTO.HIV\\key2\\key5"], ["\$\$\$PROTO.HIV\\key2\\key5", "value11"], ["\$\$\$PROTO.HIV\\key2\\key5", "value12"], ["\$\$\$PROTO.HIV\\key2\\key6"], ["\$\$\$PROTO.HIV\\key2\\key6", "value13"], ["\$\$\$PROTO.HIV\\key2\\key6", "value14"], ); run_multiple_subtree_iterator_tests($root_key, @tests); } Parse-Win32Registry-1.0/t/win95_compare_tests1.rf0000644000175000017500000000067411747213110020707 0ustar ownerownerCREGÌRGKN¬ ÿÿÿÿ<ÿÿÿÿÿÿÿÿ ÿÿÿÿX<tÿÿÿÿ<ÿÿÿÿ<ÿÿÿÿÿÿÿÿRGDBðppkey1value1value2value3value4key2key3key4key5Parse-Win32Registry-1.0/t/fake_user_dat.rf0000644000175000017500000000035411747213110017512 0ustar ownerownerCREG”RGKNt ÿÿÿÿ<ÿÿÿÿÿÿÿÿ ÿÿÿÿX ÿÿÿÿÿÿÿÿRGDBXîîîî.DEFAULTîîîîSoftwareParse-Win32Registry-1.0/t/fake_system.rf0000644000175000017500000001053011747213110017225 0ustar ownerownerregfÇ Re ghbinÇ ÿÿÿnk,Àÿÿÿÿ€ÿÿÿÿ $$$PROTO.HIVàÿÿÿlf  ÿÿÿnk À ÿÿÿÿÿÿÿÿ ControlSet001¨ÿÿÿnk À ÿÿÿÿÿÿÿÿSelectParse-Win32Registry-1.0/t/winnt_compare_tests2.rf0000644000175000017500000001104011747213110021061 0ustar ownerownerregfÇ ttings\Administrator\ntuser.datQe½ghbinÀ ÿÿÿnk,Àÿÿÿÿ0ÿÿÿÿÿÿÿÿÿÿÿÿ $$$PROTO.HIV¨ÿÿÿnk Á ÿÿÿÿ¨ÿÿÿÿÿÿÿÿkey1¨ÿÿÿnk  ÿÿÿÿÿÿÿÿÿÿÿÿkey2èÿÿÿlf€Øàÿÿÿvk€value1àÿÿÿvk€value2àÿÿÿvk€value3ðÿÿÿHhˆ¨ÿÿÿnk ÃØÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿkey3ðÿÿÿlh¸Parse-Win32Registry-1.0/t/winnt_key_tests.rf0000644000175000017500000001434011747213110020147 0ustar ownerownerregfÇ ttings\Administrator\ntuser.datQe½ghbinÀ ÿÿÿnk,Àÿÿÿÿ¸ÿÿÿÿÿÿÿÿÿÿÿÿ $$$PROTO.HIV¨ÿÿÿnk Á HÿÿÿÿÿÿÿÿØkey1ðÿÿÿkey1¨ÿÿÿnk Á  ÿÿÿÿÿÿÿÿ@key2ðÿÿÿkey2¨ÿÿÿnk Á ¨ÿÿÿÿÿÿÿÿ¨key3ðÿÿÿkey3àÿÿÿlf€èP˜ÿÿÿskØØL€0@€  ¨ÿÿÿnk €ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿkey4¨ÿÿÿnk €ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿkey5¨ÿÿÿnk €ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿkey6àÿÿÿlh@˜ð¨ÿÿÿnk Ãèÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿkey7¨ÿÿÿnk Ãèÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿkey8¨ÿÿÿnk Ãèÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿkey9¨ÿÿÿnk Ãèÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿkey10¨ÿÿÿnk Ãèÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿkey11¨ÿÿÿnk Ãèÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿkey12ìÿÿÿlihÀìÿÿÿlipÈ ðÿÿÿrixŒ°ÿÿÿnk ÄPÿÿÿÿÿÿÿÿÿÿÿÿøÿÿÿ¨ÿÿÿnk ÄPÿÿÿÿÿÿÿÿÿÿÿÿ`0øÿÿÿ0¨ÿÿÿnk ÄPÿÿÿÿÿÿÿÿÿÿÿÿÀøÿÿÿ¨ÿÿÿnk ÄPÿÿÿÿÿÿÿÿÿÿÿÿ  nameðÿÿÿnameÿÿÿnk ÄPÿÿÿÿÿÿÿÿÿÿÿÿ  @àáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ¸ÿÿÿàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿxÿÿÿnkÄPÿÿÿÿÿÿÿÿÿÿÿÿp22±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÈÿÿÿ±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÈÿÿÿlf°hÈ0èParse-Win32Registry-1.0/t/virtual_root.t0000644000175000017500000000416011747213110017302 0ustar ownerowneruse strict; use warnings; use Test::More 'no_plan'; use Parse::Win32Registry 0.60; sub find_file { my $filename = shift; return -d 't' ? "t/$filename" : $filename; } { my @tests = ( [ 'fake_user_dat.rf', 'HKEY_USERS', '', ['.DEFAULT', 'Software'], ], [ 'fake_system_dat.rf', 'HKEY_LOCAL_MACHINE', '', ['Software', 'System'], ], [ 'fake_sam.rf', 'HKEY_LOCAL_MACHINE\\SAM', 'SAM', ['SAM'], ], [ 'fake_security.rf', 'HKEY_LOCAL_MACHINE\\SECURITY', 'SECURITY', ['Cache', 'Policy', 'RXACT'], ], [ 'fake_software.rf', 'HKEY_LOCAL_MACHINE\\SOFTWARE', '$$$PROTO.HIV', ['Microsoft', 'Policies'], ], [ 'fake_system.rf', 'HKEY_LOCAL_MACHINE\\SYSTEM', '$$$PROTO.HIV', ['ControlSet001', 'Select'], ], [ 'fake_ntuser_dat.rf', 'HKEY_CURRENT_USER', '$$$PROTO.HIV', ['Control Panel', 'Environment', 'Software'], ], [ 'fake_usrclass_dat.rf', 'HKEY_CLASSES_ROOT', 'S-1-5-21-123456789-123456789-123456789-1000_Classes', ['CLSID'], ], ); foreach my $test (@tests) { my ($filename, $virtual_root, $original_root_key_name, $key_names) = @$test; $filename = find_file($filename); my $registry = Parse::Win32Registry->new($filename); ok(defined($registry), 'registry defined (valid registry)'); my $root_key = $registry->get_virtual_root_key; ok(defined($root_key), 'root key defined (valid key)'); is($root_key->get_name, $virtual_root, "root key get_name (virtual name)"); isnt($root_key->get_name, $original_root_key_name, "root key get_name (original name)"); foreach my $key_name (@$key_names) { my $key = $root_key->get_subkey($key_name); my $virtual_path = "$virtual_root\\$key_name"; is($key->get_path, $virtual_path, "subkey get_path (virtual path)"); } } } Parse-Win32Registry-1.0/t/walk.t0000644000175000017500000000624011747213110015510 0ustar ownerowneruse strict; use warnings; use Test::More 'no_plan'; use Data::Dumper; use Parse::Win32Registry 0.60; $Data::Dumper::Useqq = 1; $Data::Dumper::Terse = 1; $Data::Dumper::Indent = 0; sub find_file { my $filename = shift; return -d 't' ? "t/$filename" : $filename; } sub run_walk_tests { my $key = shift; my @tests = @_; my ($os) = ref($key) =~ /Win(NT|95)/; my $subtree_iter = $key->walk(sub { my $key = shift; my $key_path = shift @tests; is($key->get_path, $key_path, "$os entering key " . Dumper($key_path)); }, sub { my $value = shift; my $name = shift @tests; is($value->get_name, $name, "$os value " . Dumper($name)); }, sub { my $key = shift; my $key_path = shift @tests; is($key->get_path, $key_path, "$os leaving key " . Dumper($key_path)); }, ); } { my $filename = find_file('win95_iter_tests.rf'); my $registry = Parse::Win32Registry->new($filename); my $root_key = $registry->get_root_key; my @tests = ( "", # KEY ENTER "\\key1", # KEY ENTER "value1", # VALUE "value2", # VALUE "\\key1\\key3", # KEY ENTER "value5", # VALUE "value6", # VALUE "\\key1\\key3", # KEY EXIT "\\key1\\key4", # KEY ENTER "value7", # VALUE "value8", # VALUE "\\key1\\key4", # KEY EXIT "\\key1", # KEY EXIT "\\key2", # KEY ENTER "value3", # VALUE "value4", # VALUE "\\key2\\key5", # KEY ENTER "value9", # VALUE "value10", # VALUE "\\key2\\key5", # KEY EXIT "\\key2\\key6", # KEY ENTER "value11", # VALUE "value12", # VALUE "\\key2\\key6", # KEY EXIT "\\key2", # KEY EXIT "", # KEY EXIT ); run_walk_tests($root_key, @tests); } { my $filename = find_file('winnt_iter_tests.rf'); my $registry = Parse::Win32Registry->new($filename); my $root_key = $registry->get_root_key; my @tests = ( "\$\$\$PROTO.HIV", # KEY ENTER "value1", # VALUE "value2", # VALUE "\$\$\$PROTO.HIV\\key1", # KEY ENTER "value3", # VALUE "value4", # VALUE "\$\$\$PROTO.HIV\\key1\\key3", # KEY ENTER "value7", # VALUE "value8", # VALUE "\$\$\$PROTO.HIV\\key1\\key3", # KEY EXIT "\$\$\$PROTO.HIV\\key1\\key4", # KEY ENTER "value9", # VALUE "value10", # VALUE "\$\$\$PROTO.HIV\\key1\\key4", # KEY EXIT "\$\$\$PROTO.HIV\\key1", # KEY EXIT "\$\$\$PROTO.HIV\\key2", # KEY ENTER "value5", # VALUE "value6", # VALUE "\$\$\$PROTO.HIV\\key2\\key5", # KEY ENTER "value11", # VALUE "value12", # VALUE "\$\$\$PROTO.HIV\\key2\\key5", # KEY EXIT "\$\$\$PROTO.HIV\\key2\\key6", # KEY ENTER "value13", # VALUE "value14", # VALUE "\$\$\$PROTO.HIV\\key2\\key6", # KEY EXIT "\$\$\$PROTO.HIV\\key2", # KEY EXIT "\$\$\$PROTO.HIV", # KEY EXIT ); run_walk_tests($root_key, @tests); } Parse-Win32Registry-1.0/t/winnt_compare_tests1.rf0000644000175000017500000001125011747213110021063 0ustar ownerownerregfÇ ttings\Administrator\ntuser.datQe½ghbinÀ ÿÿÿnk,Àÿÿÿÿ0ÿÿÿÿÿÿÿÿÿÿÿÿ $$$PROTO.HIV¨ÿÿÿnk Á ÿÿÿÿÈÿÿÿÿÿÿÿÿkey1¨ÿÿÿnk  ÿÿÿÿÿÿÿÿÿÿÿÿkey2èÿÿÿlf€Øàÿÿÿvk€value1àÿÿÿvk€value2àÿÿÿvk€value3àÿÿÿvk€value4èÿÿÿHhˆ¨¨ÿÿÿnk ÃØÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿkey3¨ÿÿÿnk ÄØÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿkey4èÿÿÿlhà8Parse-Win32Registry-1.0/lib/0000755000175000017500000000000011747225756014711 5ustar ownerownerParse-Win32Registry-1.0/lib/Parse/0000755000175000017500000000000011747225756015763 5ustar ownerownerParse-Win32Registry-1.0/lib/Parse/Win32Registry.pm0000644000175000017500000015444011747213110020741 0ustar ownerownerpackage Parse::Win32Registry; use 5.008_001; use strict; use warnings; our $VERSION = '1.0'; use base qw(Exporter); use Carp; use Encode; use Parse::Win32Registry::Base qw(:all); use Parse::Win32Registry::Win95::File; use Parse::Win32Registry::WinNT::File; our @EXPORT_OK = ( # include old function names for backwards compatibility 'convert_filetime_to_epoch_time', 'formatted_octets', @Parse::Win32Registry::Base::EXPORT_OK ); our %EXPORT_TAGS = ( REG_ => [grep { /^REG_[A-Z_]*$/ } @EXPORT_OK], all => [@EXPORT_OK], functions => [grep { /^[a-z0-9_]*$/ } @EXPORT_OK], constants => [grep { /^[A-Z_]*$/ } @EXPORT_OK], ); *convert_filetime_to_epoch_time = \&Parse::Win32Registry::unpack_windows_time; *formatted_octets = \&Parse::Win32Registry::format_octets; sub enable_warnings { $Parse::Win32Registry::Base::WARNINGS = 1; } sub disable_warnings { $Parse::Win32Registry::Base::WARNINGS = 0; } sub set_codepage { my $codepage = shift; if (defined $codepage) { $Parse::Win32Registry::Base::CODEPAGE = $codepage; } } sub get_codepage { $Parse::Win32Registry::Base::CODEPAGE; } sub new { my $class = shift; my $filename = shift or croak "No filename specified"; open my $regfile, "<", $filename or croak "Unable to open '$filename': $!"; sysread($regfile, my $sig, 4); if (!defined($sig) || length($sig) != 4) { warnf("Could not read registry file header"); return; } close $regfile; if ($sig eq "CREG") { # attempt to parse this as a Windows 95 Registry File return Parse::Win32Registry::Win95::File->new($filename); } elsif ($sig eq "regf") { # attempt to parse this as a Windows NT Registry File return Parse::Win32Registry::WinNT::File->new($filename); } else { warnf("Invalid registry file header"); return; } } 1; __END__ =head1 NAME Parse::Win32Registry - Parse Windows Registry Files =head1 SYNOPSIS use strict; use Parse::Win32Registry qw( :REG_ unpack_windows_time unpack_unicode_string ); my $filename = shift or die "Filename?"; my $registry = Parse::Win32Registry->new($filename) or die "'$filename' is not a registry file\n"; my $root_key = $registry->get_root_key or die "Could not get root key of '$filename'\n"; # The following code works on USER.DAT or NTUSER.DAT files my $software_key = $root_key->get_subkey(".DEFAULT\\Software") || $root_key->get_subkey("Software"); if (defined($software_key)) { my @user_key_names = ( "Microsoft\\Windows\\CurrentVersion\\Explorer\\Shell Folders", "Microsoft\\Windows\\CurrentVersion\\Explorer\\RunMRU", ); foreach my $name (@user_key_names) { if (my $key = $software_key->get_subkey($name)) { print "\n", $key->as_string, "\n"; foreach my $value ($key->get_list_of_values) { print $value->as_string, "\n"; } } } # This demonstrates how you can deal with a binary value # that contains a Unicode string foreach my $ver (qw(8.0 9.0 10.0 11.0)) { my $key_name = "Microsoft\\Office\\$ver\\Common\\UserInfo"; if (my $key = $software_key->get_subkey($key_name)) { print "\n", $key->as_string, "\n"; my @value_names = qw(UserName UserInitials Company); foreach my $value_name (@value_names) { if (my $value = $key->get_value($value_name)) { print $value->as_string, "\n"; my $data = $value->get_data; my $string = unpack_unicode_string($data); print "$value_name = '$string'\n"; } } } } } # The following code works on SYSTEM.DAT or SOFTWARE files my $software_key = $root_key->get_subkey("Software") || $root_key; if (defined($software_key)) { my @software_key_names = ( "Microsoft\\Windows\\CurrentVersion", "Microsoft\\Windows NT\\CurrentVersion", ); foreach my $name (@software_key_names) { if (my $key = $software_key->get_subkey($name)) { print "\n", $key->as_string, "\n"; foreach my $value ($key->get_list_of_values) { print $value->as_string, "\n"; } } } # This demonstrates how you can deal with a Unix date # found in a registry value my $key_name = "Microsoft\\Windows NT\\CurrentVersion"; if (my $curver_key = $software_key->get_subkey($key_name)) { print "\n", $curver_key->as_string, "\n"; if (my $value = $curver_key->get_value("InstallDate")) { print $value->as_string, "\n"; my $time = $value->get_data; print "InstallDate = ", scalar gmtime $time, " GMT\n"; print "InstallDate = ", scalar localtime $time, " Local\n"; } } } # The following code works on SYSTEM.DAT or SYSTEM files my $system_key = $root_key->get_subkey("System") || $root_key; my $ccs_name = "CurrentControlSet"; # default for Win95 if (my $key = $system_key->get_subkey("Select")) { my $current_value = $key->get_value("Current"); $ccs_name = sprintf("ControlSet%03d", $current_value->get_data); print "CurrentControlSet = $ccs_name\n"; } my $ccs_key = $system_key->get_subkey($ccs_name); if (defined($ccs_key)) { my @system_key_names = ( "Control\\ComputerName\\ComputerName", "Control\\TimeZoneInformation", ); foreach my $name (@system_key_names) { if (my $key = $ccs_key->get_subkey($name)) { print "\n", $key->as_string, "\n"; foreach my $value ($key->get_list_of_values) { print $value->as_string, "\n"; } } } # This demonstrates how you can deal with a Windows date # found in a registry value my $key_name = "Control\\Windows"; if (my $windows_key = $ccs_key->get_subkey($key_name)) { print "\n", $windows_key->as_string, "\n"; if (my $value = $windows_key->get_value("ShutdownTime")) { print $value->as_string, "\n"; my $data = $value->get_data; my $time = unpack_windows_time($data); print "ShutdownTime = ", scalar gmtime $time, " GMT\n"; print "ShutdownTime = ", scalar localtime $time, " Local\n"; } } } =head1 DESCRIPTION Parse::Win32Registry is a module for parsing Windows Registry files, allowing you to read the keys and values of a registry file without going through the Windows API. It provides an object-oriented interface to the keys and values in a registry file. Registry files are structured as trees of keys, with each key containing further subkeys or values. The module is intended to be cross-platform, and run on those platforms where Perl will run. It supports both Windows NT registry files (Windows NT, 2000, XP, 2003, Vista, 7) and Windows 95 registry files (Windows 95, 98, Millennium Edition). It is intended to be used to parse offline registry files. If a registry file is currently in use, you will not be able to open it. However, you can save part or all of a currently loaded registry file using the Windows reg command if you have the appropriate administrative access. =head1 DEPENDENCIES Requires Perl 5.8.1. All required modules are standard modules. =head1 METHODS Start by creating a Registry object from a valid registry file. Use the Registry object's get_root_key method to obtain the root key of that registry file. This root key is your first Key object. From this key, you can explore the Key and Value objects that comprise the registry file using the methods described below. Data is read directly from a registry file when a Key or Value object is created, and discarded when the Key or Value object is destroyed. This avoids any delay in parsing an entire registry file to obtain a Key or Value object as most code only looks at a subset of the keys and values contained in a registry file. =head2 Registry Object Methods =over 4 =item $registry = Parse::Win32Registry->new( 'filename' ) Creates a new Registry object for the specified registry file. =item $registry->get_root_key Returns the root Key object of the registry file. The root key of a registry file is not the same as one of the virtual roots of the registry (HKEY_LOCAL_MACHINE, HKEY_USERS, etc) that you might be familiar with from using tools such as REGEDIT. The names of root keys vary by operating system and by file. For example, the name of the root key of a Windows XP NTUSER.DAT file is '$$$PROTO.HIV' and the name of the root key of a Windows 98 USER.DAT file is an empty string. =item $registry->get_virtual_root_key =item $registry->get_virtual_root_key( 'virtual root key name' ) Returns the virtual root Key object of the registry file. In all respects this is exactly the same as the root Key object, except that it pretends to be a virtual root by simply faking its name. It guesses the virtual root key name by looking at the filename of the registry file. For example, if the filename contains 'SYSTEM' the virtual root key will be named 'HKEY_LOCAL_MACHINE\\SYSTEM'. If the guess fails (because the filename is not recognised) the virtual root key will be named 'HKEY_UNKNOWN'. You can override the guess by supplying your own root key name. You can use this to pass in your preferred root key name. For example, you could pass the filename of the registry file in as the virtual root key name, which would then cause the filename to appear as part of each key's path. =item $registry->get_timestamp Returns the embedded timestamp for the registry file as a time value (the number of seconds since your computer's epoch) suitable for passing to gmtime or localtime. Only Windows NT registry files have an embedded timestamp. Returns nothing if the date is out of range or if called on a Windows 95 registry file. =item $registry->get_timestamp_as_string Returns the timestamp as a ISO 8601 string, for example, '2010-05-30T13:57:11Z'. The Z indicates that the time is GMT ('Zero Meridian'). Returns the string '(undefined)' if the date is out of range or if called on a Windows 95 registry file. =item $registry->get_embedded_filename Returns the embedded filename for the registry file. Only Windows NT registry files have an embedded filename. Returns nothing if called on a Windows 95 registry file. =item $registry->get_filename Returns the filename of the registry file. =item $registry->get_length Returns the length of the registry file. =back =head2 Key Object Methods =over 4 =item $key->get_name Returns the name of the key. The root key of a Windows 95 based registry file does not have a name; this is returned as an empty string. =item $key->get_path Returns the path to the key. This shows the all of the keys from the root key to the current key, joined by the path separator '\'. =item $key->get_subkey( 'key name' ) Returns a Key object for the specified subkey name. If a key with that name does not exist, nothing will be returned. You can specify a path to a subkey by separating keys using the path separator '\'. Remember to quote any '\' characters with a preceding '\'. For example: $key->get_subkey('Software\\Microsoft\\Windows') A path is always relative to the current key. It should start with the name of the first subkey in the path, not the current key. If any key in the path does not exist, nothing will be returned. =item $key->get_value( 'value name' ) Returns a Value object for the specified value name. If a value with that name does not exist, nothing will be returned. The default value (displayed as '(Default)' by REGEDIT) does not actually have a name. It can obtained by supplying an empty string, e.g. $key->get_value(''); =item $key->get_value_data( 'value name' ) Returns the data for the specified value name. If either the value or the value's data does not exist, nothing will be returned. This is simply a shortcut for accessing the data of a value without creating an intermediate Value object. The following code: my $value = $key->get_value('value name'); if (defined $value) { my $data = $value->get_data; if (defined $data) { ...process data... } } can be replaced with: my $data = $key->get_value_data('value name'); if (defined $data) { ...process data... } =item $key->get_list_of_subkeys Returns a list of Key objects representing the subkeys of the current key. If a key has no subkeys, an empty list will be returned. =item $key->get_list_of_values Returns a list of Value objects representing the values of the current key. If a key has no values, an empty list will be returned. =item $key->get_timestamp Returns the timestamp for the key as a time value (the number of seconds since your computer's epoch) suitable for passing to gmtime or localtime. Only Windows NT registry keys have a timestamp. Returns nothing if the date is out of range or if called on a Windows 95 registry key. =item $key->get_timestamp_as_string Returns the timestamp as an ISO 8601 string, for example, '2010-05-30T13:57:11Z'. The Z indicates that the time is GMT ('Zero Meridian'). Returns the string '(undefined)' if the date is out of range or if called on a Windows 95 registry key. =item $key->as_string Returns the path of the key as a string. The timestamp will be appended for Windows NT registry keys. =item $key->as_regedit_export Returns the path of the key as a string in the Windows Registry Editor Version 5.00 export format. The string will be terminated with a newline character. If used in conjunction with the get_virtual_root_key method of Registry objects this should generate key paths interoperable with those exported by REGEDIT. =item $key->get_parent Returns a Key object for parent of the current key. If the key does not have a valid parent key (which will normally only occur for the root key) nothing will be returned. =item $key->is_root Returns true if this key is the root key. =item $key->get_class_name Returns a string containing the class name associated with a key. Only a very few Windows NT registry key have class names. Returns nothing if the key has no class name or if called on a Windows 95 registry key. =item $key->get_security Returns a Security object containing the security information for the key. Only Windows NT registry keys have security information. Returns nothing if called on a Windows 95 registry key. =item $key->get_subkey_iterator Returns an iterator for retrieving the subkeys of the current key. Each time the get_next method of the iterator is used, it will return a single Key object. Keys will be returned one by one until the end of the list is reached, when nothing will be returned. It can be used as follows: my $subkey_iter = $key->get_subkey_iterator; while (my $subkey = $subkey_iter->get_next) { # do something with $subkey ... } Note that it is usually simpler to just use $key->get_list_of_subkeys. An iterator might be useful when you need to control the amount of processing you are performing, such as programs that need to remain responsive to user actions. =item $key->get_value_iterator Returns an iterator for retrieving the values of the current key. Each time the get_next method of the iterator is used, it will return a single Value object. Values will be returned one by one until the end of the list is reached, when nothing will be returned. It can be used as follows: my $value_iter = $key->get_value_iterator; while (my $value = $value_iter->get_next) { # do something with $value ... } Note that it is usually simpler to just use $key->get_list_of_values. =item $key->get_subtree_iterator Returns an iterator for retrieving the entire subtree of keys and values beginning at the current key. Each time the get_next method of the iterator is used, it will return either a Key object or a Key object and a Value object. Each value accompanies the key that it belongs to. Keys or Key/Value pairs will be returned one by one until the end of the list is reached, when nothing will be returned. It can be used as follows: my $subtree_iter = $key->get_subtree_iterator; while (my ($key, $value) = $subtree_iter->get_next) { if (defined $value) { # do something with $key and $value ... } else { # do something with $key ... } } Keys and values will be returned in the following order: root_key root_key\key1 root_key\key1, value1 root_key\key1, value2 root_key\key1\key2 root_key\key1\key2, value3 root_key\key1\key2, value4 If the iterator is used in a scalar context, only Key objects will returned. my $subtree_iter = $key->get_subtree_iterator; while (my $key = $subtree_iter->get_next) { # do something with $key ... } Keys will be returned in the following order: root_key root_key\key1 root_key\key1\key2 Note that it might be simpler to write a recursive function to process the keys and values. sub traverse { my $key = shift; # do something with $key ... foreach my $value ($key->get_list_of_values) { # do something with $value ... } foreach my $subkey ($key->get_list_of_subkeys) { # recursively process $key traverse($subkey); } } traverse($root_key); =item $key->walk( \&callback ); Performs a recursive descent of all the keys in the subtree starting with the calling key, and calls the callback function for each key reached. The callback function will be passed the current key. $key->walk( sub { my $key = shift; print $key->as_string, "\n"; } ); $key->walk( sub { my $key = shift; print $key->as_regedit_export; foreach my $value ($key->get_list_of_values) { print $value->as_regedit_export; } } ); =back =head2 Value Object Methods =over 4 =item $value->get_name Returns the name of the value. In both Windows NT and Windows 95 based registry files you can get values without a name. This is returned as an empty string. =item $value->get_type Returns the integer representing the type of the value (where 1 is a REG_SZ, 2 is a REG_EXPAND_SZ, etc). The constants for the value types can be imported from the Parse::Win32Registry module with use Parse::Win32Registry qw( :REG_ ); =item $value->get_type_as_string Returns the type of the value as a string instead of an integer constant, making it more suitable for printed output. =item $value->get_data Returns the data for the value. REG_SZ and REG_EXPAND_SZ values will be returned as strings. String data will be converted from Unicode (UCS-2LE) for Windows NT based registry files. Any terminating null characters will be removed. REG_MULTI_SZ values will be returned as a list of strings when called in a list context, and as a string with each element separated by the list separator $" when called in a scalar context. (The list separator defaults to the space character. See perlvar for further information.) String data will be converted from Unicode (UCS-2LE) for Windows NT based registry files. # get REG_MULTI_SZ data as a string my $data = $multi_sz_value->get_data; # get REG_MULTI_SZ data as a list my @data = $multi_sz_value->get_data; REG_DWORD values are unpacked and returned as unsigned integers. All other types are returned as packed binary strings. To extract data from these packed binary strings, you will need to use Perl's unpack function, or one of the provided support functions. Nothing will be returned if the data is invalid. =item $value->get_data_as_string Returns the data for a value, making binary data safe for printed output. REG_SZ and REG_EXPAND_SZ values will be returned directly from get_data, REG_MULTI_SZ values will have their component strings prefixed by indices to more clearly show the number of elements, and REG_DWORD values will be returned as a hexadecimal number followed by its parenthesized decimal equivalent. All other types of values will be returned as a string of hex octets. '(invalid data)' will be returned if the data is invalid (i.e. when get_data returns undef). '(no data)' will be returned if get_data returns an empty string. =item $value->get_raw_data Returns the data for a value exactly as it was read from the registry, without the processing normally performed by get_data. It is intended for those rare occasions when you need to access binary data that has been inappropriately stored in a REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ, or REG_DWORD value. =item $value->as_string Returns the name, type, and data for the value as a string, safe for printed output. '(Default)' will be used for the names of those values that do not have names. =item $value->as_regedit_export Returns the name, type, and data for the value as a string, in the Windows Registry Editor Version 5.00 export format. The string will contain line breaks to ensure that no line is longer than 80 characters. Each line will be terminated with a newline character. '@' will be used for the names of those values that do not have names. This should generate values interoperable with those exported by REGEDIT. =back =head2 Security Object Methods Only Windows NT registry files contain security information to control access to the registry keys. This information is stored in security entries which are distributed through the registry file separately from the keys that they apply to. This allows the registry to share security information amongst a large number of keys whilst unnecessary duplication. Security entries link to other security entries in a circular chain, each entry linking to the one that precedes it and the one that follows it. =over 4 =item $security->get_security_descriptor Returns a Security Descriptor Object representing the security descriptor contained in the security information registry entry. =item $security->get_next Returns the next security object. =item $security->get_previous Returns the previous security object. =item $security->get_reference_count Returns the reference count for the security object. =back =head2 Security Descriptor Object Methods A Security Descriptor object represents a security descriptor which contains an owner SID, a primary group SID, a System ACL, and a Discretionary ACL. =over 4 =item $security_descriptor->get_owner Returns a SID Object containing the Owner SID. =item $security_descriptor->get_group Returns a SID Object containing the primary group SID. =item $security_descriptor->get_sacl Returns an ACL Object containing the System ACL. The System ACL contains those ACEs used for auditing. Nothing will be returned if the security descriptor does not contain a System ACL. =item $security_descriptor->get_dacl Returns an ACL Object containing the Discretionary ACL. The Discretionary ACL contains those ACEs used for access control. Nothing will be returned if the security descriptor does not contain a Discretionary ACL. =item $security_descriptor->as_stanza Returns a multi-line string containing the security descriptor formatted for presentation. It will contain a line for the owner SID, the group SID, and each component ACE of the System ACL and the Discretionary ACL. Each line will be terminated by a newline character. =back =head2 ACL Object Methods An ACL object represents an Access Control List, which comprises a list of Access Control Entries. =over 4 =item $acl->get_list_of_aces Returns a list of ACE Objects representing the ACEs in the order they appear in the ACL. If the ACL contains no ACEs, nothing will be returned. =item $acl->as_stanza Returns a multi-line string containing the ACL formatted for presentation. It will contain a line for each component ACE of the ACL. Each line will be terminated by a newline character. =back =head2 ACE Object Methods An ACE object represents an Access Control Entry. An ACE describes the permissions assigned (the access mask) to a Security Identifier (the trustee). =over 4 =item $ace->get_type Returns an integer containing the ACE type, where 0 indicates an ACCESS_ALLOWED ACE, 1 an ACCESS_DENIED ACE, and 2 a SYSTEM_AUDIT ACE. Typically you will encounter ACCESS_ALLOWED and ACCESS_DENIED ACEs in Discretionary ACLs and SYSTEM_AUDIT ACEs in System ACLs. =item $ace->get_type_as_string Returns the type as a string, rather than integer. =item $ace->get_flags Returns an integer containing the ACE flags. =item $ace->get_access_mask Returns an integer containing the ACE access mask. The access mask controls what actions the trustee might perform with the object the ACE applies to. =item $ace->get_trustee Returns a SID Object containing the trustee that this ACE is associated with. =item $ace->as_string Returns a string containing the ACE formatted for presentation. =back =head2 SID Object Methods A SID object represents a Security Identifier. =over 4 =item $sid->get_name Returns a string containing a name for the SID (e.g. "Administrators" for S-1-5-32-544) if it is a "well known" SID. See Microsoft Knowledge Base Article KB243330. =item $sid->as_string Returns a string containing the SID formatted for presentation. =back =head1 EXPORTS =head2 Constants On request, Parse::Win32Registry will export the registry type constants: use Parse::Win32Registry qw( :REG_ ); The :REG_ tag exports all of the following constants: REG_NONE REG_SZ REG_EXPAND_SZ REG_BINARY REG_DWORD REG_DWORD_BIG_ENDIAN REG_LINK REG_MULTI_SZ REG_RESOURCE_LIST REG_FULL_RESOURCE_DESCRIPTOR REG_RESOURCE_REQUIREMENTS_LIST REG_QWORD You can import individual types by specifying them, for example: use Parse::Win32Registry qw( REG_SZ REG_DWORD ); =head1 SUPPORT FUNCTIONS Parse::Win32Registry provides a number of support functions, which are exported on request. All of the support functions can be imported with: use Parse::Win32Registry qw( :functions ); =head2 Unpacking Binary Data There are a number of functions for assisting in unpacking binary data found in registry values. These functions are exported on request: use Parse::Win32Registry qw( unpack_windows_time unpack_unicode_string unpack_sid unpack_ace unpack_acl unpack_security_descriptor ); These unpack functions also return the length of the packed object when called in a list context. For example, to extract one SID: my $sid = unpack_sid($data); To extract a series of SIDs: my $pos = 0; while ($pos < length($data)) { my ($sid, $packed_len) = unpack_sid(substr($data, $pos)); last if !defined $sid; # abort if SID not defined # ...do something with $sid... $pos += $packed_len; # move past the packed SID } =over 4 =item $time = unpack_windows_time( $data ) =item ( $time, $packed_len ) = unpack_windows_time( $data ) Returns the epoch time for the Win32 FILETIME contained in the supplied binary data. A Win32 FILETIME is a 64-bit integer containing the number of 100-nanosecond intervals since January 1st, 1601 and can sometimes be found in Windows NT registry values. Returns nothing if the date is earlier than your computer's epoch. The epoch begins at January 1st, 1970 on Unix and Windows machines. When called in a list context, it will also return the space used in the supplied data by the windows time. (This function can also be called by its previous name of convert_filetime_to_epoch_time.) =item $str = unpack_unicode_string( $data ) =item ( $str, $packed_len ) = unpack_unicode_string( $data ) Extracts a Unicode (UCS-2LE) string from the supplied binary data. Any terminating null characters are dropped. Unicode (UCS-2LE) strings are sometimes encountered in Windows NT registry REG_BINARY values. Note that Unicode strings contained in REG_SZ, REG_EXPAND_SZ, and REG_MULTI_SZ values are already automatically decoded by the get_data method of a Value object. When called in a list context, it will also return the space used in the supplied data by the Unicode string. =item $sid = unpack_sid( $data ) =item ( $sid, $packed_len) = unpack_sid( $data ) Returns a SID Object representing the SID contained in the supplied data. Returns nothing if the supplied data does not appear to contain a valid SID. When called in a list context, it will also return the space used in the supplied data by the SID. =item $ace = unpack_ace( $data ) =item ( $ace, $packed_len ) = unpack_ace( $data ) Returns an ACE Object representing the ACE contained in the supplied data. Returns nothing if the supplied data does not appear to contain a valid ACE. When called in a list context, it will also return the space used in the supplied data by the ACE. =item $acl = unpack_acl( $data ) =item ( $acl, $packed_len ) = unpack_acl( $data ) Returns an ACL Object representing the ACL contained in the supplied data. Returns nothing if the supplied data does not appear to contain a valid ACL. When called in a list context, it will also return the space used in the supplied data by the ACL. =item $sd = unpack_security_descriptor( $data ) =item ( $sd, $packed_len ) = unpack_security_descriptor( $data ) Returns a Security Descriptor Object representing the security descriptor contained in the supplied data. Returns nothing if the supplied data does not appear to contain a valid security descriptor. When called in a list context, it will also return the space used in the supplied data by the security descriptor. =back =head2 Formatting Data These functions are exported on request: use Parse::Win32Registry qw( iso8601 hexdump ); =over 4 =item $str = iso8601( $epoch_time ) Returns the ISO8601 string for the supplied $epoch_time, for example, '2010-05-30T13:57:11Z'. It assumes the supplied $epoch_time is in UTC, and appends 'Z' to indicate this. The string '(undefined)' will be returned if the epoch time is out of range. my $data = $reg_binary_value->get_data; # extract the Win32 FILETIME starting at the 9th byte of $data my $time = unpack_windows_time( substr( $data, 8 ) ); my $time_as_string = iso8601( $time ); print "$time_as_string\n"; There are a number of ways of displaying a timestamp. For example: use Parse::Win32Registry qw(iso8601); use POSIX qw(strftime); print iso8601($key->get_timestamp); print scalar(gmtime($key->get_timestamp)), " GMT\n"; print scalar(localtime($key->get_timestamp)), " Local\n"; print strftime("%Y-%m-%d %H:%M:%S GMT", gmtime($key->get_timestamp)), "\n"; print strftime("%Y-%m-%d %H:%M:%S Local", localtime($key->get_timestamp)), "\n"; ...might produce the following output: 2000-08-06T23:42:36Z Sun Aug 6 23:42:36 2000 GMT Mon Aug 7 07:42:36 2000 Local 2000-08-06 23:42:36 GMT 2000-08-07 07:42:36 Local =item $str = hexdump( $data ) Returns a multi-line string containing a hexadecimal dump of the supplied data. Each line will display 16 bytes in hexadecimal and ASCII, and will be terminated by a newline character. =back =head2 Processing Multiple Registry Files Simultaneously There are three support functions that create iterators for simultaneously processing the keys and values of multiple registry files. These functions are exported on request: use Parse::Win32Registry qw( make_multiple_subkey_iterator make_multiple_value_iterator make_multiple_subtree_iterator ); Handling lists of subkeys or values should be done with a little care as some of the processed registry files might not contain the subkey or value being examined and the list will contain missing entries: ($key1, $key2, undef, $key4) One way of handling this is to use map to check that a key is defined and return undef if the subkey or value is not present. @subkeys = map { defined $_ && $_->get_subkey('subkey') || undef } @keys; @values = map { defined $_ && $_->get_value('value') || undef } @keys; =over 4 =item $iter = make_multiple_subkey_iterator( $key1, $key2, $key3, ... ) Returns an iterator for retrieving the subkeys of the supplied Key objects. Each call to the get_next method of the iterator returns a reference to a list of Key objects with the same name and path. If any of the supplied Key objects does not have a subkey with that name, then that subkey will be undefined. my $subkey_iter = make_multiple_subkey_iterator($key1, $key2, ...); while (my ($subkey1, $subkey2, ...) = $subkey_iter->get_next) { ... } my $subkey_iter = make_multiple_subkey_iterator($key1, $key2, ...); while (my @subkeys = $subkey_iter->get_next) { foreach my $subkey (@subkeys) { if (defined $subkey) { ... } } } =item $iter = make_multiple_value_iterator( $key1, $key2, $key3, ... ) Returns an iterator for retrieving the values of the supplied Key objects. Each call to the get_next method of the iterator returns a reference to a list of Value objects with the same name. If any of the supplied Key objects does not have a value with that name, then that value will be undefined. my $value_iter = make_multiple_value_iterator($key1, $key2, ...); while (my ($value1, $value2, ...) = $value_iter->get_next) { ... } =item $iter = make_multiple_subtree_iterator( $key1, $key2, $key3, ... ) Returns an iterator for retrieving the immediate subkeys and all descendant subkeys of the supplied Key objects. Each call to the get_next method of the iterator returns a list of Key objects with the same name and path. If any of the supplied Key objects does not have a subkey with that name, then that subkey will be undefined. Each call to the get_next method of the iterator returns it will return either a reference to a list of Key objects or a reference to a list of Key objects and a reference to a list of a Value objects, with each list of values accompanying the list of keys that they belong to. Nothing is returned when the end of the list is reached. my $subtree_iter = make_multiple_subtree_iterator($key1, $key2, ...); while (my $subkeys_ref = $tree_iter->get_next) { # do something with @$subkeys_ref } my $subtree_iter = make_multiple_subtree_iterator($key1, $key2, ...); while (my ($subkeys_ref, $values_ref) = $tree_iter->get_next) { if (defined $values_ref) { # do something with @$subkeys_ref and @$values_ref for (my $i = 0; $i < @$values_ref; $i++) { print $values_ref->[$i]->as_string, "\n"; } ... } else { # do something with @$subkeys_ref my $first_defined_subkey = (grep { defined } @$subkeys_ref)[0]; print $first_defined_subkey->as_string, "\n"; ... } } =back =head2 Comparing Keys and Values These functions are exported on request: use Parse::Win32Registry qw( compare_multiple_keys compare_multiple_values ); =over 4 =item @changes = compare_multiple_keys( $key1, $key2, ... ); Returns a list of strings describing the differences found between the supplied keys. The keys are compared in the order they are supplied. If one of the supplied keys is undefined, it is assumed to have been deleted. The possible changes are 'ADDED', and 'DELETED', and for Windows NT registry keys (which have timestamps) 'NEWER', and 'OLDER'. For example, compare_multiple_keys($k1, $k2, $k3) would return the list ('', 'NEWER', '') if $k2 had a more recent timestamp than $k1, but $k3 had the same timestamp as $k2. You can count the number of changed keys using the grep operator: my $num_changes = grep { $_ } @changes; =item @changes = compare_multiple_values( $value1, $value2, ... ); Returns a list of strings describing the differences found between the supplied values. The values are compared in the order they are supplied. If one of the supplied values is undefined, it is assumed to have been deleted. The possible changes are 'ADDED', 'DELETED', and 'CHANGED'. For example, compare_multiple_keys($v1, $v2, $v3) would return the list ('', 'ADDED', 'CHANGED') if $v2 exists but $v1 did not, and $v3 had different data from $v2. You can count the number of changed values using the grep operator: my $num_changes = grep { $_ } @changes; =back =head1 HANDLING INVALID DATA The Parse::Win32Registry module will skip keys or values that cannot be successfully parsed. If keys or values cannot be parsed, then the get_subkey and get_value methods of Key objects will return nothing. The get_list_of_subkeys and get_list_of_values methods of Key objects will skip those keys or values that cannot be parsed. If none of the keys or values can be parsed successfully, an empty list will be returned. Additionally, values (in Windows NT registry files) often store data in a separate area of the registry file. If the value can be parsed, but the data cannot, a Value object will be created, but it will have no data. The get_data method will return nothing. The most robust way of handling keys or values or data is therefore to check that they are defined before processing them. For example: my $key = $root_key->get_subkey( "Software\\Perl" ); if ( defined $key ) { print $key->as_string, "\n"; my $value = $key->get_value( "Version" ); if ( defined $value ) { print $value->as_string, "\n"; my $data = $value->get_data; if ( defined $data ) { # process $data in some way... } } } You might not feel this robustness is necessary for your scripts. You can be alerted when there are problems parsing registry keys or values by switching on warnings with: Parse::Win32Registry->enable_warnings; They can be switched off again with: Parse::Win32Registry->disable_warnings; =head1 LOW-LEVEL METHODS These methods are intended for those who want to look at the structure of a registry file, but with something a little more helpful than a hex editor. They are not designed for pulling data out of keys and values: they are designed to make it easier to look at the underlying components of a registry file. Windows NT registry files are composed of one or more Hbin blocks. Hbin blocks can contain a series of entries, such as key, value, and security entries, but also includes subkey lists, value lists, key class names, and value data. Windows 95 registry files are composed of an RGKN block, followed by one or more RGDB blocks. RGKN blocks contain the entries which link the registry keys in the form of a tree. RGDB blocks contain a corresponding entry for each key in the RGKN block. This RGDB entry includes the name of the key and any associated values. For convenience, when iterating the entries in an RGDB block, each will be returned as a key entry followed by zero or more value entries. To see demonstrations of how these methods can be used, look at the regscan.pl, gtkregscope.pl, and wxregscope.pl scripts. =head2 Registry Object Methods =over 4 =item $registry->get_block_iterator Returns an iterator for retrieving all the blocks in a registry file. Each time the get_next method of the iterator is used, it will return a single Block object. Blocks will be returned one by one until the end of the registry file is reached, when nothing will be returned. Typically you would iterate over all the blocks in a registry file, and iterate over all the entries in each block: my $block_iter = $registry->get_block_iterator; while (my $block = $block_iter->get_next) { my $entry_iter = $block->get_entry_iterator; while (my $entry = $entry_iter->get_next) { ... } } =item $registry->get_entry_iterator Returns an iterator for retrieving all the entries in a registry file. Each time the get_next method of the iterator is used, it will return a single Entry object. Entries will be returned one by one until the end of the registry file is reached, when nothing will be returned. This is simply a more convenient method for retrieving all the entries in a registry file, which does not require you to iterate over each block. =back =head2 Block Object Methods =over 4 =item $block->get_entry_iterator Returns an iterator for retrieving all the entries in a block. Each time the get_next method of the iterator is used, it will return a single Entry object. Entries will be returned one by one until the end of the block is reached, when nothing will be returned. my $entry_iter = $block->get_entry_iterator; while (my $entry = $entry_iter->get_next) { ... } =item $block->get_offset Returns the position of the block relative to the start of the file. =item $block->get_length Returns the length of the block. =item $block->parse_info Returns a string containing a summary of the parser information for the block. =item $block->unparsed Returns a string containing a hex dump of the unparsed on-disk data for the block header. =item $block->get_raw_bytes Returns the unparsed on-disk data for the block header. =back =head2 Entry Object Methods In addition to the basic methods provided by all entries, if an entry is a key, value, or security entry, it will also provide the methods available to Key, Value, or Security objects. You might therefore find it useful to check what methods are available so that you can use them: # use Entry object methods... ... if ($entry->can('get_subkey')) { # use Key object methods... } elsif ($entry->can('get_data')) { # use Value object methods... } elsif ($entry->can('get_security_descriptor')) { # use Security object methods... } =over 4 =item $entry->get_offset Returns the position of the entry relative to the start of the file. =item $entry->get_length Returns the length of the entry. =item $entry->get_tag Returns a string containing a descriptive tag for the entry. For Windows NT registry entries, the tags reflect the signatures used to identify them. These are: 'nk' for keys; 'vk' for values; 'sk' for security entries; and 'lf', 'lh', 'li', or 'ri' for subkey lists. Entries that do not have signatures will return an empty string. Unidentified entries include value lists, value data, and the class names of keys. For Windows 95 registry files, the tag reflects which part of the registry file the entry is from, and will be 'rgkn key', 'rgdb key', or 'rgdb value'. =item $entry->is_allocated Returns a boolean value indicating the 'allocated' state of a Windows NT registry entry. This value has no meaning for Windows 95 registry entries. =item $entry->as_string Returns a string representation of the entry. If the entry is a valid Key, Value, or Security object, then as_string will call the as_string method of that object. =item $entry->parse_info Returns a string containing a summary of the parser information for that entry. If the entry is a valid Key, Value, or Security object, then parse_info will call the parse_info method of that object. =item $entry->unparsed Returns a string containing a hex dump of the unparsed on-disk data for the entry. =item $entry->get_raw_bytes Returns the unparsed on-disk data for the entry. =back =head1 SCRIPTS All of the supplied scripts are intended to be used either as tools or as examples for you to modify and develop. Try regdump.pl or regshell.pl to look at a registry file from the command line, or gtkregview.pl or wxregview.pl if you want a GUI. If you want to compare registry files, try regmultidiff.pl from the command line or gtkregcompare.pl or wxregcompare.pl if you want a GUI. You can edit the scripts to customize them for your own requirements. If you specify subkeys on the command line, note that you need to quote the subkey on Windows if it contains spaces: regdump.pl ntuser.dat "software\microsoft\windows nt" You will also need to quote backslashes and spaces in Unix shells: regdump.pl ntuser.dat software\\microsoft\\windows\ nt or use single quotes: regdump.pl ntuser.dat 'software\microsoft\windows nt' =head2 gtkregcompare.pl gtkregcompare.pl is a GTK+ program for comparing multiple registry files. It displays a tree of the registry keys and values highlighting those that have changed. It requires Gtk2-Perl to be installed. Filenames of registry files to compare can be supplied on the command line: gtkregcompare.pl ... You can of course use wildcards when running from a Unix shell. =head2 gtkregscope.pl gtkregscope.pl is a GTK+ registry scanner. It presents all the entries in a registry file returned by the get_block_iterator and get_entry_iterator methods. It uses color to highlight key, value, security, and subkey list entries, and presents the block as a colored map. It requires Gtk2-Perl to be installed. A filename can also be supplied on the command line: gtkregscope.pl =head2 gtkregview.pl gtkregview.pl is a GTK+ registry viewer. It displays a tree of registry keys on the left hand side, a list of values on the right, and a hex dump of the selected value data at the bottom. It requires Gtk2-Perl to be installed. A filename can also be supplied on the command line: gtkregview.pl =head2 regclassnames.pl regclassnames.pl will display registry keys that have class names. Only a very few Windows NT registry key have class names. Type regclassnames.pl on its own to see the help: regclassnames.pl [subkey] =head2 regdump.pl regdump.pl is used to display the keys and values of a registry file. Type regdump.pl on its own to see the help: regdump.pl [subkey] [-r] [-v] [-x] [-c] [-s] [-o] -r or --recurse traverse all child keys from the root key or the subkey specified -v or --values display values -x or --hexdump display value data as a hex dump -c or --class-name display the class name for the key (if present) -s or --security display the security information for the key, including the owner and group SIDs, and the system and discretionary ACLs (if present) -o or --owner display the owner SID for the key (if present) The contents of the root key will be displayed unless a subkey is specified. Paths to subkeys are always specified relative to the root key. By default, only the subkeys and values immediately underneath the specified key will be displayed. To display all keys and values beneath a key, use the -r or --recurse option. For example, regdump.pl ntuser.dat might display the following: $$$PROTO.HIV [2005-01-01T09:00:00Z] ..\AppEvents ..\Console ..\Control Panel ..\Environment ..\Identities ..\Keyboard Layout ..\Printers ..\Software ..\UNICODE Program Groups From here, you can explore the subkeys to find those keys or values you are interested in: regdump.pl ntuser.dat software regdump.pl ntuser.dat software\microsoft ... =head2 regexport.pl regexport.pl will display registry keys and values in the Windows Registry Editor Version 5.00 format used by REGEDIT on Windows 2000 and later. Type regexport.pl on its own to see the help: regexport.pl [subkey] [-r] -r or --recurse traverse all child keys from the root key or the subkey specified Values are always shown for each key displayed. Subkeys are displayed as comments when not recursing. (Comments are preceded by the ';' character.) =head2 regfind.pl regfind.pl is used to search the keys, values, data, or types of a registry file for a matching string. Type regfind.pl on its own to see the help: regfind.pl [-k] [-v] [-d] [-t] [-x] -k or --key search key names for a match -v or --value search value names for a match -d or --data search value data for a match -t or --type search value types for a match -x or --hexdump display value data as a hex dump To search for the string "recent" in the names of any keys or values: regfind.pl ntuser.dat recent -kv To search for the string "administrator" in the data of any values: regfind.pl ntuser.dat administrator -d To list all REG_MULTI_SZ values: regfind.pl ntuser.dat -t multi_sz Search strings are not case-sensitive. =head2 regml.pl regml.pl will display those keys with explicit System Mandatory Label ACEs set in the System ACL. This feature was introduced with Windows Vista, and is used by applications such as Internet Explorer running in Protected Mode. Note that if a key does not have an explicit System Mandatory Label ACE, it has Medium Integrity Level. Only Windows NT registry files can contain System Mandatory Label ACEs. Type regml.pl on its own to see the help: regml.pl =head2 regmultidiff.pl regmultidiff.pl can be used to compare multiple registry files and identify the differences between them. Type regmultidiff.pl on its own to see the help: regmultidiff.pl ... [] [-v] [-x] [-l] [-a] -v or --values display values -x or --hexdump display value data as a hex dump -l or --long show each changed key or value instead of a summary -a or --all show all keys and values before and after a change You can limit the comparison by specifying an initial subkey. =head2 regscan.pl regscan.pl dumps all the entries in a registry file. This will include defunct keys and values that are no longer part of the current active registry. Type regscan.pl on its own to see the help: regscan.pl [-k] [-v] [-s] [-a] [-p] [-u] [-w] -k or --keys list only 'key' entries -v or --values list only 'value' entries -s or --security list only 'security' entries -a or --allocated list only 'allocated' entries -p or --parse-info show the technical information for an entry instead of the string representation -u or --unparsed show the unparsed on-disk entries as a hex dump =head2 regsecurity.pl regsecurity.pl will display the security information contained in a registry files. Only Windows NT registry files contain security information. Type regsecurity.pl on its own to see the help: regsecurity.pl =head2 regshell.pl Provides an interactive command shell where you navigate through the keys using 'cd' to change the current key and 'ls' or 'dir' to list the contents of the current key. Tab completion of subkey and value names is available. Names containing spaces are supported by quoting names with " characters. Note that names are case sensitive. A filename should be supplied on the command line: regshell.pl Once regshell.pl is running, type help to see the available commands. It requires Term::ReadLine to be installed. =head2 regstats.pl regstats.pl counts the number of keys and values in a registry file. It will also provide a count of each value type if requested. Type regstats.pl on its own to see the help: regstats.pl [-t] -t or --types count value types =head2 regtimeline.pl regtimeline.pl displays keys and values in date order. As only Windows NT based registry keys provide timestamps, this script only works on Windows NT registry files. You can limit the display to a given number of days (counting back from the timestamp of the last key). Type regtimeline.pl on its own to see the help: regtimeline.pl [subkey] [-l ] [-v] [-x] -l or --last display only the last days of registry activity -v or --values display values -x or --hexdump display value data as a hex dump =head2 regtree.pl regtree.pl simply displays the registry as an indented tree, optionally displaying the values of each key. Type regtree.pl on its own to see the help: regtree.pl [subkey] [-v] -v or --values display values =head2 wxregcompare.pl wxregcompare.pl is a wxWidgets program for comparing multiple registry files. It displays a tree of the registry keys and values, highlighting those that have changed. It requires wxPerl to be installed. Filenames of registry files to compare can be supplied on the command line: wxregcompare.pl ... You can of course use wildcards when running from a Unix shell. =head2 wxregscope.pl wxregscope.pl is a wxWidgets registry scanner. It presents all the entries in a registry file returned by the get_block_iterator and get_entry_iterator methods. It uses color to highlight key, value, security, and subkey list entries. It requires wxPerl to be installed. A filename can also be supplied on the command line: wxregscope.pl =head2 wxregview.pl wxregview.pl is a wxWidgets registry viewer. It displays a tree of registry keys on the left hand side, a list of values on the right, and a hex dump of the selected value data at the bottom. It can also provide a timeline view of all of the registry keys, which can be used to navigate the main tree view by clicking or double-clicking on a timeline key. It requires wxPerl to be installed. A filename can also be supplied on the command line: wxregview.pl =head1 ACKNOWLEDGEMENTS This would not have been possible without the work of those people who have analysed and shared their knowledge of the structure of Windows Registry files, primarily: B.D. (WinReg.txt), Petter Nordahl-Hagen (chntpw), and Richard Sharpe and Jerry Carter (Samba 3). =head1 AUTHOR James Macfarlane, Ejmacfarla@cpan.orgE =head1 COPYRIGHT AND LICENSE Copyright (C) 2006-2012 by James Macfarlane This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut Parse-Win32Registry-1.0/lib/Parse/Win32Registry/0000755000175000017500000000000011747225756020416 5ustar ownerownerParse-Win32Registry-1.0/lib/Parse/Win32Registry/Value.pm0000644000175000017500000000366611747213110022020 0ustar ownerownerpackage Parse::Win32Registry::Value; use strict; use warnings; use base qw(Parse::Win32Registry::Entry); use Carp; use Parse::Win32Registry::Base qw(:all); sub get_name { my $self = shift; return $self->{_name}; } sub get_type { my $self = shift; return $self->{_type}; } our @Types = qw( REG_NONE REG_SZ REG_EXPAND_SZ REG_BINARY REG_DWORD REG_DWORD_BIG_ENDIAN REG_LINK REG_MULTI_SZ REG_RESOURCE_LIST REG_FULL_RESOURCE_DESCRIPTOR REG_RESOURCE_REQUIREMENTS_LIST REG_QWORD ); sub get_type_as_string { my $self = shift; my $type = $self->get_type; if (exists $Types[$type]) { return $Types[$type]; } else { # Return unrecognised types as REG_ # REGEDIT displays them as formatted hex numbers, e.g. 0x1f4 return "REG_$type"; } } sub get_data_as_string { my $self = shift; my $type = $self->get_type; my $data = $self->get_data; if (!defined($data)) { return '(invalid data)'; } elsif (length($data) == 0) { return '(no data)'; } elsif ($type == REG_SZ || $type == REG_EXPAND_SZ) { return $data; } elsif ($type == REG_MULTI_SZ) { my @data = $self->get_data; my $i = 0; return join(' ', map { "[" . $i++ . "] $_" } @data); } elsif ($type == REG_DWORD || $type == REG_DWORD_BIG_ENDIAN) { return sprintf '0x%08x (%u)', $data, $data; } else { return join(' ', unpack('(H2)*', $data)); } } sub get_raw_data { my $self = shift; return $self->{_data}; } sub as_string { my $self = shift; my $name = $self->get_name; $name = '(Default)' if $name eq ''; my $type_as_string = $self->get_type_as_string; my $data_as_string = $self->get_data_as_string; return "$name ($type_as_string) = $data_as_string"; } sub print_summary { my $self = shift; print $self->as_string, "\n"; } 1; Parse-Win32Registry-1.0/lib/Parse/Win32Registry/Entry.pm0000644000175000017500000000607311747213110022040 0ustar ownerownerpackage Parse::Win32Registry::Entry; use strict; use warnings; use Carp; use Parse::Win32Registry::Base qw(:all); sub get_regfile { my $self = shift; return $self->{_regfile}; } sub get_offset { my $self = shift; return $self->{_offset}; } sub get_length { my $self = shift; return $self->{_length}; } sub is_allocated { my $self = shift; return $self->{_allocated}; } sub get_tag { my $self = shift; return $self->{_tag}; } sub as_string { my $self = shift; my $tag = $self->{_tag}; $tag = 'unidentified entry' if !defined $tag; return "($tag)"; } sub parse_info { my $self = shift; my $info = sprintf '0x%x %s len=0x%x', $self->{_offset}, $self->{_tag}, $self->{_length}; return $info; } sub unparsed { my $self = shift; return hexdump($self->get_raw_bytes, $self->get_offset); } sub get_raw_bytes { my $self = shift; my $regfile = $self->{_regfile}; my $fh = $regfile->get_filehandle; my $offset = $self->{_offset}; my $length = $self->{_length}; if (defined $self->{_header_length}) { $length = $self->{_header_length}; } sysseek($fh, $offset, 0); my $bytes_read = sysread($fh, my $buffer, $length); if ($bytes_read == $length) { return $buffer; } else { return ''; } } sub looks_like_key { return UNIVERSAL::isa($_[0], "Parse::Win32Registry::Key"); } sub looks_like_value { return UNIVERSAL::isa($_[0], "Parse::Win32Registry::Value"); } sub looks_like_security { return UNIVERSAL::isa($_[0], "Parse::Win32Registry::WinNT::Security"); } sub _dumpvar { my $self = shift; my $depth = shift || 1; my $dumpvar = ''; foreach (sort keys %$self) { $dumpvar .= ' ' x ($depth*2); $dumpvar .= "$_ => "; my $var = $self->{$_}; if (!defined $var) { $dumpvar .= "undef\n"; } elsif (/offset/ || /_id$/ || /^_unk/) { $dumpvar .= sprintf "0x%x\n", $var; } elsif (/_flags$/) { $dumpvar .= sprintf "0x%x (0b%b)\n", $var, $var; } elsif (/length/ || /bytes_used/) { $dumpvar .= sprintf "0x%x (%d)\n", $var, $var; } elsif (/_data$/) { if (length($var) == 0) { $dumpvar .= '(no data)'; } else { $dumpvar .= join(' ', unpack('(H2)20', $var)); if (length($var) > 20) { $dumpvar .= '...'; } } $dumpvar .= "\n"; } elsif (/timestamp$/) { $dumpvar .= $var . " (" . iso8601($var) . ")\n"; } elsif ($var =~ /^\d+$/) { $dumpvar .= sprintf "%d\n", $var; } elsif (ref($var)) { $dumpvar .= "$var\n"; # stringify object ref } else { $dumpvar .= qq{"$var"}; $dumpvar .= ' '; $dumpvar .= Encode::is_utf8($var) ? "(UTF8)" : "(BYTES)"; $dumpvar .= "\n"; } } return $dumpvar; } 1; Parse-Win32Registry-1.0/lib/Parse/Win32Registry/File.pm0000644000175000017500000000250511747213110021612 0ustar ownerownerpackage Parse::Win32Registry::File; use strict; use warnings; sub get_filehandle { my $self = shift; return $self->{_filehandle}; } sub get_filename { my $self = shift; return $self->{_filename}; } sub get_length { my $self = shift; return $self->{_length}; } sub get_entry_iterator { my $self = shift; my $entry_iter; my $block_iter = $self->get_block_iterator; return Parse::Win32Registry::Iterator->new(sub { while (1) { if (defined $entry_iter) { my $entry = $entry_iter->(); if (defined $entry) { return $entry; } } # entry iterator is undefined or finished my $block = $block_iter->(); if (!defined $block) { return; # block iterator finished } $entry_iter = $block->get_entry_iterator; } }); } # method provided for backwards compatibility sub move_to_first_entry { my $self = shift; $self->{_entry_iter} = undef; } # method provided for backwards compatibility sub get_next_entry { my $self = shift; my $entry_iter = $self->{_entry_iter}; if (!defined $entry_iter) { $self->{_entry_iter} = $entry_iter = $self->get_entry_iterator; } return $entry_iter->(); } 1; Parse-Win32Registry-1.0/lib/Parse/Win32Registry/WinNT/0000755000175000017500000000000011747225756021415 5ustar ownerownerParse-Win32Registry-1.0/lib/Parse/Win32Registry/WinNT/Value.pm0000644000175000017500000002306311747213110023010 0ustar ownerownerpackage Parse::Win32Registry::WinNT::Value; use strict; use warnings; use base qw(Parse::Win32Registry::Value); use Carp; use Encode; use Parse::Win32Registry::Base qw(:all); use constant VK_HEADER_LENGTH => 0x18; use constant OFFSET_TO_FIRST_HBIN => 0x1000; sub new { my $class = shift; my $regfile = shift; my $offset = shift; # offset to vk record relative to first hbin croak 'Missing registry file' if !defined $regfile; croak 'Missing offset' if !defined $offset; my $fh = $regfile->get_filehandle; # 0x00 dword = value length (negative = allocated) # 0x04 word = 'vk' signature # 0x06 word = value name length # 0x08 dword = value data length (bit 31 set => data stored inline) # 0x0c dword = offset to data/inline data # 0x10 dword = value type # 0x14 word = flags (bit 1 set => compressed name) # 0x16 word # 0x18 = value name [for value name length bytes] # Extracted offsets are always relative to first hbin sysseek($fh, $offset, 0); my $bytes_read = sysread($fh, my $vk_header, VK_HEADER_LENGTH); if ($bytes_read != VK_HEADER_LENGTH) { warnf('Could not read value at 0x%x', $offset); return; } my ($length, $sig, $name_length, $data_length, $offset_to_data, $type, $flags, ) = unpack('Va2vVVVv', $vk_header); my $allocated = 0; if ($length > 0x7fffffff) { $allocated = 1; $length = (0xffffffff - $length) + 1; } # allocated should be true if ($length < VK_HEADER_LENGTH) { warnf('Invalid value entry length at 0x%x', $offset); return; } if ($sig ne 'vk') { warnf('Invalid signature for value at 0x%x', $offset); return; } $bytes_read = sysread($fh, my $name, $name_length); if ($bytes_read != $name_length) { warnf('Could not read name for value at 0x%x', $offset); return; } if ($flags & 1) { $name = decode($Parse::Win32Registry::Base::CODEPAGE, $name); } else { $name = decode('UCS-2LE', $name); }; # If the top bit of the data_length is set, then # the value is inline and stored in the offset to data field (at 0xc). my $data; my $data_inline = $data_length >> 31; if ($data_inline) { # REG_DWORDs are always inline, but I've also seen # REG_SZ, REG_BINARY, REG_EXPAND_SZ, and REG_NONE inline $data_length &= 0x7fffffff; if ($data_length > 4) { warnf("Invalid inline data length for value '%s' at 0x%x", $name, $offset); $data = undef; } else { # unpack inline data from header $data = substr($vk_header, 0xc, $data_length); } } else { if ($offset_to_data != 0 && $offset_to_data != 0xffffffff) { $offset_to_data += OFFSET_TO_FIRST_HBIN; if ($offset_to_data < ($regfile->get_length - $data_length)) { $data = _extract_data($fh, $offset_to_data, $data_length); } else { warnf("Invalid offset to data for value '%s' at 0x%x", $name, $offset); } } } my $self = {}; $self->{_regfile} = $regfile; $self->{_offset} = $offset; $self->{_length} = $length; $self->{_allocated} = $allocated; $self->{_tag} = $sig; $self->{_name} = $name; $self->{_name_length} = $name_length; $self->{_type} = $type; $self->{_data} = $data; $self->{_data_length} = $data_length; $self->{_data_inline} = $data_inline; $self->{_offset_to_data} = $offset_to_data; $self->{_flags} = $flags; bless $self, $class; return $self; } sub _extract_data { my $fh = shift; my $offset_to_data = shift; my $data_length = shift; if ($offset_to_data == 0 || $offset_to_data == 0xffffffff) { return undef; } sysseek($fh, $offset_to_data, 0); my $bytes_read = sysread($fh, my $data_header, 4); if ($bytes_read != 4) { warnf('Could not read data at 0x%x', $offset_to_data); return undef; } my ($max_data_length) = unpack('V', $data_header); my $data_allocated = 0; if ($max_data_length > 0x7fffffff) { $data_allocated = 1; $max_data_length = (0xffffffff - $max_data_length) + 1; } # data_allocated should be true my $data; if ($data_length > $max_data_length) { $bytes_read = sysread($fh, my $db_entry, 8); if ($bytes_read != 8) { warnf('Could not read data at 0x%x', $offset_to_data); return undef; } my ($sig, $num_data_blocks, $offset_to_data_block_list) = unpack('a2vV', $db_entry); if ($sig ne 'db') { warnf('Invalid signature for big data at 0x%x', $offset_to_data); return undef; } $offset_to_data_block_list += OFFSET_TO_FIRST_HBIN; sysseek($fh, $offset_to_data_block_list + 4, 0); $bytes_read = sysread($fh, my $data_block_list, $num_data_blocks * 4); if ($bytes_read != $num_data_blocks * 4) { warnf('Could not read data block list at 0x%x', $offset_to_data_block_list); return undef; } $data = ""; my @offsets = map { OFFSET_TO_FIRST_HBIN + $_ } unpack("V$num_data_blocks", $data_block_list); foreach my $offset (@offsets) { sysseek($fh, $offset, 0); $bytes_read = sysread($fh, my $block_header, 4); if ($bytes_read != 4) { warnf('Could not read data block at 0x%x', $offset); return undef; } my ($block_length) = unpack('V', $block_header); if ($block_length > 0x7fffffff) { $block_length = (0xffffffff - $block_length) + 1; } $bytes_read = sysread($fh, my $block_data, $block_length - 8); if ($bytes_read != $block_length - 8) { warnf('Could not read data block at 0x%x', $offset); return undef; } $data .= $block_data; } if (length($data) < $data_length) { warnf("Insufficient data blocks for data at 0x%x", $offset_to_data); return undef; } $data = substr($data, 0, $data_length); return $data; } else { $bytes_read = sysread($fh, $data, $data_length); if ($bytes_read != $data_length) { warnf("Could not read data at 0x%x", $offset_to_data); return undef; } } return $data; } sub get_data { my $self = shift; my $type = $self->get_type; my $data = $self->{_data}; return if !defined $data; # apply decoding to appropriate data types if ($type == REG_DWORD) { if (length($data) == 4) { $data = unpack('V', $data); } else { # incorrect length for dword data $data = undef; } } elsif ($type == REG_DWORD_BIG_ENDIAN) { if (length($data) == 4) { $data = unpack('N', $data); } else { # incorrect length for dword data $data = undef; } } elsif ($type == REG_SZ || $type == REG_EXPAND_SZ) { $data = decode('UCS-2LE', $data); # snip off any terminating null chop $data if substr($data, -1, 1) eq "\0"; } elsif ($type == REG_MULTI_SZ) { $data = decode('UCS-2LE', $data); # snip off any terminating nulls chop $data if substr($data, -1, 1) eq "\0"; chop $data if substr($data, -1, 1) eq "\0"; my @multi_sz = split("\0", $data, -1); # make sure there is at least one empty string @multi_sz = ('') if @multi_sz == 0; return wantarray ? @multi_sz : join($", @multi_sz); } return $data; } sub as_regedit_export { my $self = shift; my $version = shift || 5; my $name = $self->get_name; my $export = $name eq '' ? '@=' : '"' . $name . '"='; my $type = $self->get_type; # XXX # if (!defined $self->{_data}) { # $name = $name eq '' ? '@' : qq{"$name"}; # return qq{; $name=(invalid data)\n}; # } if ($type == REG_SZ) { $export .= '"' . $self->get_data . '"'; $export .= "\n"; } elsif ($type == REG_BINARY) { $export .= "hex:"; $export .= format_octets($self->{_data}, length($export)); } elsif ($type == REG_DWORD) { my $data = $self->get_data; $export .= defined($data) ? sprintf("dword:%08x", $data) : "dword:"; $export .= "\n"; } elsif ($type == REG_EXPAND_SZ || $type == REG_MULTI_SZ) { my $data = $version == 4 ? encode("ascii", $self->{_data}) # unicode->ascii : $self->{_data}; # raw data $export .= sprintf("hex(%x):", $type); $export .= format_octets($data, length($export)); } else { $export .= sprintf("hex(%x):", $type); $export .= format_octets($self->{_data}, length($export)); } return $export; } sub parse_info { my $self = shift; my $info = sprintf '0x%x vk len=0x%x alloc=%d "%s" type=%d', $self->{_offset}, $self->{_length}, $self->{_allocated}, $self->{_name}, $self->{_type}; if ($self->{_data_inline}) { $info .= sprintf ' data=inline,len=0x%x', $self->{_data_length}; } else { $info .= sprintf ' data=0x%x,len=0x%x', $self->{_offset_to_data}, $self->{_data_length}; } return $info; } 1; Parse-Win32Registry-1.0/lib/Parse/Win32Registry/WinNT/Entry.pm0000644000175000017500000000475511747213110023044 0ustar ownerownerpackage Parse::Win32Registry::WinNT::Entry; use strict; use warnings; use base qw(Parse::Win32Registry::Entry); use Carp; use Parse::Win32Registry::Base qw(:all); use Parse::Win32Registry::WinNT::Key; use Parse::Win32Registry::WinNT::Value; use Parse::Win32Registry::WinNT::Security; sub new { my $class = shift; my $regfile = shift; my $offset = shift; croak 'Missing registry file' if !defined $regfile; croak 'Missing offset' if !defined $offset; my $fh = $regfile->get_filehandle; sysseek($fh, $offset, 0); my $bytes_read = sysread($fh, my $entry_header, 8); if ($bytes_read != 8) { return; } my ($length, $tag) = unpack('Va2', $entry_header); my $allocated = 0; if ($length > 0x7fffffff) { $allocated = 1; $length = (0xffffffff - $length) + 1; } $tag = '' if $tag !~ /(nk|vk|lh|lf|li|ri|sk)/; if ($tag eq 'nk') { if (my $key = Parse::Win32Registry::WinNT::Key->new($regfile, $offset)) { $key->regenerate_path; return $key; } } elsif ($tag eq 'vk') { if (my $value = Parse::Win32Registry::WinNT::Value->new($regfile, $offset)) { return $value; } } elsif ($tag eq 'sk') { if (my $value = Parse::Win32Registry::WinNT::Security->new($regfile, $offset)) { return $value; } } my $self = {}; $self->{_regfile} = $regfile, $self->{_offset} = $offset, $self->{_length} = $length, $self->{_tag} = $tag, $self->{_allocated} = $allocated, bless $self, $class; return $self; } sub as_string { my $self = shift; my $tag = $self->{_tag}; if ($tag eq 'nk') { return '(key entry)'; } elsif ($tag eq 'vk') { return '(value entry)'; } elsif ($tag eq 'sk') { return '(security entry)'; } elsif ($tag =~ /(lh|lf|li|ri)/) { return '(subkey list entry)'; } return '(unidentified entry)'; } sub parse_info { my $self = shift; my $tag = $self->{_tag}; $tag = defined($tag) && $tag ne '' ? $tag . ' ' : '.. '; my $info = sprintf '0x%x %slen=0x%x alloc=%d', $self->{_offset}, $tag, $self->{_length}, $self->{_allocated}; return $info; } 1; Parse-Win32Registry-1.0/lib/Parse/Win32Registry/WinNT/File.pm0000644000175000017500000001704411747213110022615 0ustar ownerownerpackage Parse::Win32Registry::WinNT::File; use strict; use warnings; use base qw(Parse::Win32Registry::File); use Carp; use Encode; use File::Basename; use Parse::Win32Registry::Base qw(:all); use Parse::Win32Registry::WinNT::Key; use constant REGF_HEADER_LENGTH => 0x200; use constant OFFSET_TO_FIRST_HBIN => 0x1000; sub new { my $class = shift; my $filename = shift or croak "No filename specified"; open my $fh, '<', $filename or croak "Unable to open '$filename': $!"; # 0x00 dword = 'regf' signature # 0x04 dword = seq1 # 0x08 dword = seq2 # 0x0c qword = timestamp # 0x14 dword = major version # 0x18 dword = minor version # 0x1c dword = type (0 = registry file, 1 = log file) # 0x20 dword = (1) # 0x24 dword = offset to root key # 0x28 dword = total length of all hbins (excludes header) # 0x2c dword = (1) # 0x30 = embedded filename # Extracted offsets are always relative to first hbin my $bytes_read = sysread($fh, my $regf_header, REGF_HEADER_LENGTH); if ($bytes_read != REGF_HEADER_LENGTH) { warnf('Could not read registry file header'); return; } my ($regf_sig, $seq1, $seq2, $timestamp, $major_version, $minor_version, $type, $offset_to_root_key, $total_hbin_length, $embedded_filename, ) = unpack('a4VVa8VVVx4VVx4a64', $regf_header); $offset_to_root_key += OFFSET_TO_FIRST_HBIN; if ($regf_sig ne 'regf') { warnf('Invalid registry file signature'); return; } $embedded_filename = unpack('Z*', decode('UCS-2LE', $embedded_filename)); # The header checksum is the xor of the first 127 dwords. # The checksum is stored in the 128th dword, at offset 0x1fc (508). my $checksum = 0; foreach my $x (unpack('V127', $regf_header)) { $checksum ^= $x; } my $embedded_checksum = unpack('x508V', $regf_header); if ($checksum != $embedded_checksum) { warnf('Invalid checksum for registry file header'); } my $self = {}; $self->{_filehandle} = $fh; $self->{_filename} = $filename; $self->{_length} = (stat $fh)[7]; $self->{_offset_to_root_key} = $offset_to_root_key; $self->{_timestamp} = unpack_windows_time($timestamp); $self->{_embedded_filename} = $embedded_filename; $self->{_seq1} = $seq1; $self->{_seq2} = $seq2; $self->{_version} = "$major_version.$minor_version"; $self->{_type} = $type; $self->{_total_hbin_length} = $total_hbin_length; $self->{_embedded_checksum} = $embedded_checksum; $self->{_security_cache} = {}; # comment out to disable cache bless $self, $class; return $self; } sub get_root_key { my $self = shift; my $offset_to_root_key = $self->{_offset_to_root_key}; my $root_key = Parse::Win32Registry::WinNT::Key->new($self, $offset_to_root_key); return $root_key; } sub get_virtual_root_key { my $self = shift; my $fake_root = shift; my $root_key = $self->get_root_key; return if !defined $root_key; if (!defined $fake_root) { # guess virtual root from filename my $filename = basename $self->{_filename}; if ($filename =~ /NTUSER/i) { $fake_root = 'HKEY_CURRENT_USER'; } elsif ($filename =~ /USRCLASS/i) { $fake_root = 'HKEY_CLASSES_ROOT'; } elsif ($filename =~ /SOFTWARE/i) { $fake_root = 'HKEY_LOCAL_MACHINE\SOFTWARE'; } elsif ($filename =~ /SYSTEM/i) { $fake_root = 'HKEY_LOCAL_MACHINE\SYSTEM'; } elsif ($filename =~ /SAM/i) { $fake_root = 'HKEY_LOCAL_MACHINE\SAM'; } elsif ($filename =~ /SECURITY/i) { $fake_root = 'HKEY_LOCAL_MACHINE\SECURITY'; } else { $fake_root = 'HKEY_UNKNOWN'; } } $root_key->{_name} = $fake_root; $root_key->{_key_path} = $fake_root; return $root_key; } sub get_timestamp { my $self = shift; return $self->{_timestamp}; } sub get_timestamp_as_string { my $self = shift; return iso8601($self->{_timestamp}); } sub get_embedded_filename { my $self = shift; return $self->{_embedded_filename}; } sub get_block_iterator { my $self = shift; my $offset_to_next_hbin = OFFSET_TO_FIRST_HBIN; my $end_of_file = $self->{_length}; return Parse::Win32Registry::Iterator->new(sub { if ($offset_to_next_hbin > $end_of_file) { return; # no more hbins } if (my $hbin = Parse::Win32Registry::WinNT::Hbin->new($self, $offset_to_next_hbin)) { return unless $hbin->get_length > 0; $offset_to_next_hbin += $hbin->get_length; return $hbin; } else { return; # no more hbins } }); } *get_hbin_iterator = \&get_block_iterator; sub _dump_security_cache { my $self = shift; if (defined(my $cache = $self->{_security_cache})) { foreach my $offset (sort { $a <=> $b } keys %$cache) { my $security = $cache->{$offset}; printf '0x%x %s\n', $offset, $security->as_string; } } } package Parse::Win32Registry::WinNT::Hbin; use strict; use warnings; use base qw(Parse::Win32Registry::Entry); use Carp; use Parse::Win32Registry::Base qw(:all); use Parse::Win32Registry::WinNT::Entry; use constant HBIN_HEADER_LENGTH => 0x20; sub new { my $class = shift; my $regfile = shift; my $offset = shift; croak 'Missing registry file' if !defined $regfile; croak 'Missing offset' if !defined $offset; my $fh = $regfile->get_filehandle; # 0x00 dword = 'hbin' signature # 0x04 dword = offset from first hbin to this hbin # 0x08 dword = length of this hbin / relative offset to next hbin # 0x14 qword = timestamp (first hbin only) # Extracted offsets are always relative to first hbin sysseek($fh, $offset, 0); my $bytes_read = sysread($fh, my $hbin_header, HBIN_HEADER_LENGTH); if ($bytes_read != HBIN_HEADER_LENGTH) { return; } my ($sig, $offset_to_hbin, $length, $timestamp) = unpack('a4VVx8a8x4', $hbin_header); if ($sig ne 'hbin') { return; } my $self = {}; $self->{_regfile} = $regfile; $self->{_offset} = $offset; $self->{_length} = $length; $self->{_header_length} = HBIN_HEADER_LENGTH; $self->{_allocated} = 1; $self->{_tag} = $sig; $self->{_timestamp} = unpack_windows_time($timestamp); bless $self, $class; return $self; } sub get_timestamp { my $self = shift; return $self->{_timestamp}; } sub get_timestamp_as_string { my $self = shift; return iso8601($self->{_timestamp}); } sub get_entry_iterator { my $self = shift; my $regfile = $self->{_regfile}; my $offset = $self->{_offset}; my $length = $self->{_length}; my $offset_to_next_entry = $offset + HBIN_HEADER_LENGTH; my $end_of_hbin = $offset + $length; return Parse::Win32Registry::Iterator->new(sub { if ($offset_to_next_entry >= $end_of_hbin) { return; # no more entries } if (my $entry = Parse::Win32Registry::WinNT::Entry->new($regfile, $offset_to_next_entry)) { return unless $entry->get_length > 0; $offset_to_next_entry += $entry->get_length; return $entry; } else { return; # no more entries } }); } 1; Parse-Win32Registry-1.0/lib/Parse/Win32Registry/WinNT/Security.pm0000644000175000017500000000772711747213110023554 0ustar ownerownerpackage Parse::Win32Registry::WinNT::Security; use strict; use warnings; use base qw(Parse::Win32Registry::Entry); use Carp; use Parse::Win32Registry::Base qw(:all); use constant SK_HEADER_LENGTH => 0x18; use constant OFFSET_TO_FIRST_HBIN => 0x1000; sub new { my $class = shift; my $regfile = shift; my $offset = shift; # offset to sk record relative to start of file croak 'Missing registry file' if !defined $regfile; croak 'Missing offset' if !defined $offset; if (defined(my $cache = $regfile->{_security_cache})) { if (exists $cache->{$offset}) { return $cache->{$offset}; } } my $fh = $regfile->get_filehandle; # 0x00 dword = security length (negative = allocated) # 0x04 word = 'sk' signature # 0x08 dword = offset to previous sk # 0x0c dword = offset to next sk # 0x10 dword = ref count # 0x14 dword = length of security descriptor # 0x18 = start of security descriptor # Extracted offsets are always relative to first hbin sysseek($fh, $offset, 0); my $bytes_read = sysread($fh, my $sk_header, SK_HEADER_LENGTH); if ($bytes_read != SK_HEADER_LENGTH) { warnf('Could not read security at 0x%x', $offset); return; } my ($length, $sig, $offset_to_previous, $offset_to_next, $ref_count, $sd_length, ) = unpack('Va2x2VVVV', $sk_header); $offset_to_previous += OFFSET_TO_FIRST_HBIN if $offset_to_previous != 0xffffffff; $offset_to_next += OFFSET_TO_FIRST_HBIN if $offset_to_next != 0xffffffff; my $allocated = 0; if ($length > 0x7fffffff) { $allocated = 1; $length = (0xffffffff - $length) + 1; } # allocated should be true if ($sig ne 'sk') { warnf('Invalid signature for security at 0x%x', $offset); return; } $bytes_read = sysread($fh, my $sd_data, $sd_length); if ($bytes_read != $sd_length) { warnf('Could not read security descriptor for security at 0x%x', $offset); return; } my $sd = unpack_security_descriptor($sd_data); if (!defined $sd) { warnf('Invalid security descriptor for security at 0x%x', $offset); # Abandon security object if security descriptor is invalid return; } my $self = {}; $self->{_regfile} = $regfile; $self->{_offset} = $offset; $self->{_length} = $length; $self->{_allocated} = $allocated; $self->{_tag} = $sig; $self->{_offset_to_previous} = $offset_to_previous; $self->{_offset_to_next} = $offset_to_next; $self->{_ref_count} = $ref_count; $self->{_security_descriptor_length} = $sd_length; $self->{_security_descriptor} = $sd; bless $self, $class; if (defined(my $cache = $regfile->{_security_cache})) { $cache->{$offset} = $self; } return $self; } sub get_previous { my $self = shift; my $regfile = $self->{_regfile}; my $offset_to_previous = $self->{_offset_to_previous}; return Parse::Win32Registry::WinNT::Security->new($regfile, $offset_to_previous); } sub get_next { my $self = shift; my $regfile = $self->{_regfile}; my $offset_to_next = $self->{_offset_to_next}; return Parse::Win32Registry::WinNT::Security->new($regfile, $offset_to_next); } sub get_reference_count { my $self = shift; return $self->{_ref_count}; } sub get_security_descriptor { my $self = shift; return $self->{_security_descriptor}; } sub as_string { my $self = shift; return '(security entry)'; } sub parse_info { my $self = shift; my $info = sprintf '0x%x sk len=0x%x alloc=%d prev=0x%x,next=0x%x refs=%d', $self->{_offset}, $self->{_length}, $self->{_allocated}, $self->{_offset_to_previous}, $self->{_offset_to_next}, $self->{_ref_count}; return $info; } 1; Parse-Win32Registry-1.0/lib/Parse/Win32Registry/WinNT/Key.pm0000644000175000017500000003160411747213110022464 0ustar ownerownerpackage Parse::Win32Registry::WinNT::Key; use strict; use warnings; use base qw(Parse::Win32Registry::Key); use Carp; use Encode; use Parse::Win32Registry::Base qw(:all); use Parse::Win32Registry::WinNT::Value; use Parse::Win32Registry::WinNT::Security; use constant NK_HEADER_LENGTH => 0x50; use constant OFFSET_TO_FIRST_HBIN => 0x1000; sub new { my $class = shift; my $regfile = shift; my $offset = shift; # offset to nk record relative to start of file my $parent_key_path = shift; # parent key path (optional) croak 'Missing registry file' if !defined $regfile; croak 'Missing offset' if !defined $offset; my $fh = $regfile->get_filehandle; # 0x00 dword = key length (negative = allocated) # 0x04 word = 'nk' signature # 0x06 word = flags # 0x08 qword = timestamp # 0x10 # 0x14 dword = offset to parent # 0x18 dword = number of subkeys # 0x1c # 0x20 dword = offset to subkey list (lf, lh, ri, li) # 0x24 # 0x28 dword = number of values # 0x2c dword = offset to value list # 0x30 dword = offset to security # 0x34 dword = offset to class name # 0x38 dword = max subkey name length # 0x3c dword = max class name length # 0x40 dword = max value name length # 0x44 dword = max value data length # 0x48 # 0x4c word = key name length # 0x4e word = class name length # 0x50 = key name [for key name length bytes] # Extracted offsets are always relative to first hbin sysseek($fh, $offset, 0); my $bytes_read = sysread($fh, my $nk_header, NK_HEADER_LENGTH); if ($bytes_read != NK_HEADER_LENGTH) { warnf('Could not read key at 0x%x', $offset); return; } my ($length, $sig, $flags, $timestamp, $offset_to_parent, $num_subkeys, $offset_to_subkey_list, $num_values, $offset_to_value_list, $offset_to_security, $offset_to_class_name, $name_length, $class_name_length, ) = unpack('Va2va8x4VVx4Vx4VVVVx20vv', $nk_header); $offset_to_parent += OFFSET_TO_FIRST_HBIN if $offset_to_parent != 0xffffffff; $offset_to_subkey_list += OFFSET_TO_FIRST_HBIN if $offset_to_subkey_list != 0xffffffff; $offset_to_value_list += OFFSET_TO_FIRST_HBIN if $offset_to_value_list != 0xffffffff; $offset_to_security += OFFSET_TO_FIRST_HBIN if $offset_to_security != 0xffffffff; $offset_to_class_name += OFFSET_TO_FIRST_HBIN if $offset_to_class_name != 0xffffffff; my $allocated = 0; if ($length > 0x7fffffff) { $allocated = 1; $length = (0xffffffff - $length) + 1; } # allocated should be true if ($length < NK_HEADER_LENGTH) { warnf('Invalid value entry length at 0x%x', $offset); return; } if ($sig ne 'nk') { warnf('Invalid signature for key at 0x%x', $offset); return; } $bytes_read = sysread($fh, my $name, $name_length); if ($bytes_read != $name_length) { warnf('Could not read name for key at 0x%x', $offset); return; } if ($flags & 0x20) { $name = decode($Parse::Win32Registry::Base::CODEPAGE, $name); } else { $name = decode('UCS-2LE', $name); } my $key_path = (defined $parent_key_path) ? "$parent_key_path\\$name" : "$name"; my $class_name; if ($offset_to_class_name != 0xffffffff) { sysseek($fh, $offset_to_class_name + 4, 0); $bytes_read = sysread($fh, $class_name, $class_name_length); if ($bytes_read != $class_name_length) { warnf('Could not read class name at 0x%x', $offset_to_class_name); $class_name = undef; } else { $class_name = decode('UCS-2LE', $class_name); } } my $self = {}; $self->{_regfile} = $regfile; $self->{_offset} = $offset; $self->{_length} = $length; $self->{_allocated} = $allocated; $self->{_tag} = $sig; $self->{_name} = $name; $self->{_name_length} = $name_length; $self->{_key_path} = $key_path; $self->{_flags} = $flags; $self->{_offset_to_parent} = $offset_to_parent; $self->{_num_subkeys} = $num_subkeys; $self->{_offset_to_subkey_list} = $offset_to_subkey_list; $self->{_num_values} = $num_values; $self->{_offset_to_value_list} = $offset_to_value_list; $self->{_timestamp} = unpack_windows_time($timestamp); $self->{_offset_to_security} = $offset_to_security; $self->{_offset_to_class_name} = $offset_to_class_name; $self->{_class_name_length} = $class_name_length; $self->{_class_name} = $class_name; bless $self, $class; return $self; } sub get_timestamp { my $self = shift; return $self->{_timestamp}; } sub get_timestamp_as_string { my $self = shift; return iso8601($self->get_timestamp); } sub get_class_name { my $self = shift; return $self->{_class_name}; } sub is_root { my $self = shift; my $flags = $self->{_flags}; return $flags & 4 || $flags & 8; } sub get_parent { my $self = shift; my $regfile = $self->{_regfile}; my $offset_to_parent = $self->{_offset_to_parent}; my $key_path = $self->{_key_path}; return if $self->is_root; my $grandparent_key_path; my @keys = split /\\/, $key_path, -1; if (@keys > 2) { $grandparent_key_path = join('\\', @keys[0..$#keys-2]); } return Parse::Win32Registry::WinNT::Key->new($regfile, $offset_to_parent, $grandparent_key_path); } sub get_security { my $self = shift; my $regfile = $self->{_regfile}; my $offset_to_security = $self->{_offset_to_security}; my $key_path = $self->{_key_path}; if ($offset_to_security == 0xffffffff) { return; } return Parse::Win32Registry::WinNT::Security->new($regfile, $offset_to_security, $key_path); } sub as_string { my $self = shift; my $string = $self->get_path . ' [' . $self->get_timestamp_as_string . ']'; return $string; } sub parse_info { my $self = shift; my $info = sprintf '0x%x nk len=0x%x alloc=%d "%s" par=0x%x keys=%d,0x%x vals=%d,0x%x sec=0x%x class=0x%x', $self->{_offset}, $self->{_length}, $self->{_allocated}, $self->{_name}, $self->{_offset_to_parent}, $self->{_num_subkeys}, $self->{_offset_to_subkey_list}, $self->{_num_values}, $self->{_offset_to_value_list}, $self->{_offset_to_security}, $self->{_offset_to_class_name}; if (defined $self->{_class_name}) { $info .= sprintf ',len=0x%x', $self->{_class_name_length}; } return $info; } sub _get_offsets_to_subkeys { my $self = shift; # Offset is passed as a parameter for recursive lists such as 'ri' my $offset_to_subkey_list = shift || $self->{_offset_to_subkey_list}; my $regfile = $self->{_regfile}; my $fh = $regfile->get_filehandle; return if $offset_to_subkey_list == 0xffffffff || $self->{_num_subkeys} == 0; sysseek($fh, $offset_to_subkey_list, 0); my $bytes_read = sysread($fh, my $subkey_list_header, 8); if ($bytes_read != 8) { warnf('Could not read subkey list header at 0x%x', $offset_to_subkey_list); return; } # 0x00 dword = subkey list length (negative = allocated) # 0x04 word = 'lf' signature # 0x06 word = number of entries # 0x08 dword = offset to 1st subkey # 0x0c dword = first four characters of the key name # 0x10 dword = offset to 2nd subkey # 0x14 dword = first four characters of the key name # ... # 0x00 dword = subkey list length (negative = allocated) # 0x04 word = 'lh' signature # 0x06 word = number of entries # 0x08 dword = offset to 1st subkey # 0x0c dword = hash of the key name # 0x10 dword = offset to 2nd subkey # 0x14 dword = hash of the key name # ... # 0x00 dword = subkey list length (negative = allocated) # 0x04 word = 'ri' signature # 0x06 word = number of entries in ri list # 0x08 dword = offset to 1st lf/lh/li list # 0x0c dword = offset to 2nd lf/lh/li list # 0x10 dword = offset to 3rd lf/lh/li list # ... # 0x00 dword = subkey list length (negative = allocated) # 0x04 word = 'li' signature # 0x06 word = number of entries in li list # 0x08 dword = offset to 1st subkey # 0x0c dword = offset to 2nd subkey # ... # Extracted offsets are always relative to first hbin my @offsets_to_subkeys = (); my ($length, $sig, $num_entries, ) = unpack('Va2v', $subkey_list_header); my $subkey_list_length; if ($sig eq 'lf' || $sig eq 'lh') { $subkey_list_length = 2 * 4 * $num_entries; } elsif ($sig eq 'ri' || $sig eq 'li') { $subkey_list_length = 4 * $num_entries; } else { warnf('Invalid signature for subkey list at 0x%x', $offset_to_subkey_list); return; } $bytes_read = sysread($fh, my $subkey_list, $subkey_list_length); if ($bytes_read != $subkey_list_length) { warnf('Could not read subkey list at 0x%x', $offset_to_subkey_list); return; } if ($sig eq 'lf') { foreach my $offset (unpack("(Vx4)$num_entries", $subkey_list)) { push @offsets_to_subkeys, OFFSET_TO_FIRST_HBIN + $offset; } } elsif ($sig eq 'lh') { foreach my $offset (unpack("(Vx4)$num_entries", $subkey_list)) { push @offsets_to_subkeys, OFFSET_TO_FIRST_HBIN + $offset; } } elsif ($sig eq 'ri') { foreach my $offset (unpack("V$num_entries", $subkey_list)) { my $offsets_ref = $self->_get_offsets_to_subkeys(OFFSET_TO_FIRST_HBIN + $offset); if (defined $offsets_ref && ref $offsets_ref eq 'ARRAY') { push @offsets_to_subkeys, @{ $offsets_ref }; } } } elsif ($sig eq 'li') { foreach my $offset (unpack("V$num_entries", $subkey_list)) { push @offsets_to_subkeys, OFFSET_TO_FIRST_HBIN + $offset; } } return \@offsets_to_subkeys; } sub get_subkey_iterator { my $self = shift; my $regfile = $self->{_regfile}; my $key_path = $self->{_key_path}; my @offsets_to_subkeys = (); if ($self->{_num_subkeys} > 0) { my $offsets_to_subkeys_ref = $self->_get_offsets_to_subkeys; if (defined $offsets_to_subkeys_ref) { @offsets_to_subkeys = @{$self->_get_offsets_to_subkeys}; } } return Parse::Win32Registry::Iterator->new(sub { while (defined(my $offset_to_subkey = shift @offsets_to_subkeys)) { my $subkey = Parse::Win32Registry::WinNT::Key->new($regfile, $offset_to_subkey, $key_path); if (defined $subkey) { return $subkey; } } return; # no more offsets to subkeys }); } sub _get_offsets_to_values { my $self = shift; my $regfile = $self->{_regfile}; my $fh = $regfile->get_filehandle; my $offset_to_value_list = $self->{_offset_to_value_list}; my $num_values = $self->{_num_values}; return if $num_values == 0; # Actually, this could probably just fall through # as unpack("x4V0", ...) would return an empty array. my @offsets_to_values = (); # 0x00 dword = value list length (negative = allocated) # 0x04 dword = 1st offset # 0x08 dword = 2nd offset # ... # Extracted offsets are always relative to first hbin sysseek($fh, $offset_to_value_list, 0); my $value_list_length = 0x4 + $num_values * 4; my $bytes_read = sysread($fh, my $value_list, $value_list_length); if ($bytes_read != $value_list_length) { warnf("Could not read value list at 0x%x", $offset_to_value_list); return; } foreach my $offset (unpack("x4V$num_values", $value_list)) { push @offsets_to_values, OFFSET_TO_FIRST_HBIN + $offset; } return \@offsets_to_values; } sub get_value_iterator { my $self = shift; my $regfile = $self->{_regfile}; my $key_path = $self->{_key_path}; my @offsets_to_values = (); if ($self->{_num_values} > 0) { my $offsets_to_values_ref = $self->_get_offsets_to_values; if (defined $offsets_to_values_ref) { @offsets_to_values = @{$self->_get_offsets_to_values}; } } return Parse::Win32Registry::Iterator->new(sub { while (defined(my $offset_to_value = shift @offsets_to_values)) { my $value = Parse::Win32Registry::WinNT::Value->new($regfile, $offset_to_value); if (defined $value) { return $value; } } return; # no more offsets to values }); } 1; Parse-Win32Registry-1.0/lib/Parse/Win32Registry/Base.pm0000644000175000017500000006526111747213110021615 0ustar ownerownerpackage Parse::Win32Registry::Base; use strict; use warnings; use base qw(Exporter); use Carp; use Encode; use Time::Local qw(timegm); our @EXPORT_OK = qw( warnf iso8601 hexdump format_octets unpack_windows_time unpack_string unpack_unicode_string unpack_guid unpack_sid unpack_ace unpack_acl unpack_security_descriptor unpack_series make_multiple_subkey_iterator make_multiple_value_iterator make_multiple_subtree_iterator compare_multiple_keys compare_multiple_values REG_NONE REG_SZ REG_EXPAND_SZ REG_BINARY REG_DWORD REG_DWORD_BIG_ENDIAN REG_LINK REG_MULTI_SZ REG_RESOURCE_LIST REG_FULL_RESOURCE_DESCRIPTOR REG_RESOURCE_REQUIREMENTS_LIST REG_QWORD ); our %EXPORT_TAGS = ( all => [@EXPORT_OK], ); use constant REG_NONE => 0; use constant REG_SZ => 1; use constant REG_EXPAND_SZ => 2; use constant REG_BINARY => 3; use constant REG_DWORD => 4; use constant REG_DWORD_BIG_ENDIAN => 5; use constant REG_LINK => 6; use constant REG_MULTI_SZ => 7; use constant REG_RESOURCE_LIST => 8; use constant REG_FULL_RESOURCE_DESCRIPTOR => 9; use constant REG_RESOURCE_REQUIREMENTS_LIST => 10; use constant REG_QWORD => 11; our $WARNINGS = 0; our $CODEPAGE = 'cp1252'; sub warnf { my $message = shift; warn sprintf "$message\n", @_ if $WARNINGS; } sub hexdump { my $data = shift; # packed binary data my $start = shift || 0; # starting value for displayed offset return '' if !defined($data); my $output = ''; my $fake_start = $start & ~0xf; my $end = length($data); my $pos = 0; if ($fake_start < $start) { $output .= sprintf '%8x ', $fake_start; my $indent = $start - $fake_start; $output .= ' ' x $indent; my $row = substr($data, $pos, 16 - $indent); my $len = length($row); $output .= join(' ', unpack('H2' x $len, $row)); if ($indent + $len < 16) { my $padding = 16 - $len - $indent; $output .= ' ' x $padding; } $output .= ' '; $output .= ' ' x $indent; $row =~ tr/\x20-\x7e/./c; $output .= $row; $output .= "\n"; $pos += $len; } while ($pos < $end) { $output .= sprintf '%8x ', $start + $pos; my $row = substr($data, $pos, 16); my $len = length($row); $output .= join(' ', unpack('H2' x $len, $row)); if ($len < 16) { my $padding = 16 - $len; $output .= ' ' x $padding; } $output .= ' '; $row =~ tr/\x20-\x7e/./c; $output .= $row; $output .= "\n"; $pos += 16; } return $output; } sub format_octets { my $data = shift; # packed binary data my $col = shift || 0; # starting column, e.g. length of initial string return "\n" if !defined($data); my $output = ''; $col = 76 if $col > 76; my $max_octets = int((76 - $col) / 3) + 1; my $end = length($data); my $pos = 0; my $num_octets = $end - $pos; $num_octets = $max_octets if $num_octets > $max_octets; while ($pos < $end) { $output .= join(',', unpack("x$pos(H2)$num_octets", $data)); $pos += $num_octets; $num_octets = $end - $pos; $num_octets = 25 if $num_octets > 25; if ($num_octets > 0) { $output .= ",\\\n "; } } $output .= "\n"; return $output; } sub unpack_windows_time { my $data = shift; if (!defined $data) { return; } if (length($data) < 8) { return; } # The conversion uses real numbers # as 32-bit perl does not provide 64-bit integers. # The equation can be found in several places on the Net. # My thanks go to Dan Sully for Audio::WMA's _fileTimeToUnixTime # which shows a perl implementation of it. my ($low, $high) = unpack("VV", $data); my $filetime = $high * 2 ** 32 + $low; my $epoch_time = int(($filetime - 116444736000000000) / 10000000); # adjust the UNIX epoch time to the local OS's epoch time # (see perlport's Time and Date section) my $epoch_offset = timegm(0, 0, 0, 1, 0, 70); $epoch_time += $epoch_offset; if ($epoch_time < 0 || $epoch_time > 0x7fffffff) { $epoch_time = undef; } return wantarray ? ($epoch_time, 8) : $epoch_time; } sub iso8601 { my $time = shift; my $tz = shift; if (!defined $time) { return '(undefined)'; } if (!defined $tz || $tz ne 'Z') { $tz = 'Z' } # On Windows, gmtime will return undef if $time < 0 or > 0x7fffffff if ($time < 0 || $time > 0x7fffffff) { return '(undefined)'; } my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime $time; # The final 'Z' indicates UTC ("zero meridian") return sprintf '%04d-%02d-%02dT%02d:%02d:%02d%s', 1900+$year, 1+$mon, $mday, $hour, $min, $sec, $tz; } sub unpack_string { my $data = shift; if (!defined $data) { return; } my $str; my $str_len; if ((my $end = index($data, "\0")) != -1) { $str = substr($data, 0, $end); $str_len = $end + 1; # include the final null in the length } else { $str = $data; $str_len = length($data); } return wantarray ? ($str, $str_len) : $str; } sub unpack_unicode_string { my $data = shift; if (!defined $data) { return; } my $str_len = 0; foreach my $v (unpack('v*', $data)) { $str_len += 2; last if $v == 0; # include the final null in the length } my $str = decode('UCS-2LE', substr($data, 0, $str_len)); # The decode function from Encode may create invalid unicode characters # which cause subsequent warnings (e.g. during regex matching). # For example, characters in the 0xd800 to 0xdfff range of the # basic multilingual plane (0x0000 to 0xffff) are 'surrogate pairs' # and are expected to appear as a 'high surrogate' (0xd800 to 0xdbff) # followed by a 'low surrogate' (0xdc00 to 0xdfff). # remove any final null if (length($str) > 0 && substr($str, -1, 1) eq "\0") { chop $str; } return wantarray ? ($str, $str_len) : $str; } sub unpack_guid { my $guid = Parse::Win32Registry::GUID->new($_[0]); return if !defined $guid; return wantarray ? ($guid, $guid->get_length) : $guid; } sub unpack_sid { my $sid = Parse::Win32Registry::SID->new($_[0]); return if !defined $sid; return wantarray ? ($sid, $sid->get_length) : $sid; } sub unpack_ace { my $ace = Parse::Win32Registry::ACE->new($_[0]); return if !defined $ace; return wantarray ? ($ace, $ace->get_length) : $ace; } sub unpack_acl { my $acl = Parse::Win32Registry::ACL->new($_[0]); return if !defined $acl; return wantarray ? ($acl, $acl->get_length) : $acl; } sub unpack_security_descriptor { my $sd = Parse::Win32Registry::SecurityDescriptor->new($_[0]); return if !defined $sd; return wantarray ? ($sd, $sd->get_length) : $sd; } sub unpack_series { my $function = shift; my $data = shift; if (!defined $function || !defined $data) { croak "Usage: unpack_series(\\\&unpack_function, \$data)"; } my $pos = 0; my @items = (); while (my ($item, $item_len) = $function->(substr($data, $pos))) { push @items, $item; $pos += $item_len; } return @items; } sub make_multiple_subkey_iterator { my @keys = @_; # check @keys contains keys if (@keys == 0 || grep { defined && !UNIVERSAL::isa($_, 'Parse::Win32Registry::Key') } @keys) { croak 'Usage: make_multiple_subkey_iterator($key1, $key2, ...)'; } my %subkeys_seen = (); my @subkeys_queue; for (my $i = 0; $i < @keys; $i++) { my $key = $keys[$i]; next if !defined $key; foreach my $subkey ($key->get_list_of_subkeys) { my $name = $subkey->get_name; $subkeys_seen{$name}[$i] = $subkey; } } foreach my $name (sort keys %subkeys_seen) { # make sure number of subkeys matches number of keys if (@{$subkeys_seen{$name}} != @keys) { @{$subkeys_seen{$name}}[@keys - 1] = undef; } push @subkeys_queue, $subkeys_seen{$name}; } return Parse::Win32Registry::Iterator->new(sub { my $subkeys = shift @subkeys_queue; if (defined $subkeys) { return $subkeys; } else { return; } }); } sub make_multiple_value_iterator { my @keys = @_; # check @keys contains keys if (@keys == 0 || grep { defined && !UNIVERSAL::isa($_, 'Parse::Win32Registry::Key') } @keys) { croak 'Usage: make_multiple_value_iterator($key1, $key2, ...)'; } my %values_seen = (); my @values_queue; for (my $i = 0; $i < @keys; $i++) { my $key = $keys[$i]; next if !defined $key; foreach my $value ($key->get_list_of_values) { my $name = $value->get_name; $values_seen{$name}[$i] = $value; } } foreach my $name (sort keys %values_seen) { # make sure number of values matches number of keys if (@{$values_seen{$name}} != @keys) { @{$values_seen{$name}}[@keys - 1] = undef; } push @values_queue, $values_seen{$name}; } return Parse::Win32Registry::Iterator->new(sub { my $values = shift @values_queue; if (defined $values) { return $values; } else { return; } }); } sub make_multiple_subtree_iterator { my @keys = @_; # check @keys contains keys if (@keys == 0 || grep { defined && !UNIVERSAL::isa($_, 'Parse::Win32Registry::Key') } @keys) { croak 'Usage: make_multiple_subtree_iterator($key1, $key2, ...)'; } my @start_keys = (\@keys); push my (@subkey_iters), Parse::Win32Registry::Iterator->new(sub { return shift @start_keys; }); my $value_iter; my $subkeys; # used to remember subkeys while iterating values return Parse::Win32Registry::Iterator->new(sub { if (defined $value_iter && wantarray) { my $values = $value_iter->(); if (defined $values) { return ($subkeys, $values); } } while (@subkey_iters > 0) { $subkeys = $subkey_iters[-1]->(); # depth-first if (defined $subkeys) { push @subkey_iters, make_multiple_subkey_iterator(@$subkeys); $value_iter = make_multiple_value_iterator(@$subkeys); return $subkeys; } pop @subkey_iters; # iter finished, so remove it } return; }); } sub compare_multiple_keys { my @keys = @_; # check @keys contains keys if (@keys == 0 || grep { defined && !UNIVERSAL::isa($_, 'Parse::Win32Registry::Key') } @keys) { croak 'Usage: compare_multiple_keys($key1, $key2, ...)'; } my @changes = (); my $benchmark_key; foreach my $key (@keys) { my $diff = ''; # Skip comparison for the first value if (@changes > 0) { $diff = _compare_keys($benchmark_key, $key); } $benchmark_key = $key; push @changes, $diff; } return @changes; } sub compare_multiple_values { my @values = @_; # check @values contains values if (@values == 0 || grep { defined && !UNIVERSAL::isa($_, 'Parse::Win32Registry::Value') } @values) { croak 'Usage: compare_multiple_values($value1, $value2, ...)'; } my @changes = (); my $benchmark_value; foreach my $value (@values) { my $diff = ''; # Skip comparison for the first value if (@changes > 0) { $diff = _compare_values($benchmark_value, $value); } $benchmark_value = $value; push @changes, $diff; } return @changes; } sub _compare_keys { my ($key1, $key2) = @_; if (!defined $key1 && !defined $key2) { return ''; # 'MISSING' } elsif (defined $key1 && !defined $key2) { return 'DELETED'; } elsif (!defined $key1 && defined $key2) { return 'ADDED'; } my $timestamp1 = $key1->get_timestamp; my $timestamp2 = $key2->get_timestamp; if ($key1->get_name ne $key2->get_name) { return 'CHANGED'; } elsif (defined $timestamp1 && defined $timestamp2) { if ($timestamp1 < $timestamp2) { return 'NEWER'; } elsif ($timestamp1 > $timestamp2) { return 'OLDER'; } } else { return ''; # comment out to check values... my $value_iter = make_multiple_value_iterator($key1, $key2); while (my ($val1, $val2) = $value_iter->get_next) { if (_compare_values($val1, $val2) ne '') { return 'VALUES'; } } return ''; } } sub _compare_values { my ($val1, $val2) = @_; if (!defined $val1 && !defined $val2) { return ''; # 'MISSING' } elsif (defined $val1 && !defined $val2) { return 'DELETED'; } elsif (!defined $val1 && defined $val2) { return 'ADDED'; } my $data1 = $val1->get_data; my $data2 = $val2->get_data; if ($val1->get_name ne $val2->get_name || $val1->get_type != $val2->get_type || defined $data1 ne defined $data2 || (defined $data1 && defined $data2 && $data1 ne $data2)) { return 'CHANGED'; } else { return ''; } } package Parse::Win32Registry::Iterator; use Carp; sub new { my $class = shift; my $self = shift; my $type = ref $self; croak 'Missing iterator subroutine' if $type ne 'CODE' && $type ne __PACKAGE__; bless $self, $class; return $self; } sub get_next { $_[0]->(); } package Parse::Win32Registry::GUID; sub new { my $class = shift; my $data = shift; if (!defined $data) { return; } if (length($data) < 16) { return; } my $guid = sprintf '{%08X-%04X-%04X-%02X%02X-%02X%02X%02X%02X%02X%02X}', unpack('VvvC2C6', $data); my $self = { _guid => $guid, _length => 16, }; bless $self, $class; return $self; } sub as_string { my $self = shift; return $self->{_guid}; } sub get_length { my $self = shift; return $self->{_length}; } package Parse::Win32Registry::SID; sub new { my $class = shift; my $data = shift; if (!defined $data) { return; } # 0x00 byte = revision # 0x01 byte = number of sub authorities # 0x07 byte = identifier authority # 0x08 dword = 1st sub authority # 0x0c dword = 2nd sub authority # ... if (length($data) < 8) { return; } my ($rev, $num_sub_auths, $id_auth) = unpack('CCx5C', $data); if ($num_sub_auths == 0) { return; } my $sid_len = 8 + 4 * $num_sub_auths; if (length($data) < $sid_len) { return; } my @sub_auths = unpack("x8V$num_sub_auths", $data); my $sid = "S-$rev-$id_auth-" . join('-', @sub_auths); my $self = { _sid => $sid, _length => $sid_len, }; bless $self, $class; return $self; } # See KB243330 for a list of well known sids our %WellKnownSids = ( 'S-1-0-0' => 'Nobody', 'S-1-1-0' => 'Everyone', 'S-1-3-0' => 'Creator Owner', 'S-1-3-1' => 'Creator Group', 'S-1-3-2' => 'Creator Owner Server', 'S-1-3-3' => 'Creator Group Server', 'S-1-5-1' => 'Dialup', 'S-1-5-2' => 'Network', 'S-1-5-3' => 'Batch', 'S-1-5-4' => 'Interactive', 'S-1-5-5-\\d+-\\d+' => 'Logon Session', 'S-1-5-6' => 'Service', 'S-1-5-7' => 'Anonymous', 'S-1-5-8' => 'Proxy', 'S-1-5-9' => 'Enterprise Domain Controllers', 'S-1-5-10' => 'Principal Self', 'S-1-5-11' => 'Authenticated Users', 'S-1-5-12' => 'Restricted Code', 'S-1-5-13' => 'Terminal Server Users', 'S-1-5-18' => 'Local System', 'S-1-5-19' => 'Local Service', 'S-1-5-20' => 'Network Service', 'S-1-5-\\d+-\\d+-\\d+-\\d+-500' => 'Administrator', 'S-1-5-\\d+-\\d+-\\d+-\\d+-501' => 'Guest', 'S-1-5-\\d+-\\d+-\\d+-\\d+-502' => 'KRBTGT', 'S-1-5-\\d+-\\d+-\\d+-\\d+-512' => 'Domain Admins', 'S-1-5-\\d+-\\d+-\\d+-\\d+-513' => 'Domain Users', 'S-1-5-\\d+-\\d+-\\d+-\\d+-514' => 'Domain Guests', 'S-1-5-\\d+-\\d+-\\d+-\\d+-515' => 'Domain Computers', 'S-1-5-\\d+-\\d+-\\d+-\\d+-516' => 'Domain Controllers', 'S-1-5-\\d+-\\d+-\\d+-\\d+-517' => 'Cert Publishers', 'S-1-5-\\d+-\\d+-\\d+-\\d+-518' => 'Schema Admins', 'S-1-5-\\d+-\\d+-\\d+-\\d+-519' => 'Enterprise Admins', 'S-1-5-\\d+-\\d+-\\d+-\\d+-520' => 'Group Policy Creator Owners', 'S-1-5-\\d+-\\d+-\\d+-\\d+-533' => 'RAS and IAS Servers', 'S-1-5-32-544' => 'Administrators', 'S-1-5-32-545' => 'Users', 'S-1-5-32-546' => 'Guest', 'S-1-5-32-547' => 'Power Users', 'S-1-5-32-548' => 'Account Operators', 'S-1-5-32-549' => 'Server Operators', 'S-1-5-32-550' => 'Print Operators', 'S-1-5-32-551' => 'Backup Operators', 'S-1-5-32-552' => 'Replicators', 'S-1-16-4096' => 'Low Integrity Level', 'S-1-16-8192' => 'Medium Integrity Level', 'S-1-16-12288' => 'High Integrity Level', 'S-1-16-16384' => 'System Integrity Level', ); sub get_name { my $self = shift; my $sid = $self->{_sid}; foreach my $regexp (keys %WellKnownSids) { if ($sid =~ m/^$regexp$/) { return $WellKnownSids{$regexp}; } } return; } sub as_string { my $self = shift; return $self->{_sid}; } sub get_length { my $self = shift; return $self->{_length}; } package Parse::Win32Registry::ACE; sub new { my $class = shift; my $data = shift; if (!defined $data) { return; } # 0x00 byte = type # 0x01 byte = flags # 0x02 word = length # Types: # ACCESS_ALLOWED_ACE_TYPE = 0 # ACCESS_DENIED_ACE_TYPE = 1 # SYSTEM_AUDIT_ACE_TYPE = 2 # SYSTEM_MANDATORY_LABEL_ACE_TYPE = x011 # Flags: # OBJECT_INHERIT_ACE = 0x01 # CONTAINER_INHERIT_ACE = 0x02 # NO_PROPAGATE_INHERIT_ACE = 0x04 # INHERIT_ONLY_ACE = 0x08 # INHERITED_ACE = 0x10 # SUCCESSFUL_ACCESS_ACE_FLAG = 0x40 (Audit Success) # FAILED_ACCESS_ACE_FLAG = 0x80 (Audit Failure) if (length($data) < 4) { return; } my ($type, $flags, $ace_len) = unpack('CCv', $data); if (length($data) < $ace_len) { return; } # The data following the header varies depending on the type. # For ACCESS_ALLOWED_ACE, ACCESS_DENIED_ACE, SYSTEM_AUDIT_ACE # the header is followed by an access mask and a sid. # 0x04 dword = access mask # 0x08 = SID # Only the following types are currently unpacked: # 0 (ACCESS_ALLOWED_ACE), 1 (ACCESS_DENIED_ACE), 2 (SYSTEM_AUDIT_ACE) if ($type >= 0 && $type <= 2 || $type == 0x11) { my $access_mask = unpack('x4V', $data); my $sid = Parse::Win32Registry::SID->new(substr($data, 8, $ace_len - 8)); # Abandon ace if sid is invalid if (!defined $sid) { return; } # Abandon ace if not the expected length if (($sid->get_length + 8) != $ace_len) { return; } my $self = { _type => $type, _flags => $flags, _mask => $access_mask, _trustee => $sid, _length => $ace_len, }; bless $self, $class; return $self; } else { return; } } our @Types = qw( ACCESS_ALLOWED ACCESS_DENIED SYSTEM_AUDIT SYSTEM_ALARM ALLOWED_COMPOUND ACCESS_ALLOWED_OBJECT ACCESS_DENIED_OBJECT SYSTEM_AUDIT_OBJECT SYSTEM_ALARM_OBJECT ACCESS_ALLOWED_CALLBACK ACCESS_DENIED_CALLBACK ACCESS_ALLOWED_CALLBACK_OBJECT ACCESS_DENIED_CALLBACK_OBJECT SYSTEM_AUDIT_CALLBACK SYSTEM_ALARM_CALLBACK SYSTEM_AUDIT_CALLBACK_OBJECT SYSTEM_ALARM_CALLBACK_OBJECT SYSTEM_MANDATORY_LABEL ); sub _look_up_ace_type { my $type = shift; if (exists $Types[$type]) { return $Types[$type]; } else { return ''; } } sub get_type { return $_[0]->{_type}; } sub get_type_as_string { return _look_up_ace_type($_[0]->{_type}); } sub get_flags { return $_[0]->{_flags}; } sub get_access_mask { return $_[0]->{_mask}; } sub get_trustee { return $_[0]->{_trustee}; } sub as_string { my $self = shift; my $sid = $self->{_trustee}; my $string = sprintf '%s 0x%02x 0x%08x %s', _look_up_ace_type($self->{_type}), $self->{_flags}, $self->{_mask}, $sid->as_string; my $name = $sid->get_name; $string .= " [$name]" if defined $name; return $string; } sub get_length { my $self = shift; return $self->{_length}; } package Parse::Win32Registry::ACL; use Carp; sub new { my $class = shift; my $data = shift; if (!defined $data) { return; } # 0x00 byte = revision # 0x01 # 0x02 word = length # 0x04 word = number of aces # 0x06 # 0x08 = first ace (variable length) # ... = second ace (variable length) # ... if (length($data) < 8) { return; } my ($rev, $acl_len, $num_aces) = unpack('Cxvv', $data); if (length($data) < $acl_len) { return; } my $pos = 8; my @acl = (); foreach (my $num = 0; $num < $num_aces; $num++) { my $ace = Parse::Win32Registry::ACE->new(substr($data, $pos, $acl_len - $pos)); # Abandon acl if any single ace is undefined return if !defined $ace; push @acl, $ace; $pos += $ace->get_length; } # Abandon acl if not expected length, but don't use # $pos != $acl_len as some acls contain unused space. if ($pos > $acl_len) { return; } my $self = { _acl => \@acl, _length => $acl_len, }; bless $self, $class; return $self; } sub get_list_of_aces { my $self = shift; return @{$self->{_acl}}; } sub as_string { croak 'Usage: ACLs do not have an as_string method; use as_stanza instead'; } sub as_stanza { my $self = shift; my $stanza = ''; foreach my $ace (@{$self->{_acl}}) { $stanza .= 'ACE: '. $ace->as_string . "\n"; } return $stanza; } sub get_length { my $self = shift; return $self->{_length}; } package Parse::Win32Registry::SecurityDescriptor; use Carp; sub new { my $class = shift; my $data = shift; if (!defined $data) { return; } # Unpacks "self-relative" security descriptors # 0x00 word = revision # 0x02 word = control flags # 0x04 dword = offset to owner sid # 0x08 dword = offset to group sid # 0x0c dword = offset to sacl # 0x10 dword = offset to dacl # Offsets are relative to the start of the security descriptor # Control Flags: # SE_OWNER_DEFAULTED 0x0001 # SE_GROUP_DEFAULTED 0x0002 # SE_DACL_PRESENT 0x0004 # SE_DACL_DEFAULTED 0x0008 # SE_SACL_PRESENT 0x0010 # SE_SACL_DEFAULTED 0x0020 # SE_DACL_AUTO_INHERIT_REQ 0x0100 # SE_SACL_AUTO_INHERIT_REQ 0x0200 # SE_DACL_AUTO_INHERITED 0x0400 # SE_SACL_AUTO_INHERITED 0x0800 # SE_DACL_PROTECTED 0x1000 # SE_SACL_PROTECTED 0x2000 # SE_RM_CONTROL_VALID 0x4000 # SE_SELF_RELATIVE 0x8000 if (length($data) < 20) { return; } my ($rev, $flags, $offset_to_owner, $offset_to_group, $offset_to_sacl, $offset_to_dacl) = unpack('vvVVVV', $data); my %sd = (); my $sd_len = 20; my $self = {}; if ($offset_to_owner > 0 && $offset_to_owner < length($data)) { my $owner = Parse::Win32Registry::SID->new(substr($data, $offset_to_owner)); return if !defined $owner; $self->{_owner} = $owner; if ($offset_to_owner + $owner->get_length > $sd_len) { $sd_len = $offset_to_owner + $owner->get_length; } } if ($offset_to_group > 0 && $offset_to_group < length($data)) { my $group = Parse::Win32Registry::SID->new(substr($data, $offset_to_group)); return if !defined $group; $self->{_group} = $group; if ($offset_to_group + $group->get_length > $sd_len) { $sd_len = $offset_to_group + $group->get_length; } } if ($offset_to_sacl > 0 && $offset_to_sacl < length($data)) { my $sacl = Parse::Win32Registry::ACL->new(substr($data, $offset_to_sacl)); return if !defined $sacl; $self->{_sacl} = $sacl; if ($offset_to_sacl + $sacl->get_length > $sd_len) { $sd_len = $offset_to_sacl + $sacl->get_length; } } if ($offset_to_dacl > 0 && $offset_to_dacl < length($data)) { my $dacl = Parse::Win32Registry::ACL->new(substr($data, $offset_to_dacl)); return if !defined $dacl; $self->{_dacl} = $dacl; if ($offset_to_dacl + $dacl->get_length > $sd_len) { $sd_len = $offset_to_dacl + $dacl->get_length; } } $self->{_length} = $sd_len; bless $self, $class; return $self; } sub get_owner { my $self = shift; return $self->{_owner}; } sub get_group { my $self = shift; return $self->{_group}; } sub get_sacl { my $self = shift; return $self->{_sacl}; } sub get_dacl { my $self = shift; return $self->{_dacl}; } sub as_string { croak 'Usage: Security Descriptors do not have an as_string method; use as_stanza instead'; } sub as_stanza { my $self = shift; my $stanza = ''; if (defined(my $owner = $self->{_owner})) { $stanza .= 'Owner SID: ' . $owner->as_string; my $name = $owner->get_name; $stanza .= " [$name]" if defined $name; $stanza .= "\n"; } if (defined(my $group = $self->{_group})) { $stanza .= 'Group SID: ' . $group->as_string; my $name = $group->get_name; $stanza .= " [$name]" if defined $name; $stanza .= "\n"; } if (defined(my $sacl = $self->{_sacl})) { foreach my $ace ($sacl->get_list_of_aces) { $stanza .= 'SACL ACE: ' . $ace->as_string . "\n"; } } if (defined(my $dacl = $self->{_dacl})) { foreach my $ace ($dacl->get_list_of_aces) { $stanza .= 'DACL ACE: ' . $ace->as_string . "\n"; } } return $stanza; } sub get_length { my $self = shift; return $self->{_length}; } 1; Parse-Win32Registry-1.0/lib/Parse/Win32Registry/Key.pm0000644000175000017500000001423411747213110021465 0ustar ownerownerpackage Parse::Win32Registry::Key; use strict; use warnings; use base qw(Parse::Win32Registry::Entry); use Carp; sub get_name { my $self = shift; # the root key of a windows 95 registry has no defined name # but this should be set to '' when created return $self->{_name}; } sub get_path { my $self = shift; return $self->{_key_path}; } sub _look_up_subkey { my $self = shift; my $subkey_name = shift; croak 'Missing subkey name' if !defined $subkey_name; foreach my $subkey ($self->get_list_of_subkeys) { if (uc $subkey_name eq uc $subkey->{_name}) { return $subkey; } } return; } sub get_subkey { my $self = shift; my $subkey_path = shift; # check for definedness in case key name is '' or '0' croak "Usage: get_subkey('key name')" if !defined $subkey_path; my $key = $self; # Current path component separator is '\' to match that used in Windows. # split returns nothing if it is given an empty string, # and without a limit of -1 drops trailing empty fields. # The following returns a list with a single zero-length string ("") # for an empty string, as split(/\\/, $subkey_path, -1) returns (), # an empty list. my @path_components = index($subkey_path, "\\") == -1 ? ($subkey_path) : split(/\\/, $subkey_path, -1); my %offsets_seen = (); $offsets_seen{$key->get_offset} = undef; foreach my $subkey_name (@path_components) { if (my $subkey = $key->_look_up_subkey($subkey_name)) { if (exists $offsets_seen{$subkey->get_offset}) { return; # found loop } $key = $subkey; $offsets_seen{$key->get_offset} = undef; } else { # subkey name not found, abort look up return; } } return $key; } sub get_value { my $self = shift; my $value_name = shift; # check for definedness in case value name is '' or '0' croak "Usage: get_value('value name')" if !defined $value_name; foreach my $value ($self->get_list_of_values) { if (uc $value_name eq uc $value->{_name}) { return $value; } } return undef; } sub print_summary { my $self = shift; print $self->as_string, "\n"; } sub as_regedit_export { my $self = shift; return "[" . $self->{_key_path} . "]\n"; } sub regenerate_path { my $self = shift; # ascend to the root my $key = $self; my @key_names = ($key->get_name); my %offsets_seen = (); while (!$key->is_root) { $offsets_seen{$key->get_offset}++; $key = $key->get_parent; if (!defined $key) { # found an undefined parent key unshift @key_names, '(Invalid Parent Key)'; last; } if (exists $offsets_seen{$key->get_offset}) { # found loop unshift @key_names, '(Invalid Parent Key)'; last; } unshift @key_names, $key->get_name; } my $key_path = join('\\', @key_names); $self->{_key_path} = $key_path; return $key_path; } sub get_value_data { my $self = shift; my $value_name = shift; croak "Usage: get_value_data('value name')" if !defined $value_name; if (my $value = $self->get_value($value_name)) { return $value->get_data; } return; } sub get_mru_list_of_values { my $self = shift; my @values = (); if (my $mrulist = $self->get_value('MRUList')) { foreach my $ch (split(//, $mrulist->get_data)) { if (my $value = $self->get_value($ch)) { push @values, $value; } } } elsif (my $mrulistex = $self->get_value('MRUListEx')) { foreach my $item (unpack('V*', $mrulistex->get_data)) { last if $item == 0xffffffff; if (my $value = $self->get_value($item)) { push @values, $value; } } } return @values; } sub get_list_of_subkeys { my $self = shift; my $subkey_iter = $self->get_subkey_iterator; my @subkeys; while (my $subkey = $subkey_iter->()) { push @subkeys, $subkey; } return @subkeys; } sub get_list_of_values { my $self = shift; my $value_iter = $self->get_value_iterator; my @values; while (my $value = $value_iter->()) { push @values, $value; } return @values; } sub get_subtree_iterator { my $self = shift; my @start_keys = ($self); push my (@subkey_iters), Parse::Win32Registry::Iterator->new(sub { return shift @start_keys; }); my $value_iter; my $key; # used to remember key while iterating values return Parse::Win32Registry::Iterator->new(sub { if (defined $value_iter && wantarray) { my $value = $value_iter->(); if (defined $value) { return ($key, $value); } # $value_iter finished, so fetch a new one # from the (current) $subkey_iter[-1] } while (@subkey_iters > 0) { $key = $subkey_iters[-1]->(); # depth-first if (defined $key) { push @subkey_iters, $key->get_subkey_iterator; $value_iter = $key->get_value_iterator; return $key; } pop @subkey_iters; # $subkey_iter finished, so remove it } return; }); } sub walk { my $self = shift; my $key_enter_func = shift; my $value_func = shift; my $key_leave_func = shift; if (!defined $key_enter_func && !defined $value_func && !defined $key_leave_func) { $key_enter_func = sub { print "+ ", $_[0]->get_path, "\n"; }; $value_func = sub { print " '", $_[0]->get_name, "'\n"; }; $key_leave_func = sub { print "- ", $_[0]->get_path, "\n"; }; } $key_enter_func->($self) if ref $key_enter_func eq 'CODE'; foreach my $value ($self->get_list_of_values) { $value_func->($value) if ref $value_func eq 'CODE'; } foreach my $subkey ($self->get_list_of_subkeys) { $subkey->walk($key_enter_func, $value_func, $key_leave_func); } $key_leave_func->($self) if ref $key_leave_func eq 'CODE'; } 1; Parse-Win32Registry-1.0/lib/Parse/Win32Registry/Win95/0000755000175000017500000000000011747225756021331 5ustar ownerownerParse-Win32Registry-1.0/lib/Parse/Win32Registry/Win95/Value.pm0000644000175000017500000001162111747213110022721 0ustar ownerownerpackage Parse::Win32Registry::Win95::Value; use strict; use warnings; use base qw(Parse::Win32Registry::Value); use Carp; use Encode; use Parse::Win32Registry::Base qw(:all); use constant RGDB_VALUE_HEADER_LENGTH => 0xc; sub new { my $class = shift; my $regfile = shift; my $offset = shift; # offset to RGDB value entry croak 'Missing registry file' if !defined $regfile; croak 'Missing offset' if !defined $offset; my $fh = $regfile->get_filehandle; # RGDB Value Entry # 0x00 dword = value type # 0x04 # 0x08 word = value name length # 0x0a word = value data length # 0x0c = value name [for name length bytes] # + value data [for data length bytes] # Value type may just be a word, not a dword; # following word always appears to be zero. sysseek($fh, $offset, 0); my $bytes_read = sysread($fh, my $rgdb_value_entry, RGDB_VALUE_HEADER_LENGTH); if ($bytes_read != RGDB_VALUE_HEADER_LENGTH) { warnf('Could not read RGDB value at 0x%x', $offset); return; } my ($type, $name_length, $data_length) = unpack('Vx4vv', $rgdb_value_entry); $bytes_read = sysread($fh, my $name, $name_length); if ($bytes_read != $name_length) { warnf('Could not read name for RGDB value at 0x%x', $offset); return; } $name = decode($Parse::Win32Registry::Base::CODEPAGE, $name); $bytes_read = sysread($fh, my $data, $data_length); if ($bytes_read != $data_length) { warnf('Could not read data for RGDB value at 0x%x', $offset); return; } my $self = {}; $self->{_regfile} = $regfile; $self->{_offset} = $offset; $self->{_length} = RGDB_VALUE_HEADER_LENGTH + $name_length + $data_length; $self->{_allocated} = 1; $self->{_tag} = 'rgdb value'; $self->{_name} = $name; $self->{_name_length} = $name_length; $self->{_type} = $type; $self->{_data} = $data; $self->{_data_length} = $data_length; bless $self, $class; return $self; } sub get_data { my $self = shift; my $type = $self->get_type; my $data = $self->{_data}; return if !defined $data; # actually, Win95 value data is always defined # apply decoding to appropriate data types if ($type == REG_DWORD) { if (length($data) == 4) { $data = unpack('V', $data); } else { # incorrect length for dword data $data = undef; } } elsif ($type == REG_DWORD_BIG_ENDIAN) { if (length($data) == 4) { $data = unpack('N', $data); } else { # incorrect length for dword data $data = undef; } } elsif ($type == REG_SZ || $type == REG_EXPAND_SZ) { # Snip off any terminating null. # Typically, REG_SZ values will not have a terminating null, # while REG_EXPAND_SZ values will have a terminating null chop $data if substr($data, -1, 1) eq "\0"; } elsif ($type == REG_MULTI_SZ) { # Snip off any terminating nulls chop $data if substr($data, -1, 1) eq "\0"; chop $data if substr($data, -1, 1) eq "\0"; my @multi_sz = split("\0", $data, -1); # Make sure there is at least one empty string @multi_sz = ('') if @multi_sz == 0; return wantarray ? @multi_sz : join($", @multi_sz); } return $data; } sub as_regedit_export { my $self = shift; my $version = shift || 5; my $name = $self->get_name; my $export = $name eq '' ? '@=' : '"' . $name . '"='; my $type = $self->get_type; # XXX # if (!defined $self->{_data}) { # $name = $name eq '' ? '@' : qq{"$name"}; # return qq{; $name=(invalid data)\n}; # } if ($type == REG_SZ) { $export .= '"' . $self->get_data . '"'; $export .= "\n"; } elsif ($type == REG_BINARY) { $export .= 'hex:'; $export .= format_octets($self->{_data}, length($export)); } elsif ($type == REG_DWORD) { my $data = $self->get_data; $export .= defined($data) ? sprintf("dword:%08x", $data) : "dword:"; $export .= "\n"; } elsif ($type == REG_EXPAND_SZ || $type == REG_MULTI_SZ) { my $data = $version == 4 ? $self->{_data} # raw data : encode("UCS-2LE", $self->{_data}); # ansi->unicode $export .= sprintf("hex(%x):", $type); $export .= format_octets($data, length($export)); } else { $export .= sprintf("hex(%x):", $type); $export .= format_octets($self->{_data}, length($export)); } return $export; } sub parse_info { my $self = shift; my $info = sprintf '0x%x rgdb value len=0x%x "%s" type=%d data,len=0x%x', $self->{_offset}, $self->{_length}, $self->{_name}, $self->{_type}, $self->{_data_length}; return $info; } 1; Parse-Win32Registry-1.0/lib/Parse/Win32Registry/Win95/File.pm0000644000175000017500000003300111747213110022520 0ustar ownerownerpackage Parse::Win32Registry::Win95::File; use strict; use warnings; use base qw(Parse::Win32Registry::File); use Carp; use File::Basename; use Parse::Win32Registry::Base qw(:all); use Parse::Win32Registry::Win95::Key; use constant CREG_HEADER_LENGTH => 0x20; use constant OFFSET_TO_RGKN_BLOCK => 0x20; sub new { my $class = shift; my $filename = shift or croak 'No filename specified'; open my $fh, '<', $filename or croak "Unable to open '$filename': $!"; # CREG Header # 0x00 dword = 'CREG' signature # 0x04 # 0x08 dword = offset to first rgdb block # 0x0c # 0x10 word = number of rgdb blocks my $bytes_read = sysread($fh, my $creg_header, CREG_HEADER_LENGTH); if ($bytes_read != CREG_HEADER_LENGTH) { warnf('Could not read registry file header'); return; } my ($creg_sig, $offset_to_first_rgdb_block, $num_rgdb_blocks) = unpack('a4x4Vx4v', $creg_header); if ($creg_sig ne 'CREG') { warnf('Invalid registry file signature'); return; } my $self = {}; $self->{_filehandle} = $fh; $self->{_filename} = $filename; $self->{_length} = (stat $fh)[7]; $self->{_offset_to_first_rgdb_block} = $offset_to_first_rgdb_block; $self->{_num_rgdb_blocks} = $num_rgdb_blocks; bless $self, $class; # get_rgkn will cache the rgkn block for subsequent calls my $rgkn_block = $self->get_rgkn; return if !defined $rgkn_block; # warning will already have been made # Index the rgdb entries by id for faster look up $self->_index_rgdb_entries; return $self; } sub get_timestamp { return undef; } sub get_timestamp_as_string { return iso8601(undef); } sub get_embedded_filename { return undef; } sub get_root_key { my $self = shift; return $self->get_rgkn->get_root_key; } sub get_virtual_root_key { my $self = shift; my $fake_root = shift; my $root_key = $self->get_root_key; return if !defined $root_key; if (!defined $fake_root) { # guess virtual root from filename my $filename = basename $self->{_filename}; if ($filename =~ /USER/i) { $fake_root = 'HKEY_USERS'; } elsif ($filename =~ /SYSTEM/i) { $fake_root = 'HKEY_LOCAL_MACHINE'; } else { $fake_root = 'HKEY_UNKNOWN'; } } $root_key->{_name} = $fake_root; $root_key->{_key_path} = $fake_root; return $root_key; } sub _index_rgdb_entries { my $self = shift; my %index = (); # Build index of rgdb key entries # Entries are only included if $key_block_num matches $rgdb_block_num my $rgdb_block_num = 0; my $rgdb_iter = $self->get_rgdb_iterator; while (my $rgdb = $rgdb_iter->()) { my $rgdb_key_iter = $rgdb->get_key_iterator; while (my $rgdb_key = $rgdb_key_iter->()) { my $key_id = $rgdb_key->{_id}; my $key_block_num = $key_id >> 16; if ($rgdb_block_num == $key_block_num) { $index{$key_id} = $rgdb_key; } } $rgdb_block_num++; } $self->{_rgdb_index} = \%index; } sub _dump_rgdb_index { my $self = shift; my $rgdb_index = $self->{_rgdb_index}; foreach my $key_id (sort { $a <=> $b } keys %$rgdb_index) { my $rgdb_key = $rgdb_index->{$key_id}; printf qq{id=0x%x 0x%x,%d/%d "%s" vals=%d\n}, $key_id, $rgdb_key->{_offset}, $rgdb_key->{_length_used}, $rgdb_key->{_length}, $rgdb_key->{_name}, $rgdb_key->{_num_values}; } } sub get_rgkn { my $self = shift; # Return cached rgkn block if present if (defined $self->{_rgkn}) { return $self->{_rgkn}; } my $offset = OFFSET_TO_RGKN_BLOCK; my $rgkn_block = Parse::Win32Registry::Win95::RGKN->new($self, $offset); $self->{_rgkn} = $rgkn_block; return $rgkn_block; } sub get_rgdb_iterator { my $self = shift; my $offset_to_next_rgdb_block = $self->{_offset_to_first_rgdb_block}; my $num_rgdb_blocks = $self->{_num_rgdb_blocks}; my $end_of_file = $self->{_length}; my $rgdb_block_num = 0; return Parse::Win32Registry::Iterator->new(sub { if ($offset_to_next_rgdb_block > $end_of_file) { return; # no more rgdb blocks } if ($rgdb_block_num >= $num_rgdb_blocks) { return; # no more rgdb blocks } $rgdb_block_num++; if (my $rgdb_block = Parse::Win32Registry::Win95::RGDB->new($self, $offset_to_next_rgdb_block)) { return unless $rgdb_block->get_length > 0; $offset_to_next_rgdb_block += $rgdb_block->get_length; return $rgdb_block; } }); } sub get_block_iterator { my $self = shift; my $rgdb_iter; return Parse::Win32Registry::Iterator->new(sub { if (!defined $rgdb_iter) { $rgdb_iter = $self->get_rgdb_iterator; return $self->get_rgkn; } return $rgdb_iter->(); }); } *get_hbin_iterator = \&get_block_iterator; package Parse::Win32Registry::Win95::RGKN; use strict; use warnings; use base qw(Parse::Win32Registry::Entry); use Carp; use Parse::Win32Registry::Base qw(:all); use constant RGKN_HEADER_LENGTH => 0x20; use constant OFFSET_TO_RGKN_BLOCK => 0x20; sub new { my $class = shift; my $regfile = shift; my $offset = shift || OFFSET_TO_RGKN_BLOCK; croak 'Missing registry file' if !defined $regfile; croak 'Missing offset' if !defined $offset; my $fh = $regfile->get_filehandle; # RGKN Block Header # 0x0 dword = 'RGKN' signature # 0x4 dword = length of rgkn block # 0x8 dword = offset to root key entry (relative to start of rgkn block) sysseek($fh, $offset, 0); my $bytes_read = sysread($fh, my $rgkn_header, RGKN_HEADER_LENGTH); if ($bytes_read != RGKN_HEADER_LENGTH) { warnf('Could not read RGKN header at 0x%x', $offset); return; } my ($sig, $rgkn_block_length, $offset_to_root_key) = unpack('a4VV', $rgkn_header); if ($sig ne 'RGKN') { warnf('Invalid RGKN block signature at 0x%x', $offset); return; } $offset_to_root_key += $offset; my $self = {}; $self->{_regfile} = $regfile; $self->{_offset} = $offset; $self->{_length} = $rgkn_block_length; $self->{_header_length} = RGKN_HEADER_LENGTH; $self->{_allocated} = 1; $self->{_tag} = 'rgkn block'; $self->{_offset_to_root_key} = $offset_to_root_key; bless $self, $class; return $self; } sub get_root_key { my $self = shift; my $regfile = $self->{_regfile}; my $offset_to_root_key = $self->{_offset_to_root_key}; my $root_key = Parse::Win32Registry::Win95::Key->new($regfile, $offset_to_root_key); return $root_key; } sub get_entry_iterator { my $self = shift; my $root_key = $self->get_root_key; # In the unlikely event there is no root key, return an empty iterator if (defined $root_key) { return $root_key->get_subtree_iterator; } else { return Parse::Win32Registry::Iterator->new(sub {}); } } package Parse::Win32Registry::Win95::RGDB; use base qw(Parse::Win32Registry::Entry); use Carp; use Parse::Win32Registry::Base qw(:all); use constant RGDB_HEADER_LENGTH => 0x20; sub new { my $class = shift; my $regfile = shift; my $offset = shift; croak 'Missing registry file' if !defined $regfile; croak 'Missing offset' if !defined $offset; my $fh = $regfile->get_filehandle; # RGDB Block Header # 0x0 dword = 'RDGB' signature # 0x4 dword = length of rgdb block sysseek($fh, $offset, 0); my $bytes_read = sysread($fh, my $rgdb_header, RGDB_HEADER_LENGTH); if ($bytes_read != RGDB_HEADER_LENGTH) { return; } my ($sig, $rgdb_block_length) = unpack('a4V', $rgdb_header); if ($sig ne 'RGDB') { return; } my $self = {}; $self->{_regfile} = $regfile; $self->{_offset} = $offset; $self->{_length} = $rgdb_block_length; $self->{_header_length} = RGDB_HEADER_LENGTH; $self->{_allocated} = 1; $self->{_tag} = 'rgdb block'; bless $self, $class; return $self; } sub get_key_iterator { my $self = shift; my $regfile = $self->{_regfile}; my $offset = $self->{_offset}; my $length = $self->{_length}; my $offset_to_next_rgdb_key = $offset + RGDB_HEADER_LENGTH; my $end_of_rgdb_block = $offset + $length; return Parse::Win32Registry::Iterator->new(sub { if ($offset_to_next_rgdb_key >= $end_of_rgdb_block) { return; } if (my $rgdb_key = Parse::Win32Registry::Win95::RGDBKey->new($regfile, $offset_to_next_rgdb_key)) { return unless $rgdb_key->get_length > 0; $offset_to_next_rgdb_key += $rgdb_key->get_length; # Check rgdb key has not run past end of rgdb block if ($offset_to_next_rgdb_key > $end_of_rgdb_block) { return; } return $rgdb_key; } }); } sub get_entry_iterator { my $self = shift; my $value_iter; my $key_iter = $self->get_key_iterator; return Parse::Win32Registry::Iterator->new(sub { if (defined $value_iter) { my $value = $value_iter->(); if (defined $value) { return $value; } } my $key = $key_iter->(); if (!defined $key) { return; # key iterator finished } $value_iter = $key->get_value_iterator; return $key; }); } package Parse::Win32Registry::Win95::RGDBKey; use base qw(Parse::Win32Registry::Entry); use Carp; use Encode; use Parse::Win32Registry::Base qw(:all); use constant RGDB_ENTRY_HEADER_LENGTH => 0x14; sub new { my $class = shift; my $regfile = shift; my $offset = shift; croak 'Missing registry file' if !defined $regfile; croak 'Missing offset' if !defined $offset; my $fh = $regfile->get_filehandle; # RGDB Key Entry # 0x00 dword = length of rgdb entry / offset to next rgdb entry # (this length includes any following value entries) # 0x04 dword = id (top word = block num, bottom word = id) # 0x08 dword = bytes used (unpacked, but not used) # 0x0c word = key name length # 0x0e word = number of values # 0x10 dword # 0x14 = key name [for key name length bytes] # followed immediately by any RGDB Value Entries belonging to this key sysseek($fh, $offset, 0); my $bytes_read = sysread($fh, my $rgdb_key_entry, RGDB_ENTRY_HEADER_LENGTH); if ($bytes_read != RGDB_ENTRY_HEADER_LENGTH) { return; } my ($length, $key_id, $length_used, $name_length, $num_values) = unpack('VVVvv', $rgdb_key_entry); $bytes_read = sysread($fh, my $name, $name_length); if ($bytes_read != $name_length) { return; } $name = decode($Parse::Win32Registry::Base::CODEPAGE, $name); # Calculate the length of the entry's key header my $header_length = RGDB_ENTRY_HEADER_LENGTH + $name_length; # Check for invalid/unused entries if ($key_id == 0xffffffff || $length_used == 0xffffffff || $header_length > $length) { $name = ''; $header_length = RGDB_ENTRY_HEADER_LENGTH; } my $self = {}; $self->{_regfile} = $regfile; $self->{_offset} = $offset; $self->{_length} = $length; $self->{_length_used} = $length_used; $self->{_header_length} = $header_length; $self->{_allocated} = 1; $self->{_tag} = 'rgdb key'; $self->{_id} = $key_id; $self->{_name} = $name; $self->{_name_length} = $name_length; $self->{_num_values} = $num_values; bless $self, $class; return $self; } sub get_name { my $self = shift; return $self->{_name}; } sub parse_info { my $self = shift; my $info = sprintf '0x%x rgdb key len=0x%x/0x%x "%s" id=0x%x vals=%d', $self->{_offset}, $self->{_length_used}, $self->{_length}, $self->{_name}, $self->{_id}, $self->{_num_values}; return $info; } sub get_value_iterator { my $self = shift; my $regfile = $self->{_regfile}; my $num_values_remaining = $self->{_num_values}; my $offset = $self->{_offset}; # offset_to_next_rgdb_value can only be set to a valid offset # if num_values_remaining > 0 my $offset_to_next_rgdb_value = 0xffffffff; if ($num_values_remaining > 0) { $offset_to_next_rgdb_value = $offset + $self->{_header_length}; } my $end_of_rgdb_key = $offset + $self->{_length}; # don't attempt to return values if id is invalid... if ($self->{_id} == 0xffffffff) { $num_values_remaining = 0; } return Parse::Win32Registry::Iterator->new(sub { if ($num_values_remaining-- <= 0) { return; } if ($offset_to_next_rgdb_value == 0xffffffff) { return; } if ($offset_to_next_rgdb_value > $end_of_rgdb_key) { return; } if (my $value = Parse::Win32Registry::Win95::Value->new($regfile, $offset_to_next_rgdb_value)) { return unless $value->get_length > 0; $offset_to_next_rgdb_value += $value->get_length; return $value; } else { return; # no more values } }); } 1; Parse-Win32Registry-1.0/lib/Parse/Win32Registry/Win95/Key.pm0000644000175000017500000001275411747213110022405 0ustar ownerownerpackage Parse::Win32Registry::Win95::Key; use strict; use warnings; use base qw(Parse::Win32Registry::Key); use Carp; use Parse::Win32Registry::Base qw(:all); use Parse::Win32Registry::Win95::Value; use constant RGKN_ENTRY_LENGTH => 0x1c; use constant OFFSET_TO_RGKN_BLOCK => 0x20; sub new { my $class = shift; my $regfile = shift; my $offset = shift; # offset to RGKN key entry relative to start of RGKN my $parent_key_path = shift; # parent key path (optional) croak 'Missing registry file' if !defined $regfile; croak 'Missing offset' if !defined $offset; my $fh = $regfile->get_filehandle; # RGKN Key Entry # 0x00 dword # 0x04 dword # 0x08 dword # 0x0c dword = offset to parent RGKN entry # 0x10 dword = offset to first child RGKN entry # 0x14 dword = offset to next sibling RGKN entry # 0x18 dword = entry id of RGDB entry # Extracted offsets are relative to the start of the RGKN block # Any offset of 0xffffffff marks the end of a list. # An entry id of 0xffffffff means the RGKN entry has no RGDB entry. # This occurs for the root key of the registry file. sysseek($fh, $offset, 0); my $bytes_read = sysread($fh, my $rgkn_entry, RGKN_ENTRY_LENGTH); if ($bytes_read != RGKN_ENTRY_LENGTH) { warnf('Could not read RGKN key at 0x%x', $offset); return; } my ($offset_to_parent, $offset_to_first_child, $offset_to_next_sibling, $key_id) = unpack('x12VVVV', $rgkn_entry); $offset_to_parent += OFFSET_TO_RGKN_BLOCK if $offset_to_parent != 0xffffffff; $offset_to_first_child += OFFSET_TO_RGKN_BLOCK if $offset_to_first_child != 0xffffffff; $offset_to_next_sibling += OFFSET_TO_RGKN_BLOCK if $offset_to_next_sibling != 0xffffffff; my $self = {}; $self->{_regfile} = $regfile; $self->{_offset} = $offset; $self->{_length} = RGKN_ENTRY_LENGTH; $self->{_allocated} = 1; $self->{_tag} = 'rgkn key'; $self->{_offset_to_parent} = $offset_to_parent; $self->{_offset_to_first_child} = $offset_to_first_child; $self->{_offset_to_next_sibling} = $offset_to_next_sibling; $self->{_id} = $key_id; bless $self, $class; # Look up corresponding rgdb entry my $index = $regfile->{_rgdb_index}; croak 'Missing rgdb index' if !defined $index; if (exists $index->{$key_id}) { my $rgdb_key = $index->{$key_id}; $self->{_rgdb_key} = $rgdb_key; $self->{_name} = $rgdb_key->get_name; } else { $self->{_name} = ''; # Only the root key should have no matching RGDB entry if (!$self->is_root) { warnf('Could not find RGDB entry for RGKN key at 0x%x', $offset); } } my $name = $self->{_name}; $self->{_key_path} = defined($parent_key_path) ? "$parent_key_path\\$name" : $name; return $self; } sub get_timestamp { return undef; } sub get_timestamp_as_string { return iso8601(undef); } sub get_class_name { return undef; } sub is_root { my $self = shift; my $offset = $self->{_offset}; my $regfile = $self->{_regfile}; my $rgkn_block = $regfile->get_rgkn; my $offset_to_root_key = $rgkn_block->{_offset_to_root_key}; # This gives better results than checking id == 0xffffffff return $offset == $offset_to_root_key; } sub get_parent { my $self = shift; my $regfile = $self->{_regfile}; my $offset_to_parent = $self->{_offset_to_parent}; my $key_path = $self->{_key_path}; return if $self->is_root; my $grandparent_key_path; my @keys = split(/\\/, $key_path, -1); if (@keys > 2) { $grandparent_key_path = join("\\", @keys[0..$#keys-2]); } return Parse::Win32Registry::Win95::Key->new($regfile, $offset_to_parent, $grandparent_key_path); } sub get_security { return undef; } sub as_string { my $self = shift; return $self->get_path; } sub parse_info { my $self = shift; my $info = sprintf '0x%x rgkn key len=0x%x par=0x%x,child=0x%x,next=0x%x id=0x%x', $self->{_offset}, $self->{_length}, $self->{_offset_to_parent}, $self->{_offset_to_first_child}, $self->{_offset_to_next_sibling}, $self->{_id}; return $info; } sub get_subkey_iterator { my $self = shift; my $regfile = $self->{_regfile}; my $key_path = $self->{_key_path}; my $offset_to_next_key = $self->{_offset_to_first_child}; my $end_of_file = $regfile->get_length; my $rgkn_block = $regfile->get_rgkn; my $end_of_rgkn_block = $rgkn_block->get_offset + $rgkn_block->get_length; return Parse::Win32Registry::Iterator->new(sub { if ($offset_to_next_key == 0xffffffff) { return; # no more subkeys } if ($offset_to_next_key > $end_of_rgkn_block) { return; } if (my $key = Parse::Win32Registry::Win95::Key->new($regfile, $offset_to_next_key, $key_path)) { $offset_to_next_key = $key->{_offset_to_next_sibling}; return $key; } else { return; # no more subkeys } }); } sub get_value_iterator { my $self = shift; my $rgdb_key = $self->{_rgdb_key}; if (defined $rgdb_key) { return $rgdb_key->get_value_iterator; } else { return Parse::Win32Registry::Iterator->new(sub {}); } } 1;