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);
+use File::KDBX::Constants qw(:all :icon);
use File::KDBX::Error;
use File::KDBX::Safe;
-use File::KDBX::Util qw(:empty erase generate_uuid search 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);
+use List::Util qw(any first);
use Ref::Util qw(is_ref is_arrayref is_plain_hashref);
use Scalar::Util qw(blessed);
use Time::Piece;
my $self = bless {}, $class;
$self->init(@_);
- $self->_set_default_attributes if empty $self;
+ $self->_set_nonlazy_attributes if empty $self;
return $self;
}
$kdbx = $kdbx->init(%attributes);
-Initialize a L<File::KDBX> with a new set of attributes. Returns itself to allow method chaining.
+Initialize a L<File::KDBX> with a set of attributes. Returns itself to allow method chaining.
This is called by L</new>.
$KEYS{$self} = $key;
$SAFE{$self} = $safe;
- for my $object (@{$self->all_groups}, @{$self->all_entries(history => 1)}) {
- $object->kdbx($self);
- }
+ # Dualvars aren't cloned as dualvars, so coerce the compression flags.
+ $self->compression_flags($self->compression_flags);
+
+ $self->objects(history => 1)->each(sub { $_->kdbx($self) });
}
##############################################################################
__PACKAGE__, $VERSION, @Config::Config{qw(package version osname osvers archname)});
}
-=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
-
-my %ATTRS = (
- sig1 => KDBX_SIG1,
- sig2 => KDBX_SIG2_2,
- version => KDBX_VERSION_3_1,
- headers => sub { +{} },
- inner_headers => sub { +{} },
- meta => sub { +{} },
- binaries => sub { +{} },
- deleted_objects => sub { +{} },
- raw => undef,
-);
-my %ATTRS_HEADERS = (
- HEADER_COMMENT() => '',
- HEADER_CIPHER_ID() => CIPHER_UUID_CHACHA20,
- HEADER_COMPRESSION_FLAGS() => COMPRESSION_GZIP,
- HEADER_MASTER_SEED() => sub { random_bytes(32) },
- # HEADER_TRANSFORM_SEED() => sub { random_bytes(32) },
- # HEADER_TRANSFORM_ROUNDS() => 100_000,
- HEADER_ENCRYPTION_IV() => sub { random_bytes(16) },
- # HEADER_INNER_RANDOM_STREAM_KEY() => sub { random_bytes(32) }, # 64?
- HEADER_STREAM_START_BYTES() => sub { random_bytes(32) },
- # HEADER_INNER_RANDOM_STREAM_ID() => STREAM_ID_CHACHA20,
- HEADER_KDF_PARAMETERS() => sub {
- +{
- KDF_PARAM_UUID() => KDF_UUID_AES,
- KDF_PARAM_AES_ROUNDS() => $_[0]->headers->{+HEADER_TRANSFORM_ROUNDS} // KDF_DEFAULT_AES_ROUNDS,
- KDF_PARAM_AES_SEED() => $_[0]->headers->{+HEADER_TRANSFORM_SEED} // random_bytes(32),
- };
- },
- # HEADER_PUBLIC_CUSTOM_DATA() => sub { +{} },
-);
-my %ATTRS_META = (
- generator => '',
- header_hash => '',
- database_name => '',
- database_name_changed => sub { gmtime },
- database_description => '',
- database_description_changed => sub { gmtime },
- default_username => '',
- default_username_changed => sub { gmtime },
- maintenance_history_days => 0,
- color => '',
- master_key_changed => sub { gmtime },
- master_key_change_rec => -1,
- master_key_change_force => -1,
- # memory_protection => sub { +{} },
- custom_icons => sub { +{} },
- recycle_bin_enabled => true,
- recycle_bin_uuid => "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0",
- recycle_bin_changed => sub { gmtime },
- entry_templates_group => "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0",
- entry_templates_group_changed => sub { gmtime },
- last_selected_group => "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0",
- last_top_visible_group => "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0",
- history_max_items => HISTORY_DEFAULT_MAX_ITEMS,
- history_max_size => HISTORY_DEFAULT_MAX_SIZE,
- settings_changed => sub { gmtime },
- # binaries => sub { +{} },
- # custom_data => sub { +{} },
-);
-my %ATTRS_MEMORY_PROTECTION = (
- protect_title => false,
- protect_username => false,
- protect_password => true,
- protect_url => false,
- protect_notes => false,
- auto_enable_visual_hiding => false,
-);
-
-sub _update_group_uuid {
- my $self = shift;
- my $old_uuid = shift // return;
- my $new_uuid = shift;
-
- 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} // '');
- }
-}
-
-sub _update_entry_uuid {
- my $self = shift;
- my $old_uuid = shift // return;
- my $new_uuid = shift;
-
- for my $entry (@{$self->all_entries}) {
- $entry->previous_parent_group($new_uuid) if $old_uuid eq ($entry->{previous_parent_group} // '');
- }
-}
-
-while (my ($attr, $default) = each %ATTRS) {
- no strict 'refs'; ## no critic (ProhibitNoStrict)
- *{$attr} = sub {
- my $self = shift;
- $self->{$attr} = shift if @_;
- $self->{$attr} //= (ref $default eq 'CODE') ? $default->($self) : $default;
- };
-}
-while (my ($attr, $default) = each %ATTRS_HEADERS) {
- no strict 'refs'; ## no critic (ProhibitNoStrict)
- *{$attr} = sub {
- my $self = shift;
- $self->headers->{$attr} = shift if @_;
- $self->headers->{$attr} //= (ref $default eq 'CODE') ? $default->($self) : $default;
- };
-}
-while (my ($attr, $default) = each %ATTRS_META) {
- no strict 'refs'; ## no critic (ProhibitNoStrict)
- *{$attr} = sub {
- my $self = shift;
- $self->meta->{$attr} = shift if @_;
- $self->meta->{$attr} //= (ref $default eq 'CODE') ? $default->($self) : $default;
+has sig1 => KDBX_SIG1, coerce => \&to_number;
+has sig2 => KDBX_SIG2_2, coerce => \&to_number;
+has version => KDBX_VERSION_3_1, coerce => \&to_number;
+has headers => {};
+has inner_headers => {};
+has meta => {};
+has binaries => {};
+has deleted_objects => {};
+has raw => coerce => \&to_string;
+
+# HEADERS
+has 'headers.comment' => '', coerce => \&to_string;
+has 'headers.cipher_id' => CIPHER_UUID_CHACHA20, coerce => \&to_uuid;
+has 'headers.compression_flags' => COMPRESSION_GZIP, coerce => \&to_compression_constant;
+has 'headers.master_seed' => sub { random_bytes(32) }, coerce => \&to_string;
+has 'headers.encryption_iv' => sub { random_bytes(16) }, coerce => \&to_string;
+has 'headers.stream_start_bytes' => sub { random_bytes(32) }, coerce => \&to_string;
+has 'headers.kdf_parameters' => sub {
+ +{
+ KDF_PARAM_UUID() => KDF_UUID_AES,
+ KDF_PARAM_AES_ROUNDS() => $_[0]->headers->{+HEADER_TRANSFORM_ROUNDS} // KDF_DEFAULT_AES_ROUNDS,
+ KDF_PARAM_AES_SEED() => $_[0]->headers->{+HEADER_TRANSFORM_SEED} // random_bytes(32),
};
-}
-while (my ($attr, $default) = each %ATTRS_MEMORY_PROTECTION) {
- no strict 'refs'; ## no critic (ProhibitNoStrict)
- *{$attr} = sub {
- my $self = shift;
- $self->meta->{$attr} = shift if @_;
- $self->meta->{$attr} //= (ref $default eq 'CODE') ? $default->($self) : $default;
- };
-}
-
-my @ATTRS_OTHER = (
+};
+# has 'headers.transform_seed' => sub { random_bytes(32) };
+# has 'headers.transform_rounds' => 100_000;
+# has 'headers.inner_random_stream_key' => sub { random_bytes(32) }; # 64 ?
+# has 'headers.inner_random_stream_id' => STREAM_ID_CHACHA20;
+# has 'headers.public_custom_data' => {};
+
+# META
+has 'meta.generator' => '', coerce => \&to_string;
+has 'meta.header_hash' => '', coerce => \&to_string;
+has 'meta.database_name' => '', coerce => \&to_string;
+has 'meta.database_name_changed' => sub { gmtime }, coerce => \&to_time;
+has 'meta.database_description' => '', coerce => \&to_string;
+has 'meta.database_description_changed' => sub { gmtime }, coerce => \&to_time;
+has 'meta.default_username' => '', coerce => \&to_string;
+has 'meta.default_username_changed' => sub { gmtime }, coerce => \&to_time;
+has 'meta.maintenance_history_days' => 0, coerce => \&to_number;
+has 'meta.color' => '', coerce => \&to_string;
+has 'meta.master_key_changed' => sub { gmtime }, coerce => \&to_time;
+has 'meta.master_key_change_rec' => -1, coerce => \&to_number;
+has 'meta.master_key_change_force' => -1, coerce => \&to_number;
+# has 'meta.memory_protection' => {};
+has 'meta.custom_icons' => [];
+has 'meta.recycle_bin_enabled' => true, coerce => \&to_bool;
+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' => UUID_NULL, coerce => \&to_uuid;
+has 'meta.entry_templates_group_changed' => sub { gmtime }, coerce => \&to_time;
+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;
+# has 'meta.binaries' => {};
+# has 'meta.custom_data' => {};
+
+has 'memory_protection.protect_title' => false, coerce => \&to_bool;
+has 'memory_protection.protect_username' => false, coerce => \&to_bool;
+has 'memory_protection.protect_password' => true, coerce => \&to_bool;
+has 'memory_protection.protect_url' => false, coerce => \&to_bool;
+has 'memory_protection.protect_notes' => false, coerce => \&to_bool;
+# has 'memory_protection.auto_enable_visual_hiding' => false;
+
+my @ATTRS = (
HEADER_TRANSFORM_SEED,
HEADER_TRANSFORM_ROUNDS,
HEADER_INNER_RANDOM_STREAM_KEY,
HEADER_INNER_RANDOM_STREAM_ID,
+ HEADER_PUBLIC_CUSTOM_DATA,
);
-sub _set_default_attributes {
+sub _set_nonlazy_attributes {
my $self = shift;
- $self->$_ for keys %ATTRS, keys %ATTRS_HEADERS, keys %ATTRS_META, keys %ATTRS_MEMORY_PROTECTION,
- @ATTRS_OTHER;
+ $self->$_ for list_attributes(ref $self), @ATTRS;
}
=method memory_protection
return KDBX_VERSION_4_1 if any {
nonempty $_->{name} || nonempty $_->{last_modification_time}
- } values %{$self->custom_icons};
+ } @{$self->custom_icons};
- return KDBX_VERSION_4_1 if any {
- nonempty $_->previous_parent_group || nonempty $_->tags ||
- any { nonempty $_->{last_modification_time} } values %{$_->custom_data}
- } @{$self->all_groups};
+ return KDBX_VERSION_4_1 if $self->groups->next(sub {
+ nonempty $_->previous_parent_group ||
+ nonempty $_->tags ||
+ (any { nonempty $_->{last_modification_time} } values %{$_->custom_data})
+ });
- return KDBX_VERSION_4_1 if any {
- nonempty $_->previous_parent_group || (defined $_->quality_check && !$_->quality_check) ||
- any { nonempty $_->{last_modification_time} } values %{$_->custom_data}
- } @{$self->all_entries(history => 1)};
+ return KDBX_VERSION_4_1 if $self->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_0 if $self->kdf->uuid ne KDF_UUID_AES;
return KDBX_VERSION_4_0 if nonempty $self->public_custom_data;
- return KDBX_VERSION_4_0 if any {
+ return KDBX_VERSION_4_0 if $self->objects->next(sub {
nonempty $_->custom_data
- } @{$self->all_groups}, @{$self->all_entries(history => 1)};
+ });
return KDBX_VERSION_3_1;
}
##############################################################################
-=method add_group
-
- $kdbx->add_group($group, %options);
- $kdbx->add_group(%group_attributes, %options);
-
-Add a group to a database. This is equivalent to identifying a parent group and calling
-L<File::KDBX::Group/add_group> on the parent group, forwarding the arguments. Available options:
-
-=for :list
-* C<group> (aka C<parent>) - Group (object or group UUID) to add the group to (default: root group)
-
-=cut
-
-sub add_group {
- my $self = shift;
- my $group = @_ % 2 == 1 ? shift : undef;
- my %args = @_;
-
- # find the right group to add the group to
- my $parent = delete $args{group} // delete $args{parent} // $self->root;
- ($parent) = $self->find_groups({uuid => $parent}) if !ref $parent;
- $parent or throw 'Invalid group';
-
- return $parent->add_group(defined $group ? $group : (), %args, kdbx => $self);
-}
-
-sub _wrap_group {
- my $self = shift;
- my $group = shift;
- require File::KDBX::Group;
- return File::KDBX::Group->wrap($group, $self);
-}
-
=method root
$group = $kdbx->root;
because it autovivifies when adding entries and groups to the database.
Every database has only a single root group at a time. Some old KDB files might have multiple root groups.
-When reading such files, a single implicit root group is created to contain the other explicit groups. When
+When reading such files, a single implicit root group is created to contain the actual root groups. When
writing to such a format, if the root group looks like it was implicitly created then it won't be written and
the resulting file might have multiple root groups. This allows working with older files without changing
-their written internal structure while still adhering to the modern restrictions while the database is opened.
+their written internal structure while still adhering to modern semantics while the database is opened.
-B<WARNING:> The root group of a KDBX database contains all of the database's entries and other groups. If you
-replace the root group, you are essentially replacing the entire database contents with something else.
+The root group of a KDBX database contains all of the database's entries and other groups. If you replace the
+root group, you are essentially replacing the entire database contents with something else.
=cut
return $self->_wrap_group($self->{root});
}
+# Called by File::KeePass::KDBX so that a File::KDBX an be treated as a File::KDBX::Group in that both types
+# can have subgroups. File::KDBX already has a `groups' method that does something different from the
+# File::KDBX::Groups `groups' method.
sub _kpx_groups {
my $self = shift;
return [] if !$self->{root};
);
}
-=method all_groups
-
- \@groups = $kdbx->all_groups(%options);
- \@groups = $kdbx->all_groups($base_group, %options);
-
-Get all groups deeply in a database, or all groups within a specified base group, in a flat array. Supported
-options:
-
-=for :list
-* C<base> - Only include groups within a base group (same as C<$base_group>) (default: root)
-* C<include_base> - Include the base group in the results (default: true)
-
-=cut
-
-sub all_groups {
- my $self = shift;
- my %args = @_ % 2 == 0 ? @_ : (base => shift, @_);
- my $base = $args{base} // $self->root;
-
- my @groups = $args{include_base} // 1 ? $self->_wrap_group($base) : ();
-
- for my $subgroup (@{$base->{groups} || []}) {
- my $more = $self->all_groups($subgroup);
- push @groups, @$more;
- }
-
- return \@groups;
-}
-
=method trace_lineage
\@lineage = $kdbx->trace_lineage($group);
my $base = $lineage[-1] or return [];
my $uuid = $object->uuid;
- return \@lineage if any { $_->uuid eq $uuid } @{$base->groups || []}, @{$base->entries || []};
+ return \@lineage if any { $_->uuid eq $uuid } @{$base->groups}, @{$base->entries};
- for my $subgroup (@{$base->groups || []}) {
+ for my $subgroup (@{$base->groups}) {
my $result = $self->_trace_lineage($object, @lineage, $subgroup);
return $result if $result;
}
}
-=method find_groups
+=method recycle_bin
- @groups = $kdbx->find_groups($query, %options);
+ $group = $kdbx->recycle_bin;
+ $kdbx->recycle_bin($group);
-Find all groups deeply that match to a query. Options are the same as for L</all_groups>.
+Get or set the recycle bin group. Returns C<undef> if there is no recycle bin and L</recycle_bin_enabled> is
+false, otherwise the current recycle bin or an autovivified recycle bin group is returned.
-See L</QUERY> for a description of what C<$query> can be.
+=cut
+
+sub recycle_bin {
+ my $self = shift;
+ if (my $group = shift) {
+ $self->recycle_bin_uuid($group->uuid);
+ return $group;
+ }
+ my $group;
+ my $uuid = $self->recycle_bin_uuid;
+ $group = $self->groups->grep(uuid => $uuid)->next if $uuid ne UUID_NULL;
+ if (!$group && $self->recycle_bin_enabled) {
+ $group = $self->add_group(
+ name => 'Recycle Bin',
+ icon_id => ICON_TRASHCAN_FULL,
+ enable_auto_type => false,
+ enable_searching => false,
+ );
+ $self->recycle_bin_uuid($group->uuid);
+ }
+ return $group;
+}
+
+=method entry_templates
+
+ $group = $kdbx->entry_templates;
+ $kdbx->entry_templates($group);
+
+Get or set the entry templates group. May return C<undef> if unset.
=cut
-sub find_groups {
+sub entry_templates {
my $self = shift;
- my $query = shift or throw 'Must provide a query';
- my %args = @_;
- my %all_groups = (
- base => $args{base},
- include_base => $args{include_base},
- );
- return @{search($self->all_groups(%all_groups), is_arrayref($query) ? @$query : $query)};
+ if (my $group = shift) {
+ $self->entry_templates_group($group->uuid);
+ return $group;
+ }
+ my $uuid = $self->entry_templates_group;
+ return if $uuid eq UUID_NULL;
+ return $self->groups->grep(uuid => $uuid)->next;
+}
+
+=method last_selected
+
+ $group = $kdbx->last_selected;
+ $kdbx->last_selected($group);
+
+Get or set the last selected group. May return C<undef> if unset.
+
+=cut
+
+sub last_selected {
+ my $self = shift;
+ if (my $group = shift) {
+ $self->last_selected_group($group->uuid);
+ return $group;
+ }
+ my $uuid = $self->last_selected_group;
+ return if $uuid eq UUID_NULL;
+ return $self->groups->grep(uuid => $uuid)->next;
}
-sub remove {
+=method last_top_visible
+
+ $group = $kdbx->last_top_visible;
+ $kdbx->last_top_visible($group);
+
+Get or set the last top visible group. May return C<undef> if unset.
+
+=cut
+
+sub last_top_visible {
my $self = shift;
- my $object = shift;
+ if (my $group = shift) {
+ $self->last_top_visible_group($group->uuid);
+ return $group;
+ }
+ my $uuid = $self->last_top_visible_group;
+ return if $uuid eq UUID_NULL;
+ return $self->groups->grep(uuid => $uuid)->next;
+}
+
+##############################################################################
+
+=method add_group
+
+ $kdbx->add_group($group);
+ $kdbx->add_group(%group_attributes, %options);
+
+Add a group to a database. This is equivalent to identifying a parent group and calling
+L<File::KDBX::Group/add_group> on the parent group, forwarding the arguments. Available options:
+
+=for :list
+* C<group> (aka C<parent>) - Group object or group UUID to add the group to (default: root group)
+
+=cut
+
+sub add_group {
+ my $self = shift;
+ my $group = @_ % 2 == 1 ? shift : undef;
+ my %args = @_;
+
+ # find the right group to add the group to
+ my $parent = delete $args{group} // delete $args{parent} // $self->root;
+ $parent = $self->groups->grep({uuid => $parent})->next if !ref $parent;
+ $parent or throw 'Invalid group';
+
+ return $parent->add_group(defined $group ? $group : (), %args, kdbx => $self);
+}
+
+sub _wrap_group {
+ my $self = shift;
+ my $group = shift;
+ require File::KDBX::Group;
+ return File::KDBX::Group->wrap($group, $self);
+}
+
+=method groups
+
+ \&iterator = $kdbx->groups(%options);
+ \&iterator = $kdbx->groups($base_group, %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>)
+* C<inclusive> - Include the base group in the results (default: true)
+* C<algorithm> - Search algorithm, one of C<ids>, C<bfs> or C<dfs> (default: C<ids>)
+
+=cut
+
+sub groups {
+ my $self = shift;
+ my %args = @_ % 2 == 0 ? @_ : (base => shift, @_);
+ my $base = delete $args{base} // $self->root;
+
+ return $base->groups_deeply(%args);
}
##############################################################################
L<File::KDBX::Group/add_entry> on the parent group, forwarding the arguments. Available options:
=for :list
-* C<group> (aka C<parent>) - Group (object or group UUID) to add the entry to (default: root group)
+* C<group> (aka C<parent>) - Group object or group UUID to add the entry to (default: root group)
=cut
# find the right group to add the entry to
my $parent = delete $args{group} // delete $args{parent} // $self->root;
- ($parent) = $self->find_groups({uuid => $parent}) if !ref $parent;
+ $parent = $self->groups->grep({uuid => $parent})->next if !ref $parent;
$parent or throw 'Invalid group';
return $parent->add_entry(defined $entry ? $entry : (), %args, kdbx => $self);
return File::KDBX::Entry->wrap($entry, $self);
}
-=method all_entries
+=method entries
- \@entries = $kdbx->all_entries(%options);
- \@entries = $kdbx->all_entries($base_group, %options);
+ \&iterator = $kdbx->entries(%options);
+ \&iterator = $kdbx->entries($base_group, %options);
-Get entries deeply in a database, in a flat array. Supported options:
+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<base> - Only include entries within a base group (same as C<$base_group>) (default: root)
* C<auto_type> - Only include entries with auto-type enabled (default: false, include all)
-* C<search> - Only include entries within groups with search enabled (default: false, include all)
-* C<history> - Also include historical entries (default: false, include only active entries)
+* 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
-sub all_entries {
+sub entries {
my $self = shift;
my %args = @_ % 2 == 0 ? @_ : (base => shift, @_);
+ my $base = delete $args{base} // $self->root;
- my $base = $args{base} // $self->root;
- my $history = $args{history};
- my $search = $args{search};
- my $auto_type = $args{auto_type};
-
- my $enable_auto_type = $base->{enable_auto_type} // true;
- my $enable_searching = $base->{enable_searching} // true;
-
- my @entries;
- if ((!$search || $enable_searching) && (!$auto_type || $enable_auto_type)) {
- push @entries,
- map { $self->_wrap_entry($_) }
- grep { !$auto_type || $_->{auto_type}{enabled} }
- map { $_, $history ? @{$_->{history} || []} : () }
- @{$base->{entries} || []};
- }
-
- for my $subgroup (@{$base->{groups} || []}) {
- my $more = $self->all_entries($subgroup,
- auto_type => $auto_type,
- search => $search,
- history => $history,
- );
- push @entries, @$more;
- }
-
- return \@entries;
+ return $base->entries_deeply(%args);
}
-=method find_entries
-
-=method find_entries_simple
-
- @entries = $kdbx->find_entries($query, %options);
+##############################################################################
- @entries = $kdbx->find_entries_simple($expression, \@fields, %options);
- @entries = $kdbx->find_entries_simple($expression, $operator, \@fields, %options);
+=method objects
-Find all entries deeply that match a query. Options are the same as for L</all_entries>.
+ \&iterator = $kdbx->objects(%options);
+ \&iterator = $kdbx->objects($base_group, %options);
-See L</QUERY> for a description of what C<$query> can be.
+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
-sub find_entries {
+sub objects {
my $self = shift;
- my $query = shift or throw 'Must provide a query';
- my %args = @_;
- my %all_entries = (
- base => $args{base},
- auto_type => $args{auto_type},
- search => $args{search},
- history => $args{history},
- );
- return @{search($self->all_entries(%all_entries), is_arrayref($query) ? @$query : $query)};
-}
+ my %args = @_ % 2 == 0 ? @_ : (base => shift, @_);
+ my $base = delete $args{base} // $self->root;
-sub find_entries_simple {
- my $self = shift;
- my $text = shift;
- my $op = @_ && !is_ref($_[0]) ? shift : undef;
- my $fields = shift;
- is_arrayref($fields) or throw q{Usage: find_entries_simple($expression, [$op,] \@fields)};
- return $self->find_entries([\$text, $op, $fields], @_);
+ return $base->objects_deeply(%args);
}
+sub __iter__ { $_[0]->objects }
+
##############################################################################
=method custom_icon
$kdbx->custom_icon(%icon);
$kdbx->custom_icon(uuid => $value, %icon);
+Get or set custom icons.
=cut
sub custom_icon {
my $self = shift;
- my %args = @_ == 2 ? (uuid => shift, value => shift)
+ my %args = @_ == 2 ? (uuid => shift, data => shift)
: @_ % 2 == 1 ? (uuid => shift, @_) : @_;
- if (!$args{key} && !$args{value}) {
- my %standard = (key => 1, value => 1, last_modification_time => 1);
+ if (!$args{uuid} && !$args{data}) {
+ my %standard = (uuid => 1, data => 1, name => 1, last_modification_time => 1);
my @other_keys = grep { !$standard{$_} } keys %args;
if (@other_keys == 1) {
my $key = $args{key} = $other_keys[0];
- $args{value} = delete $args{$key};
+ $args{data} = delete $args{$key};
}
}
- my $key = $args{key} or throw 'Must provide a custom_icons key to access';
+ my $uuid = $args{uuid} or throw 'Must provide a custom icon UUID to access';
+ my $icon = (first { $_->{uuid} eq $uuid } @{$self->custom_icons}) // do {
+ push @{$self->custom_icons}, my $i = { uuid => $uuid };
+ $i;
+ };
- return $self->{meta}{custom_icons}{$key} = $args{value} if is_plain_hashref($args{value});
+ my $fields = \%args;
+ $fields = $args{data} if is_plain_hashref($args{data});
- while (my ($field, $value) = each %args) {
- $self->{meta}{custom_icons}{$key}{$field} = $value;
+ while (my ($field, $value) = each %$fields) {
+ $icon->{$field} = $value;
}
- return $self->{meta}{custom_icons}{$key};
+ return $icon;
}
=method custom_icon_data
$image_data = $kdbx->custom_icon_data($uuid);
-Get a custom icon.
+Get a custom icon image data.
=cut
sub custom_icon_data {
my $self = shift;
my $uuid = shift // return;
- return if !exists $self->custom_icons->{$uuid};
- return $self->custom_icons->{$uuid}{data};
+ my $icon = first { $_->{uuid} eq $uuid } @{$self->custom_icons} or return;
+ return $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
+* 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+)
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(sub { !$self->custom_icons->{$_} });
- $self->custom_icons->{$uuid} = {
+ my $uuid = $args{uuid} // generate_uuid;
+ push @{$self->custom_icons}, {
@_,
uuid => $uuid,
- data => $img,
+ data => $args{data},
};
return $uuid;
}
sub remove_custom_icon {
my $self = shift;
my $uuid = shift;
- delete $self->custom_icons->{$uuid};
+ my @deleted;
+ @{$self->custom_icons} = grep { $_->{uuid} eq $uuid ? do { push @deleted, $_; 0 } : 1 }
+ @{$self->custom_icons};
+ $self->add_deleted_object($uuid) if @deleted;
+ return @deleted;
}
##############################################################################
=for :list
* can store strings, booleans and up to 64-bit integer values (custom data can only store text values)
* is NOT encrypted within a KDBX file (hence the "public" part of the name)
-* is a flat hash/dict of key-value pairs (no other associated fields like modification times)
+* is a plain hash/dict of key-value pairs with no other associated fields (like modification times)
=cut
# die 'Not implemented';
# }
+=method add_deleted_object
+
+ $kdbx->add_deleted_object($uuid);
+
+Add a UUID to 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 populated automatically as objects
+are removed.
+
+=cut
+
+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
use this method to resolve on-the-fly references that aren't part of any actual string in the database.
If the reference does not resolve to any field, C<undef> is returned. If the reference resolves to multiple
-fields, only the first one is returned (in the same order as L</all_entries>). To avoid ambiguity, you can
-refer to a specific entry by its UUID.
+fields, only the first one is returned (in the same order as iterated by L</entries>). To avoid ambiguity, you
+can refer to a specific entry by its UUID.
The syntax of a reference is: C<< {REF:<WantedField>@<SearchIn>:<Text>} >>. C<Text> is a
L</"Simple Expression">. C<WantedField> and C<SearchIn> are both single character codes representing a field:
$wanted && $search_in && nonempty($text) or return;
my %fields = (
- T => 'expanded_title',
- U => 'expanded_username',
- P => 'expanded_password',
- A => 'expanded_url',
- N => 'expanded_notes',
- I => 'id',
+ T => 'expand_title',
+ U => 'expand_username',
+ P => 'expand_password',
+ A => 'expand_url',
+ N => 'expand_notes',
+ I => 'uuid',
O => 'other_strings',
);
$wanted = $fields{$wanted} or return;
$search_in = $fields{$search_in} or return;
- my $query = simple_expression_query($text, ($search_in eq 'id' ? 'eq' : '=~'), $search_in);
+ my $query = $search_in eq 'uuid' ? query($search_in => uuid($text))
+ : simple_expression_query($text, '=~', $search_in);
- my ($entry) = $self->find_entries($query);
+ my $entry = $self->entries->grep($query)->next;
$entry or return;
return $entry->$wanted;
}
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 },
+ # 'PLACEHOLDER' => sub { my ($entry, $arg) = @_; ... };
+ '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] },
'OPERA' => sub { load_optional('IPC::Cmd'); IPC::Cmd::can_run('opera') },
'SAFARI' => sub { load_optional('IPC::Cmd'); IPC::Cmd::can_run('safari') },
'APPDIR' => sub { load_optional('FindBin'); $FindBin::Bin },
- 'GROUP' => sub { my $p = $_[0]->parent; $p ? $p->name : undef },
+ 'GROUP' => sub { my $p = $_[0]->group; $p ? $p->name : undef },
'GROUP_PATH' => sub { $_[0]->path },
- 'GROUP_NOTES' => sub { my $p = $_[0]->parent; $p ? $p->notes : undef },
+ 'GROUP_NOTES' => sub { my $p = $_[0]->group; $p ? $p->notes : undef },
# 'GROUP_SEL'
# 'GROUP_SEL_PATH'
# 'GROUP_SEL_NOTES'
$kdbx->lock;
-Encrypt all protected strings in a database. The encrypted strings are stored in 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.
+Encrypt all protected binaries strings in a database. The encrypted strings are stored in
+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
my @strings;
- my $entries = $self->all_entries(history => 1);
- for my $entry (@$entries) {
- push @strings, grep { $_->{protect} } values %{$entry->{strings} || {}};
- }
+ $self->entries(history => 1)->each(sub {
+ push @strings, grep { $_->{protect} } values %{$_->strings}, values %{$_->binaries};
+ });
$self->_safe(File::KDBX::Safe->new(\@strings));
=cut
-sub peek {
- my $self = shift;
- my $string = shift;
- my $safe = $self->_safe or return;
- return $safe->peek($string);
-}
-
sub unlock {
my $self = shift;
my $safe = $self->_safe or return $self;
return $self;
}
-# sub unlock_scoped {
-# my $self = shift;
-# return if !$self->is_locked;
-# require Scope::Guard;
-# my $guard = Scope::Guard->new(sub { $self->lock });
-# $self->unlock;
-# return $guard;
-# }
+=method unlock_scoped
+
+ $guard = $kdbx->unlock_scoped;
+
+Unlock a database temporarily, relocking when the guard is released (typically at the end of a scope). Returns
+C<undef> if the database is already unlocked.
+
+See L</lock> and L</unlock>.
+
+=cut
+
+sub unlock_scoped {
+ throw 'Programmer error: Cannot call unlock_scoped in void context' if !defined wantarray;
+ my $self = shift;
+ return if !$self->is_locked;
+ require Scope::Guard;
+ my $guard = Scope::Guard->new(sub { $self->lock });
+ $self->unlock;
+ return $guard;
+}
+
+=method peek
+
+ $string = $kdbx->peek(\%string);
+ $string = $kdbx->peek(\%binary);
+
+Peek at the value of a protected string or binary without unlocking the whole database. The argument can be
+a string or binary hashref as returned by L<File::KDBX::Entry/string> or L<File::KDBX::Entry/binary>.
+
+=cut
+
+sub peek {
+ my $self = shift;
+ my $string = shift;
+ my $safe = $self->_safe or return;
+ return $safe->peek($string);
+}
=method is_locked
##############################################################################
+# 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;
$key = $kdbx->key($key);
$key = $kdbx->key($primitive);
-Get or set a L<File::KDBX::Key>. This is the master key (i.e. a password or a key file that can decrypt
+Get or set a L<File::KDBX::Key>. This is the master key (e.g. a password or a key file that can decrypt
a database). See L<File::KDBX::Key/new> for an explanation of what the primitive can be.
You generally don't need to call this directly because you can provide the key directly to the loader or
-dumper when loading or saving a KDBX file.
+dumper when loading or dumping a KDBX file.
=cut
#########################################################################################
-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;
+ 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,
+ );
+ my $handler = $handlers{$type} or return;
+ $self->$handler($object, @_);
+}
+
+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 $old_uuid = $object->{uuid} // return;
+
+ my $meta = $self->meta;
+ $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} // '');
+
+ $self->add_deleted_object($old_uuid);
+}
+
+sub _handle_entry_uuid_changed {
+ my $self = shift;
+ my $object = shift;
+ my $new_uuid = shift;
+ my $old_uuid = shift // return;
+
+ my $old_pretty = format_uuid($old_uuid);
+ my $new_pretty = format_uuid($new_uuid);
+ my $fieldref_match = qr/\{REF:([TUPANI])\@I:\Q$old_pretty\E\}/is;
+
+ $self->entries->each(sub {
+ $_->previous_parent_group($new_uuid) if $old_uuid eq ($_->{previous_parent_group} // '');
+
+ for my $string (values %{$_->strings}) {
+ next if !defined $string->{value} || $string->{value} !~ $fieldref_match;
+ my $txn = $_->begin_work;
+ $string->{value} =~ s/$fieldref_match/{REF:$1\@I:$new_pretty}/g;
+ $txn->commit;
+ }
+ });
+}
+
+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} // '');
+
+ $self->groups->each(sub {
+ $_->last_top_visible_entry($new_uuid) if $old_uuid eq ($_->{last_top_visible_entry} // '');
+ $_->previous_parent_group($new_uuid) if $old_uuid eq ($_->{previous_parent_group} // '');
+ });
+ $self->entries->each(sub {
+ $_->previous_parent_group($new_uuid) if $old_uuid eq ($_->{previous_parent_group} // '');
+ });
}
#########################################################################################
+=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.
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.
$kdbx = File::KDBX->load_file('passwords.kdbx', 'M@st3rP@ssw0rd!');
- for my $entry (@{ $kdbx->all_entries }) {
+ $kdbx->entries->each(sub {
+ my ($entry) = @_;
say 'Entry: ', $entry->title;
- }
+ });
+
+See L</RECIPES> for more examples.
=head1 DESCRIPTION
B<File::KDBX> provides everything you need to work with a KDBX database. A KDBX database is a hierarchical
object database which is commonly used to store secret information securely. It was developed for the KeePass
-password safe. See L</"KDBX Introduction"> for more information about KDBX.
+password safe. See L</"Introduction to KDBX"> for more information about KDBX.
This module lets you query entries, create new entries, delete entries and modify entries. The distribution
also includes various parsers and generators for serializing and persisting databases.
-This design of this software was influenced by the L<KeePassXC|https://github.com/keepassxreboot/keepassxc>
+The design of this software was influenced by the L<KeePassXC|https://github.com/keepassxreboot/keepassxc>
implementation of KeePass as well as the L<File::KeePass> module. B<File::KeePass> is an alternative module
that works well in most cases but has a small backlog of bugs and security issues and also does not work with
newer KDBX version 4 files. If you're coming here from the B<File::KeePass> world, you might be interested in
L<File::KeePass::KDBX> that is a drop-in replacement for B<File::KeePass> that uses B<File::KDBX> for storage.
-=head2 KDBX Introduction
+This software is a B<pre-1.0 release>. The interface should be considered pretty stable, but there might be
+minor changes up until a 1.0 release. Breaking changes will be noted in the F<Changes> file.
-A KDBX database consists of a hierarchical I<group> of I<entries>. Entries can contain zero or more key-value
-pairs of I<strings> and zero or more I<binaries> (i.e. octet strings). Groups, entries, strings and binaries:
-that's the KDBX vernacular. A small amount of metadata (timestamps, etc.) is associated with each entry, group
-and the database as a whole.
+=head2 Features
+
+=for :list
+* ☑ Read and write KDBX version 3 - version 4.1
+* ☑ Read and write KDB files (requires L<File::KeePass>)
+* ☑ Unicode character strings
+* ☑ L</"Simple Expression"> Searching
+* ☑ L<Placeholders|File::KDBX::Entry/Placeholders> and L<field references|/resolve_reference>
+* ☑ L<One-time passwords|File::KDBX::Entry/"One-time Passwords">
+* ☑ L<Very secure|/SECURITY>
+* ☑ L</"Memory Protection">
+* ☑ Challenge-response key components, like L<YubiKey|File::KDBX::Key::YubiKey>
+* ☑ Variety of L<key file|File::KDBX::Key::File> types: binary, hexed, hashed, XML v1 and v2
+* ☑ Pluggable registration of different kinds of ciphers and key derivation functions
+* ☑ Built-in database maintenance functions
+* ☑ Pretty fast, with L<XS optimizations|File::KDBX::XS> available
+* ☒ Database synchronization / merging (not yet)
+
+=head2 Introduction to KDBX
+
+A KDBX database consists of a tree of I<groups> and I<entries>, with a single I<root> group. Entries can
+contain zero or more key-value pairs of I<strings> and zero or more I<binaries> (i.e. octet strings). Groups,
+entries, strings and binaries: that's the KDBX vernacular. A small amount of metadata (timestamps, etc.) is
+associated with each entry, group and the database as a whole.
You can think of a KDBX database kind of like a file system, where groups are directories, entries are files,
and strings and binaries make up a file's contents.
-Databases are typically persisted as a encrypted, compressed files. They are usually accessed directly (i.e.
+Databases are typically persisted as encrypted, compressed files. They are usually accessed directly (i.e.
not over a network). The primary focus of this type of database is data security. It is ideal for storing
relatively small amounts of data (strings and binaries) that must remain secret except to such individuals as
have the correct I<master key>. Even if the database file were to be "leaked" to the public Internet, it
-should be virtually impossible to crack with a strong key. See L</SECURITY> for an overview of security
-considerations.
+should be virtually impossible to crack with a strong key. The KDBX format is most often used by password
+managers to store passwords so that users can know a single strong password and not have to reuse passwords
+across different websites. See L</SECURITY> for an overview of security considerations.
=head1 RECIPES
=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
- for my $entry (@{ $kdbx->all_entries }) {
- say 'Found password for ', $entry->title, ':';
+ $kdbx->entries->each(sub {
+ my ($entry) = @_;
+ say 'Found password for: ', $entry->title;
say ' Username: ', $entry->username;
say ' Password: ', $entry->password;
- }
+ });
=head2 Search for entries
- my @entries = $kdbx->find_entries({
- title => 'WayneCorp',
- }, search => 1);
+ my @entries = $kdbx->entries(searching => 1)
+ ->grep(title => 'WayneCorp')
+ ->each; # return all matches
+
+The C<searching> option limits results to only entries within groups with searching enabled. Other options are
+also available. See L</entries>.
See L</QUERY> for many more query examples.
=head2 Search for entries by auto-type window association
- my @entry_key_sequences = $kdbx->find_entries_for_window('WayneCorp - Mozilla Firefox');
- for my $pair (@entry_key_sequences) {
- my ($entry, $key_sequence) = @$pair;
- say 'Entry title: ', $entry->title, ', key sequence: ', $key_sequence;
- }
+ my $window_title = 'WayneCorp - Mozilla Firefox';
+
+ my $entries = $kdbx->entries(auto_type => 1)
+ ->filter(sub {
+ my ($ata) = grep { $_->{window} =~ /\Q$window_title\E/i } @{$_->auto_type_associations};
+ return [$_, $ata->{keystroke_sequence}] if $ata;
+ })
+ ->each(sub {
+ my ($entry, $keys) = @$_;
+ say 'Entry title: ', $entry->title, ', key sequence: ', $keys;
+ });
Example output:
Entry title: WayneCorp, key sequence: {PASSWORD}{ENTER}
+=head2 Remove entries from a database
+
+ $kdbx->entries
+ ->grep(notes => {'=~' => qr/too old/i})
+ ->each(sub { $_->recycle });
+
+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.
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
=head1 QUERY
-Several methods take a I<query> as an argument (e.g. L</find_entries>). A query is just a subroutine that you
-can either write yourself or have generated for you based on either a simple expression or a declarative
-structure. It's easier to have your query generated, so I'll cover that first.
+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_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
+that first.
=head2 Simple Expression
So a simple expression is something like what you might type into a search engine. You can generate a simple
expression query using L<File::KDBX::Util/simple_expression_query> or by passing the simple expression as
-a B<string reference> to search methods like L</find_entries>.
+a B<scalar reference> to C<where>.
To search for all entries in a database with the word "canyon" appearing anywhere in the title:
- my @entries = $kdbx->find_entries([ \'canyon', qw(title) ]);
+ my $entries = $kdbx->entries->where(\'canyon', qw[title]);
-Notice the first argument is a B<stringref>. 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:
- my @entries = $kdbx->find_entries([ \'red canyon', qw(title) ]);
+ my $entries = $kdbx->entries->where(\'red canyon', qw[title]);
Each term in the simple expression must be found for an entry to match.
To search for entries with "red" in the title but B<not> "canyon", just prepend "canyon" with a minus sign:
- my @entries = $kdbx->find_entries([ \'red -canyon', qw(title) ]);
+ 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->find_entries([ \'grocery -Foodland', qw(title notes) ]);
+ my $entries = $kdbx->entries->where(\'grocery -Foodland', qw[title notes]);
The default operator is a case-insensitive regexp match, which is fine for searching text loosely. You can use
just about any binary comparison operator that perl supports. To specify an operator, list it after the simple
expression. For example, to search for any entry that has been used at least five times:
- my @entries = $kdbx->find_entries([ \5, '>=', qw(usage_count) ]);
+ 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 confusing, you can also the L</find_entries_simple> method as
-a more intuitive alternative. The following example is equivalent to the previous:
+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
+equivalent to the previous:
- my @entries = $kdbx->find_entries_simple(5, '>=', qw(usage_count));
+ my $entries = $kdbx->entries->where(simple_expression_query(5, '>=', qw[usage_count]));
-=head2 Declarative Query
+=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":
- my @entries = $kdbx->find_entries({ title => 'My Bank' });
+ my $entries = $kdbx->entries->where({ title => 'My Bank' });
-The query here is C<< { title => 'My Bank' } >>. A hashref can contain key-value pairs where the key is
-a attribute of the thing being searched for (in this case an entry) and the value is what you want the thing's
+The query here is C<< { title => 'My Bank' } >>. A hashref can contain key-value pairs where the key is an
+attribute of the thing being searched for (in this case an entry) and the value is what you want the thing's
attribute to be to consider it a match. In this case, the attribute we're using as our match criteria is
L<File::KDBX::Entry/title>, a text field. If an entry has its title attribute equal to "My Bank", it's
a match.
attributes are equal to their respective values. For example, to search for all entries with a particular URL
B<AND> username:
- my @entries = $kdbx->find_entries({
+ my $entries = $kdbx->entries->where({
url => 'https://example.com',
username => 'neo',
});
To search for entries matching I<any> criteria, just change the hashref to an arrayref. To search for entries
-with a particular URL B<OR> a particular username:
+with a particular URL B<OR> username:
- my @entries = $kdbx->find_entries([ # <-- square bracket
+ my $entries = $kdbx->entries->where([ # <-- Notice the square bracket
url => 'https://example.com',
username => 'neo',
]);
-You can user different operators to test different types of attributes. The L<File::KDBX::Entry/icon_id>
+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:
- my @entries = $kdbx->find_entries({
+ my $entries = $kdbx->entries->where({
icon_id => { '==', ICON_SMARTPHONE },
});
Note: L<File::KDBX::Constants/ICON_SMARTPHONE> is just a constant from L<File::KDBX::Constants>. It isn't
special to this example or to queries generally. We could have just used a literal number.
-The important thing to notice here is how we wrapped the condition in another arrayref with a single key-pair
-where the key is the name of an operator and the value is the thing to match against. The supported operators
-are:
+The important thing to notice here is how we wrapped the condition in another arrayref with a single key-value
+pair where the key is the name of an operator and the value is the thing to match against. The supported
+operators are:
=for :list
* C<eq> - String equal
* C<-false> - Boolean false
* C<-not> - Boolean false (alias for C<-false>)
* C<-defined> - Is defined
-* C<-undef> - Is not d efined
+* C<-undef> - Is not defined
* C<-empty> - Is empty
* C<-nonempty> - Is not empty
* C<-or> - Logical or
Let's see another example using an explicit operator. To find all groups except one in particular (identified
by its L<File::KDBX::Group/uuid>), we can use the C<ne> (string not equal) operator:
- my ($group, @other) = $kdbx->find_groups({
+ my $groups = $kdbx->groups->where(
uuid => {
'ne' => uuid('596f7520-6172-6520-7370-656369616c2e'),
},
- });
- if (@other) { 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 octets.
-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).
+
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:
- my @entries = $kdbx->find_entries({ '!' => 'quality_check' });
+ my $entries = $kdbx->entries->where('!' => 'quality_check');
This time the string after the operator is the attribute name rather than a value to compare the attribute
against. To test that a boolean value is true, use the C<!!> operator (or C<-true> if C<!!> seems a little too
weird for your taste):
- my @entries = $kdbx->find_entries({ '!!' => 'quality_check' });
- my @entries = $kdbx->find_entries({ -true => 'quality_check' });
+ my $entries = $kdbx->entries->where('!!' => '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
logically equivalent:
- my @entries = $kdbx->find_entries([ -not => { title => 'My Bank' } ]);
- my @entries = $kdbx->find_entries({ title => { 'ne' => 'My Bank' } });
+ my $entries = $kdbx->entries->where(-not => { title => 'My Bank' });
+ my $entries = $kdbx->entries->where(title => { 'ne' => 'My Bank' });
These special operators become more useful when combined with two more special operators: C<-and> and C<-or>.
With these, it is possible to construct more interesting queries with groups of logic. For example:
- my @entries = $kdbx->find_entries({
+ my $entries = $kdbx->entries->where({
title => { '=~', qr/bank/ },
-not => {
-or => {
});
In English, find entries where the word "bank" appears anywhere in the title but also do not have either the
-word "business" in the notes or is using the full trashcan icon.
+word "business" in the notes or are using the full trashcan icon.
=head2 Subroutine Query
Lastly, as mentioned at the top, you can ignore all this and write your own subroutine. Your subroutine will
-be called once for each thing being searched over. The single argument is the search candidate. The subroutine
-should match the candidate against whatever criteria you want and return true if it matches. The C<find_*>
-methods collect all matching things and return them.
+be called once for each object being searched over. The subroutine should match the candidate against whatever
+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, 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->find_entries(sub { shift->title eq 'My Bank' });
- # logically the same as this declarative structure:
- my @entries = $kdbx->find_entries({ title => 'My Bank' });
- # as well as this simple expression:
- my @entries = $kdbx->find_entries([ \'My Bank', 'eq', qw{title} ]);
+ my $entries = $kdbx->entries->where(\'"My Bank"', 'eq', qw[title]); # simple expression
+ my $entries = $kdbx->entries->where(title => 'My Bank'); # declarative syntax
+ my $entries = $kdbx->entries->where(sub { $_->title eq 'My Bank' }); # subroutine query
This is a trivial example, but of course your subroutine can be arbitrarily complex.
If the tools are getting in your way, you can of course iterate over the contents of a database and implement
your own query logic, like this:
- for my $entry (@{ $kdbx->all_entries }) {
+ my $entries = $kdbx->entries;
+ while (my $entry = $entries->next) {
if (wanted($entry)) {
do_something($entry);
}
}
}
+=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</objects>. You can specify the search algorithm to iterate over objects in different orders
+using the C<algorith> option, which can be one of these L<constants|File::KDBX::Constants/":iteration">:
+
+=for :list
+* C<ITERATION_IDS> - Iterative deepening search (default)
+* C<ITERATION_DFS> - Depth-first search
+* C<ITERATION_BFS> - Breadth-first search
+
+When iterating over objects generically, groups always precede their direct entries (if any). When the
+C<history> option is used, current entries always precede historical entries.
+
+If you have a database tree like this:
+
+ Database
+ - Root
+ - Group1
+ - EntryA
+ - Group2
+ - EntryB
+ - Group3
+ - EntryC
+
+=for :list
+* 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 SYNCHRONIZING
+
+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
=head1 SEE ALSO
-L<File::KeePass> is a much older alternative. It's good but has a backlog of bugs and lacks support for newer
-KDBX features.
+=for :list
+* L<KeePass Password Safe|https://keepass.info/> - The original KeePass
+* L<KeePassXC|https://keepassxc.org/> - Cross-Platform Password Manager written in C++
+* L<File::KeePass> has overlapping functionality. It's good but has a backlog of some pretty critical bugs and
+ lacks support for newer KDBX features.
+
+=begin :header
+
+=begin markdown
+
+[](https://github.com/chazmcgarvey/File-KDBX/actions/workflows/linux.yml)
+[](https://github.com/chazmcgarvey/File-KDBX/actions/workflows/macos.yml)
+[](https://github.com/chazmcgarvey/File-KDBX/actions/workflows/windows.yml)
+
+=end markdown
+
+=begin HTML
+
+<a title="Linux" href="https://github.com/chazmcgarvey/File-KDBX/actions/workflows/linux.yml"><img src="https://github.com/chazmcgarvey/File-KDBX/actions/workflows/linux.yml/badge.svg"></a>
+<a title="macOS" href="https://github.com/chazmcgarvey/File-KDBX/actions/workflows/macos.yml"><img src="https://github.com/chazmcgarvey/File-KDBX/actions/workflows/macos.yml/badge.svg"></a>
+<a title="Windows" href="https://github.com/chazmcgarvey/File-KDBX/actions/workflows/windows.yml"><img src="https://github.com/chazmcgarvey/File-KDBX/actions/workflows/windows.yml/badge.svg"></a>
+
+=end HTML
+
+=end :header
=cut
projects / chaz / p5-File-KDBX / blobdiff