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