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