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