]> Dogcows Code - chaz/p5-File-KDBX/blobdiff - lib/File/KDBX.pm
Add maintenance methods
[chaz/p5-File-KDBX] / lib / File / KDBX.pm
index d02199ab6a6c5f66d71e78f6de7a9da72ea56046..12e87f383b56c2984c8354354b205758ea39a307 100644 (file)
@@ -1,9 +1,10 @@
 package File::KDBX;
-# ABSTRACT: Encrypted databases to store secret text and files
+# ABSTRACT: Encrypted database to store secret text and files
 
 use warnings;
 use strict;
 
+use Crypt::Digest qw(digest_data);
 use Crypt::PRNG qw(random_bytes);
 use Devel::GlobalDestruction;
 use File::KDBX::Constants qw(:all :icon);
@@ -365,12 +366,6 @@ sub minimum_version {
         nonempty $_->previous_parent_group ||
         nonempty $_->tags ||
         (any { nonempty $_->{last_modification_time} } values %{$_->custom_data})
-        # TODO replace next paragraph with this
-        # || $_->entries(history => 1)->next(sub {
-        #     nonempty $_->previous_parent_group ||
-        #     (defined $_->quality_check && !$_->quality_check) ||
-        #     (any { nonempty $_->{last_modification_time} } values %{$_->custom_data})
-        # })
     });
 
     return KDBX_VERSION_4_1 if $self->entries(history => 1)->next(sub {
@@ -626,7 +621,7 @@ sub _wrap_group {
     \&iterator = $kdbx->groups(%options);
     \&iterator = $kdbx->groups($base_group, %options);
 
-Get an iterator over I<groups> within a database. Options:
+Get an L<File::KDBX::Iterator> over I<groups> within a database. Options:
 
 =for :list
 * C<base> - Only include groups within a base group (same as C<$base_group>) (default: L</root>)
@@ -683,12 +678,12 @@ sub _wrap_entry {
     \&iterator = $kdbx->entries(%options);
     \&iterator = $kdbx->entries($base_group, %options);
 
-Get an iterator over I<entries> within a database. Supports the same options as L</groups>, plus some new
-ones:
+Get an L<File::KDBX::Iterator> over I<entries> within a database. Supports the same options as L</groups>,
+plus some new ones:
 
 =for :list
 * C<auto_type> - Only include entries with auto-type enabled (default: false, include all)
-* C<searching> - Only include entries within groups with search enabled (default: false, include all)
+* C<searching> - Only include entries within groups with searching enabled (default: false, include all)
 * C<history> - Also include historical entries (default: false, include only current entries)
 
 =cut
@@ -708,9 +703,9 @@ sub entries {
     \&iterator = $kdbx->objects(%options);
     \&iterator = $kdbx->objects($base_group, %options);
 
-Get an iterator over I<objects> within a database. Groups and entries are considered objects, so this is
-essentially a combination of L</groups> and L</entries>. This won't often be useful, but it can be convenient
-for maintenance tasks. This method takes the same options as L</groups> and L</entries>.
+Get an L<File::KDBX::Iterator> over I<objects> within a database. Groups and entries are considered objects,
+so this is essentially a combination of L</groups> and L</entries>. This won't often be useful, but it can be
+convenient for maintenance tasks. This method takes the same options as L</groups> and L</entries>.
 
 =cut
 
@@ -784,11 +779,13 @@ sub custom_icon_data {
 =method add_custom_icon
 
     $uuid = $kdbx->add_custom_icon($image_data, %attributes);
+    $uuid = $kdbx->add_custom_icon(%attributes);
 
 Add a custom icon and get its UUID. If not provided, a random UUID will be generated. Possible attributes:
 
 =for :list
 * C<uuid> - Icon UUID (default: autogenerated)
+* C<data> - Image data (same as C<$image_data>)
 * C<name> - Name of the icon (text, KDBX4.1+)
 * C<last_modification_time> - Just what it says (datetime, KDBX4.1+)
 
@@ -796,14 +793,15 @@ Add a custom icon and get its UUID. If not provided, a random UUID will be gener
 
 sub add_custom_icon {
     my $self = shift;
-    my $img  = shift or throw 'Must provide image data';
-    my %args = @_;
+    my %args = @_ % 2 == 1 ? (data => shift, @_) : @_;
+
+    defined $args{data} or throw 'Must provide image data';
 
     my $uuid = $args{uuid} // generate_uuid;
     push @{$self->custom_icons}, {
         @_,
         uuid    => $uuid,
-        data    => $img,
+        data    => $args{data},
     };
     return $uuid;
 }
@@ -1055,11 +1053,11 @@ sub resolve_reference {
     $wanted && $search_in && nonempty($text) or return;
 
     my %fields = (
-        T   => 'expanded_title',
-        U   => 'expanded_username',
-        P   => 'expanded_password',
-        A   => 'expanded_url',
-        N   => 'expanded_notes',
+        T   => 'expand_title',
+        U   => 'expand_username',
+        P   => 'expand_password',
+        A   => 'expand_url',
+        N   => 'expand_notes',
         I   => 'uuid',
         O   => 'other_strings',
     );
@@ -1077,12 +1075,12 @@ sub resolve_reference {
 
 our %PLACEHOLDERS = (
     # 'PLACEHOLDER'       => sub { my ($entry, $arg) = @_; ... };
-    'TITLE'             => sub { $_[0]->expanded_title },
-    'USERNAME'          => sub { $_[0]->expanded_username },
-    'PASSWORD'          => sub { $_[0]->expanded_password },
-    'NOTES'             => sub { $_[0]->expanded_notes },
+    'TITLE'             => sub { $_[0]->expand_title },
+    'USERNAME'          => sub { $_[0]->expand_username },
+    'PASSWORD'          => sub { $_[0]->expand_password },
+    'NOTES'             => sub { $_[0]->expand_notes },
     'S:'                => sub { $_[0]->string_value($_[1]) },
-    'URL'               => sub { $_[0]->expanded_url },
+    'URL'               => sub { $_[0]->expand_url },
     'URL:RMVSCM'        => sub { local $_ = $_[0]->url; s!^[^:/\?\#]+://!!; $_ },
     'URL:WITHOUTSCHEME' => sub { local $_ = $_[0]->url; s!^[^:/\?\#]+://!!; $_ },
     'URL:SCM'           => sub { (split_url($_[0]->url))[0] },
@@ -1160,6 +1158,9 @@ Encrypt all protected binaries strings in a database. The encrypted strings are
 a L<File::KDBX::Safe> associated with the database and the actual strings will be replaced with C<undef> to
 indicate their protected state. Returns itself to allow method chaining.
 
+You can call C<code> on an already-locked database to memory-protect any unprotected strings and binaries
+added after the last time the database was locked.
+
 =cut
 
 sub _safe {
@@ -1257,6 +1258,129 @@ sub is_locked { $_[0]->_safe ? 1 : 0 }
 
 ##############################################################################
 
+# sub check {
+# - Fixer tool. Can repair inconsistencies, including:
+#   - Orphaned binaries... not really a thing anymore since we now distribute binaries amongst entries
+#   - Unused custom icons (OFF, data loss)
+#   - Duplicate icons
+#   - All data types are valid
+#     - date times are correct
+#     - boolean fields
+#     - All UUIDs refer to things that exist
+#       - previous parent group
+#       - recycle bin
+#       - last selected group
+#       - last visible group
+#   - Enforce history size limits (ON)
+#   - Check headers/meta (ON)
+#   - Duplicate deleted objects (ON)
+#   - Duplicate window associations (OFF)
+#   - Header UUIDs match known ciphers/KDFs?
+# }
+
+=method remove_empty_groups
+
+    $kdbx->remove_empty_groups;
+
+Remove groups with no subgroups and no entries.
+
+=cut
+
+sub remove_empty_groups {
+    my $self = shift;
+    my @removed;
+    $self->groups(algorithm => 'dfs')
+    ->where(-true => 'is_empty')
+    ->each(sub { push @removed, $_->remove });
+    return @removed;
+}
+
+=method remove_unused_icons
+
+    $kdbx->remove_unused_icons;
+
+Remove icons that are not associated with any entry or group in the database.
+
+=cut
+
+sub remove_unused_icons {
+    my $self = shift;
+    my %icons = map { $_->{uuid} => 0 } @{$self->custom_icons};
+
+    $self->objects->each(sub { ++$icons{$_->custom_icon_uuid // ''} });
+
+    my @removed;
+    push @removed, $self->remove_custom_icon($_) for grep { $icons{$_} == 0 } keys %icons;
+    return @removed;
+}
+
+=method remove_duplicate_icons
+
+    $kdbx->remove_duplicate_icons;
+
+Remove duplicate icons as determined by hashing the icon data.
+
+=cut
+
+sub remove_duplicate_icons {
+    my $self = shift;
+
+    my %seen;
+    my %dup;
+    for my $icon (@{$self->custom_icons}) {
+        my $digest = digest_data('SHA256', $icon->{data});
+        if (my $other = $seen{$digest}) {
+            $dup{$icon->{uuid}} = $other->{uuid};
+        }
+        else {
+            $seen{$digest} = $icon;
+        }
+    }
+
+    my @removed;
+    while (my ($old_uuid, $new_uuid) = each %dup) {
+        $self->objects
+        ->where(custom_icon_uuid => $old_uuid)
+        ->each(sub { $_->custom_icon_uuid($new_uuid) });
+        push @removed, $self->remove_custom_icon($old_uuid);
+    }
+    return @removed;
+}
+
+=method prune_history
+
+    $kdbx->prune_history(%options);
+
+Remove just as many older historical entries as necessary to get under certain limits.
+
+=for :list
+* C<max_items> - Maximum number of historical entries to keep (default: value of L</history_max_items>, no
+    limit: -1)
+* C<max_size> - Maximum total size (in bytes) of historical entries to keep (default: value of
+    L</history_max_size>, no limit: -1)
+* C<max_age> - Maximum age (in days) of historical entries to keep (default: 365, no limit: -1)
+
+=cut
+
+sub prune_history {
+    my $self = shift;
+    my %args = @_;
+
+    my $max_items = $args{max_items} // $self->history_max_items // HISTORY_DEFAULT_MAX_ITEMS;
+    my $max_size  = $args{max_size}  // $self->history_max_size  // HISTORY_DEFAULT_MAX_SIZE;
+    my $max_age   = $args{max_age}   // HISTORY_DEFAULT_MAX_AGE;
+
+    my @removed;
+    $self->entries->each(sub {
+        push @removed, $_->prune_history(
+            max_items   => $max_items,
+            max_size    => $max_size,
+            max_age     => $max_age,
+        );
+    });
+    return @removed;
+}
+
 =method randomize_seeds
 
     $kdbx->randomize_seeds;
@@ -1468,29 +1592,6 @@ sub inner_random_stream_key {
 
 #########################################################################################
 
-# sub check {
-# - Fixer tool. Can repair inconsistencies, including:
-#   - Orphaned binaries... not really a thing anymore since we now distribute binaries amongst entries
-#   - Unused custom icons (OFF, data loss)
-#   - Duplicate icons
-#   - All data types are valid
-#     - date times are correct
-#     - boolean fields
-#     - All UUIDs refer to things that exist
-#       - previous parent group
-#       - recycle bin
-#       - last selected group
-#       - last visible group
-#   - Enforce history size limits (ON)
-#   - Check headers/meta (ON)
-#   - Duplicate deleted objects (ON)
-#   - Duplicate window associations (OFF)
-#   - Only one root group (ON)
-  # - Header UUIDs match known ciphers/KDFs?
-# }
-
-#########################################################################################
-
 sub _handle_signal {
     my $self    = shift;
     my $object  = shift;
@@ -1573,6 +1674,29 @@ sub _handle_group_uuid_changed {
 
 #########################################################################################
 
+=attr sig1
+
+=attr sig2
+
+=attr version
+
+=attr headers
+
+=attr inner_headers
+
+=attr meta
+
+=attr binaries
+
+=attr deleted_objects
+
+Hash of UUIDs for objects that have been deleted. This includes groups, entries and even custom icons.
+
+=attr raw
+
+Bytes contained within the encrypted layer of a KDBX file. This is only set when using
+L<File::KDBX::Loader::Raw>.
+
 =attr comment
 
 A text string associated with the database. Often unset.
@@ -1692,6 +1816,12 @@ Number of days until the agent should prompt to force changing the master key.
 Note: This is purely advisory. It is up to the individual agent software to actually enforce it.
 C<File::KDBX> does NOT enforce it.
 
+=attr custom_icons
+
+Array of custom icons that can be associated with groups and entries.
+
+This list can be managed with the methods L</add_custom_icon> and L</remove_custom_icon>.
+
 =attr recycle_bin_enabled
 
 Boolean indicating whether removed groups and entries should go to a recycle bin or be immediately deleted.
@@ -1839,11 +1969,11 @@ considerations.
 =head2 Read an existing database
 
     my $kdbx = File::KDBX->load_file('mypasswords.kdbx', 'master password CHANGEME');
-    $kdbx->unlock;
+    $kdbx->unlock;  # cause $entry->password below to be defined
 
     $kdbx->entries->each(sub {
         my ($entry) = @_;
-        say 'Found password for ', $entry->title;
+        say 'Found password for: ', $entry->title;
         say '  Username: ', $entry->username;
         say '  Password: ', $entry->password;
     });
@@ -1885,10 +2015,21 @@ Example output:
 
 Recycle all entries with the string "too old" appearing in the B<Notes> string.
 
+=head2 Remove empty groups
+
+    $kdbx->groups(algorithm => 'dfs')
+        ->where(-true => 'is_empty')
+        ->each('remove');
+
+With the search/iteration C<algorithm> set to "dfs", groups will be ordered deepest first and the root group
+will be last. This allows removing groups that only contain empty groups.
+
+This can also be done with one call to L</remove_empty_groups>.
+
 =head1 SECURITY
 
 One of the biggest threats to your database security is how easily the encryption key can be brute-forced.
-Strong brute-force protection depends on a couple factors:
+Strong brute-force protection depends on:
 
 =for :list
 * Using unguessable passwords, passphrases and key files.
@@ -1951,7 +2092,7 @@ and zeroing out memory that holds secrets after they're no longer needed, but it
 
 For one thing, the encryption key is stored in the same address space. If core is dumped, the encryption key
 is available to be found out. But at least there is the chance that the encryption key and the encrypted
-secrets won't both be paged out while memory-constrained.
+secrets won't both be paged out together while memory-constrained.
 
 Another problem is that some perls (somewhat notoriously) copy around memory behind the scenes willy nilly,
 and it's difficult know when perl makes a copy of a secret in order to be able to zero it out later. It might
@@ -1983,7 +2124,7 @@ unfortunately not portable.
 To find things in a KDBX database, you should use a filtered iterator. If you have an iterator, such as
 returned by L</entries>, L</groups> or even L</objects> you can filter it using L<File::KDBX::Iterator/where>.
 
-    my $filtered_results = $kdbx->entries->where($query);
+    my $filtered_entries = $kdbx->entries->where($query);
 
 A C<$query> is just a subroutine that you can either write yourself or have generated for you from either
 a L</"Simple Expression"> or L</"Declarative Syntax">. It's easier to have your query generated, so I'll cover
@@ -2006,8 +2147,8 @@ To search for all entries in a database with the word "canyon" appearing anywher
 
     my $entries = $kdbx->entries->where(\'canyon', qw[title]);
 
-Notice the first argument is a B<scalarref>. This diambiguates a simple expression from other types of queries
-covered below.
+Notice the first argument is a B<scalarref>. This disambiguates a simple expression from other types of
+queries covered below.
 
 As mentioned, a simple expression can have multiple terms. This simple expression query matches any entry that
 has the words "red" B<and> "canyon" anywhere in the title:
@@ -2020,8 +2161,8 @@ To search for entries with "red" in the title but B<not> "canyon", just prepend
 
     my $entries = $kdbx->entries->where(\'red -canyon', qw[title]);
 
-To search over multiple fields simultaneously, just list them. To search for entries with "grocery" in the
-title or notes but not "Foodland":
+To search over multiple fields simultaneously, just list them all. To search for entries with "grocery" (but
+not "Foodland") in the title or notes:
 
     my $entries = $kdbx->entries->where(\'grocery -Foodland', qw[title notes]);
 
@@ -2031,7 +2172,7 @@ expression. For example, to search for any entry that has been used at least fiv
 
     my $entries = $kdbx->entries->where(\5, '>=', qw[usage_count]);
 
-It helps to read it right-to-left, like "usage_count is >= 5".
+It helps to read it right-to-left, like "usage_count is greater than or equal to 5".
 
 If you find the disambiguating structures to be distracting or confusing, you can also the
 L<File::KDBX::Util/simple_expression_query> function as a more intuitive alternative. The following example is
@@ -2042,7 +2183,7 @@ equivalent to the previous:
 =head2 Declarative Syntax
 
 Structuring a declarative query is similar to L<SQL::Abstract/"WHERE CLAUSES">, but you don't have to be
-familiar with that module. Just learn by examples.
+familiar with that module. Just learn by examples here.
 
 To search for all entries in a database titled "My Bank":
 
@@ -2071,8 +2212,6 @@ with a particular URL B<OR> username:
         username => 'neo',
     ]);
 
-
-
 You can use different operators to test different types of attributes. The L<File::KDBX::Entry/icon_id>
 attribute is a number, so we should use a number comparison operator. To find entries using the smartphone
 icon:
@@ -2127,17 +2266,15 @@ by its L<File::KDBX::Group/uuid>), we can use the C<ne> (string not equal) opera
             'ne' => uuid('596f7520-6172-6520-7370-656369616c2e'),
         },
     );
-    if (1 < $groups->count) { say "Problem: there can be only one!" }
 
-Note: L<File::KDBX::Util/uuid> is a little helper function to convert a UUID in its pretty form into bytes.
-This helper function isn't special to this example or to queries generally. It could have been written with
+Note: L<File::KDBX::Util/uuid> is a little utility function to convert a UUID in its pretty form into bytes.
+This utility function isn't special to this example or to queries generally. It could have been written with
 a literal such as C<"\x59\x6f\x75\x20\x61...">, but that's harder to read.
 
 Notice we searched for groups this time. Finding groups works exactly the same as it does for entries.
 
 Notice also that we didn't wrap the query in hashref curly-braces or arrayref square-braces. Those are
-optional. By default it will only match ALL attributes (as if there were curly-braces), but it doesn't matter
-if there is only one attribute so it's fine to rely on the implicit behavior.
+optional. By default it will only match ALL attributes (as if there were curly-braces).
 
 Testing the truthiness of an attribute is a little bit different because it isn't a binary operation. To find
 all entries with the password quality check disabled:
@@ -2149,7 +2286,7 @@ against. To test that a boolean value is true, use the C<!!> operator (or C<-tru
 weird for your taste):
 
     my $entries = $kdbx->entries->where('!!'  => 'quality_check');
-    my $entries = $kdbx->entries->where(-true => 'quality_check');
+    my $entries = $kdbx->entries->where(-true => 'quality_check');  # same thing
 
 Yes, there is also a C<-false> and a C<-not> if you prefer one of those over C<!>. C<-false> and C<-not>
 (along with C<-true>) are also special in that you can use them to invert the logic of a subquery. These are
@@ -2181,7 +2318,8 @@ be called once for each object being searched over. The subroutine should match
 criteria you want and return true if it matches or false to skip. To do this, just pass your subroutine
 coderef to C<where>.
 
-For example, these are all equivalent to find all entries in the database titled "My Bank":
+To review the different types of queries, these are all equivalent to find all entries in the database titled
+"My Bank":
 
     my $entries = $kdbx->entries->where(\'"My Bank"', 'eq', qw[title]);     # simple expression
     my $entries = $kdbx->entries->where(title => 'My Bank');                # declarative syntax
@@ -2203,6 +2341,47 @@ your own query logic, like this:
         }
     }
 
+=head2 Iteration
+
+Iterators are the built-in way to navigate or walk the database tree. You get an iterator from L</entries>,
+L</groups> and L</groups>. You can specify the search algorithm to iterate over objects in different orders
+using the C<algorith> option, which can be one of:
+
+=for :list
+* C<ITERATION_IDS> - Iterative deepending search (default)
+* C<ITERATION_DFS> - Depth-first search
+* C<ITERATION_BFS> - Breatdth-first search
+
+When iterating over objects generically, groups always preceed their direct entries (if any). When the
+C<history> option is used, current entries always preceed historical entries.
+
+If you have a database tree like this:
+
+    Database
+    - Root
+        - Group1
+            - EntryA
+            - Group2
+                - EntryB
+        - Group3
+            - EntryC
+
+IDS order of groups is: Root, Group1, Group2, Group3
+IDS order of entries is: EntryA, EntryB, EntryC
+IDS order of objects is: Root, Group1, EntryA, Group2, EntryB, Group3, EntryC
+
+DFS order of groups is: Group2, Group1, Group3, Root
+DFS order of entries is: EntryB, EntryA, EntryC
+DFS order of objects is: Group2, EntryB, Group1, EntryA, Group3, EntryC, Root
+
+BFS order of groups is: Root, Group1, Group3, Group2
+BFS order of entries is: EntryA, EntryC, EntryB
+BFS order of objects is: Root, Group1, EntryA, Group3, EntryC, Group2, EntryB
+
+=head1 MERGING
+
+B<TODO> - This is a planned feature, not yet implemented.
+
 =head1 ERRORS
 
 Errors in this package are constructed as L<File::KDBX::Error> objects and propagated using perl's built-in
@@ -2284,27 +2463,4 @@ when trying to use such features with undersized IVs.
 L<File::KeePass> is a much older alternative. It's good but has a backlog of bugs and lacks support for newer
 KDBX features.
 
-=attr sig1
-
-=attr sig2
-
-=attr version
-
-=attr headers
-
-=attr inner_headers
-
-=attr meta
-
-=attr binaries
-
-=attr deleted_objects
-
-=attr raw
-
-    $value = $kdbx->$attr;
-    $kdbx->$attr($value);
-
-Get and set attributes.
-
 =cut
This page took 0.032711 seconds and 4 git commands to generate.