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 auto_type_enabled {
 442     my $entry = shift;
 443     # TODO
 444 }
 445
 446 ##############################################################################
 447
 448 =method hmac_otp
 449
 450     $otp = $entry->hmac_otp(%options);
 451
 452 Generate an HMAC-based one-time password, or C<undef> if HOTP is not configured for the entry. The entry's
 453 strings generally must first be unprotected, just like when accessing the password. Valid options are:
 454
 455 =for :list
 456 * C<counter> - Specify the counter value
 457
 458 To configure HOTP, see L</"One-time Passwords">.
 459
 460 =cut
 461
 462 sub hmac_otp {
 463     my $self = shift;
 464     load_optional('Pass::OTP');
 465
 466     my %params = ($self->_hotp_params, @_);
 467     return if !defined $params{type} || !defined $params{secret};
 468
 469     $params{secret} = encode_b32r($params{secret}) if !$params{base32};
 470     $params{base32} = 1;
 471
 472     my $otp = eval {Pass::OTP::otp(%params, @_) };
 473     if (my $err = $@) {
 474         throw 'Unable to generate HOTP', error => $err;
 475     }
 476
 477     $self->_hotp_increment_counter($params{counter});
 478
 479     return $otp;
 480 }
 481
 482 =method time_otp
 483
 484     $otp = $entry->time_otp(%options);
 485
 486 Generate a time-based one-time password, or C<undef> if TOTP is not configured for the entry. The entry's
 487 strings generally must first be unprotected, just like when accessing the password. Valid options are:
 488
 489 =for :list
 490 * C<now> - Specify the value for determining the time-step counter
 491
 492 To configure TOTP, see L</"One-time Passwords">.
 493
 494 =cut
 495
 496 sub time_otp {
 497     my $self = shift;
 498     load_optional('Pass::OTP');
 499
 500     my %params = ($self->_totp_params, @_);
 501     return if !defined $params{type} || !defined $params{secret};
 502
 503     $params{secret} = encode_b32r($params{secret}) if !$params{base32};
 504     $params{base32} = 1;
 505
 506     my $otp = eval {Pass::OTP::otp(%params, @_) };
 507     if (my $err = $@) {
 508         throw 'Unable to generate TOTP', error => $err;
 509     }
 510
 511     return $otp;
 512 }
 513
 514 =method hmac_otp_uri
 515
 516 =method time_otp_uri
 517
 518     $uri_string = $entry->hmac_otp_uri;
 519     $uri_string = $entry->time_otp_uri;
 520
 521 Get a HOTP or TOTP otpauth URI for the entry, if available.
 522
 523 To configure OTP, see L</"One-time Passwords">.
 524
 525 =cut
 526
 527 sub hmac_otp_uri { $_[0]->_otp_uri($_[0]->_hotp_params) }
 528 sub time_otp_uri { $_[0]->_otp_uri($_[0]->_totp_params) }
 529
 530 sub _otp_uri {
 531     my $self = shift;
 532     my %params = @_;
 533
 534     return if 4 != grep { defined } @params{qw(type secret issuer account)};
 535     return if $params{type} !~ /^[ht]otp$/i;
 536
 537     my $label = delete $params{label};
 538     $params{$_} = uri_escape_utf8($params{$_}) for keys %params;
 539
 540     my $type    = lc($params{type});
 541     my $issuer  = $params{issuer};
 542     my $account = $params{account};
 543
 544     $label //= "$issuer:$account";
 545
 546     my $secret = $params{secret};
 547     $secret = uc(encode_b32r($secret)) if !$params{base32};
 548
 549     delete $params{algorithm} if defined $params{algorithm} && $params{algorithm} eq 'sha1';
 550     delete $params{period}    if defined $params{period} && $params{period} == 30;
 551     delete $params{digits}    if defined $params{digits} && $params{digits} == 6;
 552     delete $params{counter}   if defined $params{counter} && $params{counter} == 0;
 553
 554     my $uri = "otpauth://$type/$label?secret=$secret&issuer=$issuer";
 555
 556     if (defined $params{encoder}) {
 557         $uri .= "&encoder=$params{encoder}";
 558         return $uri;
 559     }
 560     $uri .= '&algorithm=' . uc($params{algorithm}) if defined $params{algorithm};
 561     $uri .= "&digits=$params{digits}"   if defined $params{digits};
 562     $uri .= "&counter=$params{counter}" if defined $params{counter};
 563     $uri .= "&period=$params{period}"   if defined $params{period};
 564
 565     return $uri;
 566 }
 567
 568 sub _hotp_params {
 569     my $self = shift;
 570
 571     my %params = (
 572         type    => 'hotp',
 573         issuer  => $self->title     || 'KDBX',
 574         account => $self->username  || 'none',
 575         digits  => 6,
 576         counter => $self->string_value('HmacOtp-Counter') // 0,
 577         $self->_otp_secret_params('Hmac'),
 578     );
 579     return %params if $params{secret};
 580
 581     my %otp_params = $self->_otp_params;
 582     return () if !$otp_params{secret} || $otp_params{type} ne 'hotp';
 583
 584     # $otp_params{counter} = 0
 585
 586     return (%params, %otp_params);
 587 }
 588
 589 sub _totp_params {
 590     my $self = shift;
 591
 592     my %algorithms = (
 593         'HMAC-SHA-1'    => 'sha1',
 594         'HMAC-SHA-256'  => 'sha256',
 595         'HMAC-SHA-512'  => 'sha512',
 596     );
 597     my %params = (
 598         type        => 'totp',
 599         issuer      => $self->title     || 'KDBX',
 600         account     => $self->username  || 'none',
 601         digits      => $self->string_value('TimeOtp-Length') // 6,
 602         algorithm   => $algorithms{$self->string_value('TimeOtp-Algorithm') || ''} || 'sha1',
 603         period      => $self->string_value('TimeOtp-Period') // 30,
 604         $self->_otp_secret_params('Time'),
 605     );
 606     return %params if $params{secret};
 607
 608     my %otp_params = $self->_otp_params;
 609     return () if !$otp_params{secret} || $otp_params{type} ne 'totp';
 610
 611     return (%params, %otp_params);
 612 }
 613
 614 # KeePassXC style
 615 sub _otp_params {
 616     my $self = shift;
 617     load_optional('Pass::OTP::URI');
 618
 619     my $uri = $self->string_value('otp') || '';
 620     my %params;
 621     %params = Pass::OTP::URI::parse($uri) if $uri =~ m!^otpauth://!;
 622     return () if !$params{secret} || !$params{type};
 623
 624     if (($params{encoder} // '') eq 'steam') {
 625         $params{digits} = 5;
 626         $params{chars}  = '23456789BCDFGHJKMNPQRTVWXY';
 627     }
 628
 629     # Pass::OTP::URI doesn't provide the issuer and account separately, so get them from the label
 630     my ($issuer, $user) = split(':', $params{label} // ':', 2);
 631     $params{issuer}  //= uri_unescape_utf8($issuer);
 632     $params{account} //= uri_unescape_utf8($user);
 633
 634     $params{algorithm}  = lc($params{algorithm}) if $params{algorithm};
 635     $params{counter}    = $self->string_value('HmacOtp-Counter') if $params{type} eq 'hotp';
 636
 637     return %params;
 638 }
 639
 640 sub _otp_secret_params {
 641     my $self = shift;
 642     my $type = shift // return ();
 643
 644     my $secret_txt = $self->string_value("${type}Otp-Secret");
 645     my $secret_hex = $self->string_value("${type}Otp-Secret-Hex");
 646     my $secret_b32 = $self->string_value("${type}Otp-Secret-Base32");
 647     my $secret_b64 = $self->string_value("${type}Otp-Secret-Base64");
 648
 649     my $count = grep { defined } ($secret_txt, $secret_hex, $secret_b32, $secret_b64);
 650     return () if $count == 0;
 651     alert "Found multiple ${type}Otp-Secret strings", count => $count if 1 < $count;
 652
 653     return (secret => $secret_b32, base32 => 1) if defined $secret_b32;
 654     return (secret => decode_b64($secret_b64))  if defined $secret_b64;
 655     return (secret => pack('H*', $secret_hex))  if defined $secret_hex;
 656     return (secret => encode('UTF-8', $secret_txt));
 657 }
 658
 659 sub _hotp_increment_counter {
 660     my $self    = shift;
 661     my $counter = shift // $self->string_value('HmacOtp-Counter') || 0;
 662
 663     looks_like_number($counter) or throw 'HmacOtp-Counter value must be a number', value => $counter;
 664     my $next = $counter + 1;
 665     $self->string('HmacOtp-Counter', $next);
 666     return $next;
 667 }
 668
 669 ##############################################################################
 670
 671 =method size
 672
 673     $size = $entry->size;
 674
 675 Get the size (in bytes) of an entry.
 676
 677 B<NOTE:> This is not an exact figure because there is no canonical serialization of an entry. This size should
 678 only be used as a rough estimate for comparison with other entries or to impose data size limitations.
 679
 680 =cut
 681
 682 sub size {
 683     my $self = shift;
 684
 685     my $size = 0;
 686
 687     # tags
 688     $size += length(encode('UTF-8', $self->tags // ''));
 689
 690     # attributes (strings)
 691     while (my ($key, $string) = each %{$self->strings}) {
 692         next if !defined $string->{value};
 693         $size += length(encode('UTF-8', $key)) + length(encode('UTF-8', $string->{value} // ''));
 694     }
 695
 696     # custom data
 697     while (my ($key, $item) = each %{$self->custom_data}) {
 698         next if !defined $item->{value};
 699         $size += length(encode('UTF-8', $key)) + length(encode('UTF-8', $item->{value} // ''));
 700     }
 701
 702     # binaries
 703     while (my ($key, $binary) = each %{$self->binaries}) {
 704         next if !defined $binary->{value};
 705         my $value_len = utf8::is_utf8($binary->{value}) ? length(encode('UTF-8', $binary->{value}))
 706             : length($binary->{value});
 707         $size += length(encode('UTF-8', $key)) + $value_len;
 708     }
 709
 710     # autotype associations
 711     for my $association (@{$self->auto_type->{associations} || []}) {
 712         $size += length(encode('UTF-8', $association->{window}))
 713             + length(encode('UTF-8', $association->{keystroke_sequence} // ''));
 714     }
 715
 716     return $size;
 717 }
 718
 719 ##############################################################################
 720
 721 sub history {
 722     my $self = shift;
 723     my $entries = $self->{history} //= [];
 724     # FIXME - Looping through entries on each access is too expensive.
 725     @$entries = map { $self->_wrap_entry($_, $self->kdbx) } @$entries;
 726     return $entries;
 727 }
 728
 729 =method history_size
 730
 731     $size = $entry->history_size;
 732
 733 Get the size (in bytes) of all historical entries combined.
 734
 735 =cut
 736
 737 sub history_size {
 738     my $self = shift;
 739     return sum0 map { $_->size } @{$self->history};
 740 }
 741
 742 =method prune_history
 743
 744     $entry->prune_history(%options);
 745
 746 Remove as many older historical entries as necessary to get under the database limits. The limits are taken
 747 from the associated database (if any) or can be overridden with C<%options>:
 748
 749 =for :list
 750 * C<max_items> - Maximum number of historical entries to keep (default: 10, no limit: -1)
 751 * C<max_size> - Maximum total size (in bytes) of historical entries to keep (default: 6 MiB, no limit: -1)
 752
 753 =cut
 754
 755 sub prune_history {
 756     my $self = shift;
 757     my %args = @_;
 758
 759     my $max_items = $args{max_items} // eval { $self->kdbx->history_max_items }
 760         // HISTORY_DEFAULT_MAX_ITEMS;
 761     my $max_size  = $args{max_size} // eval { $self->kdbx->history_max_size }
 762         // HISTORY_DEFAULT_MAX_SIZE;
 763
 764     # history is ordered oldest to youngest
 765     my $history = $self->history;
 766
 767     if (0 <= $max_items && $max_items < @$history) {
 768         splice @$history, -$max_items;
 769     }
 770
 771     if (0 <= $max_size) {
 772         my $current_size = $self->history_size;
 773         while ($max_size < $current_size) {
 774             my $entry = shift @$history;
 775             $current_size -= $entry->size;
 776         }
 777     }
 778 }
 779
 780 =method add_historical_entry
 781
 782     $entry->add_historical_entry($entry);
 783
 784 Add an entry to the history.
 785
 786 =cut
 787
 788 sub add_historical_entry {
 789     my $self = shift;
 790     delete $_->{history} for @_;
 791     push @{$self->{history} //= []}, map { $self->_wrap_entry($_) } @_;
 792 }
 793
 794 =method current_entry
 795
 796     $current_entry = $entry->current_entry;
 797
 798 Get an entry's current entry. If the entry itself is current (not historical), itself is returned.
 799
 800 =cut
 801
 802 sub current_entry {
 803     my $self    = shift;
 804     my $group   = $self->parent;
 805
 806     if ($group) {
 807         my $id = $self->uuid;
 808         my $entry = first { $id eq $_->uuid } @{$group->entries};
 809         return $entry if $entry;
 810     }
 811
 812     return $self;
 813 }
 814
 815 =method is_current
 816
 817     $bool = $entry->is_current;
 818
 819 Get whether or not an entry is considered current (i.e. not historical). An entry is current if it is directly
 820 in the parent group's entry list.
 821
 822 =cut
 823
 824 sub is_current {
 825     my $self    = shift;
 826     my $current = $self->current_entry;
 827     return Hash::Util::FieldHash::id($self) == Hash::Util::FieldHash::id($current);
 828 }
 829
 830 =method is_historical
 831
 832     $bool = $entry->is_historical;
 833
 834 Get whether or not an entry is considered historical (i.e. not current).
 835
 836 This is just the inverse of L</is_current>.
 837
 838 =cut
 839
 840 sub is_historical { !$_[0]->is_current }
 841
 842 ##############################################################################
 843
 844 sub _signal {
 845     my $self = shift;
 846     my $type = shift;
 847     return $self->SUPER::_signal("entry.$type", @_);
 848 }
 849
 850 sub _commit {
 851     my $self = shift;
 852     my $orig = shift;
 853     $self->add_historical_entry($orig);
 854     my $time = gmtime;
 855     $self->last_modification_time($time);
 856     $self->last_access_time($time);
 857 }
 858
 859 sub label { shift->expanded_title(@_) }
 860
 861 1;
 862 __END__
 863
 864 =head1 DESCRIPTION
 865
 866 An entry in a KDBX database is a record that can contains strings (also called "fields") and binaries (also
 867 called "files" or "attachments"). Every string and binary has a key or name. There is a default set of strings
 868 that every entry has:
 869
 870 =for :list
 871 * B<Title>
 872 * B<UserName>
 873 * B<Password>
 874 * B<URL>
 875 * B<Notes>
 876
 877 Beyond this, you can store any number of other strings and any number of binaries that you can use for
 878 whatever purpose you want.
 879
 880 There is also some metadata associated with an entry. Each entry in a database is identified uniquely by
 881 a UUID. An entry can also have an icon associated with it, and there are various timestamps. Take a look at
 882 the attributes to see what's available.
 883
 884 A B<File::KDBX::Entry> is a subclass of L<File::KDBX::Object>.
 885
 886 =head2 Placeholders
 887
 888 Entry string and auto-type key sequences can have placeholders or template tags that can be replaced by other
 889 values. Placeholders can appear like C<{PLACEHOLDER}>. For example, a B<URL> string might have a value of
 890 C<http://example.com?user={USERNAME}>. C<{USERNAME}> is a placeholder for the value of the B<UserName> string
 891 of the same entry. If the B<UserName> string had a value of "batman", the B<URL> string would expand to
 892 C<http://example.com?user=batman>.
 893
 894 Some placeholders take an argument, where the argument follows the tag after a colon but before the closing
 895 brace, like C<{PLACEHOLDER:ARGUMENT}>.
 896
 897 Placeholders are documented in the L<KeePass Help Center|https://keepass.info/help/base/placeholders.html>.
 898 This software supports many (but not all) of the placeholders documented there.
 899
 900 =head3 Entry Placeholders
 901
 902 =for :list
 903 * ☑ C<{TITLE}> - B<Title> string
 904 * ☑ C<{USERNAME}> - B<UserName> string
 905 * ☑ C<{PASSWORD}> - B<Password> string
 906 * ☑ C<{NOTES}> - B<Notes> string
 907 * ☑ C<{URL}> - B<URL> string
 908 * ☑ C<{URL:SCM}> / C<{URL:SCHEME}>
 909 * ☑ C<{URL:USERINFO}>
 910 * ☑ C<{URL:USERNAME}>
 911 * ☑ C<{URL:PASSWORD}>
 912 * ☑ C<{URL:HOST}>
 913 * ☑ C<{URL:PORT}>
 914 * ☑ C<{URL:PATH}>
 915 * ☑ C<{URL:QUERY}>
 916 * ☑ C<{URL:FRAGMENT}> / C<{URL:HASH}>
 917 * ☑ C<{URL:RMVSCM}> / C<{URL:WITHOUTSCHEME}>
 918 * ☑ C<{S:Name}> - Custom string where C<Name> is the name or key of the string
 919 * ☑ C<{UUID}> - Identifier (32 hexidecimal characters)
 920 * ☑ C<{HMACOTP}> - Generate an HMAC-based one-time password (its counter B<will> be incremented)
 921 * ☑ C<{TIMEOTP}> - Generate a time-based one-time password
 922 * ☑ C<{GROUP_NOTES}> - Notes of the parent group
 923 * ☑ C<{GROUP_PATH}> - Full path of the parent group
 924 * ☑ C<{GROUP}> - Name of the parent group
 925
 926 =head3 Field References
 927
 928 =for :list
 929 * ☑ C<{REF:Wanted@SearchIn:Text}> - See L<File::KDBX/resolve_reference>
 930
 931 =head3 File path Placeholders
 932
 933 =for :list
 934 * ☑ C<{APPDIR}> - Program directory path
 935 * ☑ C<{FIREFOX}> - Path to the Firefox browser executable
 936 * ☑ C<{GOOGLECHROME}> - Path to the Chrome browser executable
 937 * ☑ C<{INTERNETEXPLORER}> - Path to the Firefox browser executable
 938 * ☑ C<{OPERA}> - Path to the Opera browser executable
 939 * ☑ C<{SAFARI}> - Path to the Safari browser executable
 940 * ☒ C<{DB_PATH}> - Full file path of the database
 941 * ☒ C<{DB_DIR}> - Directory path of the database
 942 * ☒ C<{DB_NAME}> - File name (including extension) of the database
 943 * ☒ C<{DB_BASENAME}> - File name (excluding extension) of the database
 944 * ☒ C<{DB_EXT}> - File name extension
 945 * ☑ C<{ENV_DIRSEP}> - Directory separator
 946 * ☑ C<{ENV_PROGRAMFILES_X86}> - One of C<%ProgramFiles(x86)%> or C<%ProgramFiles%>
 947
 948 =head3 Date and Time Placeholders
 949
 950 =for :list
 951 * ☑ C<{DT_SIMPLE}> - Current local date and time as a sortable string
 952 * ☑ C<{DT_YEAR}> - Year component of the current local date
 953 * ☑ C<{DT_MONTH}> - Month component of the current local date
 954 * ☑ C<{DT_DAY}> - Day component of the current local date
 955 * ☑ C<{DT_HOUR}> - Hour component of the current local time
 956 * ☑ C<{DT_MINUTE}> - Minute component of the current local time
 957 * ☑ C<{DT_SECOND}> - Second component of the current local time
 958 * ☑ C<{DT_UTC_SIMPLE}> - Current UTC date and time as a sortable string
 959 * ☑ C<{DT_UTC_YEAR}> - Year component of the current UTC date
 960 * ☑ C<{DT_UTC_MONTH}> - Month component of the current UTC date
 961 * ☑ C<{DT_UTC_DAY}> - Day component of the current UTC date
 962 * ☑ C<{DT_UTC_HOUR}> - Hour component of the current UTC time
 963 * ☑ C<{DT_UTC_MINUTE}> Minute Year component of the current UTC time
 964 * ☑ C<{DT_UTC_SECOND}> - Second component of the current UTC time
 965
 966 If the current date and time is <2012-07-25 17:05:34>, the "simple" form would be C<20120725170534>.
 967
 968 =head3 Special Key Placeholders
 969
 970 Certain placeholders for use in auto-type key sequences are not supported for replacement, but they will
 971 remain as-is so that an auto-type engine (not included) can parse and replace them with the appropriate
 972 virtual key presses. For completeness, here is the list that the KeePass program claims to support:
 973
 974 C<{TAB}>, C<{ENTER}>, C<{UP}>, C<{DOWN}>, C<{LEFT}>, C<{RIGHT}>, C<{HOME}>, C<{END}>, C<{PGUP}>, C<{PGDN}>,
 975 C<{INSERT}>, C<{DELETE}>, C<{SPACE}>
 976
 977 C<{BACKSPACE}>, C<{BREAK}>, C<{CAPSLOCK}>, C<{ESC}>, C<{WIN}>, C<{LWIN}>, C<{RWIN}>, C<{APPS}>, C<{HELP}>,
 978 C<{NUMLOCK}>, C<{PRTSC}>, C<{SCROLLLOCK}>
 979
 980 C<{F1}>, C<{F2}>, C<{F3}>, C<{F4}>, C<{F5}>, C<{F6}>, C<{F7}>, C<{F8}>, C<{F9}>, C<{F10}>, C<{F11}>, C<{F12}>,
 981 C<{F13}>, C<{F14}>, C<{F15}>, C<{F16}>
 982
 983 C<{ADD}>, C<{SUBTRACT}>, C<{MULTIPLY}>, C<{DIVIDE}>, C<{NUMPAD0}>, C<{NUMPAD1}>, C<{NUMPAD2}>, C<{NUMPAD3}>,
 984 C<{NUMPAD4}>, C<{NUMPAD5}>, C<{NUMPAD6}>, C<{NUMPAD7}>, C<{NUMPAD8}>, C<{NUMPAD9}>
 985
 986 =head3 Miscellaneous Placeholders
 987
 988 =for :list
 989 * ☒ C<{BASE}>
 990 * ☒ C<{BASE:SCM}> / C<{BASE:SCHEME}>
 991 * ☒ C<{BASE:USERINFO}>
 992 * ☒ C<{BASE:USERNAME}>
 993 * ☒ C<{BASE:PASSWORD}>
 994 * ☒ C<{BASE:HOST}>
 995 * ☒ C<{BASE:PORT}>
 996 * ☒ C<{BASE:PATH}>
 997 * ☒ C<{BASE:QUERY}>
 998 * ☒ C<{BASE:FRAGMENT}> / C<{BASE:HASH}>
 999 * ☒ C<{BASE:RMVSCM}> / C<{BASE:WITHOUTSCHEME}>
1000 * ☒ C<{CLIPBOARD-SET:/Text/}>
1001 * ☒ C<{CLIPBOARD}>
1002 * ☒ C<{CMD:/CommandLine/Options/}>
1003 * ☑ C<{C:Comment}> - Comments are simply replaced by nothing
1004 * ☑ C<{ENV:}> and C<%ENV%> - Environment variables
1005 * ☒ C<{GROUP_SEL_NOTES}>
1006 * ☒ C<{GROUP_SEL_PATH}>
1007 * ☒ C<{GROUP_SEL}>
1008 * ☒ C<{NEWPASSWORD}>
1009 * ☒ C<{NEWPASSWORD:/Profile/}>
1010 * ☒ C<{PASSWORD_ENC}>
1011 * ☒ C<{PICKCHARS}>
1012 * ☒ C<{PICKCHARS:Field:Options}>
1013 * ☒ C<{PICKFIELD}>
1014 * ☒ C<{T-CONV:/Text/Type/}>
1015 * ☒ C<{T-REPLACE-RX:/Text/Type/Replace/}>
1016
1017 Some of these that remain unimplemented, such as C<{CLIPBOARD}>, cannot be implemented portably. Some of these
1018 I haven't implemented (yet) just because they don't seem very useful. You can create your own placeholder to
1019 augment the list of default supported placeholders or to replace a built-in placeholder handler. To create
1020 a placeholder, just set it in the C<%File::KDBX::PLACEHOLDERS> hash. For example:
1021
1022     $File::KDBX::PLACEHOLDERS{'MY_PLACEHOLDER'} = sub {
1023         my ($entry) = @_;
1024         ...;
1025     };
1026
1027 If the placeholder is expanded in the context of an entry, C<$entry> is the B<File::KDBX::Entry> object in
1028 context. Otherwise it is C<undef>. An entry is in context if, for example, the placeholder is in an entry's
1029 strings or auto-complete key sequences.
1030
1031     $File::KDBX::PLACEHOLDERS{'MY_PLACEHOLDER:'} = sub {
1032         my ($entry, $arg) = @_;         #    ^ Notice the colon here
1033         ...;
1034     };
1035
1036 If the name of the placeholder ends in a colon, then it is expected to receive an argument. During expansion,
1037 everything after the colon and before the end of the placeholder is passed to your placeholder handler
1038 subroutine. So if the placeholder is C<{MY_PLACEHOLDER:whatever}>, C<$arg> will have the value B<whatever>.
1039
1040 An argument is required for placeholders than take one. I.e. The placeholder handler won't be called if there
1041 is no argument. If you want a placeholder to support an optional argument, you'll need to set the placeholder
1042 both with and without a colon (or they could be different subroutines):
1043
1044     $File::KDBX::PLACEHOLDERS{'RAND'} = $File::KDBX::PLACEHOLDERS{'RAND:'} = sub {
1045         (undef, my $arg) = @_;
1046         return defined $arg ? rand($arg) : rand;
1047     };
1048
1049 You can also remove placeholder handlers. If you want to disable placeholder expansion entirely, just delete
1050 all the handlers:
1051
1052     %File::KDBX::PLACEHOLDERS = ();
1053
1054 =head2 One-time Passwords
1055
1056 An entry can be configured to generate one-time passwords, both HOTP (HMAC-based) and TOTP (time-based). The
1057 configuration storage isn't completely standardized, but this module supports two predominant configuration
1058 styles:
1059
1060 =for :list
1061 * L<KeePass 2|https://keepass.info/help/base/placeholders.html#otp>
1062 * KeePassXC
1063
1064 B<NOTE:> To use this feature, you must install the suggested dependency:
1065
1066 =for :list
1067 * L<Pass::OTP>
1068
1069 To configure TOTP in the KeePassXC style, there is only one string to set: C<otp>. The value should be any
1070 valid otpauth URI. When generating an OTP, all of the relevant OTP properties are parsed from the URI.
1071
1072 To configure TOTP in the KeePass 2 style, set the following strings:
1073
1074 =for :list
1075 * C<TimeOtp-Algorithm> - Cryptographic algorithm, one of C<HMAC-SHA-1> (default), C<HMAC-SHA-256> and
1076     C<HMAC-SHA-512>
1077 * C<TimeOtp-Length> - Number of digits each one-time password is (default: 6, maximum: 8)
1078 * C<TimeOtp-Period> - Time-step size in seconds (default: 30)
1079 * C<TimeOtp-Secret> - Text string secret, OR
1080 * C<TimeOtp-Secret-Hex> - Hexidecimal-encoded secret, OR
1081 * C<TimeOtp-Secret-Base32> - Base32-encoded secret (most common), OR
1082 * C<TimeOtp-Secret-Base64> - Base64-encoded secret
1083
1084 To configure HOTP in the KeePass 2 style, set the following strings:
1085
1086 =for :list
1087 * C<HmacOtp-Counter> - Counting value in decimal, starts on C<0> by default and increments when L</hmac_otp>
1088     is called
1089 * C<HmacOtp-Secret> - Text string secret, OR
1090 * C<HmacOtp-Secret-Hex> - Hexidecimal-encoded secret, OR
1091 * C<HmacOtp-Secret-Base32> - Base32-encoded secret (most common), OR
1092 * C<HmacOtp-Secret-Base64> - Base64-encoded secret
1093
1094 B<NOTE:> The multiple "Secret" strings are simply a way to store a secret in different formats. Only one of
1095 these should actually be set or an error will be thrown.
1096
1097 Here's a basic example:
1098
1099     $entry->string(otp => 'otpauth://totp/Issuer:user?secret=NBSWY3DP&issuer=Issuer');
1100     # OR
1101     $entry->string('TimeOtp-Secret-Base32' => 'NBSWY3DP');
1102
1103     my $otp = $entry->time_otp;
1104
1105 =cut