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