]> Dogcows Code - chaz/p5-File-KDBX/blob - lib/File/KDBX.pm
Make transform_rounds work with Argon KDF
[chaz/p5-File-KDBX] / lib / File / KDBX.pm
1 package File::KDBX;
2 # ABSTRACT: Encrypted database to store secret text and files
3
4 use 5.010;
5 use warnings;
6 use strict;
7
8 use Crypt::Digest qw(digest_data);
9 use Crypt::PRNG qw(random_bytes);
10 use Devel::GlobalDestruction;
11 use File::KDBX::Constants qw(:all :icon);
12 use File::KDBX::Error;
13 use File::KDBX::Safe;
14 use File::KDBX::Util qw(:class :coercion :empty :search :uuid erase simple_expression_query snakify);
15 use Hash::Util::FieldHash qw(fieldhashes);
16 use List::Util qw(any first);
17 use Ref::Util qw(is_ref is_arrayref is_plain_hashref);
18 use Scalar::Util qw(blessed);
19 use Time::Piece 1.33;
20 use boolean;
21 use namespace::clean;
22
23 our $VERSION = '999.999'; # VERSION
24 our $WARNINGS = 1;
25
26 fieldhashes \my (%SAFE, %KEYS);
27
28 =method new
29
30 $kdbx = File::KDBX->new(%attributes);
31 $kdbx = File::KDBX->new($kdbx); # copy constructor
32
33 Construct a new L<File::KDBX>.
34
35 =cut
36
37 sub new {
38 my $class = shift;
39
40 # copy constructor
41 return $_[0]->clone if @_ == 1 && blessed $_[0] && $_[0]->isa($class);
42
43 my $self = bless {}, $class;
44 $self->init(@_);
45 $self->_set_nonlazy_attributes if empty $self;
46 return $self;
47 }
48
49 sub DESTROY { local ($., $@, $!, $^E, $?); !in_global_destruction and $_[0]->reset }
50
51 =method init
52
53 $kdbx = $kdbx->init(%attributes);
54
55 Initialize a L<File::KDBX> with a set of attributes. Returns itself to allow method chaining.
56
57 This is called by L</new>.
58
59 =cut
60
61 sub init {
62 my $self = shift;
63 my %args = @_;
64
65 @$self{keys %args} = values %args;
66
67 return $self;
68 }
69
70 =method reset
71
72 $kdbx = $kdbx->reset;
73
74 Set a L<File::KDBX> to an empty state, ready to load a KDBX file or build a new one. Returns itself to allow
75 method chaining.
76
77 =cut
78
79 sub reset {
80 my $self = shift;
81 erase $self->headers->{+HEADER_INNER_RANDOM_STREAM_KEY};
82 erase $self->inner_headers->{+INNER_HEADER_INNER_RANDOM_STREAM_KEY};
83 erase $self->{raw};
84 %$self = ();
85 $self->_remove_safe;
86 return $self;
87 }
88
89 =method clone
90
91 $kdbx_copy = $kdbx->clone;
92 $kdbx_copy = File::KDBX->new($kdbx);
93
94 Clone a L<File::KDBX>. The clone will be an exact copy and completely independent of the original.
95
96 =cut
97
98 sub clone {
99 my $self = shift;
100 require Storable;
101 return Storable::dclone($self);
102 }
103
104 sub STORABLE_freeze {
105 my $self = shift;
106 my $cloning = shift;
107
108 my $copy = {%$self};
109
110 return '', $copy, $KEYS{$self} // (), $SAFE{$self} // ();
111 }
112
113 sub STORABLE_thaw {
114 my $self = shift;
115 my $cloning = shift;
116 shift;
117 my $clone = shift;
118 my $key = shift;
119 my $safe = shift;
120
121 @$self{keys %$clone} = values %$clone;
122 $KEYS{$self} = $key;
123 $SAFE{$self} = $safe;
124
125 # Dualvars aren't cloned as dualvars, so coerce the compression flags.
126 $self->compression_flags($self->compression_flags);
127
128 $self->objects(history => 1)->each(sub { $_->kdbx($self) });
129 }
130
131 ##############################################################################
132
133 =method load
134
135 =method load_string
136
137 =method load_file
138
139 =method load_handle
140
141 $kdbx = KDBX::File->load(\$string, $key);
142 $kdbx = KDBX::File->load(*IO, $key);
143 $kdbx = KDBX::File->load($filepath, $key);
144 $kdbx->load(...); # also instance method
145
146 $kdbx = File::KDBX->load_string($string, $key);
147 $kdbx = File::KDBX->load_string(\$string, $key);
148 $kdbx->load_string(...); # also instance method
149
150 $kdbx = File::KDBX->load_file($filepath, $key);
151 $kdbx->load_file(...); # also instance method
152
153 $kdbx = File::KDBX->load_handle($fh, $key);
154 $kdbx = File::KDBX->load_handle(*IO, $key);
155 $kdbx->load_handle(...); # also instance method
156
157 Load a KDBX file from a string buffer, IO handle or file from a filesystem.
158
159 L<File::KDBX::Loader> does the heavy lifting.
160
161 =cut
162
163 sub load { shift->_loader->load(@_) }
164 sub load_string { shift->_loader->load_string(@_) }
165 sub load_file { shift->_loader->load_file(@_) }
166 sub load_handle { shift->_loader->load_handle(@_) }
167
168 sub _loader {
169 my $self = shift;
170 $self = $self->new if !ref $self;
171 require File::KDBX::Loader;
172 File::KDBX::Loader->new(kdbx => $self);
173 }
174
175 =method dump
176
177 =method dump_string
178
179 =method dump_file
180
181 =method dump_handle
182
183 $kdbx->dump(\$string, $key);
184 $kdbx->dump(*IO, $key);
185 $kdbx->dump($filepath, $key);
186
187 $kdbx->dump_string(\$string, $key);
188 \$string = $kdbx->dump_string($key);
189
190 $kdbx->dump_file($filepath, $key);
191
192 $kdbx->dump_handle($fh, $key);
193 $kdbx->dump_handle(*IO, $key);
194
195 Dump a KDBX file to a string buffer, IO handle or file in a filesystem.
196
197 L<File::KDBX::Dumper> does the heavy lifting.
198
199 =cut
200
201 sub dump { shift->_dumper->dump(@_) }
202 sub dump_string { shift->_dumper->dump_string(@_) }
203 sub dump_file { shift->_dumper->dump_file(@_) }
204 sub dump_handle { shift->_dumper->dump_handle(@_) }
205
206 sub _dumper {
207 my $self = shift;
208 $self = $self->new if !ref $self;
209 require File::KDBX::Dumper;
210 File::KDBX::Dumper->new(kdbx => $self);
211 }
212
213 ##############################################################################
214
215 =method user_agent_string
216
217 $string = $kdbx->user_agent_string;
218
219 Get a text string identifying the database client software.
220
221 =cut
222
223 sub user_agent_string {
224 require Config;
225 sprintf('%s/%s (%s/%s; %s/%s; %s)',
226 __PACKAGE__, $VERSION, @Config::Config{qw(package version osname osvers archname)});
227 }
228
229 has sig1 => KDBX_SIG1, coerce => \&to_number;
230 has sig2 => KDBX_SIG2_2, coerce => \&to_number;
231 has version => KDBX_VERSION_3_1, coerce => \&to_number;
232 has headers => {};
233 has inner_headers => {};
234 has meta => {};
235 has binaries => {};
236 has deleted_objects => {};
237 has raw => coerce => \&to_string;
238
239 # HEADERS
240 has 'headers.comment' => '', coerce => \&to_string;
241 has 'headers.cipher_id' => CIPHER_UUID_CHACHA20, coerce => \&to_uuid;
242 has 'headers.compression_flags' => COMPRESSION_GZIP, coerce => \&to_compression_constant;
243 has 'headers.master_seed' => sub { random_bytes(32) }, coerce => \&to_string;
244 has 'headers.encryption_iv' => sub { random_bytes(16) }, coerce => \&to_string;
245 has 'headers.stream_start_bytes' => sub { random_bytes(32) }, coerce => \&to_string;
246 has 'headers.kdf_parameters' => sub {
247 +{
248 KDF_PARAM_UUID() => KDF_UUID_AES,
249 KDF_PARAM_AES_ROUNDS() => $_[0]->headers->{+HEADER_TRANSFORM_ROUNDS} // KDF_DEFAULT_AES_ROUNDS,
250 KDF_PARAM_AES_SEED() => $_[0]->headers->{+HEADER_TRANSFORM_SEED} // random_bytes(32),
251 };
252 };
253 # has 'headers.transform_seed' => sub { random_bytes(32) };
254 # has 'headers.transform_rounds' => 100_000;
255 # has 'headers.inner_random_stream_key' => sub { random_bytes(32) }; # 64 ?
256 # has 'headers.inner_random_stream_id' => STREAM_ID_CHACHA20;
257 # has 'headers.public_custom_data' => {};
258
259 # META
260 has 'meta.generator' => '', coerce => \&to_string;
261 has 'meta.header_hash' => '', coerce => \&to_string;
262 has 'meta.database_name' => '', coerce => \&to_string;
263 has 'meta.database_name_changed' => sub { gmtime }, coerce => \&to_time;
264 has 'meta.database_description' => '', coerce => \&to_string;
265 has 'meta.database_description_changed' => sub { gmtime }, coerce => \&to_time;
266 has 'meta.default_username' => '', coerce => \&to_string;
267 has 'meta.default_username_changed' => sub { gmtime }, coerce => \&to_time;
268 has 'meta.maintenance_history_days' => HISTORY_DEFAULT_MAX_AGE, coerce => \&to_number;
269 has 'meta.color' => '', coerce => \&to_string;
270 has 'meta.master_key_changed' => sub { gmtime }, coerce => \&to_time;
271 has 'meta.master_key_change_rec' => -1, coerce => \&to_number;
272 has 'meta.master_key_change_force' => -1, coerce => \&to_number;
273 # has 'meta.memory_protection' => {};
274 has 'meta.custom_icons' => [];
275 has 'meta.recycle_bin_enabled' => true, coerce => \&to_bool;
276 has 'meta.recycle_bin_uuid' => UUID_NULL, coerce => \&to_uuid;
277 has 'meta.recycle_bin_changed' => sub { gmtime }, coerce => \&to_time;
278 has 'meta.entry_templates_group' => UUID_NULL, coerce => \&to_uuid;
279 has 'meta.entry_templates_group_changed' => sub { gmtime }, coerce => \&to_time;
280 has 'meta.last_selected_group' => UUID_NULL, coerce => \&to_uuid;
281 has 'meta.last_top_visible_group' => UUID_NULL, coerce => \&to_uuid;
282 has 'meta.history_max_items' => HISTORY_DEFAULT_MAX_ITEMS, coerce => \&to_number;
283 has 'meta.history_max_size' => HISTORY_DEFAULT_MAX_SIZE, coerce => \&to_number;
284 has 'meta.settings_changed' => sub { gmtime }, coerce => \&to_time;
285 # has 'meta.binaries' => {};
286 # has 'meta.custom_data' => {};
287
288 has 'memory_protection.protect_title' => false, coerce => \&to_bool;
289 has 'memory_protection.protect_username' => false, coerce => \&to_bool;
290 has 'memory_protection.protect_password' => true, coerce => \&to_bool;
291 has 'memory_protection.protect_url' => false, coerce => \&to_bool;
292 has 'memory_protection.protect_notes' => false, coerce => \&to_bool;
293 # has 'memory_protection.auto_enable_visual_hiding' => false;
294
295 my @ATTRS = (
296 HEADER_TRANSFORM_SEED,
297 HEADER_TRANSFORM_ROUNDS,
298 HEADER_INNER_RANDOM_STREAM_KEY,
299 HEADER_INNER_RANDOM_STREAM_ID,
300 HEADER_PUBLIC_CUSTOM_DATA,
301 );
302 sub _set_nonlazy_attributes {
303 my $self = shift;
304 $self->$_ for list_attributes(ref $self), @ATTRS;
305 }
306
307 =method memory_protection
308
309 \%settings = $kdbx->memory_protection
310 $kdbx->memory_protection(\%settings);
311
312 $bool = $kdbx->memory_protection($string_key);
313 $kdbx->memory_protection($string_key => $bool);
314
315 Get or set memory protection settings. This globally (for the whole database) configures whether and which of
316 the standard strings should be memory-protected. The default setting is to memory-protect only I<Password>
317 strings.
318
319 Memory protection can be toggled individually for each entry string, and individual settings take precedence
320 over these global settings.
321
322 =cut
323
324 sub memory_protection {
325 my $self = shift;
326 $self->{meta}{memory_protection} = shift if @_ == 1 && is_plain_hashref($_[0]);
327 return $self->{meta}{memory_protection} //= {} if !@_;
328
329 my $string_key = shift;
330 my $key = 'protect_' . lc($string_key);
331
332 $self->meta->{memory_protection}{$key} = shift if @_;
333 $self->meta->{memory_protection}{$key};
334 }
335
336 =method minimum_version
337
338 $version = $kdbx->minimum_version;
339
340 Determine the minimum file version required to save a database losslessly. Using certain databases features
341 might increase this value. For example, setting the KDF to Argon2 will increase the minimum version to at
342 least C<KDBX_VERSION_4_0> (i.e. C<0x00040000>) because Argon2 was introduced with KDBX4.
343
344 This method never returns less than C<KDBX_VERSION_3_1> (i.e. C<0x00030001>). That file version is so
345 ubiquitous and well-supported, there are seldom reasons to dump in a lesser format nowadays.
346
347 B<WARNING:> If you dump a database with a minimum version higher than the current L</version>, the dumper will
348 typically issue a warning and automatically upgrade the database. This seems like the safest behavior in order
349 to avoid data loss, but lower versions have the benefit of being compatible with more software. It is possible
350 to prevent auto-upgrades by explicitly telling the dumper which version to use, but you do run the risk of
351 data loss. A database will never be automatically downgraded.
352
353 =cut
354
355 sub minimum_version {
356 my $self = shift;
357
358 return KDBX_VERSION_4_1 if any {
359 nonempty $_->{last_modification_time}
360 } values %{$self->custom_data};
361
362 return KDBX_VERSION_4_1 if any {
363 nonempty $_->{name} || nonempty $_->{last_modification_time}
364 } @{$self->custom_icons};
365
366 return KDBX_VERSION_4_1 if $self->groups->next(sub {
367 nonempty $_->previous_parent_group ||
368 nonempty $_->tags ||
369 (any { nonempty $_->{last_modification_time} } values %{$_->custom_data})
370 });
371
372 return KDBX_VERSION_4_1 if $self->entries(history => 1)->next(sub {
373 nonempty $_->previous_parent_group ||
374 (defined $_->quality_check && !$_->quality_check) ||
375 (any { nonempty $_->{last_modification_time} } values %{$_->custom_data})
376 });
377
378 return KDBX_VERSION_4_0 if $self->kdf->uuid ne KDF_UUID_AES;
379
380 return KDBX_VERSION_4_0 if nonempty $self->public_custom_data;
381
382 return KDBX_VERSION_4_0 if $self->objects->next(sub {
383 nonempty $_->custom_data
384 });
385
386 return KDBX_VERSION_3_1;
387 }
388
389 ##############################################################################
390
391 =method root
392
393 $group = $kdbx->root;
394 $kdbx->root($group);
395
396 Get or set a database's root group. You don't necessarily need to explicitly create or set a root group
397 because it autovivifies when adding entries and groups to the database.
398
399 Every database has only a single root group at a time. Some old KDB files might have multiple root groups.
400 When reading such files, a single implicit root group is created to contain the actual root groups. When
401 writing to such a format, if the root group looks like it was implicitly created then it won't be written and
402 the resulting file might have multiple root groups, as it was before loading. This allows working with older
403 files without changing their written internal structure while still adhering to modern semantics while the
404 database is opened.
405
406 The root group of a KDBX database contains all of the database's entries and other groups. If you replace the
407 root group, you are essentially replacing the entire database contents with something else.
408
409 =cut
410
411 sub root {
412 my $self = shift;
413 if (@_) {
414 $self->{root} = $self->_wrap_group(@_);
415 $self->{root}->kdbx($self);
416 }
417 $self->{root} //= $self->_implicit_root;
418 return $self->_wrap_group($self->{root});
419 }
420
421 # Called by File::KeePass::KDBX so that a File::KDBX an be treated as a File::KDBX::Group in that both types
422 # can have subgroups. File::KDBX already has a `groups' method that does something different from the
423 # File::KDBX::Groups `groups' method.
424 sub _kpx_groups {
425 my $self = shift;
426 return [] if !$self->{root};
427 return $self->_has_implicit_root ? $self->root->groups : [$self->root];
428 }
429
430 sub _has_implicit_root {
431 my $self = shift;
432 my $root = $self->root;
433 my $temp = __PACKAGE__->_implicit_root;
434 # If an implicit root group has been changed in any significant way, it is no longer implicit.
435 return $root->name eq $temp->name &&
436 $root->is_expanded ^ $temp->is_expanded &&
437 $root->notes eq $temp->notes &&
438 !@{$root->entries} &&
439 !defined $root->custom_icon_uuid &&
440 !keys %{$root->custom_data} &&
441 $root->icon_id == $temp->icon_id &&
442 $root->expires ^ $temp->expires &&
443 $root->default_auto_type_sequence eq $temp->default_auto_type_sequence &&
444 !defined $root->enable_auto_type &&
445 !defined $root->enable_searching;
446 }
447
448 sub _implicit_root {
449 my $self = shift;
450 require File::KDBX::Group;
451 return File::KDBX::Group->new(
452 name => 'Root',
453 is_expanded => true,
454 notes => 'Added as an implicit root group by '.__PACKAGE__.'.',
455 ref $self ? (kdbx => $self) : (),
456 );
457 }
458
459 =method trace_lineage
460
461 \@lineage = $kdbx->trace_lineage($group);
462 \@lineage = $kdbx->trace_lineage($group, $base_group);
463 \@lineage = $kdbx->trace_lineage($entry);
464 \@lineage = $kdbx->trace_lineage($entry, $base_group);
465
466 Get the direct line of ancestors from C<$base_group> (default: the root group) to a group or entry. The
467 lineage includes the base group but I<not> the target group or entry. Returns C<undef> if the target is not in
468 the database structure.
469
470 =cut
471
472 sub trace_lineage {
473 my $self = shift;
474 my $object = shift;
475 return $object->lineage(@_);
476 }
477
478 sub _trace_lineage {
479 my $self = shift;
480 my $object = shift;
481 my @lineage = @_;
482
483 push @lineage, $self->root if !@lineage;
484 my $base = $lineage[-1] or return [];
485
486 my $uuid = $object->uuid;
487 return \@lineage if any { $_->uuid eq $uuid } @{$base->groups}, @{$base->entries};
488
489 for my $subgroup (@{$base->groups}) {
490 my $result = $self->_trace_lineage($object, @lineage, $subgroup);
491 return $result if $result;
492 }
493 }
494
495 =method recycle_bin
496
497 $group = $kdbx->recycle_bin;
498 $kdbx->recycle_bin($group);
499
500 Get or set the recycle bin group. Returns C<undef> if there is no recycle bin and L</recycle_bin_enabled> is
501 false, otherwise the current recycle bin or an autovivified recycle bin group is returned.
502
503 =cut
504
505 sub recycle_bin {
506 my $self = shift;
507 if (my $group = shift) {
508 $self->recycle_bin_uuid($group->uuid);
509 return $group;
510 }
511 my $group;
512 my $uuid = $self->recycle_bin_uuid;
513 $group = $self->groups->grep(uuid => $uuid)->next if $uuid ne UUID_NULL;
514 if (!$group && $self->recycle_bin_enabled) {
515 $group = $self->add_group(
516 name => 'Recycle Bin',
517 icon_id => ICON_TRASHCAN_FULL,
518 enable_auto_type => false,
519 enable_searching => false,
520 );
521 $self->recycle_bin_uuid($group->uuid);
522 }
523 return $group;
524 }
525
526 =method entry_templates
527
528 $group = $kdbx->entry_templates;
529 $kdbx->entry_templates($group);
530
531 Get or set the entry templates group. May return C<undef> if unset.
532
533 =cut
534
535 sub entry_templates {
536 my $self = shift;
537 if (my $group = shift) {
538 $self->entry_templates_group($group->uuid);
539 return $group;
540 }
541 my $uuid = $self->entry_templates_group;
542 return if $uuid eq UUID_NULL;
543 return $self->groups->grep(uuid => $uuid)->next;
544 }
545
546 =method last_selected
547
548 $group = $kdbx->last_selected;
549 $kdbx->last_selected($group);
550
551 Get or set the last selected group. May return C<undef> if unset.
552
553 =cut
554
555 sub last_selected {
556 my $self = shift;
557 if (my $group = shift) {
558 $self->last_selected_group($group->uuid);
559 return $group;
560 }
561 my $uuid = $self->last_selected_group;
562 return if $uuid eq UUID_NULL;
563 return $self->groups->grep(uuid => $uuid)->next;
564 }
565
566 =method last_top_visible
567
568 $group = $kdbx->last_top_visible;
569 $kdbx->last_top_visible($group);
570
571 Get or set the last top visible group. May return C<undef> if unset.
572
573 =cut
574
575 sub last_top_visible {
576 my $self = shift;
577 if (my $group = shift) {
578 $self->last_top_visible_group($group->uuid);
579 return $group;
580 }
581 my $uuid = $self->last_top_visible_group;
582 return if $uuid eq UUID_NULL;
583 return $self->groups->grep(uuid => $uuid)->next;
584 }
585
586 ##############################################################################
587
588 =method add_group
589
590 $kdbx->add_group($group);
591 $kdbx->add_group(%group_attributes, %options);
592
593 Add a group to a database. This is equivalent to identifying a parent group and calling
594 L<File::KDBX::Group/add_group> on the parent group, forwarding the arguments. Available options:
595
596 =for :list
597 * C<group> - Group object or group UUID to add the group to (default: root group)
598
599 =cut
600
601 sub add_group {
602 my $self = shift;
603 my $group = @_ % 2 == 1 ? shift : undef;
604 my %args = @_;
605
606 # find the right group to add the group to
607 my $parent = delete $args{group} // $self->root;
608 $parent = $self->groups->grep({uuid => $parent})->next if !ref $parent;
609 $parent or throw 'Invalid group';
610
611 return $parent->add_group(defined $group ? $group : (), %args, kdbx => $self);
612 }
613
614 sub _wrap_group {
615 my $self = shift;
616 my $group = shift;
617 require File::KDBX::Group;
618 return File::KDBX::Group->wrap($group, $self);
619 }
620
621 =method groups
622
623 \&iterator = $kdbx->groups(%options);
624 \&iterator = $kdbx->groups($base_group, %options);
625
626 Get an L<File::KDBX::Iterator> over I<groups> within a database. Options:
627
628 =for :list
629 * C<base> - Only include groups within a base group (same as C<$base_group>) (default: L</root>)
630 * C<inclusive> - Include the base group in the results (default: true)
631 * C<algorithm> - Search algorithm, one of C<ids>, C<bfs> or C<dfs> (default: C<ids>)
632
633 =cut
634
635 sub groups {
636 my $self = shift;
637 my %args = @_ % 2 == 0 ? @_ : (base => shift, @_);
638 my $base = delete $args{base} // $self->root;
639
640 return $base->all_groups(%args);
641 }
642
643 ##############################################################################
644
645 =method add_entry
646
647 $kdbx->add_entry($entry, %options);
648 $kdbx->add_entry(%entry_attributes, %options);
649
650 Add an entry to a database. This is equivalent to identifying a parent group and calling
651 L<File::KDBX::Group/add_entry> on the parent group, forwarding the arguments. Available options:
652
653 =for :list
654 * C<group> - Group object or group UUID to add the entry to (default: root group)
655
656 =cut
657
658 sub add_entry {
659 my $self = shift;
660 my $entry = @_ % 2 == 1 ? shift : undef;
661 my %args = @_;
662
663 # find the right group to add the entry to
664 my $parent = delete $args{group} // $self->root;
665 $parent = $self->groups->grep({uuid => $parent})->next if !ref $parent;
666 $parent or throw 'Invalid group';
667
668 return $parent->add_entry(defined $entry ? $entry : (), %args, kdbx => $self);
669 }
670
671 sub _wrap_entry {
672 my $self = shift;
673 my $entry = shift;
674 require File::KDBX::Entry;
675 return File::KDBX::Entry->wrap($entry, $self);
676 }
677
678 =method entries
679
680 \&iterator = $kdbx->entries(%options);
681 \&iterator = $kdbx->entries($base_group, %options);
682
683 Get an L<File::KDBX::Iterator> over I<entries> within a database. Supports the same options as L</groups>,
684 plus some new ones:
685
686 =for :list
687 * C<auto_type> - Only include entries with auto-type enabled (default: false, include all)
688 * C<searching> - Only include entries within groups with searching enabled (default: false, include all)
689 * C<history> - Also include historical entries (default: false, include only current entries)
690
691 =cut
692
693 sub entries {
694 my $self = shift;
695 my %args = @_ % 2 == 0 ? @_ : (base => shift, @_);
696 my $base = delete $args{base} // $self->root;
697
698 return $base->all_entries(%args);
699 }
700
701 ##############################################################################
702
703 =method objects
704
705 \&iterator = $kdbx->objects(%options);
706 \&iterator = $kdbx->objects($base_group, %options);
707
708 Get an L<File::KDBX::Iterator> over I<objects> within a database. Groups and entries are considered objects,
709 so this is essentially a combination of L</groups> and L</entries>. This won't often be useful, but it can be
710 convenient for maintenance tasks. This method takes the same options as L</groups> and L</entries>.
711
712 =cut
713
714 sub objects {
715 my $self = shift;
716 my %args = @_ % 2 == 0 ? @_ : (base => shift, @_);
717 my $base = delete $args{base} // $self->root;
718
719 return $base->all_objects(%args);
720 }
721
722 sub __iter__ { $_[0]->objects }
723
724 ##############################################################################
725
726 =method custom_icon
727
728 \%icon = $kdbx->custom_icon($uuid);
729 $kdbx->custom_icon($uuid => \%icon);
730 $kdbx->custom_icon(%icon);
731 $kdbx->custom_icon(uuid => $value, %icon);
732
733 Get or set custom icons.
734
735 =cut
736
737 sub custom_icon {
738 my $self = shift;
739 my %args = @_ == 2 ? (uuid => shift, data => shift)
740 : @_ % 2 == 1 ? (uuid => shift, @_) : @_;
741
742 if (!$args{uuid} && !$args{data}) {
743 my %standard = (uuid => 1, data => 1, name => 1, last_modification_time => 1);
744 my @other_keys = grep { !$standard{$_} } keys %args;
745 if (@other_keys == 1) {
746 my $key = $args{key} = $other_keys[0];
747 $args{data} = delete $args{$key};
748 }
749 }
750
751 my $uuid = $args{uuid} or throw 'Must provide a custom icon UUID to access';
752 my $icon = (first { $_->{uuid} eq $uuid } @{$self->custom_icons}) // do {
753 push @{$self->custom_icons}, my $i = { uuid => $uuid };
754 $i;
755 };
756
757 my $fields = \%args;
758 $fields = $args{data} if is_plain_hashref($args{data});
759
760 while (my ($field, $value) = each %$fields) {
761 $icon->{$field} = $value;
762 }
763 return $icon;
764 }
765
766 =method custom_icon_data
767
768 $image_data = $kdbx->custom_icon_data($uuid);
769
770 Get a custom icon image data.
771
772 =cut
773
774 sub custom_icon_data {
775 my $self = shift;
776 my $uuid = shift // return;
777 my $icon = first { $_->{uuid} eq $uuid } @{$self->custom_icons} or return;
778 return $icon->{data};
779 }
780
781 =method add_custom_icon
782
783 $uuid = $kdbx->add_custom_icon($image_data, %attributes);
784 $uuid = $kdbx->add_custom_icon(%attributes);
785
786 Add a custom icon and get its UUID. If not provided, a random UUID will be generated. Possible attributes:
787
788 =for :list
789 * C<uuid> - Icon UUID (default: autogenerated)
790 * C<data> - Image data (same as C<$image_data>)
791 * C<name> - Name of the icon (text, KDBX4.1+)
792 * C<last_modification_time> - Just what it says (datetime, KDBX4.1+)
793
794 =cut
795
796 sub add_custom_icon {
797 my $self = shift;
798 my %args = @_ % 2 == 1 ? (data => shift, @_) : @_;
799
800 defined $args{data} or throw 'Must provide image data';
801
802 my $uuid = $args{uuid} // generate_uuid;
803 push @{$self->custom_icons}, {
804 @_,
805 uuid => $uuid,
806 data => $args{data},
807 };
808 return $uuid;
809 }
810
811 =method remove_custom_icon
812
813 $kdbx->remove_custom_icon($uuid);
814
815 Remove a custom icon.
816
817 =cut
818
819 sub remove_custom_icon {
820 my $self = shift;
821 my $uuid = shift;
822 my @deleted;
823 @{$self->custom_icons} = grep { $_->{uuid} eq $uuid ? do { push @deleted, $_; 0 } : 1 }
824 @{$self->custom_icons};
825 $self->add_deleted_object($uuid) if @deleted;
826 return @deleted;
827 }
828
829 ##############################################################################
830
831 =method custom_data
832
833 \%all_data = $kdbx->custom_data;
834 $kdbx->custom_data(\%all_data);
835
836 \%data = $kdbx->custom_data($key);
837 $kdbx->custom_data($key => \%data);
838 $kdbx->custom_data(%data);
839 $kdbx->custom_data(key => $value, %data);
840
841 Get and set custom data. Custom data is metadata associated with a database.
842
843 Each data item can have a few attributes associated with it.
844
845 =for :list
846 * C<key> - A unique text string identifier used to look up the data item (required)
847 * C<value> - A text string value (required)
848 * C<last_modification_time> (optional, KDBX4.1+)
849
850 =cut
851
852 sub custom_data {
853 my $self = shift;
854 $self->{meta}{custom_data} = shift if @_ == 1 && is_plain_hashref($_[0]);
855 return $self->{meta}{custom_data} //= {} if !@_;
856
857 my %args = @_ == 2 ? (key => shift, value => shift)
858 : @_ % 2 == 1 ? (key => shift, @_) : @_;
859
860 if (!$args{key} && !$args{value}) {
861 my %standard = (key => 1, value => 1, last_modification_time => 1);
862 my @other_keys = grep { !$standard{$_} } keys %args;
863 if (@other_keys == 1) {
864 my $key = $args{key} = $other_keys[0];
865 $args{value} = delete $args{$key};
866 }
867 }
868
869 my $key = $args{key} or throw 'Must provide a custom_data key to access';
870
871 return $self->{meta}{custom_data}{$key} = $args{value} if is_plain_hashref($args{value});
872
873 while (my ($field, $value) = each %args) {
874 $self->{meta}{custom_data}{$key}{$field} = $value;
875 }
876 return $self->{meta}{custom_data}{$key};
877 }
878
879 =method custom_data_value
880
881 $value = $kdbx->custom_data_value($key);
882
883 Exactly the same as L</custom_data> except returns just the custom data's value rather than a structure of
884 attributes. This is a shortcut for:
885
886 my $data = $kdbx->custom_data($key);
887 my $value = defined $data ? $data->{value} : undef;
888
889 =cut
890
891 sub custom_data_value {
892 my $self = shift;
893 my $data = $self->custom_data(@_) // return;
894 return $data->{value};
895 }
896
897 =method public_custom_data
898
899 \%all_data = $kdbx->public_custom_data;
900 $kdbx->public_custom_data(\%all_data);
901
902 $value = $kdbx->public_custom_data($key);
903 $kdbx->public_custom_data($key => $value);
904
905 Get and set public custom data. Public custom data is similar to custom data but different in some important
906 ways. Public custom data:
907
908 =for :list
909 * can store strings, booleans and up to 64-bit integer values (custom data can only store text values)
910 * is NOT encrypted within a KDBX file (hence the "public" part of the name)
911 * is a plain hash/dict of key-value pairs with no other associated fields (like modification times)
912
913 =cut
914
915 sub public_custom_data {
916 my $self = shift;
917 $self->{headers}{+HEADER_PUBLIC_CUSTOM_DATA} = shift if @_ == 1 && is_plain_hashref($_[0]);
918 return $self->{headers}{+HEADER_PUBLIC_CUSTOM_DATA} //= {} if !@_;
919
920 my $key = shift or throw 'Must provide a public_custom_data key to access';
921 $self->{headers}{+HEADER_PUBLIC_CUSTOM_DATA}{$key} = shift if @_;
922 return $self->{headers}{+HEADER_PUBLIC_CUSTOM_DATA}{$key};
923 }
924
925 ##############################################################################
926
927 # TODO
928
929 # sub merge_to {
930 # my $self = shift;
931 # my $other = shift;
932 # my %options = @_; # prefer_old / prefer_new
933 # $other->merge_from($self);
934 # }
935
936 # sub merge_from {
937 # my $self = shift;
938 # my $other = shift;
939
940 # die 'Not implemented';
941 # }
942
943 =method add_deleted_object
944
945 $kdbx->add_deleted_object($uuid);
946
947 Add a UUID to the deleted objects list. This list is used to support automatic database merging.
948
949 You typically do not need to call this yourself because the list will be populated automatically as objects
950 are removed.
951
952 =cut
953
954 sub add_deleted_object {
955 my $self = shift;
956 my $uuid = shift;
957
958 # ignore null and meta stream UUIDs
959 return if $uuid eq UUID_NULL || $uuid eq '0' x 16;
960
961 $self->deleted_objects->{$uuid} = {
962 uuid => $uuid,
963 deletion_time => scalar gmtime,
964 };
965 }
966
967 =method remove_deleted_object
968
969 $kdbx->remove_deleted_object($uuid);
970
971 Remove a UUID from the deleted objects list. This list is used to support automatic database merging.
972
973 You typically do not need to call this yourself because the list will be maintained automatically as objects
974 are added.
975
976 =cut
977
978 sub remove_deleted_object {
979 my $self = shift;
980 my $uuid = shift;
981 delete $self->deleted_objects->{$uuid};
982 }
983
984 =method clear_deleted_objects
985
986 Remove all UUIDs from the deleted objects list. This list is used to support automatic database merging, but
987 if you don't need merging then you can clear deleted objects to reduce the database file size.
988
989 =cut
990
991 sub clear_deleted_objects {
992 my $self = shift;
993 %{$self->deleted_objects} = ();
994 }
995
996 ##############################################################################
997
998 =method resolve_reference
999
1000 $string = $kdbx->resolve_reference($reference);
1001 $string = $kdbx->resolve_reference($wanted, $search_in, $expression);
1002
1003 Resolve a L<field reference|https://keepass.info/help/base/fieldrefs.html>. A field reference is a kind of
1004 string placeholder. You can use a field reference to refer directly to a standard field within an entry. Field
1005 references are resolved automatically while expanding entry strings (i.e. replacing placeholders), but you can
1006 use this method to resolve on-the-fly references that aren't part of any actual string in the database.
1007
1008 If the reference does not resolve to any field, C<undef> is returned. If the reference resolves to multiple
1009 fields, only the first one is returned (in the same order as iterated by L</entries>). To avoid ambiguity, you
1010 can refer to a specific entry by its UUID.
1011
1012 The syntax of a reference is: C<< {REF:<WantedField>@<SearchIn>:<Text>} >>. C<Text> is a
1013 L</"Simple Expression">. C<WantedField> and C<SearchIn> are both single character codes representing a field:
1014
1015 =for :list
1016 * C<T> - Title
1017 * C<U> - UserName
1018 * C<P> - Password
1019 * C<A> - URL
1020 * C<N> - Notes
1021 * C<I> - UUID
1022 * C<O> - Other custom strings
1023
1024 Since C<O> does not represent any specific field, it cannot be used as the C<WantedField>.
1025
1026 Examples:
1027
1028 To get the value of the I<UserName> string of the first entry with "My Bank" in the title:
1029
1030 my $username = $kdbx->resolve_reference('{REF:U@T:"My Bank"}');
1031 # OR the {REF:...} wrapper is optional
1032 my $username = $kdbx->resolve_reference('U@T:"My Bank"');
1033 # OR separate the arguments
1034 my $username = $kdbx->resolve_reference(U => T => '"My Bank"');
1035
1036 Note how the text is a L</"Simple Expression">, so search terms with spaces must be surrounded in double
1037 quotes.
1038
1039 To get the I<Password> string of a specific entry (identified by its UUID):
1040
1041 my $password = $kdbx->resolve_reference('{REF:P@I:46C9B1FFBD4ABC4BBB260C6190BAD20C}');
1042
1043 =cut
1044
1045 sub resolve_reference {
1046 my $self = shift;
1047 my $wanted = shift // return;
1048 my $search_in = shift;
1049 my $text = shift;
1050
1051 if (!defined $text) {
1052 $wanted =~ s/^\{REF:([^\}]+)\}$/$1/i;
1053 ($wanted, $search_in, $text) = $wanted =~ /^([TUPANI])\@([TUPANIO]):(.*)$/i;
1054 }
1055 $wanted && $search_in && nonempty($text) or return;
1056
1057 my %fields = (
1058 T => 'expand_title',
1059 U => 'expand_username',
1060 P => 'expand_password',
1061 A => 'expand_url',
1062 N => 'expand_notes',
1063 I => 'uuid',
1064 O => 'other_strings',
1065 );
1066 $wanted = $fields{$wanted} or return;
1067 $search_in = $fields{$search_in} or return;
1068
1069 my $query = $search_in eq 'uuid' ? query($search_in => uuid($text))
1070 : simple_expression_query($text, '=~', $search_in);
1071
1072 my $entry = $self->entries->grep($query)->next;
1073 $entry or return;
1074
1075 return $entry->$wanted;
1076 }
1077
1078 our %PLACEHOLDERS = (
1079 # 'PLACEHOLDER' => sub { my ($entry, $arg) = @_; ... };
1080 'TITLE' => sub { $_[0]->expand_title },
1081 'USERNAME' => sub { $_[0]->expand_username },
1082 'PASSWORD' => sub { $_[0]->expand_password },
1083 'NOTES' => sub { $_[0]->expand_notes },
1084 'S:' => sub { $_[0]->string_value($_[1]) },
1085 'URL' => sub { $_[0]->expand_url },
1086 'URL:RMVSCM' => sub { local $_ = $_[0]->url; s!^[^:/\?\#]+://!!; $_ },
1087 'URL:WITHOUTSCHEME' => sub { local $_ = $_[0]->url; s!^[^:/\?\#]+://!!; $_ },
1088 'URL:SCM' => sub { (split_url($_[0]->url))[0] },
1089 'URL:SCHEME' => sub { (split_url($_[0]->url))[0] }, # non-standard
1090 'URL:HOST' => sub { (split_url($_[0]->url))[2] },
1091 'URL:PORT' => sub { (split_url($_[0]->url))[3] },
1092 'URL:PATH' => sub { (split_url($_[0]->url))[4] },
1093 'URL:QUERY' => sub { (split_url($_[0]->url))[5] },
1094 'URL:HASH' => sub { (split_url($_[0]->url))[6] }, # non-standard
1095 'URL:FRAGMENT' => sub { (split_url($_[0]->url))[6] }, # non-standard
1096 'URL:USERINFO' => sub { (split_url($_[0]->url))[1] },
1097 'URL:USERNAME' => sub { (split_url($_[0]->url))[7] },
1098 'URL:PASSWORD' => sub { (split_url($_[0]->url))[8] },
1099 'UUID' => sub { local $_ = format_uuid($_[0]->uuid); s/-//g; $_ },
1100 'REF:' => sub { $_[0]->kdbx->resolve_reference($_[1]) },
1101 'INTERNETEXPLORER' => sub { load_optional('IPC::Cmd'); IPC::Cmd::can_run('iexplore') },
1102 'FIREFOX' => sub { load_optional('IPC::Cmd'); IPC::Cmd::can_run('firefox') },
1103 'GOOGLECHROME' => sub { load_optional('IPC::Cmd'); IPC::Cmd::can_run('google-chrome') },
1104 'OPERA' => sub { load_optional('IPC::Cmd'); IPC::Cmd::can_run('opera') },
1105 'SAFARI' => sub { load_optional('IPC::Cmd'); IPC::Cmd::can_run('safari') },
1106 'APPDIR' => sub { load_optional('FindBin'); $FindBin::Bin },
1107 'GROUP' => sub { my $p = $_[0]->group; $p ? $p->name : undef },
1108 'GROUP_PATH' => sub { $_[0]->path },
1109 'GROUP_NOTES' => sub { my $p = $_[0]->group; $p ? $p->notes : undef },
1110 # 'GROUP_SEL'
1111 # 'GROUP_SEL_PATH'
1112 # 'GROUP_SEL_NOTES'
1113 # 'DB_PATH'
1114 # 'DB_DIR'
1115 # 'DB_NAME'
1116 # 'DB_BASENAME'
1117 # 'DB_EXT'
1118 'ENV:' => sub { $ENV{$_[1]} },
1119 'ENV_DIRSEP' => sub { load_optional('File::Spec')->catfile('', '') },
1120 'ENV_PROGRAMFILES_X86' => sub { $ENV{'ProgramFiles(x86)'} || $ENV{'ProgramFiles'} },
1121 # 'T-REPLACE-RX:'
1122 # 'T-CONV:'
1123 'DT_SIMPLE' => sub { localtime->strftime('%Y%m%d%H%M%S') },
1124 'DT_YEAR' => sub { localtime->strftime('%Y') },
1125 'DT_MONTH' => sub { localtime->strftime('%m') },
1126 'DT_DAY' => sub { localtime->strftime('%d') },
1127 'DT_HOUR' => sub { localtime->strftime('%H') },
1128 'DT_MINUTE' => sub { localtime->strftime('%M') },
1129 'DT_SECOND' => sub { localtime->strftime('%S') },
1130 'DT_UTC_SIMPLE' => sub { gmtime->strftime('%Y%m%d%H%M%S') },
1131 'DT_UTC_YEAR' => sub { gmtime->strftime('%Y') },
1132 'DT_UTC_MONTH' => sub { gmtime->strftime('%m') },
1133 'DT_UTC_DAY' => sub { gmtime->strftime('%d') },
1134 'DT_UTC_HOUR' => sub { gmtime->strftime('%H') },
1135 'DT_UTC_MINUTE' => sub { gmtime->strftime('%M') },
1136 'DT_UTC_SECOND' => sub { gmtime->strftime('%S') },
1137 # 'PICKCHARS'
1138 # 'PICKCHARS:'
1139 # 'PICKFIELD'
1140 # 'NEWPASSWORD'
1141 # 'NEWPASSWORD:'
1142 # 'PASSWORD_ENC'
1143 'HMACOTP' => sub { $_[0]->hmac_otp },
1144 'TIMEOTP' => sub { $_[0]->time_otp },
1145 'C:' => sub { '' }, # comment
1146 # 'BASE'
1147 # 'BASE:'
1148 # 'CLIPBOARD'
1149 # 'CLIPBOARD-SET:'
1150 # 'CMD:'
1151 );
1152
1153 ##############################################################################
1154
1155 =method lock
1156
1157 $kdbx->lock;
1158
1159 Encrypt all protected strings and binaries in a database. The encrypted data is stored in
1160 a L<File::KDBX::Safe> associated with the database and the actual values will be replaced with C<undef> to
1161 indicate their protected state. Returns itself to allow method chaining.
1162
1163 You can call C<lock> on an already-locked database to memory-protect any unprotected strings and binaries
1164 added after the last time the database was locked.
1165
1166 =cut
1167
1168 sub _safe {
1169 my $self = shift;
1170 $SAFE{$self} = shift if @_;
1171 $SAFE{$self};
1172 }
1173
1174 sub _remove_safe { delete $SAFE{$_[0]} }
1175
1176 sub lock {
1177 my $self = shift;
1178
1179 $self->_safe and return $self;
1180
1181 my @strings;
1182
1183 $self->entries(history => 1)->each(sub {
1184 push @strings, grep { $_->{protect} } values %{$_->strings}, values %{$_->binaries};
1185 });
1186
1187 $self->_safe(File::KDBX::Safe->new(\@strings));
1188
1189 return $self;
1190 }
1191
1192 =method unlock
1193
1194 $kdbx->unlock;
1195
1196 Decrypt all protected strings and binaries in a database, replacing C<undef> value placeholders with their
1197 actual, unprotected values. Returns itself to allow method chaining.
1198
1199 =cut
1200
1201 sub unlock {
1202 my $self = shift;
1203 my $safe = $self->_safe or return $self;
1204
1205 $safe->unlock;
1206 $self->_remove_safe;
1207
1208 return $self;
1209 }
1210
1211 =method unlock_scoped
1212
1213 $guard = $kdbx->unlock_scoped;
1214
1215 Unlock a database temporarily, relocking when the guard is released (typically at the end of a scope). Returns
1216 C<undef> if the database is already unlocked.
1217
1218 See L</lock> and L</unlock>.
1219
1220 Example:
1221
1222 {
1223 my $guard = $kdbx->unlock_scoped;
1224 ...;
1225 }
1226 # $kdbx is now memory-locked
1227
1228 =cut
1229
1230 sub unlock_scoped {
1231 throw 'Programmer error: Cannot call unlock_scoped in void context' if !defined wantarray;
1232 my $self = shift;
1233 return if !$self->is_locked;
1234 require Scope::Guard;
1235 my $guard = Scope::Guard->new(sub { $self->lock });
1236 $self->unlock;
1237 return $guard;
1238 }
1239
1240 =method peek
1241
1242 $string = $kdbx->peek(\%string);
1243 $string = $kdbx->peek(\%binary);
1244
1245 Peek at the value of a protected string or binary without unlocking the whole database. The argument can be
1246 a string or binary hashref as returned by L<File::KDBX::Entry/string> or L<File::KDBX::Entry/binary>.
1247
1248 =cut
1249
1250 sub peek {
1251 my $self = shift;
1252 my $string = shift;
1253 my $safe = $self->_safe or return;
1254 return $safe->peek($string);
1255 }
1256
1257 =method is_locked
1258
1259 $bool = $kdbx->is_locked;
1260
1261 Get whether or not a database's contents are in a locked (i.e. memory-protected) state. If this is true, then
1262 some or all of the protected strings and binaries within the database will be unavailable (literally have
1263 C<undef> values) until L</unlock> is called.
1264
1265 =cut
1266
1267 sub is_locked { !!$_[0]->_safe }
1268
1269 ##############################################################################
1270
1271 # sub check {
1272 # - Fixer tool. Can repair inconsistencies, including:
1273 # - Orphaned binaries... not really a thing anymore since we now distribute binaries amongst entries
1274 # - Unused custom icons (OFF, data loss)
1275 # - Duplicate icons
1276 # - All data types are valid
1277 # - date times are correct
1278 # - boolean fields
1279 # - All UUIDs refer to things that exist
1280 # - previous parent group
1281 # - recycle bin
1282 # - last selected group
1283 # - last visible group
1284 # - Enforce history size limits (ON)
1285 # - Check headers/meta (ON)
1286 # - Duplicate deleted objects (ON)
1287 # - Duplicate window associations (OFF)
1288 # - Header UUIDs match known ciphers/KDFs?
1289 # }
1290
1291 =method remove_empty_groups
1292
1293 $kdbx->remove_empty_groups;
1294
1295 Remove groups with no subgroups and no entries.
1296
1297 =cut
1298
1299 sub remove_empty_groups {
1300 my $self = shift;
1301 my @removed;
1302 $self->groups(algorithm => 'dfs')
1303 ->where(-true => 'is_empty')
1304 ->each(sub { push @removed, $_->remove });
1305 return @removed;
1306 }
1307
1308 =method remove_unused_icons
1309
1310 $kdbx->remove_unused_icons;
1311
1312 Remove icons that are not associated with any entry or group in the database.
1313
1314 =cut
1315
1316 sub remove_unused_icons {
1317 my $self = shift;
1318 my %icons = map { $_->{uuid} => 0 } @{$self->custom_icons};
1319
1320 $self->objects->each(sub { ++$icons{$_->custom_icon_uuid // ''} });
1321
1322 my @removed;
1323 push @removed, $self->remove_custom_icon($_) for grep { $icons{$_} == 0 } keys %icons;
1324 return @removed;
1325 }
1326
1327 =method remove_duplicate_icons
1328
1329 $kdbx->remove_duplicate_icons;
1330
1331 Remove duplicate icons as determined by hashing the icon data.
1332
1333 =cut
1334
1335 sub remove_duplicate_icons {
1336 my $self = shift;
1337
1338 my %seen;
1339 my %dup;
1340 for my $icon (@{$self->custom_icons}) {
1341 my $digest = digest_data('SHA256', $icon->{data});
1342 if (my $other = $seen{$digest}) {
1343 $dup{$icon->{uuid}} = $other->{uuid};
1344 }
1345 else {
1346 $seen{$digest} = $icon;
1347 }
1348 }
1349
1350 my @removed;
1351 while (my ($old_uuid, $new_uuid) = each %dup) {
1352 $self->objects
1353 ->where(custom_icon_uuid => $old_uuid)
1354 ->each(sub { $_->custom_icon_uuid($new_uuid) });
1355 push @removed, $self->remove_custom_icon($old_uuid);
1356 }
1357 return @removed;
1358 }
1359
1360 =method prune_history
1361
1362 $kdbx->prune_history(%options);
1363
1364 Remove just as many older historical entries as necessary to get under certain limits.
1365
1366 =for :list
1367 * C<max_items> - Maximum number of historical entries to keep (default: value of L</history_max_items>, no
1368 limit: -1)
1369 * C<max_size> - Maximum total size (in bytes) of historical entries to keep (default: value of
1370 L</history_max_size>, no limit: -1)
1371 * C<max_age> - Maximum age (in days) of historical entries to keep (default: value of
1372 L</maintenance_history_days>, no limit: -1)
1373
1374 =cut
1375
1376 sub prune_history {
1377 my $self = shift;
1378 my %args = @_;
1379
1380 my $max_items = $args{max_items} // $self->history_max_items // HISTORY_DEFAULT_MAX_ITEMS;
1381 my $max_size = $args{max_size} // $self->history_max_size // HISTORY_DEFAULT_MAX_SIZE;
1382 my $max_age = $args{max_age} // $self->maintenance_history_days // HISTORY_DEFAULT_MAX_AGE;
1383
1384 my @removed;
1385 $self->entries->each(sub {
1386 push @removed, $_->prune_history(
1387 max_items => $max_items,
1388 max_size => $max_size,
1389 max_age => $max_age,
1390 );
1391 });
1392 return @removed;
1393 }
1394
1395 =method randomize_seeds
1396
1397 $kdbx->randomize_seeds;
1398
1399 Set various keys, seeds and IVs to random values. These values are used by the cryptographic functions that
1400 secure the database when dumped. The attributes that will be randomized are:
1401
1402 =for :list
1403 * L</encryption_iv>
1404 * L</inner_random_stream_key>
1405 * L</master_seed>
1406 * L</stream_start_bytes>
1407 * L</transform_seed>
1408
1409 Randomizing these values has no effect on a loaded database. These are only used when a database is dumped.
1410 You normally do not need to call this method explicitly because the dumper does it for you by default.
1411
1412 =cut
1413
1414 sub randomize_seeds {
1415 my $self = shift;
1416 $self->encryption_iv(random_bytes(16));
1417 $self->inner_random_stream_key(random_bytes(64));
1418 $self->master_seed(random_bytes(32));
1419 $self->stream_start_bytes(random_bytes(32));
1420 $self->transform_seed(random_bytes(32));
1421 }
1422
1423 ##############################################################################
1424
1425 =method key
1426
1427 $key = $kdbx->key;
1428 $key = $kdbx->key($key);
1429 $key = $kdbx->key($primitive);
1430
1431 Get or set a L<File::KDBX::Key>. This is the master key (e.g. a password or a key file that can decrypt
1432 a database). You can also pass a primitive castable to a B<Key>. See L<File::KDBX::Key/new> for an explanation
1433 of what the primitive can be.
1434
1435 You generally don't need to call this directly because you can provide the key directly to the loader or
1436 dumper when loading or dumping a KDBX file.
1437
1438 =cut
1439
1440 sub key {
1441 my $self = shift;
1442 $KEYS{$self} = File::KDBX::Key->new(@_) if @_;
1443 $KEYS{$self};
1444 }
1445
1446 =method composite_key
1447
1448 $key = $kdbx->composite_key($key);
1449 $key = $kdbx->composite_key($primitive);
1450
1451 Construct a L<File::KDBX::Key::Composite> from a B<Key> or primitive. See L<File::KDBX::Key/new> for an
1452 explanation of what the primitive can be. If the primitive does not represent a composite key, it will be
1453 wrapped.
1454
1455 You generally don't need to call this directly. The loader and dumper use it to transform a master key into
1456 a raw encryption key.
1457
1458 =cut
1459
1460 sub composite_key {
1461 my $self = shift;
1462 require File::KDBX::Key::Composite;
1463 return File::KDBX::Key::Composite->new(@_);
1464 }
1465
1466 =method kdf
1467
1468 $kdf = $kdbx->kdf(%options);
1469 $kdf = $kdbx->kdf(\%parameters, %options);
1470
1471 Get a L<File::KDBX::KDF> (key derivation function).
1472
1473 Options:
1474
1475 =for :list
1476 * C<params> - KDF parameters, same as C<\%parameters> (default: value of L</kdf_parameters>)
1477
1478 =cut
1479
1480 sub kdf {
1481 my $self = shift;
1482 my %args = @_ % 2 == 1 ? (params => shift, @_) : @_;
1483
1484 my $params = $args{params};
1485
1486 $params //= $self->kdf_parameters;
1487 $params = {%{$params || {}}};
1488
1489 if (empty $params || !defined $params->{+KDF_PARAM_UUID}) {
1490 $params->{+KDF_PARAM_UUID} = KDF_UUID_AES;
1491 }
1492 if ($params->{+KDF_PARAM_UUID} eq KDF_UUID_AES) {
1493 # AES_CHALLENGE_RESPONSE is equivalent to AES if there are no challenge-response keys, and since
1494 # non-KeePassXC implementations don't support challenge-response keys anyway, there's no problem with
1495 # always using AES_CHALLENGE_RESPONSE for all KDBX4+ databases.
1496 # For compatibility, we should not *write* AES_CHALLENGE_RESPONSE, but the dumper handles that.
1497 if ($self->version >= KDBX_VERSION_4_0) {
1498 $params->{+KDF_PARAM_UUID} = KDF_UUID_AES_CHALLENGE_RESPONSE;
1499 }
1500 $params->{+KDF_PARAM_AES_SEED} //= $self->transform_seed;
1501 $params->{+KDF_PARAM_AES_ROUNDS} //= $self->transform_rounds;
1502 }
1503
1504 require File::KDBX::KDF;
1505 return File::KDBX::KDF->new(%$params);
1506 }
1507
1508 sub transform_seed {
1509 my $self = shift;
1510 my $param = KDF_PARAM_AES_SEED; # Short cut: Argon2 uses the same parameter name ("S")
1511 $self->headers->{+HEADER_TRANSFORM_SEED} =
1512 $self->headers->{+HEADER_KDF_PARAMETERS}{$param} = shift if @_;
1513 $self->headers->{+HEADER_TRANSFORM_SEED} =
1514 $self->headers->{+HEADER_KDF_PARAMETERS}{$param} //= random_bytes(32);
1515 }
1516
1517 sub transform_rounds {
1518 my $self = shift;
1519 require File::KDBX::KDF;
1520 my $info = $File::KDBX::KDF::ROUNDS_INFO{$self->kdf_parameters->{+KDF_PARAM_UUID} // ''} //
1521 $File::KDBX::KDF::DEFAULT_ROUNDS_INFO;
1522 $self->headers->{+HEADER_TRANSFORM_ROUNDS} =
1523 $self->headers->{+HEADER_KDF_PARAMETERS}{$info->{p}} = shift if @_;
1524 $self->headers->{+HEADER_TRANSFORM_ROUNDS} =
1525 $self->headers->{+HEADER_KDF_PARAMETERS}{$info->{p}} //= $info->{d};
1526 }
1527
1528 =method cipher
1529
1530 $cipher = $kdbx->cipher(key => $key);
1531 $cipher = $kdbx->cipher(key => $key, iv => $iv, uuid => $uuid);
1532
1533 Get a L<File::KDBX::Cipher> capable of encrypting and decrypting the body of a database file.
1534
1535 A key is required. This should be a raw encryption key made up of a fixed number of octets (depending on the
1536 cipher), not a L<File::KDBX::Key> or primitive.
1537
1538 If not passed, the UUID comes from C<< $kdbx->headers->{cipher_id} >> and the encryption IV comes from
1539 C<< $kdbx->headers->{encryption_iv} >>.
1540
1541 You generally don't need to call this directly. The loader and dumper use it to decrypt and encrypt KDBX
1542 files.
1543
1544 =cut
1545
1546 sub cipher {
1547 my $self = shift;
1548 my %args = @_;
1549
1550 $args{uuid} //= $self->headers->{+HEADER_CIPHER_ID};
1551 $args{iv} //= $self->headers->{+HEADER_ENCRYPTION_IV};
1552
1553 require File::KDBX::Cipher;
1554 return File::KDBX::Cipher->new(%args);
1555 }
1556
1557 =method random_stream
1558
1559 $cipher = $kdbx->random_stream;
1560 $cipher = $kdbx->random_stream(id => $stream_id, key => $key);
1561
1562 Get a L<File::KDBX::Cipher::Stream> for decrypting and encrypting protected values.
1563
1564 If not passed, the ID and encryption key comes from C<< $kdbx->headers->{inner_random_stream_id} >> and
1565 C<< $kdbx->headers->{inner_random_stream_key} >> (respectively) for KDBX3 files and from
1566 C<< $kdbx->inner_headers->{inner_random_stream_key} >> and
1567 C<< $kdbx->inner_headers->{inner_random_stream_id} >> (respectively) for KDBX4 files.
1568
1569 You generally don't need to call this directly. The loader and dumper use it to scramble protected strings.
1570
1571 =cut
1572
1573 sub random_stream {
1574 my $self = shift;
1575 my %args = @_;
1576
1577 $args{stream_id} //= delete $args{id} // $self->inner_random_stream_id;
1578 $args{key} //= $self->inner_random_stream_key;
1579
1580 require File::KDBX::Cipher;
1581 File::KDBX::Cipher->new(%args);
1582 }
1583
1584 sub inner_random_stream_id {
1585 my $self = shift;
1586 $self->inner_headers->{+INNER_HEADER_INNER_RANDOM_STREAM_ID}
1587 = $self->headers->{+HEADER_INNER_RANDOM_STREAM_ID} = shift if @_;
1588 $self->inner_headers->{+INNER_HEADER_INNER_RANDOM_STREAM_ID}
1589 //= $self->headers->{+HEADER_INNER_RANDOM_STREAM_ID} //= do {
1590 my $version = $self->minimum_version;
1591 $version < KDBX_VERSION_4_0 ? STREAM_ID_SALSA20 : STREAM_ID_CHACHA20;
1592 };
1593 }
1594
1595 sub inner_random_stream_key {
1596 my $self = shift;
1597 if (@_) {
1598 # These are probably the same SvPV so erasing one will CoW, but erasing the second should do the
1599 # trick anyway.
1600 erase \$self->inner_headers->{+INNER_HEADER_INNER_RANDOM_STREAM_KEY};
1601 erase \$self->headers->{+HEADER_INNER_RANDOM_STREAM_KEY};
1602 $self->inner_headers->{+INNER_HEADER_INNER_RANDOM_STREAM_KEY}
1603 = $self->headers->{+HEADER_INNER_RANDOM_STREAM_KEY} = shift;
1604 }
1605 $self->inner_headers->{+INNER_HEADER_INNER_RANDOM_STREAM_KEY}
1606 //= $self->headers->{+HEADER_INNER_RANDOM_STREAM_KEY} //= random_bytes(64); # 32
1607 }
1608
1609 #########################################################################################
1610
1611 sub _handle_signal {
1612 my $self = shift;
1613 my $object = shift;
1614 my $type = shift;
1615
1616 my %handlers = (
1617 'entry.added' => \&_handle_object_added,
1618 'group.added' => \&_handle_object_added,
1619 'entry.removed' => \&_handle_object_removed,
1620 'group.removed' => \&_handle_object_removed,
1621 'entry.uuid.changed' => \&_handle_entry_uuid_changed,
1622 'group.uuid.changed' => \&_handle_group_uuid_changed,
1623 );
1624 my $handler = $handlers{$type} or return;
1625 $self->$handler($object, @_);
1626 }
1627
1628 sub _handle_object_added {
1629 my $self = shift;
1630 my $object = shift;
1631 $self->remove_deleted_object($object->uuid);
1632 }
1633
1634 sub _handle_object_removed {
1635 my $self = shift;
1636 my $object = shift;
1637 my $old_uuid = $object->{uuid} // return;
1638
1639 my $meta = $self->meta;
1640 $self->recycle_bin_uuid(UUID_NULL) if $old_uuid eq ($meta->{recycle_bin_uuid} // '');
1641 $self->entry_templates_group(UUID_NULL) if $old_uuid eq ($meta->{entry_templates_group} // '');
1642 $self->last_selected_group(UUID_NULL) if $old_uuid eq ($meta->{last_selected_group} // '');
1643 $self->last_top_visible_group(UUID_NULL) if $old_uuid eq ($meta->{last_top_visible_group} // '');
1644
1645 $self->add_deleted_object($old_uuid);
1646 }
1647
1648 sub _handle_entry_uuid_changed {
1649 my $self = shift;
1650 my $object = shift;
1651 my $new_uuid = shift;
1652 my $old_uuid = shift // return;
1653
1654 my $old_pretty = format_uuid($old_uuid);
1655 my $new_pretty = format_uuid($new_uuid);
1656 my $fieldref_match = qr/\{REF:([TUPANI])\@I:\Q$old_pretty\E\}/is;
1657
1658 $self->entries->each(sub {
1659 $_->previous_parent_group($new_uuid) if $old_uuid eq ($_->{previous_parent_group} // '');
1660
1661 for my $string (values %{$_->strings}) {
1662 next if !defined $string->{value} || $string->{value} !~ $fieldref_match;
1663 my $txn = $_->begin_work;
1664 $string->{value} =~ s/$fieldref_match/{REF:$1\@I:$new_pretty}/g;
1665 $txn->commit;
1666 }
1667 });
1668 }
1669
1670 sub _handle_group_uuid_changed {
1671 my $self = shift;
1672 my $object = shift;
1673 my $new_uuid = shift;
1674 my $old_uuid = shift // return;
1675
1676 my $meta = $self->meta;
1677 $self->recycle_bin_uuid($new_uuid) if $old_uuid eq ($meta->{recycle_bin_uuid} // '');
1678 $self->entry_templates_group($new_uuid) if $old_uuid eq ($meta->{entry_templates_group} // '');
1679 $self->last_selected_group($new_uuid) if $old_uuid eq ($meta->{last_selected_group} // '');
1680 $self->last_top_visible_group($new_uuid) if $old_uuid eq ($meta->{last_top_visible_group} // '');
1681
1682 $self->groups->each(sub {
1683 $_->last_top_visible_entry($new_uuid) if $old_uuid eq ($_->{last_top_visible_entry} // '');
1684 $_->previous_parent_group($new_uuid) if $old_uuid eq ($_->{previous_parent_group} // '');
1685 });
1686 $self->entries->each(sub {
1687 $_->previous_parent_group($new_uuid) if $old_uuid eq ($_->{previous_parent_group} // '');
1688 });
1689 }
1690
1691 #########################################################################################
1692
1693 =attr sig1
1694
1695 =attr sig2
1696
1697 =attr version
1698
1699 =attr headers
1700
1701 =attr inner_headers
1702
1703 =attr meta
1704
1705 =attr binaries
1706
1707 =attr deleted_objects
1708
1709 Hash of UUIDs for objects that have been deleted. This includes groups, entries and even custom icons.
1710
1711 =attr raw
1712
1713 Bytes contained within the encrypted layer of a KDBX file. This is only set when using
1714 L<File::KDBX::Loader::Raw>.
1715
1716 =attr comment
1717
1718 A text string associated with the database stored unencrypted in the file header. Often unset.
1719
1720 =attr cipher_id
1721
1722 The UUID of a cipher used to encrypt the database when stored as a file.
1723
1724 See L<File::KDBX::Cipher>.
1725
1726 =attr compression_flags
1727
1728 Configuration for whether or not and how the database gets compressed. See
1729 L<File::KDBX::Constants/":compression">.
1730
1731 =attr master_seed
1732
1733 The master seed is a string of 32 random bytes that is used as salt in hashing the master key when loading
1734 and saving the database. If a challenge-response key is used in the master key, the master seed is also the
1735 challenge.
1736
1737 The master seed I<should> be changed each time the database is saved to file.
1738
1739 =attr transform_seed
1740
1741 The transform seed is a string of 32 random bytes that is used in the key derivation function, either as the
1742 salt or the key (depending on the algorithm).
1743
1744 The transform seed I<should> be changed each time the database is saved to file.
1745
1746 =attr transform_rounds
1747
1748 The number of rounds or iterations used in the key derivation function. Increasing this number makes loading
1749 and saving the database slower in order to make dictionary and brute force attacks more costly.
1750
1751 =attr encryption_iv
1752
1753 The initialization vector used by the cipher.
1754
1755 The encryption IV I<should> be changed each time the database is saved to file.
1756
1757 =attr inner_random_stream_key
1758
1759 The encryption key (possibly including the IV, depending on the cipher) used to encrypt the protected strings
1760 within the database.
1761
1762 =attr stream_start_bytes
1763
1764 A string of 32 random bytes written in the header and encrypted in the body. If the bytes do not match when
1765 loading a file then the wrong master key was used or the file is corrupt. Only KDBX 2 and KDBX 3 files use
1766 this. KDBX 4 files use an improved HMAC method to verify the master key and data integrity of the header and
1767 entire file body.
1768
1769 =attr inner_random_stream_id
1770
1771 A number indicating the cipher algorithm used to encrypt the protected strings within the database, usually
1772 Salsa20 or ChaCha20. See L<File::KDBX::Constants/":random_stream">.
1773
1774 =attr kdf_parameters
1775
1776 A hash/dict of key-value pairs used to configure the key derivation function. This is the KDBX4+ way to
1777 configure the KDF, superceding L</transform_seed> and L</transform_rounds>.
1778
1779 =attr generator
1780
1781 The name of the software used to generate the KDBX file.
1782
1783 =attr header_hash
1784
1785 The header hash used to verify that the file header is not corrupt. (KDBX 2 - KDBX 3.1, removed KDBX 4.0)
1786
1787 =attr database_name
1788
1789 Name of the database.
1790
1791 =attr database_name_changed
1792
1793 Timestamp indicating when the database name was last changed.
1794
1795 =attr database_description
1796
1797 Description of the database
1798
1799 =attr database_description_changed
1800
1801 Timestamp indicating when the database description was last changed.
1802
1803 =attr default_username
1804
1805 When a new entry is created, the I<UserName> string will be populated with this value.
1806
1807 =attr default_username_changed
1808
1809 Timestamp indicating when the default username was last changed.
1810
1811 =attr color
1812
1813 A color associated with the database (in the form C<#ffffff> where "f" is a hexidecimal digit). Some agents
1814 use this to help users visually distinguish between different databases.
1815
1816 =attr master_key_changed
1817
1818 Timestamp indicating when the master key was last changed.
1819
1820 =attr master_key_change_rec
1821
1822 Number of days until the agent should prompt to recommend changing the master key.
1823
1824 =attr master_key_change_force
1825
1826 Number of days until the agent should prompt to force changing the master key.
1827
1828 Note: This is purely advisory. It is up to the individual agent software to actually enforce it.
1829 B<File::KDBX> does NOT enforce it.
1830
1831 =attr custom_icons
1832
1833 Array of custom icons that can be associated with groups and entries.
1834
1835 This list can be managed with the methods L</add_custom_icon> and L</remove_custom_icon>.
1836
1837 =attr recycle_bin_enabled
1838
1839 Boolean indicating whether removed groups and entries should go to a recycle bin or be immediately deleted.
1840
1841 =attr recycle_bin_uuid
1842
1843 The UUID of a group used to store thrown-away groups and entries.
1844
1845 =attr recycle_bin_changed
1846
1847 Timestamp indicating when the recycle bin group was last changed.
1848
1849 =attr entry_templates_group
1850
1851 The UUID of a group containing template entries used when creating new entries.
1852
1853 =attr entry_templates_group_changed
1854
1855 Timestamp indicating when the entry templates group was last changed.
1856
1857 =attr last_selected_group
1858
1859 The UUID of the previously-selected group.
1860
1861 =attr last_top_visible_group
1862
1863 The UUID of the group visible at the top of the list.
1864
1865 =attr history_max_items
1866
1867 The maximum number of historical entries that should be kept for each entry. Default is 10.
1868
1869 =attr history_max_size
1870
1871 The maximum total size (in bytes) that each individual entry's history is allowed to grow. Default is 6 MiB.
1872
1873 =attr maintenance_history_days
1874
1875 The maximum age (in days) historical entries should be kept. Default it 365.
1876
1877 =attr settings_changed
1878
1879 Timestamp indicating when the database settings were last updated.
1880
1881 =attr protect_title
1882
1883 Alias of the L</memory_protection> setting for the I<Title> string.
1884
1885 =attr protect_username
1886
1887 Alias of the L</memory_protection> setting for the I<UserName> string.
1888
1889 =attr protect_password
1890
1891 Alias of the L</memory_protection> setting for the I<Password> string.
1892
1893 =attr protect_url
1894
1895 Alias of the L</memory_protection> setting for the I<URL> string.
1896
1897 =attr protect_notes
1898
1899 Alias of the L</memory_protection> setting for the I<Notes> string.
1900
1901 =cut
1902
1903 #########################################################################################
1904
1905 sub TO_JSON { +{%{$_[0]}} }
1906
1907 1;
1908 __END__
1909
1910 =for Pod::Coverage STORABLE_freeze STORABLE_thaw TO_JSON
1911
1912 =head1 SYNOPSIS
1913
1914 use File::KDBX;
1915
1916 # Create a new database from scratch
1917 my $kdbx = File::KDBX->new;
1918
1919 # Add some objects to the database
1920 my $group = $kdbx->add_group(
1921 name => 'Passwords',
1922 );
1923 my $entry = $group->add_entry(
1924 title => 'My Bank',
1925 username => 'mreynolds',
1926 password => 's3cr3t',
1927 );
1928
1929 # Save the database to the filesystem
1930 $kdbx->dump_file('passwords.kdbx', 'masterpw changeme');
1931
1932 # Load the database from the filesystem into a new database instance
1933 my $kdbx2 = File::KDBX->load_file('passwords.kdbx', 'masterpw changeme');
1934
1935 # Iterate over database entries, print entry titles
1936 $kdbx2->entries->each(sub($entry, @) {
1937 say 'Entry: ', $entry->title;
1938 });
1939
1940 See L</RECIPES> for more examples.
1941
1942 =head1 DESCRIPTION
1943
1944 B<File::KDBX> provides everything you need to work with KDBX databases. A KDBX database is a hierarchical
1945 object database which is commonly used to store secret information securely. It was developed for the KeePass
1946 password safe. See L</"Introduction to KDBX"> for more information about KDBX.
1947
1948 This module lets you query entries, create new entries, delete entries, modify entries and more. The
1949 distribution also includes various parsers and generators for serializing and persisting databases.
1950
1951 The design of this software was influenced by the L<KeePassXC|https://github.com/keepassxreboot/keepassxc>
1952 implementation of KeePass as well as the L<File::KeePass> module. B<File::KeePass> is an alternative module
1953 that works well in most cases but has a small backlog of bugs and security issues and also does not work with
1954 newer KDBX version 4 files. If you're coming here from the B<File::KeePass> world, you might be interested in
1955 L<File::KeePass::KDBX> that is a drop-in replacement for B<File::KeePass> that uses B<File::KDBX> for storage.
1956
1957 This software is a B<pre-1.0 release>. The interface should be considered pretty stable, but there might be
1958 minor changes up until a 1.0 release. Breaking changes will be noted in the F<Changes> file.
1959
1960 =head2 Features
1961
1962 =for :list
1963 * ☑ Read and write KDBX version 3 - version 4.1
1964 * ☑ Read and write KDB files (requires L<File::KeePass>)
1965 * ☑ Unicode character strings
1966 * ☑ L</"Simple Expression"> Searching
1967 * ☑ L<Placeholders|File::KDBX::Entry/Placeholders> and L<field references|/resolve_reference>
1968 * ☑ L<One-time passwords|File::KDBX::Entry/"One-time Passwords">
1969 * ☑ L<Very secure|/SECURITY>
1970 * ☑ L</"Memory Protection">
1971 * ☑ Challenge-response key components, like L<YubiKey|File::KDBX::Key::YubiKey>
1972 * ☑ Variety of L<key file|File::KDBX::Key::File> types: binary, hexed, hashed, XML v1 and v2
1973 * ☑ Pluggable registration of different kinds of ciphers and key derivation functions
1974 * ☑ Built-in database maintenance functions
1975 * ☑ Pretty fast, with L<XS optimizations|File::KDBX::XS> available
1976 * ☒ Database synchronization / merging (not yet)
1977
1978 =head2 Introduction to KDBX
1979
1980 A KDBX database consists of a tree of I<groups> and I<entries>, with a single I<root> group. Entries can
1981 contain zero or more key-value pairs of I<strings> and zero or more I<binaries> (i.e. octet strings). Groups,
1982 entries, strings and binaries: that's the KDBX vernacular. A small amount of metadata (timestamps, etc.) is
1983 associated with each entry, group and the database as a whole.
1984
1985 You can think of a KDBX database kind of like a file system, where groups are directories, entries are files,
1986 and strings and binaries make up a file's contents.
1987
1988 Databases are typically persisted as encrypted, compressed files. They are usually accessed directly (i.e.
1989 not over a network). The primary focus of this type of database is data security. It is ideal for storing
1990 relatively small amounts of data (strings and binaries) that must remain secret except to such individuals as
1991 have the correct I<master key>. Even if the database file were to be "leaked" to the public Internet, it
1992 should be virtually impossible to crack with a strong key. The KDBX format is most often used by password
1993 managers to store passwords so that users can know a single strong password and not have to reuse passwords
1994 across different websites. See L</SECURITY> for an overview of security considerations.
1995
1996 =head1 RECIPES
1997
1998 =head2 Create a new database
1999
2000 my $kdbx = File::KDBX->new;
2001
2002 my $group = $kdbx->add_group(name => 'Passwords);
2003 my $entry = $group->add_entry(
2004 title => 'WayneCorp',
2005 username => 'bwayne',
2006 password => 'iambatman',
2007 url => 'https://example.com/login'
2008 );
2009 $entry->add_auto_type_window_association('WayneCorp - Mozilla Firefox', '{PASSWORD}{ENTER}');
2010
2011 $kdbx->dump_file('mypasswords.kdbx', 'master password CHANGEME');
2012
2013 =head2 Read an existing database
2014
2015 my $kdbx = File::KDBX->load_file('mypasswords.kdbx', 'master password CHANGEME');
2016 $kdbx->unlock; # cause $entry->password below to be defined
2017
2018 $kdbx->entries->each(sub($entry, @) {
2019 say 'Found password for: ', $entry->title;
2020 say ' Username: ', $entry->username;
2021 say ' Password: ', $entry->password;
2022 });
2023
2024 =head2 Search for entries
2025
2026 my @entries = $kdbx->entries(searching => 1)
2027 ->grep(title => 'WayneCorp')
2028 ->each; # return all matches
2029
2030 The C<searching> option limits results to only entries within groups with searching enabled. Other options are
2031 also available. See L</entries>.
2032
2033 See L</QUERY> for many more query examples.
2034
2035 =head2 Search for entries by auto-type window association
2036
2037 my $window_title = 'WayneCorp - Mozilla Firefox';
2038
2039 my $entries = $kdbx->entries(auto_type => 1)
2040 ->filter(sub {
2041 my ($ata) = grep { $_->{window} =~ /\Q$window_title\E/i } @{$_->auto_type_associations};
2042 return [$_, $ata->{keystroke_sequence}] if $ata;
2043 })
2044 ->each(sub {
2045 my ($entry, $keys) = @$_;
2046 say 'Entry title: ', $entry->title, ', key sequence: ', $keys;
2047 });
2048
2049 Example output:
2050
2051 Entry title: WayneCorp, key sequence: {PASSWORD}{ENTER}
2052
2053 =head2 Remove entries from a database
2054
2055 $kdbx->entries
2056 ->grep(notes => {'=~' => qr/too old/i})
2057 ->each(sub { $_->recycle });
2058
2059 Recycle all entries with the string "too old" appearing in the B<Notes> string.
2060
2061 =head2 Remove empty groups
2062
2063 $kdbx->groups(algorithm => 'dfs')
2064 ->where(-true => 'is_empty')
2065 ->each('remove');
2066
2067 With the search/iteration C<algorithm> set to "dfs", groups will be ordered deepest first and the root group
2068 will be last. This allows removing groups that only contain empty groups.
2069
2070 This can also be done with one call to L</remove_empty_groups>.
2071
2072 =head1 SECURITY
2073
2074 One of the biggest threats to your database security is how easily the encryption key can be brute-forced.
2075 Strong brute-force protection depends on:
2076
2077 =for :list
2078 * Using unguessable passwords, passphrases and key files.
2079 * Using a brute-force resistent key derivation function.
2080
2081 The first factor is up to you. This module does not enforce strong master keys. It is up to you to pick or
2082 generate strong keys.
2083
2084 The KDBX format allows for the key derivation function to be tuned. The idea is that you want each single
2085 brute-force attempt to be expensive (in terms of time, CPU usage or memory usage), so that making a lot of
2086 attempts (which would be required if you have a strong master key) gets I<really> expensive.
2087
2088 How expensive you want to make each attempt is up to you and can depend on the application.
2089
2090 This and other KDBX-related security issues are covered here more in depth:
2091 L<https://keepass.info/help/base/security.html>
2092
2093 Here are other security risks you should be thinking about:
2094
2095 =head2 Cryptography
2096
2097 This distribution uses the excellent L<CryptX> and L<Crypt::Argon2> packages to handle all crypto-related
2098 functions. As such, a lot of the security depends on the quality of these dependencies. Fortunately these
2099 modules are maintained and appear to have good track records.
2100
2101 The KDBX format has evolved over time to incorporate improved security practices and cryptographic functions.
2102 This package uses the following functions for authentication, hashing, encryption and random number
2103 generation:
2104
2105 =for :list
2106 * AES-128 (legacy)
2107 * AES-256
2108 * Argon2d & Argon2id
2109 * CBC block mode
2110 * HMAC-SHA256
2111 * SHA256
2112 * SHA512
2113 * Salsa20 & ChaCha20
2114 * Twofish
2115
2116 At the time of this writing, I am not aware of any successful attacks against any of these functions. These
2117 are among the most-analyzed and widely-adopted crypto functions available.
2118
2119 The KDBX format allows the body cipher and key derivation function to be configured. If a flaw is discovered
2120 in one of these functions, you can hopefully just switch to a better function without needing to update this
2121 software. A later software release may phase out the use of any functions which are no longer secure.
2122
2123 =head2 Memory Protection
2124
2125 It is not a good idea to keep secret information unencrypted in system memory for longer than is needed. The
2126 address space of your program can generally be read by a user with elevated privileges on the system. If your
2127 system is memory-constrained or goes into a hibernation mode, the contents of your address space could be
2128 written to a disk where it might be persisted for long time.
2129
2130 There might be system-level things you can do to reduce your risk, like using swap encryption and limiting
2131 system access to your program's address space while your program is running.
2132
2133 B<File::KDBX> helps minimize (but not eliminate) risk by keeping secrets encrypted in memory until accessed
2134 and zeroing out memory that holds secrets after they're no longer needed, but it's not a silver bullet.
2135
2136 For one thing, the encryption key is stored in the same address space. If core is dumped, the encryption key
2137 is available to be found out. But at least there is the chance that the encryption key and the encrypted
2138 secrets won't both be paged out together while memory-constrained.
2139
2140 Another problem is that some perls (somewhat notoriously) copy around memory behind the scenes willy nilly,
2141 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
2142 be impossible. The good news is that perls with SvPV copy-on-write (enabled by default beginning with perl
2143 5.20) are much better in this regard. With COW, it's mostly possible to know what operations will cause perl
2144 to copy the memory of a scalar string, and the number of copies will be significantly reduced. There is a unit
2145 test named F<t/memory-protection.t> in this distribution that can be run on POSIX systems to determine how
2146 well B<File::KDBX> memory protection is working.
2147
2148 Memory protection also depends on how your application handles secrets. If your app code is handling scalar
2149 strings with secret information, it's up to you to make sure its memory is zeroed out when no longer needed.
2150 L<File::KDBX::Util/erase> et al. provide some tools to help accomplish this. Or if you're not too concerned
2151 about the risks memory protection is meant to mitigate, then maybe don't worry about it. The security policy
2152 of B<File::KDBX> is to try hard to keep secrets protected while in memory so that your app might claim a high
2153 level of security, in case you care about that.
2154
2155 There are some memory protection strategies that B<File::KDBX> does NOT use today but could in the future:
2156
2157 Many systems allow programs to mark unswappable pages. Secret information should ideally be stored in such
2158 pages. You could potentially use L<mlockall(2)> (or equivalent for your system) in your own application to
2159 prevent the entire address space from being swapped.
2160
2161 Some systems provide special syscalls for storing secrets in memory while keeping the encryption key outside
2162 of the program's address space, like C<CryptProtectMemory> for Windows. This could be a good option, though
2163 unfortunately not portable.
2164
2165 =head1 QUERY
2166
2167 To find things in a KDBX database, you should use a filtered iterator. If you have an iterator, such as
2168 returned by L</entries>, L</groups> or even L</objects> you can filter it using L<File::KDBX::Iterator/where>.
2169
2170 my $filtered_entries = $kdbx->entries->where(\&query);
2171
2172 A C<\&query> is just a subroutine that you can either write yourself or have generated for you from either
2173 a L</"Simple Expression"> or L</"Declarative Syntax">. It's easier to have your query generated, so I'll cover
2174 that first.
2175
2176 =head2 Simple Expression
2177
2178 A simple expression is mostly compatible with the KeePass 2 implementation
2179 L<described here|https://keepass.info/help/base/search.html#mode_se>.
2180
2181 An expression is a string with one or more space-separated terms. Terms with spaces can be enclosed in double
2182 quotes. Terms are negated if they are prefixed with a minus sign. A record must match every term on at least
2183 one of the given fields.
2184
2185 So a simple expression is something like what you might type into a search engine. You can generate a simple
2186 expression query using L<File::KDBX::Util/simple_expression_query> or by passing the simple expression as
2187 a B<scalar reference> to C<where>.
2188
2189 To search for all entries in a database with the word "canyon" appearing anywhere in the title:
2190
2191 my $entries = $kdbx->entries->where(\'canyon', qw[title]);
2192
2193 Notice the first argument is a B<scalarref>. This disambiguates a simple expression from other types of
2194 queries covered below.
2195
2196 As mentioned, a simple expression can have multiple terms. This simple expression query matches any entry that
2197 has the words "red" B<and> "canyon" anywhere in the title:
2198
2199 my $entries = $kdbx->entries->where(\'red canyon', qw[title]);
2200
2201 Each term in the simple expression must be found for an entry to match.
2202
2203 To search for entries with "red" in the title but B<not> "canyon", just prepend "canyon" with a minus sign:
2204
2205 my $entries = $kdbx->entries->where(\'red -canyon', qw[title]);
2206
2207 To search over multiple fields simultaneously, just list them all. To search for entries with "grocery" (but
2208 not "Foodland") in the title or notes:
2209
2210 my $entries = $kdbx->entries->where(\'grocery -Foodland', qw[title notes]);
2211
2212 The default operator is a case-insensitive regexp match, which is fine for searching text loosely. You can use
2213 just about any binary comparison operator that perl supports. To specify an operator, list it after the simple
2214 expression. For example, to search for any entry that has been used at least five times:
2215
2216 my $entries = $kdbx->entries->where(\5, '>=', qw[usage_count]);
2217
2218 It helps to read it right-to-left, like "usage_count is greater than or equal to 5".
2219
2220 If you find the disambiguating structures to be distracting or confusing, you can also use the
2221 L<File::KDBX::Util/simple_expression_query> function as a more intuitive alternative. The following example is
2222 equivalent to the previous:
2223
2224 my $entries = $kdbx->entries->where(simple_expression_query(5, '>=', qw[usage_count]));
2225
2226 =head2 Declarative Syntax
2227
2228 Structuring a declarative query is similar to L<SQL::Abstract/"WHERE CLAUSES">, but you don't have to be
2229 familiar with that module. Just learn by examples here.
2230
2231 To search for all entries in a database titled "My Bank":
2232
2233 my $entries = $kdbx->entries->where({ title => 'My Bank' });
2234
2235 The query here is C<< { title => 'My Bank' } >>. A hashref can contain key-value pairs where the key is an
2236 attribute of the thing being searched for (in this case an entry) and the value is what you want the thing's
2237 attribute to be to consider it a match. In this case, the attribute we're using as our match criteria is
2238 L<File::KDBX::Entry/title>, a text field. If an entry has its title attribute equal to "My Bank", it's
2239 a match.
2240
2241 A hashref can contain multiple attributes. The search candidate will be a match if I<all> of the specified
2242 attributes are equal to their respective values. For example, to search for all entries with a particular URL
2243 B<AND> username:
2244
2245 my $entries = $kdbx->entries->where({
2246 url => 'https://example.com',
2247 username => 'neo',
2248 });
2249
2250 To search for entries matching I<any> criteria, just change the hashref to an arrayref. To search for entries
2251 with a particular URL B<OR> username:
2252
2253 my $entries = $kdbx->entries->where([ # <-- Notice the square bracket
2254 url => 'https://example.com',
2255 username => 'neo',
2256 ]);
2257
2258 You can use different operators to test different types of attributes. The L<File::KDBX::Entry/icon_id>
2259 attribute is a number, so we should use a number comparison operator. To find entries using the smartphone
2260 icon:
2261
2262 my $entries = $kdbx->entries->where({
2263 icon_id => { '==', ICON_SMARTPHONE },
2264 });
2265
2266 Note: L<File::KDBX::Constants/ICON_SMARTPHONE> is just a constant from L<File::KDBX::Constants>. It isn't
2267 special to this example or to queries generally. We could have just used a literal number.
2268
2269 The important thing to notice here is how we wrapped the condition in another hashref with a single key-value
2270 pair where the key is the name of an operator and the value is the thing to match against. The supported
2271 operators are:
2272
2273 =for :list
2274 * C<eq> - String equal
2275 * C<ne> - String not equal
2276 * C<lt> - String less than
2277 * C<gt> - String greater than
2278 * C<le> - String less than or equal
2279 * C<ge> - String greater than or equal
2280 * C<==> - Number equal
2281 * C<!=> - Number not equal
2282 * C<< < >> - Number less than
2283 * C<< > >> - Number greater than
2284 * C<< <= >> - Number less than or equal
2285 * C<< >= >> - Number less than or equal
2286 * C<=~> - String match regular expression
2287 * C<!~> - String does not match regular expression
2288 * C<!> - Boolean false
2289 * C<!!> - Boolean true
2290
2291 Other special operators:
2292
2293 =for :list
2294 * C<-true> - Boolean true
2295 * C<-false> - Boolean false
2296 * C<-not> - Boolean false (alias for C<-false>)
2297 * C<-defined> - Is defined
2298 * C<-undef> - Is not defined
2299 * C<-empty> - Is empty
2300 * C<-nonempty> - Is not empty
2301 * C<-or> - Logical or
2302 * C<-and> - Logical and
2303
2304 Let's see another example using an explicit operator. To find all groups except one in particular (identified
2305 by its L<File::KDBX::Group/uuid>), we can use the C<ne> (string not equal) operator:
2306
2307 my $groups = $kdbx->groups->where(
2308 uuid => {
2309 'ne' => uuid('596f7520-6172-6520-7370-656369616c2e'),
2310 },
2311 );
2312
2313 Note: L<File::KDBX::Util/uuid> is a little utility function to convert a UUID in its pretty form into bytes.
2314 This utility function isn't special to this example or to queries generally. It could have been written with
2315 a literal such as C<"\x59\x6f\x75\x20\x61...">, but that's harder to read.
2316
2317 Notice we searched for groups this time. Finding groups works exactly the same as it does for entries.
2318
2319 Notice also that we didn't wrap the query in hashref curly-braces or arrayref square-braces. Those are
2320 optional. By default it will only match ALL attributes (as if there were curly-braces).
2321
2322 Testing the truthiness of an attribute is a little bit different because it isn't a binary operation. To find
2323 all entries with the password quality check disabled:
2324
2325 my $entries = $kdbx->entries->where('!' => 'quality_check');
2326
2327 This time the string after the operator is the attribute name rather than a value to compare the attribute
2328 against. To test that a boolean value is true, use the C<!!> operator (or C<-true> if C<!!> seems a little too
2329 weird for your taste):
2330
2331 my $entries = $kdbx->entries->where('!!' => 'quality_check');
2332 my $entries = $kdbx->entries->where(-true => 'quality_check'); # same thing
2333
2334 Yes, there is also a C<-false> and a C<-not> if you prefer one of those over C<!>. C<-false> and C<-not>
2335 (along with C<-true>) are also special in that you can use them to invert the logic of a subquery. These are
2336 logically equivalent:
2337
2338 my $entries = $kdbx->entries->where(-not => { title => 'My Bank' });
2339 my $entries = $kdbx->entries->where(title => { 'ne' => 'My Bank' });
2340
2341 These special operators become more useful when combined with two more special operators: C<-and> and C<-or>.
2342 With these, it is possible to construct more interesting queries with groups of logic. For example:
2343
2344 my $entries = $kdbx->entries->where({
2345 title => { '=~', qr/bank/ },
2346 -not => {
2347 -or => {
2348 notes => { '=~', qr/business/ },
2349 icon_id => { '==', ICON_TRASHCAN_FULL },
2350 },
2351 },
2352 });
2353
2354 In English, find entries where the word "bank" appears anywhere in the title but also do not have either the
2355 word "business" in the notes or are using the full trashcan icon.
2356
2357 =head2 Subroutine Query
2358
2359 Lastly, as mentioned at the top, you can ignore all this and write your own subroutine. Your subroutine will
2360 be called once for each object being searched over. The subroutine should match the candidate against whatever
2361 criteria you want and return true if it matches or false to skip. To do this, just pass your subroutine
2362 coderef to C<where>.
2363
2364 To review the different types of queries, these are all equivalent to find all entries in the database titled
2365 "My Bank":
2366
2367 my $entries = $kdbx->entries->where(\'"My Bank"', 'eq', qw[title]); # simple expression
2368 my $entries = $kdbx->entries->where(title => 'My Bank'); # declarative syntax
2369 my $entries = $kdbx->entries->where(sub { $_->title eq 'My Bank' }); # subroutine query
2370
2371 This is a trivial example, but of course your subroutine can be arbitrarily complex.
2372
2373 All of these query mechanisms described in this section are just tools, each with its own set of limitations.
2374 If the tools are getting in your way, you can of course iterate over the contents of a database and implement
2375 your own query logic, like this:
2376
2377 my $entries = $kdbx->entries;
2378 while (my $entry = $entries->next) {
2379 if (wanted($entry)) {
2380 do_something($entry);
2381 }
2382 else {
2383 ...
2384 }
2385 }
2386
2387 =head2 Iteration
2388
2389 Iterators are the built-in way to navigate or walk the database tree. You get an iterator from L</entries>,
2390 L</groups> and L</objects>. You can specify the search algorithm to iterate over objects in different orders
2391 using the C<algorithm> option, which can be one of these L<constants|File::KDBX::Constants/":iteration">:
2392
2393 =for :list
2394 * C<ITERATION_IDS> - Iterative deepening search (default)
2395 * C<ITERATION_DFS> - Depth-first search
2396 * C<ITERATION_BFS> - Breadth-first search
2397
2398 When iterating over objects generically, groups always precede their direct entries (if any). When the
2399 C<history> option is used, current entries always precede historical entries.
2400
2401 If you have a database tree like this:
2402
2403 Database
2404 - Root
2405 - Group1
2406 - EntryA
2407 - Group2
2408 - EntryB
2409 - Group3
2410 - EntryC
2411
2412 =for :list
2413 * IDS order of groups is: Root, Group1, Group2, Group3
2414 * IDS order of entries is: EntryA, EntryB, EntryC
2415 * IDS order of objects is: Root, Group1, EntryA, Group2, EntryB, Group3, EntryC
2416 * DFS order of groups is: Group2, Group1, Group3, Root
2417 * DFS order of entries is: EntryB, EntryA, EntryC
2418 * DFS order of objects is: Group2, EntryB, Group1, EntryA, Group3, EntryC, Root
2419 * BFS order of groups is: Root, Group1, Group3, Group2
2420 * BFS order of entries is: EntryA, EntryC, EntryB
2421 * BFS order of objects is: Root, Group1, EntryA, Group3, EntryC, Group2, EntryB
2422
2423 =head1 SYNCHRONIZING
2424
2425 B<TODO> - This is a planned feature, not yet implemented.
2426
2427 =head1 ERRORS
2428
2429 Errors in this package are constructed as L<File::KDBX::Error> objects and propagated using perl's built-in
2430 mechanisms. Fatal errors are propagated using L<perlfunc/"die LIST"> and non-fatal errors (a.k.a. warnings)
2431 are propagated using L<perlfunc/"warn LIST"> while adhering to perl's L<warnings> system. If you're already
2432 familiar with these mechanisms, you can skip this section.
2433
2434 You can catch fatal errors using L<perlfunc/"eval BLOCK"> (or something like L<Try::Tiny>) and non-fatal
2435 errors using C<$SIG{__WARN__}> (see L<perlvar/%SIG>). Examples:
2436
2437 use File::KDBX::Error qw(error);
2438
2439 my $key = ''; # uh oh
2440 eval {
2441 $kdbx->load_file('whatever.kdbx', $key);
2442 };
2443 if (my $error = error($@)) {
2444 handle_missing_key($error) if $error->type eq 'key.missing';
2445 $error->throw;
2446 }
2447
2448 or using C<Try::Tiny>:
2449
2450 try {
2451 $kdbx->load_file('whatever.kdbx', $key);
2452 }
2453 catch {
2454 handle_error($_);
2455 };
2456
2457 Catching non-fatal errors:
2458
2459 my @warnings;
2460 local $SIG{__WARN__} = sub { push @warnings, $_[0] };
2461
2462 $kdbx->load_file('whatever.kdbx', $key);
2463
2464 handle_warnings(@warnings) if @warnings;
2465
2466 By default perl prints warnings to C<STDERR> if you don't catch them. If you don't want to catch them and also
2467 don't want them printed to C<STDERR>, you can suppress them lexically (perl v5.28 or higher required):
2468
2469 {
2470 no warnings 'File::KDBX';
2471 ...
2472 }
2473
2474 or locally:
2475
2476 {
2477 local $File::KDBX::WARNINGS = 0;
2478 ...
2479 }
2480
2481 or globally in your program:
2482
2483 $File::KDBX::WARNINGS = 0;
2484
2485 You cannot suppress fatal errors, and if you don't catch them your program will exit.
2486
2487 =head1 ENVIRONMENT
2488
2489 This software will alter its behavior depending on the value of certain environment variables:
2490
2491 =for :list
2492 * C<PERL_FILE_KDBX_XS> - Do not use L<File::KDBX::XS> if false (default: true)
2493 * C<PERL_ONLY> - Do not use L<File::KDBX::XS> if true (default: false)
2494 * C<NO_FORK> - Do not fork if true (default: false)
2495
2496 =head1 SEE ALSO
2497
2498 =for :list
2499 * L<KeePass Password Safe|https://keepass.info/> - The original KeePass
2500 * L<KeePassXC|https://keepassxc.org/> - Cross-Platform Password Manager written in C++
2501 * L<File::KeePass> has overlapping functionality. It's good but has a backlog of some pretty critical bugs and
2502 lacks support for newer KDBX features.
2503
2504 =begin :header
2505
2506 =begin markdown
2507
2508 [![Linux](https://github.com/chazmcgarvey/File-KDBX/actions/workflows/linux.yml/badge.svg)](https://github.com/chazmcgarvey/File-KDBX/actions/workflows/linux.yml)
2509 [![macOS](https://github.com/chazmcgarvey/File-KDBX/actions/workflows/macos.yml/badge.svg)](https://github.com/chazmcgarvey/File-KDBX/actions/workflows/macos.yml)
2510 [![Windows](https://github.com/chazmcgarvey/File-KDBX/actions/workflows/windows.yml/badge.svg)](https://github.com/chazmcgarvey/File-KDBX/actions/workflows/windows.yml)
2511
2512 =end markdown
2513
2514 =begin HTML
2515
2516 <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>
2517 <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>
2518 <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>
2519
2520 =end HTML
2521
2522 =end :header
2523
2524 =cut
This page took 0.211731 seconds and 4 git commands to generate.