From 1d0a10e989a4d0487aa13cf4f56e533d3795469d Mon Sep 17 00:00:00 2001 From: Charles McGarvey Date: Mon, 25 Apr 2022 13:42:59 -0600 Subject: [PATCH] Remove objects from deleted objects when added --- lib/File/KDBX.pm | 109 ++++++++++++++++++++++-------- lib/File/KDBX/Dumper/XML.pm | 8 +-- lib/File/KDBX/Group.pm | 47 +++++++++++-- lib/File/KDBX/Object.pm | 129 ++++++++++++++++++++---------------- lib/File/KDBX/Util.pm | 10 ++- t/kdb.t | 4 +- 6 files changed, 208 insertions(+), 99 deletions(-) diff --git a/lib/File/KDBX.pm b/lib/File/KDBX.pm index ff2756e..6784ced 100644 --- a/lib/File/KDBX.pm +++ b/lib/File/KDBX.pm @@ -9,7 +9,7 @@ use Devel::GlobalDestruction; use File::KDBX::Constants qw(:all); use File::KDBX::Error; use File::KDBX::Safe; -use File::KDBX::Util qw(:class :coercion :empty :uuid :search erase simple_expression_query snakify); +use File::KDBX::Util qw(:class :coercion :empty :search :uuid erase simple_expression_query snakify); use Hash::Util::FieldHash qw(fieldhashes); use List::Util qw(any first); use Ref::Util qw(is_ref is_arrayref is_plain_hashref); @@ -50,7 +50,7 @@ sub DESTROY { local ($., $@, $!, $^E, $?); !in_global_destruction and $_[0]->res $kdbx = $kdbx->init(%attributes); -Initialize a L with a new set of attributes. Returns itself to allow method chaining. +Initialize a L with a set of attributes. Returns itself to allow method chaining. This is called by L. @@ -273,12 +273,12 @@ has 'meta.master_key_change_force' => -1, coer # has 'meta.memory_protection' => {}; has 'meta.custom_icons' => []; has 'meta.recycle_bin_enabled' => true, coerce => \&to_bool; -has 'meta.recycle_bin_uuid' => "\0" x 16, coerce => \&to_uuid; +has 'meta.recycle_bin_uuid' => UUID_NULL, coerce => \&to_uuid; has 'meta.recycle_bin_changed' => sub { gmtime }, coerce => \&to_time; -has 'meta.entry_templates_group' => "\0" x 16, coerce => \&to_uuid; +has 'meta.entry_templates_group' => UUID_NULL, coerce => \&to_uuid; has 'meta.entry_templates_group_changed' => sub { gmtime }, coerce => \&to_time; -has 'meta.last_selected_group' => "\0" x 16, coerce => \&to_uuid; -has 'meta.last_top_visible_group' => "\0" x 16, coerce => \&to_uuid; +has 'meta.last_selected_group' => UUID_NULL, coerce => \&to_uuid; +has 'meta.last_top_visible_group' => UUID_NULL, coerce => \&to_uuid; has 'meta.history_max_items' => HISTORY_DEFAULT_MAX_ITEMS, coerce => \&to_number; has 'meta.history_max_size' => HISTORY_DEFAULT_MAX_SIZE, coerce => \&to_number; has 'meta.settings_changed' => sub { gmtime }, coerce => \&to_time; @@ -497,7 +497,7 @@ Add a group to a database. This is equivalent to identifying a parent group and L on the parent group, forwarding the arguments. Available options: =for :list -* C (aka C) - Group (object or group UUID) to add the group to (default: root group) +* C (aka C) - Group object or group UUID to add the group to (default: root group) =cut @@ -540,6 +540,10 @@ sub all_groups { my %args = @_ % 2 == 0 ? @_ : (base => shift, @_); my $base = $args{base} // $self->root; + # my @groups; + # push @groups, $self->_wrap_group($base) if $args{include_base} // 1; + # push @groups, @{$base->all_groups}; + # return \@groups; my @groups = $args{include_base} // 1 ? $self->_wrap_group($base) : (); for my $subgroup (@{$base->{groups} || []}) { @@ -582,7 +586,7 @@ Add a entry to a database. This is equivalent to identifying a parent group and L on the parent group, forwarding the arguments. Available options: =for :list -* C (aka C) - Group (object or group UUID) to add the entry to (default: root group) +* C (aka C) - Group object or group UUID to add the entry to (default: root group) =cut @@ -927,12 +931,45 @@ are removed. sub add_deleted_object { my $self = shift; my $uuid = shift; + + # ignore null and meta stream UUIDs + return if $uuid eq UUID_NULL || $uuid eq '0' x 16; + $self->deleted_objects->{$uuid} = { uuid => $uuid, deletion_time => scalar gmtime, }; } +=method remove_deleted_object + + $kdbx->remove_deleted_object($uuid); + +Remove a UUID from the deleted objects list. This list is used to support automatic database merging. + +You typically do not need to call this yourself because the list will be maintained automatically as objects +are added. + +=cut + +sub remove_deleted_object { + my $self = shift; + my $uuid = shift; + delete $self->deleted_objects->{$uuid}; +} + +=method clear_deleted_objects + +Remove all UUIDs from the deleted objects list. This list is used to support automatic database merging, but +if you don't need merging then you can clear deleted objects to reduce the database file size. + +=cut + +sub clear_deleted_objects { + my $self = shift; + %{$self->deleted_objects} = (); +} + ############################################################################## =method resolve_reference @@ -1438,34 +1475,35 @@ sub _handle_signal { my $type = shift; my %handlers = ( + 'entry.added' => \&_handle_object_added, + 'group.added' => \&_handle_object_added, + 'entry.removed' => \&_handle_object_removed, + 'group.removed' => \&_handle_object_removed, 'entry.uuid.changed' => \&_handle_entry_uuid_changed, 'group.uuid.changed' => \&_handle_group_uuid_changed, - 'entry.uuid.removed' => \&_handle_object_removed, - 'group.uuid.removed' => \&_handle_object_removed, ); my $handler = $handlers{$type} or return; $self->$handler($object, @_); } -sub _handle_group_uuid_changed { +sub _handle_object_added { + my $self = shift; + my $object = shift; + $self->remove_deleted_object($object->uuid); +} + +sub _handle_object_removed { my $self = shift; my $object = shift; - my $new_uuid = shift; - my $old_uuid = shift // return; + my $old_uuid = $object->{uuid} // return; my $meta = $self->meta; - $self->recycle_bin_uuid($new_uuid) if $old_uuid eq ($meta->{recycle_bin_uuid} // ''); - $self->entry_templates_group($new_uuid) if $old_uuid eq ($meta->{entry_templates_group} // ''); - $self->last_selected_group($new_uuid) if $old_uuid eq ($meta->{last_selected_group} // ''); - $self->last_top_visible_group($new_uuid) if $old_uuid eq ($meta->{last_top_visible_group} // ''); + $self->recycle_bin_uuid(UUID_NULL) if $old_uuid eq ($meta->{recycle_bin_uuid} // ''); + $self->entry_templates_group(UUID_NULL) if $old_uuid eq ($meta->{entry_templates_group} // ''); + $self->last_selected_group(UUID_NULL) if $old_uuid eq ($meta->{last_selected_group} // ''); + $self->last_top_visible_group(UUID_NULL) if $old_uuid eq ($meta->{last_top_visible_group} // ''); - for my $group (@{$self->all_groups}) { - $group->last_top_visible_entry($new_uuid) if $old_uuid eq ($group->{last_top_visible_entry} // ''); - $group->previous_parent_group($new_uuid) if $old_uuid eq ($group->{previous_parent_group} // ''); - } - for my $entry (@{$self->all_entries}) { - $entry->previous_parent_group($new_uuid) if $old_uuid eq ($entry->{previous_parent_group} // ''); - } + $self->add_deleted_object($old_uuid); } sub _handle_entry_uuid_changed { @@ -1490,10 +1528,25 @@ sub _handle_entry_uuid_changed { } } -sub _handle_object_removed { - my $self = shift; - my $object = shift; - $self->add_delete_object($object->uuid); +sub _handle_group_uuid_changed { + my $self = shift; + my $object = shift; + my $new_uuid = shift; + my $old_uuid = shift // return; + + my $meta = $self->meta; + $self->recycle_bin_uuid($new_uuid) if $old_uuid eq ($meta->{recycle_bin_uuid} // ''); + $self->entry_templates_group($new_uuid) if $old_uuid eq ($meta->{entry_templates_group} // ''); + $self->last_selected_group($new_uuid) if $old_uuid eq ($meta->{last_selected_group} // ''); + $self->last_top_visible_group($new_uuid) if $old_uuid eq ($meta->{last_top_visible_group} // ''); + + for my $group (@{$self->all_groups}) { + $group->last_top_visible_entry($new_uuid) if $old_uuid eq ($group->{last_top_visible_entry} // ''); + $group->previous_parent_group($new_uuid) if $old_uuid eq ($group->{previous_parent_group} // ''); + } + for my $entry (@{$self->all_entries}) { + $entry->previous_parent_group($new_uuid) if $old_uuid eq ($entry->{previous_parent_group} // ''); + } } ######################################################################################### diff --git a/lib/File/KDBX/Dumper/XML.pm b/lib/File/KDBX/Dumper/XML.pm index 07f3888..86eb5c9 100644 --- a/lib/File/KDBX/Dumper/XML.pm +++ b/lib/File/KDBX/Dumper/XML.pm @@ -296,7 +296,7 @@ sub _write_xml_root { if (my $group = $kdbx->root) { my $group_node = $node->addNewChild(undef, 'Group'); - $self->_write_xml_group($group_node, $group->_confirmed); + $self->_write_xml_group($group_node, $group->_committed); } undef $guard; # re-lock if needed, as early as possible @@ -337,12 +337,12 @@ sub _write_xml_group { for my $entry (@{$group->entries}) { my $entry_node = $node->addNewChild(undef, 'Entry'); - $self->_write_xml_entry($entry_node, $entry->_confirmed); + $self->_write_xml_entry($entry_node, $entry->_committed); } for my $group (@{$group->groups}) { my $group_node = $node->addNewChild(undef, 'Group'); - $self->_write_xml_group($group_node, $group->_confirmed); + $self->_write_xml_group($group_node, $group->_committed); } } @@ -423,7 +423,7 @@ sub _write_xml_entry { my $history_node = $node->addNewChild(undef, 'History'); for my $historical (@history) { my $historical_node = $history_node->addNewChild(undef, 'Entry'); - $self->_write_xml_entry($historical_node, $historical->_confirmed, 1); + $self->_write_xml_entry($historical_node, $historical->_committed, 1); } } } diff --git a/lib/File/KDBX/Group.pm b/lib/File/KDBX/Group.pm index 87cda2a..f89d933 100644 --- a/lib/File/KDBX/Group.pm +++ b/lib/File/KDBX/Group.pm @@ -102,7 +102,7 @@ sub add_entry { $entry->kdbx($kdbx) if $kdbx; push @{$self->{entries} ||= []}, $entry->remove; - return $entry->_set_group($self); + return $entry->_set_group($self)->_signal('added', $self); } sub remove_entry { @@ -112,9 +112,8 @@ sub remove_entry { for (my $i = 0; $i < @$objects; ++$i) { my $o = $objects->[$i]; next if $uuid ne $o->uuid; + $o->_set_group(undef)->_signal('removed'); return splice @$objects, $i, 1; - $o->_set_group(undef); - return @$objects, $i, 1; } } @@ -128,10 +127,44 @@ sub groups { return $groups; } +=method all_groups + + \@groups = $group->all_groups(%options); + +Get all groups within a group, deeply, in a flat array. Supported options: + +=cut + sub all_groups { my $self = shift; - # FIXME - shouldn't have to delegate to the database to get this - return $self->kdbx->all_groups(base => $self, include_base => false); + + my @groups; + for my $subgroup (@{$self->groups}) { + push @groups, @{$subgroup->all_groups}; + } + + return \@groups; +} + +=method find_groups + + @groups = $kdbx->find_groups($query, %options); + +Find all groups deeply that match to a query. Options are the same as for L. + +See L for a description of what C<$query> can be. + +=cut + +sub find_groups { + my $self = shift; + my $query = shift or throw 'Must provide a query'; + my %args = @_; + my %all_groups = ( # FIXME + base => $args{base}, + include_base => $args{include_base}, + ); + return @{search($self->all_groups(%all_groups), is_arrayref($query) ? @$query : $query)}; } sub _kpx_groups { shift->groups(@_) } @@ -158,7 +191,7 @@ sub add_group { $group->kdbx($kdbx) if $kdbx; push @{$self->{groups} ||= []}, $group->remove; - return $group->_set_group($self); + return $group->_set_group($self)->_signal('added', $self); } sub remove_group { @@ -168,7 +201,7 @@ sub remove_group { for (my $i = 0; $i < @$objects; ++$i) { my $o = $objects->[$i]; next if $uuid ne $o->uuid; - $o->_set_group(undef); + $o->_set_group(undef)->_signal('removed'); return splice @$objects, $i, 1; } } diff --git a/lib/File/KDBX/Object.pm b/lib/File/KDBX/Object.pm index f01944a..bcbfd58 100644 --- a/lib/File/KDBX/Object.pm +++ b/lib/File/KDBX/Object.pm @@ -469,56 +469,6 @@ sub custom_data_value { ############################################################################## -sub _signal { - my $self = shift; - my $type = shift; - - if ($self->_in_txn) { - my $stack = $self->_signal_stack; - my $queue = $stack->[-1]; - push @$queue, [$type, @_]; - } - - $self->_signal_send([[$type, @_]]); -} - -sub _signal_stack { $SIGNALS{$_[0]} //= [] } - -sub _signal_begin_work { - my $self = shift; - push @{$self->_signal_stack}, []; -} - -sub _signal_commit { - my $self = shift; - my $signals = pop @{$self->_signal_stack}; - my $previous = $self->_signal_stack->[-1] // []; - push @$previous, @$signals; - return $previous; -} - -sub _signal_rollback { - my $self = shift; - pop @{$self->_signal_stack}; -} - -sub _signal_send { - my $self = shift; - my $signals = shift // []; - - my $kdbx = $KDBX{$self} or return; - - # de-duplicate, keeping the most recent signal for each type - my %seen; - my @signals = grep { !$seen{$_->[0]}++ } reverse @$signals; - - for my $sig (reverse @signals) { - $kdbx->_handle_signal($self, @$sig); - } -} - -############################################################################## - =method begin_work $txn = $object->begin_work(%options); @@ -605,10 +555,6 @@ sub commit { return $self; } -sub _commit { die 'Not implemented' } -sub _in_txn { scalar @{$_[0]->_txns} } -sub _txns { $TXNS{$_[0]} //= [] } - =method rollback $object->rollback; @@ -631,6 +577,28 @@ sub rollback { return $self; } +# Get whether or not there is at least one pending transaction. +sub _in_txn { scalar @{$_[0]->_txns} } + +# Get an array ref of pending transactions. +sub _txns { $TXNS{$_[0]} //= [] } + +# The _commit hook notifies subclasses that a commit has occurred. +sub _commit { die 'Not implemented' } + +# Get a reference to an object that represents an object's committed state. If there is no pending +# transaction, this is just $self. If there is a transaction, this is the snapshot take before the transaction +# began. This method is private because it provides direct access to the actual snapshot. It is important that +# the snapshot not be changed or a rollback would roll back to an altered state. +# This is used by File::KDBX::Dumper::XML so as to not dump uncommitted changes. +sub _committed { + my $self = shift; + my ($orig) = @{$self->_txns}; + return $orig // $self; +} + +# In addition to cloning an object when beginning work, we also keep track its hashrefs and arrayrefs +# internally so that we can restore to the very same structures in the case of a rollback. sub _save_references { my $id = shift; my $self = shift; @@ -650,6 +618,7 @@ sub _save_references { } } +# During a rollback, copy data from the snapshot back into the original internal structures. sub _restore_references { my $id = shift; my $orig = shift // return; @@ -669,10 +638,56 @@ sub _restore_references { return $self; } -sub _confirmed { +############################################################################## + +sub _signal { my $self = shift; - my ($orig) = @{$self->_txns}; - return $orig // $self; + my $type = shift; + + if ($self->_in_txn) { + my $stack = $self->_signal_stack; + my $queue = $stack->[-1]; + push @$queue, [$type, @_]; + } + + $self->_signal_send([[$type, @_]]); + + return $self; +} + +sub _signal_stack { $SIGNALS{$_[0]} //= [] } + +sub _signal_begin_work { + my $self = shift; + push @{$self->_signal_stack}, []; +} + +sub _signal_commit { + my $self = shift; + my $signals = pop @{$self->_signal_stack}; + my $previous = $self->_signal_stack->[-1] // []; + push @$previous, @$signals; + return $previous; +} + +sub _signal_rollback { + my $self = shift; + pop @{$self->_signal_stack}; +} + +sub _signal_send { + my $self = shift; + my $signals = shift // []; + + my $kdbx = $KDBX{$self} or return; + + # de-duplicate, keeping the most recent signal for each type + my %seen; + my @signals = grep { !$seen{$_->[0]}++ } reverse @$signals; + + for my $sig (reverse @signals) { + $kdbx->_handle_signal($self, @$sig); + } } ############################################################################## diff --git a/lib/File/KDBX/Util.pm b/lib/File/KDBX/Util.pm index 8f7dcb8..f1b9976 100644 --- a/lib/File/KDBX/Util.pm +++ b/lib/File/KDBX/Util.pm @@ -35,7 +35,7 @@ our %EXPORT_TAGS = ( load => [qw(load_optional load_xs try_load_optional)], search => [qw(query search search_limited simple_expression_query)], text => [qw(snakify trim)], - uuid => [qw(format_uuid generate_uuid is_uuid uuid)], + uuid => [qw(format_uuid generate_uuid is_uuid uuid UUID_NULL)], uri => [qw(split_url uri_escape_utf8 uri_unescape_utf8)], ); @@ -976,6 +976,14 @@ sub uuid { } +=func UUID_NULL + +Get the null UUID (i.e. string of 16 null bytes). + +=cut + +sub UUID_NULL() { "\0" x 16 } + ### -------------------------------------------------------------------------- # Determine if an array looks like keypairs from a hash. diff --git a/t/kdb.t b/t/kdb.t index c16aaf8..02927e8 100644 --- a/t/kdb.t +++ b/t/kdb.t @@ -27,8 +27,8 @@ sub test_basic { transform_seed => "\227\264\n^\230\2\301:!f\364\336\251\277\241[\3`\314RG\343\16U\333\305eT3:\240\257", }), 'Get expected headers from KDB file' or diag explain $kdbx->headers; - is keys %{$kdbx->deleted_objects}, 0, 'There are no deleted objects'; - is scalar @{$kdbx->root->groups}, 2, 'Root group has two children.'; + is keys %{$kdbx->deleted_objects}, 0, 'There are no deleted objects' or dumper $kdbx->deleted_objects; + is scalar @{$kdbx->root->groups}, 2, 'Root group has two children'; my $group1 = $kdbx->root->groups->[0]; isnt $group1->uuid, undef, 'Group 1 has a UUID'; -- 2.43.0