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