diff -Nru libparse-win32registry-perl-0.60/bin/gtkregcompare.pl libparse-win32registry-perl-1.0/bin/gtkregcompare.pl --- libparse-win32registry-perl-0.60/bin/gtkregcompare.pl 2010-08-15 21:22:00.000000000 +0000 +++ libparse-win32registry-perl-1.0/bin/gtkregcompare.pl 2012-04-29 10:22:00.000000000 +0000 @@ -170,22 +170,21 @@ my @actions = ( # name, stock id, label ['FileMenu', undef, '_File'], + ['EditMenu', undef, '_Edit'], ['SearchMenu', undef, '_Search'], - ['BookmarksMenu', undef, '_Bookmarks'], ['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], - ['AddBookmark', 'gtk-add', '_Add Bookmark', 'D', undef, \&add_bookmark], - ['EditBookmarks', undef, '_Edit Bookmarks...', 'B', undef, \&edit_bookmarks], ['About', 'gtk-about', '_About...', undef, undef, \&about], ); @@ -194,16 +193,11 @@ my @toggle_actions = ( # name, stock id, label, accelerator, tooltip, callback, active - ['ShowDetail', 'gtk-edit', 'Show _Detail', 'X', undef, \&toggle_item_detail, TRUE], + ['ShowDetail', 'gtk-edit', 'Show _Detail', 'D', undef, \&toggle_item_detail, TRUE], ); $default_actions->add_toggle_actions(\@toggle_actions, undef); -my $bookmark_actions = Gtk2::ActionGroup->new('actions2'); # bookmarks -my $bookmarks_merge_id = $uimanager->new_merge_id; -my $action_name = 1; # unique action name - $uimanager->insert_action_group($default_actions, 0); -$uimanager->insert_action_group($bookmark_actions, 1); my $ui_info = < @@ -214,6 +208,9 @@ + + + @@ -221,11 +218,6 @@ - - - - - @@ -242,7 +234,6 @@ $uimanager->add_ui_from_string($ui_info); my $menubar = $uimanager->get_widget('/MenuBar'); -my $bookmarks_menu = $uimanager->get_widget('/MenuBar/BookmarksMenu')->get_submenu; ### STATUSBAR @@ -364,119 +355,6 @@ my $open_files_dialog = build_open_files_dialog; -### BOOKMARKS STORE - -use constant { - BMCOL_NAME => 0, - BMCOL_LOCATION => 1, - BMCOL_ICON => 2, -}; - -my $bookmark_store = Gtk2::ListStore->new( - 'Glib::String', 'Glib::Scalar', 'Glib::String', -); - -sub build_bookmarks_dialog { - my $bookmark_view = Gtk2::TreeView->new($bookmark_store); - $bookmark_view->set_reorderable(TRUE); - - my $bookmark_icon_cell = Gtk2::CellRendererPixbuf->new; - my $bookmark_name_cell = Gtk2::CellRendererText->new; - my $bookmark_column0 = Gtk2::TreeViewColumn->new; - $bookmark_column0->set_title('Bookmark'); - $bookmark_column0->pack_start($bookmark_icon_cell, FALSE); - $bookmark_column0->pack_start($bookmark_name_cell, TRUE); - $bookmark_column0->set_attributes($bookmark_icon_cell, - 'stock-id', BMCOL_ICON); - $bookmark_column0->set_attributes($bookmark_name_cell, - 'text', BMCOL_NAME); - $bookmark_column0->set_resizable(TRUE); - $bookmark_view->append_column($bookmark_column0); - - my $bookmark_location_cell = Gtk2::CellRendererText->new; - my $bookmark_column1 = $bookmark_view->insert_column_with_data_func( - 1, 'Path From Root', $bookmark_location_cell, - sub { - my ($column, $cell, $model, $iter, $num) = @_; - my $location = $model->get($iter, BMCOL_LOCATION); - if (defined $location) { - my ($subkey_path, $value_name) = @$location; - my $string = $subkey_path; - if (defined $value_name) { - $value_name = '(Default)' if $value_name eq ''; - $string .= ", $value_name"; - } - $cell->set('text', $string); - } - else { - $cell->set('text', '?'); - } - }, - ); - $bookmark_location_cell->set('ellipsize', 'end'); - - my $scrolled_bookmark_view = Gtk2::ScrolledWindow->new; - $scrolled_bookmark_view->set_policy('automatic', 'automatic'); - $scrolled_bookmark_view->set_shadow_type('in'); - $scrolled_bookmark_view->add($bookmark_view); - - my $label = Gtk2::Label->new; - $label->set_markup('Drag bookmarks to reorder them'); - - my $dialog = Gtk2::Dialog->new('Edit Bookmarks', $window, 'modal', - 'gtk-remove' => 50, - 'gtk-ok' => 'ok', - ); - $dialog->resize($window_width * 0.8, $window_height * 0.8); - $dialog->vbox->pack_start($scrolled_bookmark_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 '50') { - # Remove selected bookmark - my $selection = $bookmark_view->get_selection; - my $iter = $selection->get_selected; - if (defined $iter) { - $bookmark_store->remove($iter); - } - } - else { - # Before exiting, move menuitems into current bookmark order - $uimanager->remove_ui($bookmarks_merge_id); - $uimanager->ensure_update; - foreach my $action ($bookmark_actions->list_actions) { - $bookmark_actions->remove_action($action); - } - $action_name = 1; - my $iter = $bookmark_store->get_iter_first; - while (defined $iter) { - my $bookmark_name = $bookmark_store->get($iter, BMCOL_NAME); - my $location = $bookmark_store->get($iter, BMCOL_LOCATION); - my $icon = $bookmark_store->get($iter, BMCOL_ICON); - my $display_name = $bookmark_name; - $display_name =~ s/_/__/g; - $bookmark_actions->add_actions([ - [$action_name, $icon, $display_name, undef, undef, \&go_to_bookmark], - ], $location); - $uimanager->add_ui($bookmarks_merge_id, '/MenuBar/BookmarksMenu', $action_name, $action_name, 'menuitem', FALSE); - $action_name++; - $iter = $bookmark_store->iter_next($iter); - } - $dialog->hide; - } - }); - - return $dialog; -} - -my $bookmarks_dialog = build_bookmarks_dialog; - ######################## GLOBAL SETUP my @registries = (); @@ -917,7 +795,7 @@ Gtk2->show_about_dialog(undef, 'program-name' => $script_name, 'version' => $Parse::Win32Registry::VERSION, - 'copyright' => 'Copyright (c) 2008,2009,2010 James Macfarlane', + 'copyright' => 'Copyright (c) 2008-2012 James Macfarlane', 'comments' => 'GTK2 Registry Compare for the Parse::Win32Registry module', ); } @@ -938,6 +816,36 @@ $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) = @_; @@ -1037,18 +945,6 @@ return $message; } -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 find_next { if (!defined $find_param || !defined $find_iter) { return; @@ -1171,13 +1067,12 @@ $dialog->show_all; my $response = $dialog->run; - $dialog->destroy; - 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 @@ -1186,6 +1081,9 @@ find_next; } } + else { + $dialog->destroy; + } } sub find_next_change { @@ -1309,71 +1207,18 @@ $dialog->show_all; my $response = $dialog->run; - $dialog->destroy; - 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; } -} - -sub add_bookmark { - my ($keys, $values) = get_location; - if (defined $keys) { - my $any_key = (grep { defined } @$keys)[0]; - my $key_path = $any_key->get_path; - my $key_name = $any_key->get_name; - - # Remove root key name to get subkey path - my $subkey_path = (split(/\\/, $key_path, 2))[1]; - return if !defined $subkey_path; - - my $bookmark_name; - my $location; - my $icon; - if (defined $values) { - my $any_value = (grep { defined } @$values)[0]; - my $value_name = $any_value->get_name; - $location = [$subkey_path, $value_name]; - $value_name = '(Default)' if $value_name eq ''; - $bookmark_name = "$value_name"; - $icon = 'gtk-file'; - } - else { - $bookmark_name = $key_name; - $location = [$subkey_path]; - $icon = 'gtk-directory'; - } - $bookmark_name =~ s/\0/[NUL]/g; - my $display_name = $bookmark_name; - $display_name =~ s/_/__/g; - $bookmark_actions->add_actions([ - [$action_name, $icon, $display_name, undef, undef, \&go_to_bookmark], - ], $location); - $uimanager->add_ui($bookmarks_merge_id, '/MenuBar/BookmarksMenu', $action_name, $action_name, 'menuitem', FALSE); - $action_name++; - if (my $iter = $bookmark_store->append) { - $bookmark_store->set($iter, - BMCOL_NAME, $bookmark_name, - BMCOL_LOCATION, $location, - BMCOL_ICON, $icon, - ); - } + else { + $dialog->destroy; } } - -sub edit_bookmarks { - $bookmarks_dialog->show_all; -} - -sub go_to_bookmark { - my ($menuitem, $location) = @_; - my ($subkey_path, $value_name) = @$location; - go_to_subkey_and_value($subkey_path, $value_name); -} diff -Nru libparse-win32registry-perl-0.60/bin/gtkregscope.pl libparse-win32registry-perl-1.0/bin/gtkregscope.pl --- libparse-win32registry-perl-0.60/bin/gtkregscope.pl 2010-08-15 21:22:00.000000000 +0000 +++ libparse-win32registry-perl-1.0/bin/gtkregscope.pl 2012-04-29 10:22:00.000000000 +0000 @@ -427,7 +427,7 @@ Gtk2->show_about_dialog(undef, 'program-name' => $script_name, 'version' => $Parse::Win32Registry::VERSION, - 'copyright' => 'Copyright (c) 2009,2010 James Macfarlane', + 'copyright' => 'Copyright (c) 2009-2012 James Macfarlane', 'comments' => 'GTK2 Registry Scope for the Parse::Win32Registry module', ); } @@ -490,34 +490,31 @@ $dialog->show_all; my $id = Glib::Idle->add(sub { - my $entry = $find_iter->get_next; - if (defined $entry) { - my $found = 0; - - if (index($entry->get_raw_bytes, $find_param) > -1) { + 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; } - else { - my $uni_find_param = encode("UCS-2LE", $find_param); - if (index($entry->get_raw_bytes, $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; - } + } + if ($found) { + go_to_block($entry->get_offset); + go_to_entry($entry->get_offset); - return TRUE; # continue searching... + $dialog->response(50); + return FALSE; } + return TRUE; # continue searching... + } + $dialog->response('ok'); return FALSE; - }); my $response = $dialog->run; @@ -552,16 +549,18 @@ $dialog->show_all; my $response = $dialog->run; - $dialog->destroy; - 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 { @@ -583,6 +582,7 @@ $entry->set_position(-1); my $response = $dialog->run; + my $answer = $entry->get_text; $dialog->destroy; if ($response ne 'ok') { @@ -591,7 +591,6 @@ my $offset; eval { - my $answer = $entry->get_text; if ($answer =~ m/^\s*0x[\da-fA-F]+\s*$/ || $answer =~ m/^\s*\d+\s*$/) { $offset = int(eval $answer); } diff -Nru libparse-win32registry-perl-0.60/bin/gtkregview.pl libparse-win32registry-perl-1.0/bin/gtkregview.pl --- libparse-win32registry-perl-0.60/bin/gtkregview.pl 2010-08-15 21:22:00.000000000 +0000 +++ libparse-win32registry-perl-1.0/bin/gtkregview.pl 2012-04-29 10:22:00.000000000 +0000 @@ -197,34 +197,6 @@ $search_menu->append($find_menuitem); $search_menu->append($find_next_menuitem); -# Bookmarks Menu -my $add_bookmark_menuitem = Gtk2::MenuItem->new('_Add Bookmark'); -$add_bookmark_menuitem->signal_connect('activate' => \&add_bookmark); -$add_bookmark_menuitem->add_accelerator('activate', $accel_group, - $Gtk2::Gdk::Keysyms{D}, ['control-mask'], ['visible', 'locked']); -my $edit_bookmarks_menuitem = Gtk2::MenuItem->new('_Edit Bookmarks...'); -$edit_bookmarks_menuitem->signal_connect('activate' => \&edit_bookmarks); -$edit_bookmarks_menuitem->add_accelerator('activate', $accel_group, - $Gtk2::Gdk::Keysyms{B}, ['control-mask'], ['visible', 'locked']); - -my $bookmarks_menu = Gtk2::Menu->new; -$bookmarks_menu->append($add_bookmark_menuitem); -$bookmarks_menu->append($edit_bookmarks_menuitem); - -my $bookmarks_separator; # placeholder, becomes separator for bookmarks - -# Reports Menu -my $show_report_menuitem = Gtk2::MenuItem->new('Show _Bookmark Report...'); -$show_report_menuitem->signal_connect('activate' => \&view_report); -$show_report_menuitem->add_accelerator('activate', $accel_group, - $Gtk2::Gdk::Keysyms{R}, ['control-mask'], ['visible', 'locked']); -#my $dump_loaded_keys_menuitem = Gtk2::MenuItem->new('Dump loaded keys'); -#$dump_loaded_keys_menuitem->signal_connect('activate' => \&dump_loaded_keys); - -my $view_menu = Gtk2::Menu->new; -$view_menu->append($show_report_menuitem); -#$view_menu->append($dump_loaded_keys_menuitem); - # Help Menu my $about_menuitem = Gtk2::MenuItem->new('_About...'); $about_menuitem->signal_connect('activate' => \&about); @@ -245,14 +217,6 @@ $search_menuitem->set_submenu($search_menu); $menubar->append($search_menuitem); -my $bookmarks_menuitem = Gtk2::MenuItem->new('_Bookmarks'); -$bookmarks_menuitem->set_submenu($bookmarks_menu); -$menubar->append($bookmarks_menuitem); - -my $view_menuitem = Gtk2::MenuItem->new('_View'); -$view_menuitem->set_submenu($view_menu); -$menubar->append($view_menuitem); - my $help_menuitem = Gtk2::MenuItem->new('_Help'); $help_menuitem->set_submenu($help_menu); $menubar->append($help_menuitem); @@ -279,123 +243,6 @@ $window->set_title($script_name); $window->show_all; -### BOOKMARK STORE - -my $bookmark_store = Gtk2::ListStore->new( - 'Glib::String', 'Glib::String', 'Glib::Scalar', -); -# 0 = bookmark name -# 1 = bookmark location (subkey path) -# 2 = bookmark menuitem - -sub build_bookmarks_dialog { - my $bookmark_view = Gtk2::TreeView->new($bookmark_store); - $bookmark_view->set_reorderable(TRUE); - - my $bookmark_column0 = Gtk2::TreeViewColumn->new_with_attributes( - 'Bookmark', Gtk2::CellRendererText->new, 'text', 0); - $bookmark_column0->set_resizable(TRUE); - $bookmark_view->append_column($bookmark_column0); - - my $bookmark_location_cell = Gtk2::CellRendererText->new; - my $bookmark_column1 = Gtk2::TreeViewColumn->new_with_attributes( - 'Path From Root', $bookmark_location_cell, 'text', 1); - $bookmark_location_cell->set('ellipsize', 'end'); - $bookmark_column1->set_resizable(FALSE); - $bookmark_view->append_column($bookmark_column1); - - my $scrolled_bookmark_view = Gtk2::ScrolledWindow->new; - $scrolled_bookmark_view->set_policy('automatic', 'automatic'); - $scrolled_bookmark_view->set_shadow_type('in'); - $scrolled_bookmark_view->add($bookmark_view); - - my $label = Gtk2::Label->new; - $label->set_markup('Drag bookmarks to reorder them'); - - my $dialog = Gtk2::Dialog->new('Edit Bookmarks', $window, 'modal', - 'gtk-remove' => 50, - 'gtk-ok' => 'ok', - ); - $dialog->resize($window_width * 0.8, $window_height * 0.8); - $dialog->vbox->pack_start($scrolled_bookmark_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 '50') { - # Remove selected bookmark - my $selection = $bookmark_view->get_selection; - my $iter = $selection->get_selected; - if (defined $iter) { - my $menuitem = $bookmark_store->get($iter, 2); - $menuitem->destroy; - $bookmark_store->remove($iter); - } - } - else { - # Before exiting, move menuitems into current bookmark order - my $iter = $bookmark_store->get_iter_first; - while (defined $iter) { - my $menuitem = $bookmark_store->get($iter, 2); - $bookmarks_menu->remove($menuitem); - $bookmarks_menu->append($menuitem); - $iter = $bookmark_store->iter_next($iter); - } - $dialog->hide; - } - }); - - return $dialog; -} - -my $bookmarks_dialog = build_bookmarks_dialog; - -my $report_view; - -sub build_report_dialog { - $report_view = Gtk2::TextView->new; - $report_view->set_editable(FALSE); - $report_view->modify_font(Gtk2::Pango::FontDescription->from_string('monospace')); - - my $text_buffer = $report_view->get_buffer; - - my $scrolled_report_view = Gtk2::ScrolledWindow->new; - $scrolled_report_view->set_policy('automatic', 'automatic'); - $scrolled_report_view->set_shadow_type('in'); - $scrolled_report_view->add($report_view); - - my $dialog = Gtk2::Dialog->new('Report', $window, 'modal', - 'gtk-save' => 50, - 'gtk-cancel' => 'cancel', - ); - $dialog->resize($window_width * 0.8, $window_height * 0.8); - $dialog->vbox->add($scrolled_report_view); - $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 '50') { - save_report(); - } - else { - $dialog->hide; - } - }); - - return $dialog; -} - -my $report_dialog = build_report_dialog; - ### GLOBALS my $search_keys = TRUE; @@ -644,22 +491,6 @@ } } -sub save_report { - if (my $filename = choose_file('Save Log File As', 'save', "report.txt")) { - my $basename = basename $filename; - if (open my $fh, ">", $filename) { - my $text_buffer = $report_view->get_buffer; - my $start_iter = $text_buffer->get_start_iter; - my $end_iter = $text_buffer->get_end_iter; - print {$fh} $text_buffer->get_text($start_iter, $end_iter, 0); -# show_message("info", "Report saved to '$basename'"); - } - else { - show_message("error", "Error saving log to '$basename'"); - } - } -} - sub close_file { $tree_store->clear; $list_store->clear; @@ -677,7 +508,7 @@ Gtk2->show_about_dialog(undef, 'program-name' => $script_name, 'version' => $Parse::Win32Registry::VERSION, - 'copyright' => 'Copyright (c) 2008,2009,2010 James Macfarlane', + 'copyright' => 'Copyright (c) 2008-2012 James Macfarlane', 'comments' => 'GTK2 Registry Viewer for the Parse::Win32Registry module', ); } @@ -698,76 +529,15 @@ $dialog->destroy; } -sub create_bookmark_menuitem { - my ($name, $subkey_path) = @_; - - my $display_name = $name; - $display_name =~ s/_/__/g; - if (my $menuitem = Gtk2::MenuItem->new($display_name)) { - $bookmarks_menu->append($menuitem); - $bookmarks_menu->show_all; - if (my $iter = $bookmark_store->append) { - $bookmark_store->set($iter, - 0, $name, - 1, $subkey_path, - 2, $menuitem, - ); - } - $menuitem->signal_connect('activate' => \&go_to_bookmark, - $subkey_path); - } -} - -sub add_bookmark { - my $iter = $tree_selection->get_selected; - return if !defined $iter; - - # Add separator for bookmarks if it is not already there - if (!defined $bookmarks_separator) { - $bookmarks_separator = Gtk2::SeparatorMenuItem->new; - $bookmarks_menu->append($bookmarks_separator); - } - - my $key = $tree_store->get($iter, 3); - - # Remove root key name to get subkey path - my $subkey_path = (split(/\\/, $key->get_path, 2))[1]; - - if (defined $subkey_path) { - my $name = $key->get_name; - create_bookmark_menuitem($name, $subkey_path); - } -} - -sub edit_bookmarks { - $bookmarks_dialog->show_all; -} - -sub remove_all_bookmarks { - my $iter = $bookmark_store->get_iter_first; - # destroy all the bookmark menu items - while (defined $iter) { - my $menuitem = $bookmark_store->get($iter, 2); - $bookmarks_menu->remove($menuitem); - $menuitem->destroy; - $iter = $bookmark_store->iter_next($iter); - } - # then empty the bookmark store - $bookmark_store->clear; -} - -sub go_to_bookmark { - my ($menuitem, $path) = @_; - go_to_subkey($path); -} - 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); - my $clipboard = Gtk2::Clipboard->get(Gtk2::Gdk->SELECTION_CLIPBOARD); - $clipboard->set_text($key->get_path); + 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 { @@ -1002,13 +772,12 @@ $dialog->show_all; my $response = $dialog->run; - $dialog->destroy; - 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 @@ -1017,55 +786,7 @@ find_next; } } -} - -sub dump_loaded_keys { - print "Dumping loaded keys:\n"; - $tree_store->foreach(sub { - my ($model, $path, $iter) = @_; - - my $key = $model->get($iter, 3); - if (defined $key) { - print $key->get_path, "\n"; - } - return FALSE; - }); -} - -sub view_report { - my $root_iter = $tree_store->get_iter_first; - if (!defined $root_iter) { - print "(no registry file loaded)\n"; - return; - } - - my $text_buffer = $report_view->get_buffer; - $text_buffer->set_text(''); - - my $root_key = $tree_store->get($root_iter, 3); - my $iter = $bookmark_store->get_iter_first; - while (defined $iter) { - my $name = $bookmark_store->get($iter, 0); - my $path = $bookmark_store->get($iter, 1); - - if (my $key = $root_key->get_subkey($path)) { - my $str = $key->as_string . "\n"; - $str =~ s/\0/[NUL]/g; - $text_buffer->insert_at_cursor($str); - foreach my $value ($key->get_list_of_values) { - my $value_name = $value->get_name; - $value_name = "(Default)" if $value_name eq ""; - $value_name =~ s/\0/[NUL]/g; - my $value_type = $value->get_type_as_string; - my $str = "$value_name ($value_type):\n"; - $str .= hexdump($value->get_raw_data); - $text_buffer->insert_at_cursor($str); - } - $text_buffer->insert_at_cursor("\n"); - } - $iter = $bookmark_store->iter_next($iter); + else { + $dialog->destroy; } - - $report_dialog->show_all; } - diff -Nru libparse-win32registry-perl-0.60/bin/regdump.pl libparse-win32registry-perl-1.0/bin/regdump.pl --- libparse-win32registry-perl-0.60/bin/regdump.pl 2010-08-15 21:22:00.000000000 +0000 +++ libparse-win32registry-perl-1.0/bin/regdump.pl 2012-04-29 10:22:00.000000000 +0000 @@ -116,6 +116,6 @@ -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 only the owner SID for the key (if present) + -o or --owner display the owner SID for the key (if present) USAGE } diff -Nru libparse-win32registry-perl-0.60/bin/regml.pl libparse-win32registry-perl-1.0/bin/regml.pl --- libparse-win32registry-perl-0.60/bin/regml.pl 1970-01-01 00:00:00.000000000 +0000 +++ libparse-win32registry-perl-1.0/bin/regml.pl 2012-04-29 10:22:00.000000000 +0000 @@ -0,0 +1,55 @@ +#!/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 +} diff -Nru libparse-win32registry-perl-0.60/bin/regscan.pl libparse-win32registry-perl-1.0/bin/regscan.pl --- libparse-win32registry-perl-0.60/bin/regscan.pl 2010-08-15 21:22:00.000000000 +0000 +++ libparse-win32registry-perl-1.0/bin/regscan.pl 2012-04-29 10:22:00.000000000 +0000 @@ -15,15 +15,7 @@ 'allocated|a' => \my $list_allocated, 'keys|k' => \my $list_keys, 'values|v' => \my $list_values, - 'security|s' => \my $list_security, - 'warnings|w' => \my $show_warnings); - -if ($show_warnings) { - Parse::Win32Registry->enable_warnings; -} -else { - Parse::Win32Registry->disable_warnings; -} + 'security|s' => \my $list_security); my $filename = shift or die usage(); @@ -60,7 +52,7 @@ some of the keys, values, and associated elements displayed will no longer be active and may be invalid or deleted. -$script_name [-k] [-v] [-s] [-a] [-p] [-u] [-w] +$script_name [-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 @@ -68,6 +60,5 @@ -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 - -w or --warnings display warnings of invalid keys and values USAGE } diff -Nru libparse-win32registry-perl-0.60/bin/regsecurity.pl libparse-win32registry-perl-1.0/bin/regsecurity.pl --- libparse-win32registry-perl-0.60/bin/regsecurity.pl 2010-08-15 21:22:00.000000000 +0000 +++ libparse-win32registry-perl-1.0/bin/regsecurity.pl 2012-04-29 10:22:00.000000000 +0000 @@ -3,15 +3,10 @@ use warnings; use File::Basename; -use Getopt::Long; use Parse::Win32Registry 0.50; binmode(STDOUT, ':utf8'); -Getopt::Long::Configure('bundling'); - -GetOptions('unparsed|u' => \my $show_unparsed); - my $filename = shift or die usage(); my $registry = Parse::Win32Registry->new($filename) @@ -26,7 +21,7 @@ my %offsets_seen = (); my $offset = $security->get_offset; while (!exists $offsets_seen{$offset}) { - $offsets_seen{$offset} = $security; + $offsets_seen{$offset} = undef; # value not required printf "Security at offset 0x%x, %d references\n", $offset, $security->get_reference_count; diff -Nru libparse-win32registry-perl-0.60/bin/wxregcompare.pl libparse-win32registry-perl-1.0/bin/wxregcompare.pl --- libparse-win32registry-perl-0.60/bin/wxregcompare.pl 2010-08-15 21:22:00.000000000 +0000 +++ libparse-win32registry-perl-1.0/bin/wxregcompare.pl 2012-04-29 10:22:00.000000000 +0000 @@ -131,43 +131,6 @@ } } -sub DumpLoadedEntries { - my ($self) = @_; - - my $root_item = $self->GetRootItem; - my @items; - if ($root_item->IsOk) { - push @items, $root_item; - } - while (@items) { - my $item = shift @items; - - my ($changes, $keys, $values) = @{$self->GetPlData($item)}; - - my $num_changes = grep { $_ } @$changes; - printf "%2d", $num_changes; - - my $any_key = (grep { defined } @$keys)[0]; - print " ", $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 ''; - print " ", $name; - } - print "\n"; - - if ($self->ItemHasChildren($item)) { - my ($child_item, $cookie) = $self->GetFirstChild($item); - while ($child_item->IsOk) { - push @items, $child_item; - ($child_item, $cookie) = $self->GetNextChild($item, $cookie); - } - } - } -} - sub FindMatchingKey { my ($self, $item, $key_name) = @_; @@ -456,8 +419,7 @@ $menu1->Append(wxID_EXIT, "E&xit\tAlt+F4"); my $menu2 = Wx::Menu->new; - $menu2->Append(wxID_COPY, "&Copy Key Path\tCtrl+C"); -# $menu2->Append(ID_DUMP_ENTRIES, "Dump Loaded Entries"); + $menu2->Append(wxID_COPY, "&Copy Path\tCtrl+C"); my $menu3 = Wx::Menu->new; $menu3->Append(wxID_FIND, "&Find...\tCtrl+F"); @@ -488,7 +450,6 @@ EVT_MENU($self, wxID_CLOSE, \&OnCloseFiles); EVT_MENU($self, wxID_EXIT, \&OnQuit); EVT_MENU($self, wxID_COPY, \&OnCopy); - EVT_MENU($self, ID_DUMP_ENTRIES, sub { $_[0]->{_tree}->DumpLoadedEntries; }); EVT_MENU($self, wxID_FIND, \&OnFind); EVT_MENU($self, ID_FIND_NEXT, \&FindNext); EVT_MENU($self, wxID_REPLACE, \&OnFindChange); @@ -507,7 +468,7 @@ my $list = EntryListCtrl->new($vsplitter); - my $text = Wx::TextCtrl->new($vsplitter, -1, '', wxDefaultPosition, wxDefaultSize, wxTE_MULTILINE|wxTE_DONTWRAP); + 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); @@ -524,13 +485,6 @@ EVT_TREE_SEL_CHANGED($self, $tree, \&OnEntryTreeSelChanged); EVT_LIST_ITEM_SELECTED($self, $list, \&OnEntryListItemSelected); - if (@ARGV) { - $self->LoadFiles(@ARGV); - } - else { - $self->{_registries} = []; - } - $self->SetIcon(Wx::GetWxPerlIcon()); my $accelerators = Wx::AcceleratorTable->new( @@ -538,6 +492,13 @@ ); $self->SetAcceleratorTable($accelerators); + if (@ARGV) { + $self->LoadFiles(@ARGV); + } + else { + $self->{_registries} = []; + } + return $self; } @@ -560,7 +521,7 @@ if (defined $keys) { my $any_key = (grep { defined } @$keys)[0]; - if (defined $values) { # only values + if (defined $values) { my $any_value = (grep { defined } @$values)[0]; $clip = $any_key->get_path . ", " . $any_value->get_name; } @@ -655,7 +616,7 @@ my $info = Wx::AboutDialogInfo->new; $info->SetName($FindBin::Script); $info->SetVersion($Parse::Win32Registry::VERSION); - $info->SetCopyright("Copyright (c) 2010 James Macfarlane"); + $info->SetCopyright("Copyright (c) 2010-2012 James Macfarlane"); $info->SetDescription("wxWidgets Registry Compare for the Parse::Win32Registry module"); Wx::AboutBox($info); } @@ -1085,25 +1046,26 @@ sub SetSearchKeys { my ($self, $state) = @_; $state = 1 if !defined $state; - return $self->{_check1}->SetValue($state); + $self->{_check1}->SetValue($state); } sub SetSearchValues { my ($self, $state) = @_; $state = 1 if !defined $state; - return $self->{_check2}->SetValue($state); + $self->{_check2}->SetValue($state); } sub SetText { my ($self, $value) = @_; $value = '' if !defined $value; - return $self->{_text}->ChangeValue($value); + $self->{_text}->ChangeValue($value); + $self->{_text}->SetSelection(-1, -1); } sub SetSearchSelected { my ($self, $n) = @_; $n = 0 if !defined $n; - return $self->{_radio}->SetSelection($n); + $self->{_radio}->SetSelection($n); } @@ -1180,19 +1142,19 @@ sub SetSearchKeys { my ($self, $state) = @_; $state = 1 if !defined $state; - return $self->{_check1}->SetValue($state); + $self->{_check1}->SetValue($state); } sub SetSearchValues { my ($self, $state) = @_; $state = 1 if !defined $state; - return $self->{_check2}->SetValue($state); + $self->{_check2}->SetValue($state); } sub SetSearchSelected { my ($self, $n) = @_; $n = 0 if !defined $n; - return $self->{_radio}->SetSelection($n); + $self->{_radio}->SetSelection($n); } diff -Nru libparse-win32registry-perl-0.60/bin/wxregscope.pl libparse-win32registry-perl-1.0/bin/wxregscope.pl --- libparse-win32registry-perl-0.60/bin/wxregscope.pl 2010-08-15 21:22:00.000000000 +0000 +++ libparse-win32registry-perl-1.0/bin/wxregscope.pl 2012-04-29 10:22:00.000000000 +0000 @@ -163,7 +163,7 @@ elsif ($column == 4) { my $name = ''; if ($entry->can('get_name')) { - $name = $entry->get_name; # FIXME nulls? + $name = $entry->get_name; $name =~ s/\0/[NUL]/g; $name =~ s/\n/[LF]/g; $name =~ s/\r/[CR]/g; @@ -280,12 +280,14 @@ my ($self, $value) = @_; $value = '' if !defined $value; - return $self->{_text}->ChangeValue($value); + $self->{_text}->ChangeValue($value); + $self->{_text}->SetSelection(-1, -1); } package ScopeFrame; +use Encode; use File::Basename; use FindBin; use Parse::Win32Registry; @@ -316,7 +318,7 @@ $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+I"); + $menu2->Append(ID_GO_TO, "&Go To Offset...\tCtrl+G"); my $menu3 = Wx::Menu->new; $menu3->Append(ID_SELECT_FONT, "Select &Font..."); @@ -346,7 +348,7 @@ my $vsplitter = Wx::SplitterWindow->new($self, -1, wxDefaultPosition, wxDefaultSize, wxSP_NOBORDER); - my $text = Wx::TextCtrl->new($vsplitter, -1, '', wxDefaultPosition, wxDefaultSize, wxTE_MULTILINE|wxTE_DONTWRAP); + 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); @@ -373,11 +375,6 @@ EVT_LIST_ITEM_SELECTED($self, $list1, \&OnBlockSelected); EVT_LIST_ITEM_SELECTED($self, $list2, \&OnEntrySelected); - my $filename = shift @ARGV; - if (defined $filename) { - $self->LoadFile($filename); - } - $self->SetIcon(Wx::GetWxPerlIcon()); my $accelerators = Wx::AcceleratorTable->new( @@ -385,6 +382,11 @@ ); $self->SetAcceleratorTable($accelerators); + my $filename = shift @ARGV; + if (defined $filename) { + $self->LoadFile($filename); + } + return $self; } @@ -439,20 +441,19 @@ my $index = $event->GetIndex; my $block = $self->{_list1}->GetBlock($index); -# if (defined $block) { - $self->{_list2}->SetBlock($block); - my $parse_info = $block->parse_info; # FIXME nulls - not relevant - $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); -# } + $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 { @@ -461,18 +462,16 @@ my $index = $event->GetIndex; my $entry = $self->{_list2}->GetEntry($index); -# if (defined $entry) { - my $parse_info = $entry->parse_info; # FIXME nulls - $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); -# } + 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 { @@ -481,7 +480,7 @@ my $info = Wx::AboutDialogInfo->new; $info->SetName($FindBin::Script); $info->SetVersion($Parse::Win32Registry::VERSION); - $info->SetCopyright('Copyright (c) 2010 James Macfarlane'); + $info->SetCopyright('Copyright (c) 2010-2012 James Macfarlane'); $info->SetDescription('wxWidgets Registry Scope for the Parse::Win32Registry module'); Wx::AboutBox($info); } @@ -520,15 +519,22 @@ my $iter_finished = 1; while (my $entry = $find_iter->get_next) { - if ($entry->can('get_name')) { - my $name = $entry->get_name; - if (index(lc $name, lc $find_param) >= 0) { - $self->{_list1}->GoToBlock($entry->get_offset); - $self->{_list2}->GoToEntry($entry->get_offset); - $iter_finished = 0; - last; + 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) { diff -Nru libparse-win32registry-perl-0.60/bin/wxregview.pl libparse-win32registry-perl-1.0/bin/wxregview.pl --- libparse-win32registry-perl-0.60/bin/wxregview.pl 2010-08-15 21:22:00.000000000 +0000 +++ libparse-win32registry-perl-1.0/bin/wxregview.pl 2012-04-29 10:22:00.000000000 +0000 @@ -84,30 +84,6 @@ } } -sub DumpLoadedKeys { - my ($self) = @_; - - my $root_item = $self->GetRootItem; - my @items; - if ($root_item->IsOk) { - push @items, $root_item; - } - while (@items) { - my $item = shift @items; - - my $key = $self->GetPlData($item); - print $key->get_path, "\n"; - - if ($self->ItemHasChildren($item)) { - my ($child_item, $cookie) = $self->GetFirstChild($item); - while ($child_item->IsOk) { - push @items, $child_item; - ($child_item, $cookie) = $self->GetNextChild($item, $cookie); - } - } - } -} - sub FindMatchingItem { my ($self, $key_name, $item) = @_; @@ -305,7 +281,6 @@ my $menu2 = Wx::Menu->new; $menu2->Append(wxID_COPY, "&Copy Key Path\tCtrl+C"); -# $menu2->Append(ID_DUMP_KEYS, "Dump Loaded Keys"); my $menu3 = Wx::Menu->new; $menu3->Append(wxID_FIND, "&Find...\tCtrl+F"); @@ -335,7 +310,6 @@ EVT_MENU($self, wxID_CLOSE, \&OnCloseFile); EVT_MENU($self, wxID_EXIT, \&OnQuit); EVT_MENU($self, wxID_COPY, \&OnCopy); - EVT_MENU($self, ID_DUMP_KEYS, sub { $_[0]->{_tree}->DumpLoadedKeys; }); EVT_MENU($self, wxID_FIND, \&OnFind); EVT_MENU($self, ID_FIND_NEXT, \&FindNext); EVT_MENU($self, ID_TIMELINE, \&ShowTimeline); @@ -353,7 +327,7 @@ my $list = ValueListCtrl->new($vsplitter); - my $text = Wx::TextCtrl->new($vsplitter, -1, '', wxDefaultPosition, wxDefaultSize, wxTE_MULTILINE|wxTE_DONTWRAP); + 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)); @@ -371,11 +345,6 @@ EVT_TREE_SEL_CHANGED($self, $tree, \&OnKeyTreeSelChanged); EVT_LIST_ITEM_SELECTED($self, $list, \&OnValueListItemSelected); - my $filename = shift @ARGV; - if (defined $filename) { - $self->LoadFile($filename); - } - $self->SetIcon(Wx::GetWxPerlIcon()); my $accelerators = Wx::AcceleratorTable->new( @@ -383,6 +352,11 @@ ); $self->SetAcceleratorTable($accelerators); + my $filename = shift @ARGV; + if (defined $filename) { + $self->LoadFile($filename); + } + return $self; } @@ -437,6 +411,14 @@ $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; @@ -456,7 +438,9 @@ 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); + 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) { @@ -541,7 +525,7 @@ my $info = Wx::AboutDialogInfo->new; $info->SetName($FindBin::Script); $info->SetVersion($Parse::Win32Registry::VERSION); - $info->SetCopyright('Copyright (c) 2010 James Macfarlane'); + $info->SetCopyright('Copyright (c) 2010-2012 James Macfarlane'); $info->SetDescription('wxWidgets Registry Viewer for the Parse::Win32Registry module'); Wx::AboutBox($info); } @@ -762,8 +746,6 @@ $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); @@ -817,25 +799,26 @@ sub SetSearchKeys { my ($self, $state) = @_; $state = 1 if !defined $state; - return $self->{_check1}->SetValue($state); + $self->{_check1}->SetValue($state); } sub SetSearchValues { my ($self, $state) = @_; $state = 1 if !defined $state; - return $self->{_check2}->SetValue($state); + $self->{_check2}->SetValue($state); } sub SetText { my ($self, $value) = @_; $value = '' if !defined $value; - return $self->{_text}->ChangeValue($value); + $self->{_text}->ChangeValue($value); + $self->{_text}->SetSelection(-1, -1); } sub SetSearchSelected { my ($self, $n) = @_; $n = 0 if !defined $n; - return $self->{_radio}->SetSelection($n); + $self->{_radio}->SetSelection($n); } diff -Nru libparse-win32registry-perl-0.60/Changes libparse-win32registry-perl-1.0/Changes --- libparse-win32registry-perl-0.60/Changes 2010-08-15 21:22:00.000000000 +0000 +++ libparse-win32registry-perl-1.0/Changes 2012-04-29 10:22:00.000000000 +0000 @@ -1,5 +1,25 @@ Revision 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. diff -Nru libparse-win32registry-perl-0.60/debian/changelog libparse-win32registry-perl-1.0/debian/changelog --- libparse-win32registry-perl-0.60/debian/changelog 2012-06-13 09:25:43.000000000 +0000 +++ libparse-win32registry-perl-1.0/debian/changelog 2012-06-13 09:25:44.000000000 +0000 @@ -1,3 +1,11 @@ +libparse-win32registry-perl (1.0-1) unstable; urgency=low + + * New upstream version + * Switched to Debhelper 7 + * Bumped Standards-Version + + -- Hilko Bengen Tue, 12 Jun 2012 23:13:04 +0200 + libparse-win32registry-perl (0.60-1) unstable; urgency=low * New upstream version diff -Nru libparse-win32registry-perl-0.60/debian/compat libparse-win32registry-perl-1.0/debian/compat --- libparse-win32registry-perl-0.60/debian/compat 2012-06-13 09:25:43.000000000 +0000 +++ libparse-win32registry-perl-1.0/debian/compat 2012-06-13 09:25:44.000000000 +0000 @@ -1 +1 @@ -5 +7 diff -Nru libparse-win32registry-perl-0.60/debian/control libparse-win32registry-perl-1.0/debian/control --- libparse-win32registry-perl-0.60/debian/control 2012-06-13 09:25:43.000000000 +0000 +++ libparse-win32registry-perl-1.0/debian/control 2012-06-13 09:25:44.000000000 +0000 @@ -1,10 +1,10 @@ Source: libparse-win32registry-perl Section: perl Priority: optional -Build-Depends: debhelper (>= 5) +Build-Depends: debhelper (>= 7.0.50~) Build-Depends-Indep: perl (>= 5.6.0-12) Maintainer: Hilko Bengen -Standards-Version: 3.8.3 +Standards-Version: 3.9.3 Homepage: http://search.cpan.org/dist/Parse-Win32Registry/ Package: libparse-win32registry-perl diff -Nru libparse-win32registry-perl-0.60/debian/dirs libparse-win32registry-perl-1.0/debian/dirs --- libparse-win32registry-perl-0.60/debian/dirs 1970-01-01 00:00:00.000000000 +0000 +++ libparse-win32registry-perl-1.0/debian/dirs 2012-06-13 09:25:44.000000000 +0000 @@ -0,0 +1 @@ +/usr/share/doc/libparse-win32registry-perl/examples diff -Nru libparse-win32registry-perl-0.60/debian/libparse-win32registry-perl.install libparse-win32registry-perl-1.0/debian/libparse-win32registry-perl.install --- libparse-win32registry-perl-0.60/debian/libparse-win32registry-perl.install 2012-06-13 09:25:43.000000000 +0000 +++ libparse-win32registry-perl-1.0/debian/libparse-win32registry-perl.install 1970-01-01 00:00:00.000000000 +0000 @@ -1,2 +0,0 @@ -usr/share/perl5 -usr/share/man/man3 diff -Nru libparse-win32registry-perl-0.60/debian/rules libparse-win32registry-perl-1.0/debian/rules --- libparse-win32registry-perl-0.60/debian/rules 2012-06-13 09:25:43.000000000 +0000 +++ libparse-win32registry-perl-1.0/debian/rules 2012-06-13 09:25:44.000000000 +0000 @@ -1,69 +1,13 @@ #!/usr/bin/make -f -# This debian/rules file is provided as a template for normal perl -# packages. It was created by Marc Brockschmidt for -# the Debian Perl Group (http://pkg-perl.alioth.debian.org/) but may -# be used freely wherever it is useful. -# Uncomment this to turn on verbose mode. #export DH_VERBOSE=1 -# If set to a true value then MakeMaker's prompt function will -# always return the default without waiting for user input. -export PERL_MM_USE_DEFAULT=1 +%: + dh $@ -PERL ?= /usr/bin/perl -PACKAGE = $(shell dh_listpackages) -TMP = $(CURDIR)/debian/tmp - -build: build-stamp -build-stamp: - dh_testdir - # Add commands to compile the package here - $(PERL) Makefile.PL INSTALLDIRS=vendor - $(MAKE) - $(MAKE) test - touch $@ - -clean: - dh_testdir - dh_testroot - dh_clean build-stamp install-stamp - # Add commands to clean up after the build process here - [ ! -f Makefile ] || $(MAKE) realclean - -install: install-stamp -install-stamp: build-stamp - dh_testdir - dh_testroot - dh_clean -k - dh_installdirs - # Add commands to install the package into $(TMP) here - $(MAKE) install DESTDIR=$(TMP) PREFIX=/usr - [ ! -d $(TMP)/usr/lib/perl5 ] || \ - rmdir --ignore-fail-on-non-empty --parents --verbose \ - $(TMP)/usr/lib/perl5 - - dh_installexamples bin/*.pl - chmod 755 $(CURDIR)/debian/${PACKAGE}/usr/share/doc/${PACKAGE}/examples/*.pl - - dh_install --sourcedir=debian/tmp --autodest - touch $@ - -binary-arch: -# We have nothing to do here for an architecture-independent package - -binary-indep: build install - dh_testdir - dh_testroot - dh_installdocs - dh_installchangelogs Changes - dh_perl +override_dh_auto_install: + dh_auto_install + mv debian/libparse-win32registry-perl/usr/bin/*.pl \ + debian/libparse-win32registry-perl/usr/share/doc/libparse-win32registry-perl/examples +override_dh_compress: dh_compress -X.pl - dh_fixperms - dh_installdeb - dh_gencontrol - dh_md5sums - dh_builddeb - -binary: binary-indep binary-arch -.PHONY: build clean binary-indep binary-arch binary install diff -Nru libparse-win32registry-perl-0.60/lib/Parse/Win32Registry/Base.pm libparse-win32registry-perl-1.0/lib/Parse/Win32Registry/Base.pm --- libparse-win32registry-perl-0.60/lib/Parse/Win32Registry/Base.pm 2010-08-15 21:22:00.000000000 +0000 +++ libparse-win32registry-perl-1.0/lib/Parse/Win32Registry/Base.pm 2012-04-29 10:22:00.000000000 +0000 @@ -94,10 +94,6 @@ $output .= ' '; $output .= ' ' x $indent; $row =~ tr/\x20-\x7e/./c; -# $row = decode($CODEPAGE, $row); -# $row =~ s/\x{00ad}/ /g; -# $row =~ s/[\x{0000}-\x{001f}]/\x{00b7}/g; -# $row =~ s/[\x{fffd}\x{007f}]/\x{25ab}/g; $output .= $row; $output .= "\n"; $pos += $len; @@ -113,10 +109,6 @@ } $output .= ' '; $row =~ tr/\x20-\x7e/./c; -# $row = decode($CODEPAGE, $row); -# $row =~ s/\x{00ad}/ /g; -# $row =~ s/[\x{0000}-\x{001f}]/\x{00b7}/g; -# $row =~ s/[\x{fffd}\x{007f}]/\x{25ab}/g; $output .= $row; $output .= "\n"; $pos += 16; @@ -178,7 +170,7 @@ my $epoch_offset = timegm(0, 0, 0, 1, 0, 70); $epoch_time += $epoch_offset; - if ($epoch_time < 0) { + if ($epoch_time < 0 || $epoch_time > 0x7fffffff) { $epoch_time = undef; } @@ -187,11 +179,16 @@ 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)'; @@ -199,8 +196,8 @@ 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:%02dZ', - 1900+$year, 1+$mon, $mday, $hour, $min, $sec; + return sprintf '%04d-%02d-%02dT%02d:%02d:%02d%s', + 1900+$year, 1+$mon, $mday, $hour, $min, $sec, $tz; } sub unpack_string { @@ -681,6 +678,10 @@ '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 { @@ -727,7 +728,7 @@ # ACCESS_ALLOWED_ACE_TYPE = 0 # ACCESS_DENIED_ACE_TYPE = 1 # SYSTEM_AUDIT_ACE_TYPE = 2 - # SYSTEM_ALARM_ACE_TYPE = 3 + # SYSTEM_MANDATORY_LABEL_ACE_TYPE = x011 # Flags: # OBJECT_INHERIT_ACE = 0x01 @@ -756,7 +757,7 @@ # Only the following types are currently unpacked: # 0 (ACCESS_ALLOWED_ACE), 1 (ACCESS_DENIED_ACE), 2 (SYSTEM_AUDIT_ACE) - if ($type >= 0 && $type <= 2) { + 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)); @@ -797,6 +798,15 @@ 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 { @@ -994,28 +1004,36 @@ $offset_to_owner)); return if !defined $owner; $self->{_owner} = $owner; - $sd_len += $owner->get_length; + 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; - $sd_len += $group->get_length; + 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; - $sd_len += $sacl->get_length; + 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; - $sd_len += $dacl->get_length; + if ($offset_to_dacl + $dacl->get_length > $sd_len) { + $sd_len = $offset_to_dacl + $dacl->get_length; + } } $self->{_length} = $sd_len; bless $self, $class; diff -Nru libparse-win32registry-perl-0.60/lib/Parse/Win32Registry/Entry.pm libparse-win32registry-perl-1.0/lib/Parse/Win32Registry/Entry.pm --- libparse-win32registry-perl-0.60/lib/Parse/Win32Registry/Entry.pm 2010-08-15 21:22:00.000000000 +0000 +++ libparse-win32registry-perl-1.0/lib/Parse/Win32Registry/Entry.pm 2012-04-29 10:22:00.000000000 +0000 @@ -6,6 +6,12 @@ use Carp; use Parse::Win32Registry::Base qw(:all); +sub get_regfile { + my $self = shift; + + return $self->{_regfile}; +} + sub get_offset { my $self = shift; diff -Nru libparse-win32registry-perl-0.60/lib/Parse/Win32Registry/Value.pm libparse-win32registry-perl-1.0/lib/Parse/Win32Registry/Value.pm --- libparse-win32registry-perl-0.60/lib/Parse/Win32Registry/Value.pm 2010-08-15 21:22:00.000000000 +0000 +++ libparse-win32registry-perl-1.0/lib/Parse/Win32Registry/Value.pm 2012-04-29 10:22:00.000000000 +0000 @@ -68,7 +68,7 @@ my $i = 0; return join(' ', map { "[" . $i++ . "] $_" } @data); } - elsif ($type == REG_DWORD) { + elsif ($type == REG_DWORD || $type == REG_DWORD_BIG_ENDIAN) { return sprintf '0x%08x (%u)', $data, $data; } else { diff -Nru libparse-win32registry-perl-0.60/lib/Parse/Win32Registry/Win95/File.pm libparse-win32registry-perl-1.0/lib/Parse/Win32Registry/Win95/File.pm --- libparse-win32registry-perl-0.60/lib/Parse/Win32Registry/Win95/File.pm 2010-08-15 21:22:00.000000000 +0000 +++ libparse-win32registry-perl-1.0/lib/Parse/Win32Registry/Win95/File.pm 2012-04-29 10:22:00.000000000 +0000 @@ -82,6 +82,7 @@ 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 diff -Nru libparse-win32registry-perl-0.60/lib/Parse/Win32Registry/Win95/Key.pm libparse-win32registry-perl-1.0/lib/Parse/Win32Registry/Win95/Key.pm --- libparse-win32registry-perl-0.60/lib/Parse/Win32Registry/Win95/Key.pm 2010-08-15 21:22:00.000000000 +0000 +++ libparse-win32registry-perl-1.0/lib/Parse/Win32Registry/Win95/Key.pm 2012-04-29 10:22:00.000000000 +0000 @@ -204,18 +204,4 @@ } } -sub get_associated_offsets { - my $self = shift; - - my @owners = (); - - push @owners, $self->{_offset}; - - if (defined $self->{_offset_to_rgdb_entry}) { - push @owners, $self->{_offset_to_rgdb_entry}; - } - - return @owners; -} - 1; diff -Nru libparse-win32registry-perl-0.60/lib/Parse/Win32Registry/Win95/Value.pm libparse-win32registry-perl-1.0/lib/Parse/Win32Registry/Win95/Value.pm --- libparse-win32registry-perl-0.60/lib/Parse/Win32Registry/Win95/Value.pm 2010-08-15 21:22:00.000000000 +0000 +++ libparse-win32registry-perl-1.0/lib/Parse/Win32Registry/Win95/Value.pm 2012-04-29 10:22:00.000000000 +0000 @@ -90,6 +90,15 @@ $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, @@ -118,13 +127,19 @@ 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->get_data, length($export)); + $export .= format_octets($self->{_data}, length($export)); } elsif ($type == REG_DWORD) { my $data = $self->get_data; @@ -141,9 +156,8 @@ $export .= format_octets($data, length($export)); } else { - my $data = $self->get_data; $export .= sprintf("hex(%x):", $type); - $export .= format_octets($data, length($export)); + $export .= format_octets($self->{_data}, length($export)); } return $export; } @@ -160,14 +174,4 @@ return $info; } -sub get_associated_offsets { - my $self = shift; - - my @owners = (); - - push @owners, $self->{_offset}; - - return @owners; -} - 1; diff -Nru libparse-win32registry-perl-0.60/lib/Parse/Win32Registry/WinNT/File.pm libparse-win32registry-perl-1.0/lib/Parse/Win32Registry/WinNT/File.pm --- libparse-win32registry-perl-0.60/lib/Parse/Win32Registry/WinNT/File.pm 2010-08-15 21:22:00.000000000 +0000 +++ libparse-win32registry-perl-1.0/lib/Parse/Win32Registry/WinNT/File.pm 2012-04-29 10:22:00.000000000 +0000 @@ -107,6 +107,7 @@ 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 diff -Nru libparse-win32registry-perl-0.60/lib/Parse/Win32Registry/WinNT/Key.pm libparse-win32registry-perl-1.0/lib/Parse/Win32Registry/WinNT/Key.pm --- libparse-win32registry-perl-0.60/lib/Parse/Win32Registry/WinNT/Key.pm 2010-08-15 21:22:00.000000000 +0000 +++ libparse-win32registry-perl-1.0/lib/Parse/Win32Registry/WinNT/Key.pm 2012-04-29 10:22:00.000000000 +0000 @@ -90,6 +90,11 @@ } # 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; @@ -100,6 +105,7 @@ warnf('Could not read name for key at 0x%x', $offset); return; } + if ($flags & 0x20) { $name = decode($Parse::Win32Registry::Base::CODEPAGE, $name); } @@ -330,7 +336,6 @@ } elsif ($sig eq 'ri') { foreach my $offset (unpack("V$num_entries", $subkey_list)) { - $self->{_indirect_offsets}{OFFSET_TO_FIRST_HBIN + $offset} = undef; my $offsets_ref = $self->_get_offsets_to_subkeys(OFFSET_TO_FIRST_HBIN + $offset); if (defined $offsets_ref && ref $offsets_ref eq 'ARRAY') { @@ -436,37 +441,4 @@ }); } -sub get_associated_offsets { - my $self = shift; - - my @owners = (); - - push @owners, $self->{_offset}; - - if ($self->{_offset_to_security}) { - push @owners, $self->{_offset_to_security}; - } - - if ($self->{_offset_to_class_name}) { - push @owners, $self->{_offset_to_class_name}; - } - - if ($self->{_num_subkeys}) { - push @owners, $self->{_offset_to_subkey_list}; - } - - # Indirect offsets must be added after _get_offsets_to_subkeys - # has been called (as this populates the _indirect_offsets field) - $self->_get_offsets_to_subkeys; - if ($self->{_indirect_offsets}) { - push @owners, keys %{ $self->{_indirect_offsets} }; - } - - if ($self->{_num_values}) { - push @owners, $self->{_offset_to_value_list}; - } - - return @owners; -} - 1; diff -Nru libparse-win32registry-perl-0.60/lib/Parse/Win32Registry/WinNT/Value.pm libparse-win32registry-perl-1.0/lib/Parse/Win32Registry/WinNT/Value.pm --- libparse-win32registry-perl-0.60/lib/Parse/Win32Registry/WinNT/Value.pm 2010-08-15 21:22:00.000000000 +0000 +++ libparse-win32registry-perl-1.0/lib/Parse/Win32Registry/WinNT/Value.pm 2012-04-29 10:22:00.000000000 +0000 @@ -57,6 +57,11 @@ } # 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; @@ -67,6 +72,7 @@ warnf('Could not read name for value at 0x%x', $offset); return; } + if ($flags & 1) { $name = decode($Parse::Win32Registry::Base::CODEPAGE, $name); } @@ -74,10 +80,9 @@ $name = decode('UCS-2LE', $name); }; - my $data; - # 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 @@ -94,15 +99,15 @@ } } else { - $offset_to_data += OFFSET_TO_FIRST_HBIN - if $offset_to_data != 0xffffffff; - - sysseek($fh, $offset_to_data + 4, 0); - $bytes_read = sysread($fh, $data, $data_length); - if ($bytes_read != $data_length) { - warnf("Could not read data at 0x%x for value '%s' at 0x%x", - $offset_to_data, $name, $offset); - $data = undef; + 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); + } } } @@ -125,6 +130,94 @@ 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; @@ -143,6 +236,15 @@ $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 @@ -171,13 +273,19 @@ 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->get_data, length($export)); + $export .= format_octets($self->{_data}, length($export)); } elsif ($type == REG_DWORD) { my $data = $self->get_data; @@ -194,9 +302,8 @@ $export .= format_octets($data, length($export)); } else { - my $data = $self->get_data; $export .= sprintf("hex(%x):", $type); - $export .= format_octets($data, length($export)); + $export .= format_octets($self->{_data}, length($export)); } return $export; } @@ -222,18 +329,4 @@ return $info; } -sub get_associated_offsets { - my $self = shift; - - my @owners = (); - - push @owners, $self->{_offset}; - - if (!$self->{_data_inline}) { - push @owners, $self->{_offset_to_data}; - } - - return @owners; -} - 1; diff -Nru libparse-win32registry-perl-0.60/lib/Parse/Win32Registry.pm libparse-win32registry-perl-1.0/lib/Parse/Win32Registry.pm --- libparse-win32registry-perl-0.60/lib/Parse/Win32Registry.pm 2010-08-15 21:22:00.000000000 +0000 +++ libparse-win32registry-perl-1.0/lib/Parse/Win32Registry.pm 2012-04-29 10:22:00.000000000 +0000 @@ -4,7 +4,7 @@ use strict; use warnings; -our $VERSION = '0.60'; +our $VERSION = '1.0'; use base qw(Exporter); @@ -39,14 +39,6 @@ $Parse::Win32Registry::Base::WARNINGS = 0; } -sub enable_trace { - $Parse::Win32Registry::Base::TRACE = 1; -} - -sub disable_trace { - $Parse::Win32Registry::Base::TRACE = 0; -} - sub set_codepage { my $codepage = shift; if (defined $codepage) { @@ -1585,7 +1577,7 @@ -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 only the owner SID for the key (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 @@ -1658,6 +1650,20 @@ 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 @@ -1689,7 +1695,6 @@ -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 - -w or --warnings display warnings of invalid keys and values =head2 regsecurity.pl @@ -1816,7 +1821,7 @@ =head1 COPYRIGHT AND LICENSE -Copyright (C) 2006,2007,2008,2009,2010 by James Macfarlane +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. diff -Nru libparse-win32registry-perl-0.60/Makefile.PL libparse-win32registry-perl-1.0/Makefile.PL --- libparse-win32registry-perl-0.60/Makefile.PL 2010-08-15 21:22:00.000000000 +0000 +++ libparse-win32registry-perl-1.0/Makefile.PL 2012-04-29 10:22:00.000000000 +0000 @@ -23,6 +23,7 @@ 'bin/regdump.pl', 'bin/regexport.pl', 'bin/regfind.pl', + 'bin/regml.pl', 'bin/regmultidiff.pl', 'bin/regscan.pl', 'bin/regsecurity.pl', diff -Nru libparse-win32registry-perl-0.60/MANIFEST libparse-win32registry-perl-1.0/MANIFEST --- libparse-win32registry-perl-0.60/MANIFEST 2010-08-15 22:07:25.000000000 +0000 +++ libparse-win32registry-perl-1.0/MANIFEST 2012-04-29 10:22:00.000000000 +0000 @@ -10,6 +10,7 @@ bin/regdump.pl bin/regexport.pl bin/regfind.pl +bin/regml.pl bin/regmultidiff.pl bin/regscan.pl bin/regsecurity.pl diff -Nru libparse-win32registry-perl-0.60/META.yml libparse-win32registry-perl-1.0/META.yml --- libparse-win32registry-perl-0.60/META.yml 2010-08-15 22:07:25.000000000 +0000 +++ libparse-win32registry-perl-1.0/META.yml 2012-04-29 11:54:22.000000000 +0000 @@ -1,19 +1,27 @@ --- #YAML:1.0 -name: Parse-Win32Registry -version: 0.60 -abstract: Parse Windows Registry Files -license: perl -author: +name: Parse-Win32Registry +version: 1.0 +abstract: Parse Windows Registry Files +author: - James Macfarlane -generated_by: ExtUtils::MakeMaker version 6.42 -distribution_type: module -requires: - Carp: 0 - Data::Dumper: 0 - Encode: 0 - File::Basename: 0 - Test::More: 0 - Time::Local: 0 +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.3.html - version: 1.3 + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: 1.4 diff -Nru libparse-win32registry-perl-0.60/README libparse-win32registry-perl-1.0/README --- libparse-win32registry-perl-0.60/README 2010-08-15 21:22:00.000000000 +0000 +++ libparse-win32registry-perl-1.0/README 2012-04-29 10:22:00.000000000 +0000 @@ -25,7 +25,7 @@ COPYRIGHT AND LICENCE -Copyright (C) 2006,2007,2008,2009,2010 by James Macfarlane +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. diff -Nru libparse-win32registry-perl-0.60/t/errors.t libparse-win32registry-perl-1.0/t/errors.t --- libparse-win32registry-perl-0.60/t/errors.t 2010-08-15 21:22:00.000000000 +0000 +++ libparse-win32registry-perl-1.0/t/errors.t 2012-04-29 10:22:00.000000000 +0000 @@ -272,7 +272,7 @@ filename => 'winnt_error_tests.rf', class => 'Parse::Win32Registry::WinNT::Value', offset => 0x19c0, - warning => 'Could not read data at 0x', + warning => 'Invalid offset to data for value \'.*\' at 0x', further_tests => [ ['defined($object)'], ['$object->get_name', 'value5'], diff -Nru libparse-win32registry-perl-0.60/t/misc.t libparse-win32registry-perl-1.0/t/misc.t --- libparse-win32registry-perl-0.60/t/misc.t 2010-08-15 21:22:00.000000000 +0000 +++ libparse-win32registry-perl-1.0/t/misc.t 2012-04-29 10:22:00.000000000 +0000 @@ -478,13 +478,13 @@ [ "TIME22", "\x00\x80\x3e\xd5\x1e\xfd\xe9\x01", - 2147483648, # 2147483648 + undef, # 2147483648 '(undefined)', # '2038-01-19T03:14:08Z' ], [ "TIME23", "\x00\x00\x00\x00\x00\x00\x00\x02", - 2767045207, # 2767045207 + undef, # 2767045207 '(undefined)', # '2057-09-06T23:40:07Z' ], [ diff -Nru libparse-win32registry-perl-0.60/t/security.t libparse-win32registry-perl-1.0/t/security.t --- libparse-win32registry-perl-0.60/t/security.t 2010-08-15 21:22:00.000000000 +0000 +++ libparse-win32registry-perl-1.0/t/security.t 2012-04-29 10:22:00.000000000 +0000 @@ -174,6 +174,19 @@ "\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 { diff -Nru libparse-win32registry-perl-0.60/t/use.t libparse-win32registry-perl-1.0/t/use.t --- libparse-win32registry-perl-0.60/t/use.t 2010-08-15 21:22:00.000000000 +0000 +++ libparse-win32registry-perl-1.0/t/use.t 2012-04-29 10:22:00.000000000 +0000 @@ -5,7 +5,7 @@ BEGIN { use_ok('Parse::Win32Registry') }; -is($Parse::Win32Registry::VERSION, '0.60', 'correct version'); +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'); diff -Nru libparse-win32registry-perl-0.60/t/value.t libparse-win32registry-perl-1.0/t/value.t --- libparse-win32registry-perl-0.60/t/value.t 2010-08-15 21:22:00.000000000 +0000 +++ libparse-win32registry-perl-1.0/t/value.t 2012-04-29 10:22:00.000000000 +0000 @@ -5,6 +5,8 @@ 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; @@ -231,6 +233,78 @@ 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', @@ -632,6 +706,114 @@ 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', Binary files /tmp/jODATHpg0h/libparse-win32registry-perl-0.60/t/win95_value_tests.rf and /tmp/ZlqoBSPtQ9/libparse-win32registry-perl-1.0/t/win95_value_tests.rf differ Binary files /tmp/jODATHpg0h/libparse-win32registry-perl-0.60/t/winnt_value_tests.rf and /tmp/ZlqoBSPtQ9/libparse-win32registry-perl-1.0/t/winnt_value_tests.rf differ