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