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

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