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