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