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