Dogcows Code - chaz/p5-File-KDBX/blob - lib/File/KDBX.pm

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