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