Dogcows Code - chaz/p5-File-KDBX/blob - lib/File/KDBX/Entry.pm

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