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

   1 package File::KDBX::Entry;
   2 # ABSTRACT: A KDBX database entry
   3
   4 use warnings;
   5 use strict;
   6
   7 use Crypt::Misc 0.029 qw(decode_b64 encode_b32r);
   8 use Devel::GlobalDestruction;
   9 use Encode qw(encode);
  10 use File::KDBX::Constants qw(:history :icon);
  11 use File::KDBX::Error;
  12 use File::KDBX::Util qw(:class :coercion :function :uri generate_uuid load_optional);
  13 use Hash::Util::FieldHash;
  14 use List::Util qw(first sum0);
  15 use Ref::Util qw(is_coderef is_plain_hashref);
  16 use Scalar::Util qw(looks_like_number);
  17 use Storable qw(dclone);
  18 use Time::Piece;
  19 use boolean;
  20 use namespace::clean;
  21
  22 extends 'File::KDBX::Object';
  23
  24 our $VERSION = '999.999'; # VERSION
  25
  26 my $PLACEHOLDER_MAX_DEPTH = 10;
  27 my %PLACEHOLDERS;
  28 my %STANDARD_STRINGS = map { $_ => 1 } qw(Title UserName Password URL Notes);
  29
  30 sub _parent_container { 'entries' }
  31
  32 =attr uuid
  33
  34 128-bit UUID identifying the entry within the database.
  35
  36 =attr icon_id
  37
  38 Integer representing a default icon. See L<File::KDBX::Constants/":icon"> for valid values.
  39
  40 =attr custom_icon_uuid
  41
  42 128-bit UUID identifying a custom icon within the database.
  43
  44 =attr foreground_color
  45
  46 Text color represented as a string of the form C<#000000>.
  47
  48 =attr background_color
  49
  50 Background color represented as a string of the form C<#FFFFFF>.
  51
  52 =attr override_url
  53
  54 TODO
  55
  56 =attr tags
  57
  58 Text string with arbitrary tags which can be used to build a taxonomy.
  59
  60 =attr auto_type
  61
  62 Auto-type details.
  63
  64     {
  65         enabled                     => true,
  66         data_transfer_obfuscation   => 0,
  67         default_sequence            => '{USERNAME}{TAB}{PASSWORD}{ENTER}',
  68         associations                => [
  69             {
  70                 window              => 'My Bank - Mozilla Firefox',
  71                 keystroke_sequence  => '{PASSWORD}{ENTER}',
  72             },
  73         ],
  74     }
  75
  76 =attr previous_parent_group
  77
  78 128-bit UUID identifying a group within the database.
  79
  80 =attr quality_check
  81
  82 Boolean indicating whether the entry password should be tested for weakness and show up in reports.
  83
  84 =attr strings
  85
  86 Hash with entry strings, including the standard strings as well as any custom ones.
  87
  88     {
  89         # Every entry has these five strings:
  90         Title    => { value => 'Example Entry' },
  91         UserName => { value => 'jdoe' },
  92         Password => { value => 's3cr3t', protect => true },
  93         URL      => { value => 'https://example.com' }
  94         Notes    => { value => '' },
  95         # May also have custom strings:
  96         MySystem => { value => 'The mainframe' },
  97     }
  98
  99 =attr binaries
 100
 101 Files or attachments.
 102
 103 =attr custom_data
 104
 105 A set of key-value pairs used to store arbitrary data, usually used by software to keep track of state rather
 106 than by end users (who typically work with the strings and binaries).
 107
 108 =attr history
 109
 110 Array of historical entries. Historical entries are prior versions of the same entry so they all share the
 111 same UUID with the current entry.
 112
 113 =attr last_modification_time
 114
 115 Date and time when the entry was last modified.
 116
 117 =attr creation_time
 118
 119 Date and time when the entry was created.
 120
 121 =attr last_access_time
 122
 123 Date and time when the entry was last accessed.
 124
 125 =attr expiry_time
 126
 127 Date and time when the entry expired or will expire.
 128
 129 =attr expires
 130
 131 Boolean value indicating whether or not an entry is expired.
 132
 133 =attr usage_count
 134
 135 The number of times an entry has been used, which typically means how many times the B<Password> string has
 136 been accessed.
 137
 138 =attr location_changed
 139
 140 Date and time when the entry was last moved to a different group.
 141
 142 =attr notes
 143
 144 Alias for the B<Notes> string value.
 145
 146 =attr password
 147
 148 Alias for the B<Password> string value.
 149
 150 =attr title
 151
 152 Alias for the B<Title> string value.
 153
 154 =attr url
 155
 156 Alias for the B<URL> string value.
 157
 158 =attr username
 159
 160 Aliases for the B<UserName> string value.
 161
 162 =cut
 163
 164 sub uuid {
 165     my $self = shift;
 166     if (@_ || !defined $self->{uuid}) {
 167         my %args = @_ % 2 == 1 ? (uuid => shift, @_) : @_;
 168         my $old_uuid = $self->{uuid};
 169         my $uuid = $self->{uuid} = delete $args{uuid} // generate_uuid;
 170         for my $entry (@{$self->history}) {
 171             $entry->{uuid} = $uuid;
 172         }
 173         $self->_signal('uuid.changed', $uuid, $old_uuid) if defined $old_uuid && $self->is_current;
 174     }
 175     $self->{uuid};
 176 }
 177
 178 # has uuid                    => sub { generate_uuid(printable => 1) };
 179 has icon_id                 => ICON_PASSWORD,   coerce => \&to_icon_constant;
 180 has custom_icon_uuid        => undef,           coerce => \&to_uuid;
 181 has foreground_color        => '',              coerce => \&to_string;
 182 has background_color        => '',              coerce => \&to_string;
 183 has override_url            => '',              coerce => \&to_string;
 184 has tags                    => '',              coerce => \&to_string;
 185 has auto_type               => {};
 186 has previous_parent_group   => undef,           coerce => \&to_uuid;
 187 has quality_check           => true,            coerce => \&to_bool;
 188 has strings                 => {};
 189 has binaries                => {};
 190 has times                   => {};
 191 # has custom_data             => {};
 192 # has history                 => [];
 193
 194 has last_modification_time  => sub { gmtime }, store => 'times', coerce => \&to_time;
 195 has creation_time           => sub { gmtime }, store => 'times', coerce => \&to_time;
 196 has last_access_time        => sub { gmtime }, store => 'times', coerce => \&to_time;
 197 has expiry_time             => sub { gmtime }, store => 'times', coerce => \&to_time;
 198 has expires                 => false,          store => 'times', coerce => \&to_bool;
 199 has usage_count             => 0,              store => 'times', coerce => \&to_number;
 200 has location_changed        => sub { gmtime }, store => 'times', coerce => \&to_time;
 201
 202 my %ATTRS_STRINGS = (
 203     title                   => 'Title',
 204     username                => 'UserName',
 205     password                => 'Password',
 206     url                     => 'URL',
 207     notes                   => 'Notes',
 208 );
 209 while (my ($attr, $string_key) = each %ATTRS_STRINGS) {
 210     no strict 'refs'; ## no critic (ProhibitNoStrict)
 211     *{$attr} = sub { shift->string_value($string_key, @_) };
 212     *{"expanded_${attr}"} = sub { shift->expanded_string_value($string_key, @_) };
 213 }
 214
 215 my @ATTRS = qw(uuid custom_data history);
 216 sub _set_nonlazy_attributes {
 217     my $self = shift;
 218     $self->$_ for @ATTRS, keys %ATTRS_STRINGS, list_attributes(ref $self);
 219 }
 220
 221 sub init {
 222     my $self = shift;
 223     my %args = @_;
 224
 225     while (my ($key, $val) = each %args) {
 226         if (my $method = $self->can($key)) {
 227             $self->$method($val);
 228         }
 229         else {
 230             $self->string($key => $val);
 231         }
 232     }
 233
 234     return $self;
 235 }
 236
 237 ##############################################################################
 238
 239 =method string
 240
 241     \%string = $entry->string($string_key);
 242
 243     $entry->string($string_key, \%string);
 244     $entry->string($string_key, %attributes);
 245     $entry->string($string_key, $value); # same as: value => $value
 246
 247 Get or set a string. Every string has a unique (to the entry) key and flags and so are returned as a hash
 248 structure. For example:
 249
 250     $string = {
 251         value   => 'Password',
 252         protect => true,    # optional
 253     };
 254
 255 Every string should have a value (but might be C<undef> due to memory protection) and these optional flags
 256 which might exist:
 257
 258 =for :list
 259 * C<protect> - Whether or not the string value should be memory-protected.
 260
 261 =cut
 262
 263 sub string {
 264     my $self = shift;
 265     my %args = @_     == 2 ? (key => shift, value => shift)
 266              : @_ % 2 == 1 ? (key => shift, @_) : @_;
 267
 268     if (!defined $args{key} && !defined $args{value}) {
 269         my %standard = (value => 1, protect => 1);
 270         my @other_keys = grep { !$standard{$_} } keys %args;
 271         if (@other_keys == 1) {
 272             my $key = $args{key} = $other_keys[0];
 273             $args{value} = delete $args{$key};
 274         }
 275     }
 276
 277     my $key = delete $args{key} or throw 'Must provide a string key to access';
 278
 279     return $self->{strings}{$key} = $args{value} if is_plain_hashref($args{value});
 280
 281     while (my ($field, $value) = each %args) {
 282         $self->{strings}{$key}{$field} = $value;
 283     }
 284
 285     # Auto-vivify the standard strings.
 286     if ($STANDARD_STRINGS{$key}) {
 287         return $self->{strings}{$key} //= {value => '', $self->_protect($key) ? (protect => true) : ()};
 288     }
 289     return $self->{strings}{$key};
 290 }
 291
 292 ### Get whether or not a standard string is configured to be protected
 293 sub _protect {
 294     my $self = shift;
 295     my $key  = shift;
 296     return false if !$STANDARD_STRINGS{$key};
 297     if (my $kdbx = eval { $self->kdbx }) {
 298         my $protect = $kdbx->memory_protection($key);
 299         return $protect if defined $protect;
 300     }
 301     return $key eq 'Password';
 302 }
 303
 304 =method string_value
 305
 306     $string = $entry->string_value;
 307
 308 Access a string value directly. Returns C<undef> if the string is not set.
 309
 310 =cut
 311
 312 sub string_value {
 313     my $self = shift;
 314     my $string = $self->string(@_) // return undef;
 315     return $string->{value};
 316 }
 317
 318 =method expanded_string_value
 319
 320     $string = $entry->expanded_string_value;
 321
 322 Same as L</string_value> but will substitute placeholders and resolve field references. Any placeholders that
 323 do not expand to values are left as-is.
 324
 325 See L</Placeholders>.
 326
 327 Some placeholders (notably field references) require the entry be associated with a database and will throw an
 328 error if there is no association.
 329
 330 =cut
 331
 332 sub _expand_placeholder {
 333     my $self = shift;
 334     my $placeholder = shift;
 335     my $arg = shift;
 336
 337     require File::KDBX;
 338
 339     my $placeholder_key = $placeholder;
 340     if (defined $arg) {
 341         $placeholder_key = $File::KDBX::PLACEHOLDERS{"${placeholder}:${arg}"} ? "${placeholder}:${arg}"
 342                                                                               : "${placeholder}:";
 343     }
 344     return if !defined $File::KDBX::PLACEHOLDERS{$placeholder_key};
 345
 346     my $local_key = join('/', Hash::Util::FieldHash::id($self), $placeholder_key);
 347     local $PLACEHOLDERS{$local_key} = my $handler = $PLACEHOLDERS{$local_key} // do {
 348         my $handler = $File::KDBX::PLACEHOLDERS{$placeholder_key} or next;
 349         memoize recurse_limit($handler, $PLACEHOLDER_MAX_DEPTH, sub {
 350             alert "Detected deep recursion while expanding $placeholder placeholder",
 351                 placeholder => $placeholder;
 352             return; # undef
 353         });
 354     };
 355
 356     return $handler->($self, $arg, $placeholder);
 357 }
 358
 359 sub _expand_string {
 360     my $self    = shift;
 361     my $str     = shift;
 362
 363     my $expand = memoize $self->can('_expand_placeholder'), $self;
 364
 365     # placeholders (including field references):
 366     $str =~ s!\{([^:\}]+)(?::([^\}]*))?\}!$expand->(uc($1), $2, @_) // $&!egi;
 367
 368     # environment variables (alt syntax):
 369     my $vars = join('|', map { quotemeta($_) } keys %ENV);
 370     $str =~ s!\%($vars)\%!$expand->(ENV => $1, @_) // $&!eg;
 371
 372     return $str;
 373 }
 374
 375 sub expanded_string_value {
 376     my $self = shift;
 377     my $str  = $self->string_value(@_) // return undef;
 378     return $self->_expand_string($str);
 379 }
 380
 381 =method other_strings
 382
 383     $other = $entry->other_strings;
 384     $other = $entry->other_strings($delimiter);
 385
 386 Get a concatenation of all non-standard string values. The default delimiter is a newline. This is is useful
 387 for executing queries to search for entities based on the contents of these other strings (if any).
 388
 389 =cut
 390
 391 sub other_strings {
 392     my $self    = shift;
 393     my $delim   = shift // "\n";
 394
 395     my @strings = map { $self->string_value($_) } grep { !$STANDARD_STRINGS{$_} } sort keys %{$self->strings};
 396     return join($delim, @strings);
 397 }
 398
 399 sub string_peek {
 400     my $self = shift;
 401     my $string = $self->string(@_);
 402     return defined $string->{value} ? $string->{value} : $self->kdbx->peek($string);
 403 }
 404
 405 sub password_peek { $_[0]->string_peek('Password') }
 406
 407 ##############################################################################
 408
 409 sub binary {
 410     my $self = shift;
 411     my $key  = shift or throw 'Must provide a binary key to access';
 412     if (@_) {
 413         my $arg = @_ == 1 ? shift : undef;
 414         my %args;
 415         @args{keys %$arg} = values %$arg if ref $arg eq 'HASH';
 416         $args{value} = $arg if !ref $arg;
 417         while (my ($field, $value) = each %args) {
 418             $self->{binaries}{$key}{$field} = $value;
 419         }
 420     }
 421     my $binary = $self->{binaries}{$key} //= {value => ''};
 422     if (defined (my $ref = $binary->{ref})) {
 423         $binary = $self->{binaries}{$key} = dclone($self->kdbx->binaries->{$ref});
 424     }
 425     return $binary;
 426 }
 427
 428 sub binary_novivify {
 429     my $self = shift;
 430     my $binary_key = shift;
 431     return if !$self->{binaries}{$binary_key} && !@_;
 432     return $self->binary($binary_key, @_);
 433 }
 434
 435 sub binary_value {
 436     my $self = shift;
 437     my $binary = $self->binary_novivify(@_) // return undef;
 438     return $binary->{value};
 439 }
 440
 441 sub searching_enabled {
 442     my $self = shift;
 443     my $parent = $self->parent;
 444     return $parent->effective_enable_searching if $parent;
 445     return true;
 446 }
 447
 448 sub auto_type_enabled {
 449     my $self = shift;
 450     return false if !$self->auto_type->{enabled};
 451     my $parent = $self->parent;
 452     return $parent->effective_enable_auto_type if $parent;
 453     return true;
 454 }
 455
 456 ##############################################################################
 457
 458 =method hmac_otp
 459
 460     $otp = $entry->hmac_otp(%options);
 461
 462 Generate an HMAC-based one-time password, or C<undef> if HOTP is not configured for the entry. The entry's
 463 strings generally must first be unprotected, just like when accessing the password. Valid options are:
 464
 465 =for :list
 466 * C<counter> - Specify the counter value
 467
 468 To configure HOTP, see L</"One-time Passwords">.
 469
 470 =cut
 471
 472 sub hmac_otp {
 473     my $self = shift;
 474     load_optional('Pass::OTP');
 475
 476     my %params = ($self->_hotp_params, @_);
 477     return if !defined $params{type} || !defined $params{secret};
 478
 479     $params{secret} = encode_b32r($params{secret}) if !$params{base32};
 480     $params{base32} = 1;
 481
 482     my $otp = eval {Pass::OTP::otp(%params, @_) };
 483     if (my $err = $@) {
 484         throw 'Unable to generate HOTP', error => $err;
 485     }
 486
 487     $self->_hotp_increment_counter($params{counter});
 488
 489     return $otp;
 490 }
 491
 492 =method time_otp
 493
 494     $otp = $entry->time_otp(%options);
 495
 496 Generate a time-based one-time password, or C<undef> if TOTP is not configured for the entry. The entry's
 497 strings generally must first be unprotected, just like when accessing the password. Valid options are:
 498
 499 =for :list
 500 * C<now> - Specify the value for determining the time-step counter
 501
 502 To configure TOTP, see L</"One-time Passwords">.
 503
 504 =cut
 505
 506 sub time_otp {
 507     my $self = shift;
 508     load_optional('Pass::OTP');
 509
 510     my %params = ($self->_totp_params, @_);
 511     return if !defined $params{type} || !defined $params{secret};
 512
 513     $params{secret} = encode_b32r($params{secret}) if !$params{base32};
 514     $params{base32} = 1;
 515
 516     my $otp = eval {Pass::OTP::otp(%params, @_) };
 517     if (my $err = $@) {
 518         throw 'Unable to generate TOTP', error => $err;
 519     }
 520
 521     return $otp;
 522 }
 523
 524 =method hmac_otp_uri
 525
 526 =method time_otp_uri
 527
 528     $uri_string = $entry->hmac_otp_uri;
 529     $uri_string = $entry->time_otp_uri;
 530
 531 Get a HOTP or TOTP otpauth URI for the entry, if available.
 532
 533 To configure OTP, see L</"One-time Passwords">.
 534
 535 =cut
 536
 537 sub hmac_otp_uri { $_[0]->_otp_uri($_[0]->_hotp_params) }
 538 sub time_otp_uri { $_[0]->_otp_uri($_[0]->_totp_params) }
 539
 540 sub _otp_uri {
 541     my $self = shift;
 542     my %params = @_;
 543
 544     return if 4 != grep { defined } @params{qw(type secret issuer account)};
 545     return if $params{type} !~ /^[ht]otp$/i;
 546
 547     my $label = delete $params{label};
 548     $params{$_} = uri_escape_utf8($params{$_}) for keys %params;
 549
 550     my $type    = lc($params{type});
 551     my $issuer  = $params{issuer};
 552     my $account = $params{account};
 553
 554     $label //= "$issuer:$account";
 555
 556     my $secret = $params{secret};
 557     $secret = uc(encode_b32r($secret)) if !$params{base32};
 558
 559     delete $params{algorithm} if defined $params{algorithm} && $params{algorithm} eq 'sha1';
 560     delete $params{period}    if defined $params{period} && $params{period} == 30;
 561     delete $params{digits}    if defined $params{digits} && $params{digits} == 6;
 562     delete $params{counter}   if defined $params{counter} && $params{counter} == 0;
 563
 564     my $uri = "otpauth://$type/$label?secret=$secret&issuer=$issuer";
 565
 566     if (defined $params{encoder}) {
 567         $uri .= "&encoder=$params{encoder}";
 568         return $uri;
 569     }
 570     $uri .= '&algorithm=' . uc($params{algorithm}) if defined $params{algorithm};
 571     $uri .= "&digits=$params{digits}"   if defined $params{digits};
 572     $uri .= "&counter=$params{counter}" if defined $params{counter};
 573     $uri .= "&period=$params{period}"   if defined $params{period};
 574
 575     return $uri;
 576 }
 577
 578 sub _hotp_params {
 579     my $self = shift;
 580
 581     my %params = (
 582         type    => 'hotp',
 583         issuer  => $self->title     || 'KDBX',
 584         account => $self->username  || 'none',
 585         digits  => 6,
 586         counter => $self->string_value('HmacOtp-Counter') // 0,
 587         $self->_otp_secret_params('Hmac'),
 588     );
 589     return %params if $params{secret};
 590
 591     my %otp_params = $self->_otp_params;
 592     return () if !$otp_params{secret} || $otp_params{type} ne 'hotp';
 593
 594     # $otp_params{counter} = 0
 595
 596     return (%params, %otp_params);
 597 }
 598
 599 sub _totp_params {
 600     my $self = shift;
 601
 602     my %algorithms = (
 603         'HMAC-SHA-1'    => 'sha1',
 604         'HMAC-SHA-256'  => 'sha256',
 605         'HMAC-SHA-512'  => 'sha512',
 606     );
 607     my %params = (
 608         type        => 'totp',
 609         issuer      => $self->title     || 'KDBX',
 610         account     => $self->username  || 'none',
 611         digits      => $self->string_value('TimeOtp-Length') // 6,
 612         algorithm   => $algorithms{$self->string_value('TimeOtp-Algorithm') || ''} || 'sha1',
 613         period      => $self->string_value('TimeOtp-Period') // 30,
 614         $self->_otp_secret_params('Time'),
 615     );
 616     return %params if $params{secret};
 617
 618     my %otp_params = $self->_otp_params;
 619     return () if !$otp_params{secret} || $otp_params{type} ne 'totp';
 620
 621     return (%params, %otp_params);
 622 }
 623
 624 # KeePassXC style
 625 sub _otp_params {
 626     my $self = shift;
 627     load_optional('Pass::OTP::URI');
 628
 629     my $uri = $self->string_value('otp') || '';
 630     my %params;
 631     %params = Pass::OTP::URI::parse($uri) if $uri =~ m!^otpauth://!;
 632     return () if !$params{secret} || !$params{type};
 633
 634     if (($params{encoder} // '') eq 'steam') {
 635         $params{digits} = 5;
 636         $params{chars}  = '23456789BCDFGHJKMNPQRTVWXY';
 637     }
 638
 639     # Pass::OTP::URI doesn't provide the issuer and account separately, so get them from the label
 640     my ($issuer, $user) = split(':', $params{label} // ':', 2);
 641     $params{issuer}  //= uri_unescape_utf8($issuer);
 642     $params{account} //= uri_unescape_utf8($user);
 643
 644     $params{algorithm}  = lc($params{algorithm}) if $params{algorithm};
 645     $params{counter}    = $self->string_value('HmacOtp-Counter') if $params{type} eq 'hotp';
 646
 647     return %params;
 648 }
 649
 650 sub _otp_secret_params {
 651     my $self = shift;
 652     my $type = shift // return ();
 653
 654     my $secret_txt = $self->string_value("${type}Otp-Secret");
 655     my $secret_hex = $self->string_value("${type}Otp-Secret-Hex");
 656     my $secret_b32 = $self->string_value("${type}Otp-Secret-Base32");
 657     my $secret_b64 = $self->string_value("${type}Otp-Secret-Base64");
 658
 659     my $count = grep { defined } ($secret_txt, $secret_hex, $secret_b32, $secret_b64);
 660     return () if $count == 0;
 661     alert "Found multiple ${type}Otp-Secret strings", count => $count if 1 < $count;
 662
 663     return (secret => $secret_b32, base32 => 1) if defined $secret_b32;
 664     return (secret => decode_b64($secret_b64))  if defined $secret_b64;
 665     return (secret => pack('H*', $secret_hex))  if defined $secret_hex;
 666     return (secret => encode('UTF-8', $secret_txt));
 667 }
 668
 669 sub _hotp_increment_counter {
 670     my $self    = shift;
 671     my $counter = shift // $self->string_value('HmacOtp-Counter') || 0;
 672
 673     looks_like_number($counter) or throw 'HmacOtp-Counter value must be a number', value => $counter;
 674     my $next = $counter + 1;
 675     $self->string('HmacOtp-Counter', $next);
 676     return $next;
 677 }
 678
 679 ##############################################################################
 680
 681 =method size
 682
 683     $size = $entry->size;
 684
 685 Get the size (in bytes) of an entry.
 686
 687 B<NOTE:> This is not an exact figure because there is no canonical serialization of an entry. This size should
 688 only be used as a rough estimate for comparison with other entries or to impose data size limitations.
 689
 690 =cut
 691
 692 sub size {
 693     my $self = shift;
 694
 695     my $size = 0;
 696
 697     # tags
 698     $size += length(encode('UTF-8', $self->tags // ''));
 699
 700     # attributes (strings)
 701     while (my ($key, $string) = each %{$self->strings}) {
 702         next if !defined $string->{value};
 703         $size += length(encode('UTF-8', $key)) + length(encode('UTF-8', $string->{value} // ''));
 704     }
 705
 706     # custom data
 707     while (my ($key, $item) = each %{$self->custom_data}) {
 708         next if !defined $item->{value};
 709         $size += length(encode('UTF-8', $key)) + length(encode('UTF-8', $item->{value} // ''));
 710     }
 711
 712     # binaries
 713     while (my ($key, $binary) = each %{$self->binaries}) {
 714         next if !defined $binary->{value};
 715         my $value_len = utf8::is_utf8($binary->{value}) ? length(encode('UTF-8', $binary->{value}))
 716             : length($binary->{value});
 717         $size += length(encode('UTF-8', $key)) + $value_len;
 718     }
 719
 720     # autotype associations
 721     for my $association (@{$self->auto_type->{associations} || []}) {
 722         $size += length(encode('UTF-8', $association->{window}))
 723             + length(encode('UTF-8', $association->{keystroke_sequence} // ''));
 724     }
 725
 726     return $size;
 727 }
 728
 729 ##############################################################################
 730
 731 sub history {
 732     my $self = shift;
 733     my $entries = $self->{history} //= [];
 734     # FIXME - Looping through entries on each access is too expensive.
 735     @$entries = map { $self->_wrap_entry($_, $self->kdbx) } @$entries;
 736     return $entries;
 737 }
 738
 739 =method history_size
 740
 741     $size = $entry->history_size;
 742
 743 Get the size (in bytes) of all historical entries combined.
 744
 745 =cut
 746
 747 sub history_size {
 748     my $self = shift;
 749     return sum0 map { $_->size } @{$self->history};
 750 }
 751
 752 =method prune_history
 753
 754     $entry->prune_history(%options);
 755
 756 Remove as many older historical entries as necessary to get under the database limits. The limits are taken
 757 from the associated database (if any) or can be overridden with C<%options>:
 758
 759 =for :list
 760 * C<max_items> - Maximum number of historical entries to keep (default: 10, no limit: -1)
 761 * C<max_size> - Maximum total size (in bytes) of historical entries to keep (default: 6 MiB, no limit: -1)
 762
 763 =cut
 764
 765 sub prune_history {
 766     my $self = shift;
 767     my %args = @_;
 768
 769     my $max_items = $args{max_items} // eval { $self->kdbx->history_max_items }
 770         // HISTORY_DEFAULT_MAX_ITEMS;
 771     my $max_size  = $args{max_size} // eval { $self->kdbx->history_max_size }
 772         // HISTORY_DEFAULT_MAX_SIZE;
 773
 774     # history is ordered oldest to youngest
 775     my $history = $self->history;
 776
 777     if (0 <= $max_items && $max_items < @$history) {
 778         splice @$history, -$max_items;
 779     }
 780
 781     if (0 <= $max_size) {
 782         my $current_size = $self->history_size;
 783         while ($max_size < $current_size) {
 784             my $entry = shift @$history;
 785             $current_size -= $entry->size;
 786         }
 787     }
 788 }
 789
 790 =method add_historical_entry
 791
 792     $entry->add_historical_entry($entry);
 793
 794 Add an entry to the history.
 795
 796 =cut
 797
 798 sub add_historical_entry {
 799     my $self = shift;
 800     delete $_->{history} for @_;
 801     push @{$self->{history} //= []}, map { $self->_wrap_entry($_) } @_;
 802 }
 803
 804 =method current_entry
 805
 806     $current_entry = $entry->current_entry;
 807
 808 Get an entry's current entry. If the entry itself is current (not historical), itself is returned.
 809
 810 =cut
 811
 812 sub current_entry {
 813     my $self    = shift;
 814     my $group   = $self->parent;
 815
 816     if ($group) {
 817         my $id = $self->uuid;
 818         my $entry = first { $id eq $_->uuid } @{$group->entries};
 819         return $entry if $entry;
 820     }
 821
 822     return $self;
 823 }
 824
 825 =method is_current
 826
 827     $bool = $entry->is_current;
 828
 829 Get whether or not an entry is considered current (i.e. not historical). An entry is current if it is directly
 830 in the parent group's entry list.
 831
 832 =cut
 833
 834 sub is_current {
 835     my $self    = shift;
 836     my $current = $self->current_entry;
 837     return Hash::Util::FieldHash::id($self) == Hash::Util::FieldHash::id($current);
 838 }
 839
 840 =method is_historical
 841
 842     $bool = $entry->is_historical;
 843
 844 Get whether or not an entry is considered historical (i.e. not current).
 845
 846 This is just the inverse of L</is_current>.
 847
 848 =cut
 849
 850 sub is_historical { !$_[0]->is_current }
 851
 852 ##############################################################################
 853
 854 sub _signal {
 855     my $self = shift;
 856     my $type = shift;
 857     return $self->SUPER::_signal("entry.$type", @_);
 858 }
 859
 860 sub _commit {
 861     my $self = shift;
 862     my $orig = shift;
 863     $self->add_historical_entry($orig);
 864     my $time = gmtime;
 865     $self->last_modification_time($time);
 866     $self->last_access_time($time);
 867 }
 868
 869 sub label { shift->expanded_title(@_) }
 870
 871 1;
 872 __END__
 873
 874 =head1 DESCRIPTION
 875
 876 An entry in a KDBX database is a record that can contains strings (also called "fields") and binaries (also
 877 called "files" or "attachments"). Every string and binary has a key or name. There is a default set of strings
 878 that every entry has:
 879
 880 =for :list
 881 * B<Title>
 882 * B<UserName>
 883 * B<Password>
 884 * B<URL>
 885 * B<Notes>
 886
 887 Beyond this, you can store any number of other strings and any number of binaries that you can use for
 888 whatever purpose you want.
 889
 890 There is also some metadata associated with an entry. Each entry in a database is identified uniquely by
 891 a UUID. An entry can also have an icon associated with it, and there are various timestamps. Take a look at
 892 the attributes to see what's available.
 893
 894 A B<File::KDBX::Entry> is a subclass of L<File::KDBX::Object>.
 895
 896 =head2 Placeholders
 897
 898 Entry string and auto-type key sequences can have placeholders or template tags that can be replaced by other
 899 values. Placeholders can appear like C<{PLACEHOLDER}>. For example, a B<URL> string might have a value of
 900 C<http://example.com?user={USERNAME}>. C<{USERNAME}> is a placeholder for the value of the B<UserName> string
 901 of the same entry. If the B<UserName> string had a value of "batman", the B<URL> string would expand to
 902 C<http://example.com?user=batman>.
 903
 904 Some placeholders take an argument, where the argument follows the tag after a colon but before the closing
 905 brace, like C<{PLACEHOLDER:ARGUMENT}>.
 906
 907 Placeholders are documented in the L<KeePass Help Center|https://keepass.info/help/base/placeholders.html>.
 908 This software supports many (but not all) of the placeholders documented there.
 909
 910 =head3 Entry Placeholders
 911
 912 =for :list
 913 * ☑ C<{TITLE}> - B<Title> string
 914 * ☑ C<{USERNAME}> - B<UserName> string
 915 * ☑ C<{PASSWORD}> - B<Password> string
 916 * ☑ C<{NOTES}> - B<Notes> string
 917 * ☑ C<{URL}> - B<URL> string
 918 * ☑ C<{URL:SCM}> / C<{URL:SCHEME}>
 919 * ☑ C<{URL:USERINFO}>
 920 * ☑ C<{URL:USERNAME}>
 921 * ☑ C<{URL:PASSWORD}>
 922 * ☑ C<{URL:HOST}>
 923 * ☑ C<{URL:PORT}>
 924 * ☑ C<{URL:PATH}>
 925 * ☑ C<{URL:QUERY}>
 926 * ☑ C<{URL:FRAGMENT}> / C<{URL:HASH}>
 927 * ☑ C<{URL:RMVSCM}> / C<{URL:WITHOUTSCHEME}>
 928 * ☑ C<{S:Name}> - Custom string where C<Name> is the name or key of the string
 929 * ☑ C<{UUID}> - Identifier (32 hexidecimal characters)
 930 * ☑ C<{HMACOTP}> - Generate an HMAC-based one-time password (its counter B<will> be incremented)
 931 * ☑ C<{TIMEOTP}> - Generate a time-based one-time password
 932 * ☑ C<{GROUP_NOTES}> - Notes of the parent group
 933 * ☑ C<{GROUP_PATH}> - Full path of the parent group
 934 * ☑ C<{GROUP}> - Name of the parent group
 935
 936 =head3 Field References
 937
 938 =for :list
 939 * ☑ C<{REF:Wanted@SearchIn:Text}> - See L<File::KDBX/resolve_reference>
 940
 941 =head3 File path Placeholders
 942
 943 =for :list
 944 * ☑ C<{APPDIR}> - Program directory path
 945 * ☑ C<{FIREFOX}> - Path to the Firefox browser executable
 946 * ☑ C<{GOOGLECHROME}> - Path to the Chrome browser executable
 947 * ☑ C<{INTERNETEXPLORER}> - Path to the Firefox browser executable
 948 * ☑ C<{OPERA}> - Path to the Opera browser executable
 949 * ☑ C<{SAFARI}> - Path to the Safari browser executable
 950 * ☒ C<{DB_PATH}> - Full file path of the database
 951 * ☒ C<{DB_DIR}> - Directory path of the database
 952 * ☒ C<{DB_NAME}> - File name (including extension) of the database
 953 * ☒ C<{DB_BASENAME}> - File name (excluding extension) of the database
 954 * ☒ C<{DB_EXT}> - File name extension
 955 * ☑ C<{ENV_DIRSEP}> - Directory separator
 956 * ☑ C<{ENV_PROGRAMFILES_X86}> - One of C<%ProgramFiles(x86)%> or C<%ProgramFiles%>
 957
 958 =head3 Date and Time Placeholders
 959
 960 =for :list
 961 * ☑ C<{DT_SIMPLE}> - Current local date and time as a sortable string
 962 * ☑ C<{DT_YEAR}> - Year component of the current local date
 963 * ☑ C<{DT_MONTH}> - Month component of the current local date
 964 * ☑ C<{DT_DAY}> - Day component of the current local date
 965 * ☑ C<{DT_HOUR}> - Hour component of the current local time
 966 * ☑ C<{DT_MINUTE}> - Minute component of the current local time
 967 * ☑ C<{DT_SECOND}> - Second component of the current local time
 968 * ☑ C<{DT_UTC_SIMPLE}> - Current UTC date and time as a sortable string
 969 * ☑ C<{DT_UTC_YEAR}> - Year component of the current UTC date
 970 * ☑ C<{DT_UTC_MONTH}> - Month component of the current UTC date
 971 * ☑ C<{DT_UTC_DAY}> - Day component of the current UTC date
 972 * ☑ C<{DT_UTC_HOUR}> - Hour component of the current UTC time
 973 * ☑ C<{DT_UTC_MINUTE}> Minute Year component of the current UTC time
 974 * ☑ C<{DT_UTC_SECOND}> - Second component of the current UTC time
 975
 976 If the current date and time is <2012-07-25 17:05:34>, the "simple" form would be C<20120725170534>.
 977
 978 =head3 Special Key Placeholders
 979
 980 Certain placeholders for use in auto-type key sequences are not supported for replacement, but they will
 981 remain as-is so that an auto-type engine (not included) can parse and replace them with the appropriate
 982 virtual key presses. For completeness, here is the list that the KeePass program claims to support:
 983
 984 C<{TAB}>, C<{ENTER}>, C<{UP}>, C<{DOWN}>, C<{LEFT}>, C<{RIGHT}>, C<{HOME}>, C<{END}>, C<{PGUP}>, C<{PGDN}>,
 985 C<{INSERT}>, C<{DELETE}>, C<{SPACE}>
 986
 987 C<{BACKSPACE}>, C<{BREAK}>, C<{CAPSLOCK}>, C<{ESC}>, C<{WIN}>, C<{LWIN}>, C<{RWIN}>, C<{APPS}>, C<{HELP}>,
 988 C<{NUMLOCK}>, C<{PRTSC}>, C<{SCROLLLOCK}>
 989
 990 C<{F1}>, C<{F2}>, C<{F3}>, C<{F4}>, C<{F5}>, C<{F6}>, C<{F7}>, C<{F8}>, C<{F9}>, C<{F10}>, C<{F11}>, C<{F12}>,
 991 C<{F13}>, C<{F14}>, C<{F15}>, C<{F16}>
 992
 993 C<{ADD}>, C<{SUBTRACT}>, C<{MULTIPLY}>, C<{DIVIDE}>, C<{NUMPAD0}>, C<{NUMPAD1}>, C<{NUMPAD2}>, C<{NUMPAD3}>,
 994 C<{NUMPAD4}>, C<{NUMPAD5}>, C<{NUMPAD6}>, C<{NUMPAD7}>, C<{NUMPAD8}>, C<{NUMPAD9}>
 995
 996 =head3 Miscellaneous Placeholders
 997
 998 =for :list
 999 * ☒ C<{BASE}>
1000 * ☒ C<{BASE:SCM}> / C<{BASE:SCHEME}>
1001 * ☒ C<{BASE:USERINFO}>
1002 * ☒ C<{BASE:USERNAME}>
1003 * ☒ C<{BASE:PASSWORD}>
1004 * ☒ C<{BASE:HOST}>
1005 * ☒ C<{BASE:PORT}>
1006 * ☒ C<{BASE:PATH}>
1007 * ☒ C<{BASE:QUERY}>
1008 * ☒ C<{BASE:FRAGMENT}> / C<{BASE:HASH}>
1009 * ☒ C<{BASE:RMVSCM}> / C<{BASE:WITHOUTSCHEME}>
1010 * ☒ C<{CLIPBOARD-SET:/Text/}>
1011 * ☒ C<{CLIPBOARD}>
1012 * ☒ C<{CMD:/CommandLine/Options/}>
1013 * ☑ C<{C:Comment}> - Comments are simply replaced by nothing
1014 * ☑ C<{ENV:}> and C<%ENV%> - Environment variables
1015 * ☒ C<{GROUP_SEL_NOTES}>
1016 * ☒ C<{GROUP_SEL_PATH}>
1017 * ☒ C<{GROUP_SEL}>
1018 * ☒ C<{NEWPASSWORD}>
1019 * ☒ C<{NEWPASSWORD:/Profile/}>
1020 * ☒ C<{PASSWORD_ENC}>
1021 * ☒ C<{PICKCHARS}>
1022 * ☒ C<{PICKCHARS:Field:Options}>
1023 * ☒ C<{PICKFIELD}>
1024 * ☒ C<{T-CONV:/Text/Type/}>
1025 * ☒ C<{T-REPLACE-RX:/Text/Type/Replace/}>
1026
1027 Some of these that remain unimplemented, such as C<{CLIPBOARD}>, cannot be implemented portably. Some of these
1028 I haven't implemented (yet) just because they don't seem very useful. You can create your own placeholder to
1029 augment the list of default supported placeholders or to replace a built-in placeholder handler. To create
1030 a placeholder, just set it in the C<%File::KDBX::PLACEHOLDERS> hash. For example:
1031
1032     $File::KDBX::PLACEHOLDERS{'MY_PLACEHOLDER'} = sub {
1033         my ($entry) = @_;
1034         ...;
1035     };
1036
1037 If the placeholder is expanded in the context of an entry, C<$entry> is the B<File::KDBX::Entry> object in
1038 context. Otherwise it is C<undef>. An entry is in context if, for example, the placeholder is in an entry's
1039 strings or auto-complete key sequences.
1040
1041     $File::KDBX::PLACEHOLDERS{'MY_PLACEHOLDER:'} = sub {
1042         my ($entry, $arg) = @_;         #    ^ Notice the colon here
1043         ...;
1044     };
1045
1046 If the name of the placeholder ends in a colon, then it is expected to receive an argument. During expansion,
1047 everything after the colon and before the end of the placeholder is passed to your placeholder handler
1048 subroutine. So if the placeholder is C<{MY_PLACEHOLDER:whatever}>, C<$arg> will have the value B<whatever>.
1049
1050 An argument is required for placeholders than take one. I.e. The placeholder handler won't be called if there
1051 is no argument. If you want a placeholder to support an optional argument, you'll need to set the placeholder
1052 both with and without a colon (or they could be different subroutines):
1053
1054     $File::KDBX::PLACEHOLDERS{'RAND'} = $File::KDBX::PLACEHOLDERS{'RAND:'} = sub {
1055         (undef, my $arg) = @_;
1056         return defined $arg ? rand($arg) : rand;
1057     };
1058
1059 You can also remove placeholder handlers. If you want to disable placeholder expansion entirely, just delete
1060 all the handlers:
1061
1062     %File::KDBX::PLACEHOLDERS = ();
1063
1064 =head2 One-time Passwords
1065
1066 An entry can be configured to generate one-time passwords, both HOTP (HMAC-based) and TOTP (time-based). The
1067 configuration storage isn't completely standardized, but this module supports two predominant configuration
1068 styles:
1069
1070 =for :list
1071 * L<KeePass 2|https://keepass.info/help/base/placeholders.html#otp>
1072 * KeePassXC
1073
1074 B<NOTE:> To use this feature, you must install the suggested dependency:
1075
1076 =for :list
1077 * L<Pass::OTP>
1078
1079 To configure TOTP in the KeePassXC style, there is only one string to set: C<otp>. The value should be any
1080 valid otpauth URI. When generating an OTP, all of the relevant OTP properties are parsed from the URI.
1081
1082 To configure TOTP in the KeePass 2 style, set the following strings:
1083
1084 =for :list
1085 * C<TimeOtp-Algorithm> - Cryptographic algorithm, one of C<HMAC-SHA-1> (default), C<HMAC-SHA-256> and
1086     C<HMAC-SHA-512>
1087 * C<TimeOtp-Length> - Number of digits each one-time password is (default: 6, maximum: 8)
1088 * C<TimeOtp-Period> - Time-step size in seconds (default: 30)
1089 * C<TimeOtp-Secret> - Text string secret, OR
1090 * C<TimeOtp-Secret-Hex> - Hexidecimal-encoded secret, OR
1091 * C<TimeOtp-Secret-Base32> - Base32-encoded secret (most common), OR
1092 * C<TimeOtp-Secret-Base64> - Base64-encoded secret
1093
1094 To configure HOTP in the KeePass 2 style, set the following strings:
1095
1096 =for :list
1097 * C<HmacOtp-Counter> - Counting value in decimal, starts on C<0> by default and increments when L</hmac_otp>
1098     is called
1099 * C<HmacOtp-Secret> - Text string secret, OR
1100 * C<HmacOtp-Secret-Hex> - Hexidecimal-encoded secret, OR
1101 * C<HmacOtp-Secret-Base32> - Base32-encoded secret (most common), OR
1102 * C<HmacOtp-Secret-Base64> - Base64-encoded secret
1103
1104 B<NOTE:> The multiple "Secret" strings are simply a way to store a secret in different formats. Only one of
1105 these should actually be set or an error will be thrown.
1106
1107 Here's a basic example:
1108
1109     $entry->string(otp => 'otpauth://totp/Issuer:user?secret=NBSWY3DP&issuer=Issuer');
1110     # OR
1111     $entry->string('TimeOtp-Secret-Base32' => 'NBSWY3DP');
1112
1113     my $otp = $entry->time_otp;
1114
1115 =cut