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