X-Git-Url: https://git.dogcows.com/gitweb?a=blobdiff_plain;f=lib%2FFile%2FKDBX%2FEntry.pm;h=bc81d5ac87948c2f0aa8db79949e60c7b05c7e2f;hb=05e0bcef1c2165c556b910314312866dc4a667b7;hp=c3ddcb95ead4d4fb03c623e60feef3f6900c4524;hpb=f63182fc62b25269b1c38588dca2b3535ed1a1a2;p=chaz%2Fp5-File-KDBX diff --git a/lib/File/KDBX/Entry.pm b/lib/File/KDBX/Entry.pm index c3ddcb9..bc81d5a 100644 --- a/lib/File/KDBX/Entry.pm +++ b/lib/File/KDBX/Entry.pm @@ -10,9 +10,10 @@ use Encode qw(encode); use File::KDBX::Constants qw(:history :icon); use File::KDBX::Error; use File::KDBX::Util qw(:function :uri generate_uuid load_optional); -use List::Util qw(sum0); -use Ref::Util qw(is_plain_hashref is_ref); -use Scalar::Util qw(looks_like_number refaddr); +use Hash::Util::FieldHash; +use List::Util qw(first sum0); +use Ref::Util qw(is_coderef is_plain_hashref); +use Scalar::Util qw(looks_like_number); use Storable qw(dclone); use Time::Piece; use boolean; @@ -26,6 +27,8 @@ my $PLACEHOLDER_MAX_DEPTH = 10; my %PLACEHOLDERS; my %STANDARD_STRINGS = map { $_ => 1 } qw(Title UserName Password URL Notes); +sub _parent_container { 'entries' } + =attr uuid 128-bit UUID identifying the entry within the database. @@ -129,7 +132,7 @@ Boolean value indicating whether or not an entry is expired. =attr usage_count -The number of times an entry has been used, which typically means how many times the C string has +The number of times an entry has been used, which typically means how many times the B string has been accessed. =attr location_changed @@ -138,23 +141,23 @@ Date and time when the entry was last moved to a different group. =attr notes -Alias for the C string value. +Alias for the B string value. =attr password -Alias for the C string value. +Alias for the B string value. =attr title -Alias for the C string value. +Alias for the B<Title> string value. =attr url -Alias for the C<URL> string value. +Alias for the B<URL> string value. =attr username -Aliases for the C<UserName> string value. +Aliases for the B<UserName> string value. =cut @@ -167,9 +170,7 @@ sub uuid { for my $entry (@{$self->history}) { $entry->{uuid} = $uuid; } - # if (defined $old_uuid and my $kdbx = $KDBX{refaddr($self)}) { - # $kdbx->_update_entry_uuid($old_uuid, $uuid, $self); - # } + $self->_signal('uuid.changed', $uuid, $old_uuid) if defined $old_uuid && $self->is_current; } $self->{uuid}; } @@ -177,7 +178,7 @@ sub uuid { my @ATTRS = qw(uuid custom_data history); my %ATTRS = ( # uuid => sub { generate_uuid(printable => 1) }, - icon_id => ICON_PASSWORD, + icon_id => sub { defined $_[1] ? icon($_[1]) : ICON_PASSWORD }, custom_icon_uuid => undef, foreground_color => '', background_color => '', @@ -192,13 +193,13 @@ my %ATTRS = ( # history => sub { +[] }, ); my %ATTRS_TIMES = ( - last_modification_time => sub { gmtime }, - creation_time => sub { gmtime }, - last_access_time => sub { gmtime }, - expiry_time => sub { gmtime }, + last_modification_time => sub { scalar gmtime }, + creation_time => sub { scalar gmtime }, + last_access_time => sub { scalar gmtime }, + expiry_time => sub { scalar gmtime }, expires => false, usage_count => 0, - location_changed => sub { gmtime }, + location_changed => sub { scalar gmtime }, ); my %ATTRS_STRINGS = ( title => 'Title', @@ -208,12 +209,16 @@ my %ATTRS_STRINGS = ( notes => 'Notes', ); -while (my ($attr, $default) = each %ATTRS) { +while (my ($attr, $setter) = each %ATTRS) { no strict 'refs'; ## no critic (ProhibitNoStrict) - *{$attr} = sub { + *{$attr} = is_coderef $setter ? sub { + my $self = shift; + $self->{$attr} = $setter->($self, shift) if @_; + $self->{$attr} //= $setter->($self); + } : sub { my $self = shift; $self->{$attr} = shift if @_; - $self->{$attr} //= (ref $default eq 'CODE') ? $default->($self) : $default; + $self->{$attr} //= $setter; }; } while (my ($attr, $default) = each %ATTRS_TIMES) { @@ -252,8 +257,6 @@ sub init { return $self; } -sub label { shift->title(@_) } - ############################################################################## =method string @@ -269,10 +272,11 @@ structure. For example: $string = { value => 'Password', - protect => true, + protect => true, # optional }; -Every string should have a value and these optional flags which might exist: +Every string should have a value (but might be C<undef> due to memory protection) and these optional flags +which might exist: =for :list * C<protect> - Whether or not the string value should be memory-protected. @@ -281,10 +285,6 @@ Every string should have a value and these optional flags which might exist: sub string { my $self = shift; - # use Data::Dumper; - # $self->{strings} = shift if @_ == 1 && is_plain_hashref($_[0]); - # return $self->{strings} //= {} if !@_; - my %args = @_ == 2 ? (key => shift, value => shift) : @_ % 2 == 1 ? (key => shift, @_) : @_; @@ -366,7 +366,7 @@ sub _expand_placeholder { } return if !defined $File::KDBX::PLACEHOLDERS{$placeholder_key}; - my $local_key = join('/', refaddr($self), $placeholder_key); + my $local_key = join('/', Hash::Util::FieldHash::id($self), $placeholder_key); local $PLACEHOLDERS{$local_key} = my $handler = $PLACEHOLDERS{$local_key} // do { my $handler = $File::KDBX::PLACEHOLDERS{$placeholder_key} or next; memoize recurse_limit($handler, $PLACEHOLDER_MAX_DEPTH, sub { @@ -461,6 +461,11 @@ sub binary_value { return $binary->{value}; } +sub auto_type_enabled { + my $entry = shift; + # TODO +} + ############################################################################## =method hmac_otp @@ -738,7 +743,10 @@ sub size { sub history { my $self = shift; - return [map { __PACKAGE__->wrap($_, $self->kdbx) } @{$self->{history} || []}]; + my $entries = $self->{history} //= []; + # FIXME - Looping through entries on each access is too expensive. + @$entries = map { $self->_wrap_entry($_, $self->kdbx) } @$entries; + return $entries; } =method history_size @@ -759,7 +767,7 @@ sub history_size { $entry->prune_history(%options); Remove as many older historical entries as necessary to get under the database limits. The limits are taken -from the database or can be specified with C<%options>: +from the associated database (if any) or can be overridden with C<%options>: =for :list * C<max_items> - Maximum number of historical entries to keep (default: 10, no limit: -1) @@ -792,28 +800,86 @@ sub prune_history { } } -sub add_history { +=method add_historical_entry + + $entry->add_historical_entry($entry); + +Add an entry to the history. + +=cut + +sub add_historical_entry { my $self = shift; delete $_->{history} for @_; - push @{$self->{history} //= []}, @_; + push @{$self->{history} //= []}, map { $self->_wrap_entry($_) } @_; +} + +=method current_entry + + $current_entry = $entry->current_entry; + +Get an entry's current entry. If the entry itself is current (not historical), itself is returned. + +=cut + +sub current_entry { + my $self = shift; + my $group = $self->parent; + + if ($group) { + my $id = $self->uuid; + my $entry = first { $id eq $_->uuid } @{$group->entries}; + return $entry if $entry; + } + + return $self; +} + +=method is_current + + $bool = $entry->is_current; + +Get whether or not an entry is considered current (i.e. not historical). An entry is current if it is directly +in the parent group's entry list. + +=cut + +sub is_current { + my $self = shift; + my $current = $self->current_entry; + return Hash::Util::FieldHash::id($self) == Hash::Util::FieldHash::id($current); } +=method is_historical + + $bool = $entry->is_historical; + +Get whether or not an entry is considered historical (i.e. not current). + +This is just the inverse of L</is_current>. + +=cut + +sub is_historical { !$_[0]->is_current } + ############################################################################## -sub begin_work { +sub _signal { my $self = shift; - require File::KDBX::Transaction; - return File::KDBX::Transaction->new($self, @_); + my $type = shift; + return $self->SUPER::_signal("entry.$type", @_); } sub _commit { my $self = shift; - my $txn = shift; - $self->add_history($txn->original); - $self->last_modification_time(gmtime); + my $orig = shift; + $self->add_historical_entry($orig); + my $time = gmtime; + $self->last_modification_time($time); + $self->last_access_time($time); } -sub TO_JSON { +{%{$_[0]}} } +sub label { shift->expanded_title(@_) } 1; __END__ @@ -825,11 +891,11 @@ called "files" or "attachments"). Every string and binary has a key or name. The that every entry has: =for :list -* C<Title> -* C<UserName> -* C<Password> -* C<URL> -* C<Notes> +* B<Title> +* B<UserName> +* B<Password> +* B<URL> +* B<Notes> Beyond this, you can store any number of other strings and any number of binaries that you can use for whatever purpose you want. @@ -838,16 +904,18 @@ There is also some metadata associated with an entry. Each entry in a database i a UUID. An entry can also have an icon associated with it, and there are various timestamps. Take a look at the attributes to see what's available. +A B<File::KDBX::Entry> is a subclass of L<File::KDBX::Object>. + =head2 Placeholders -Entry strings and auto-type key sequences can have placeholders or template tags that can be replaced by other +Entry string and auto-type key sequences can have placeholders or template tags that can be replaced by other values. Placeholders can appear like C<{PLACEHOLDER}>. For example, a B<URL> string might have a value of C<http://example.com?user={USERNAME}>. C<{USERNAME}> is a placeholder for the value of the B<UserName> string -of the same entry. If the C<UserName> string had a value of "batman", the B<URL> string would expand to +of the same entry. If the B<UserName> string had a value of "batman", the B<URL> string would expand to C<http://example.com?user=batman>. -Some placeholders take an argument, where the argument follows the tag after a colon. The syntax for this is -C<{PLACEHOLDER:ARGUMENT}>. +Some placeholders take an argument, where the argument follows the tag after a colon but before the closing +brace, like C<{PLACEHOLDER:ARGUMENT}>. Placeholders are documented in the L<KeePass Help Center|https://keepass.info/help/base/placeholders.html>. This software supports many (but not all) of the placeholders documented there. @@ -872,7 +940,7 @@ This software supports many (but not all) of the placeholders documented there. * ☑ C<{URL:RMVSCM}> / C<{URL:WITHOUTSCHEME}> * ☑ C<{S:Name}> - Custom string where C<Name> is the name or key of the string * ☑ C<{UUID}> - Identifier (32 hexidecimal characters) -* ☑ C<{HMACOTP}> - Generate an HMAC-based one-time password +* ☑ C<{HMACOTP}> - Generate an HMAC-based one-time password (its counter B<will> be incremented) * ☑ C<{TIMEOTP}> - Generate a time-based one-time password * ☑ C<{GROUP_NOTES}> - Notes of the parent group * ☑ C<{GROUP_PATH}> - Full path of the parent group @@ -956,7 +1024,7 @@ C<{NUMPAD4}>, C<{NUMPAD5}>, C<{NUMPAD6}>, C<{NUMPAD7}>, C<{NUMPAD8}>, C<{NUMPAD9 * ☒ C<{CLIPBOARD}> * ☒ C<{CMD:/CommandLine/Options/}> * ☑ C<{C:Comment}> - Comments are simply replaced by nothing -* ☑ C<{ENV:} and C<%ENV%> - Environment variables +* ☑ C<{ENV:}> and C<%ENV%> - Environment variables * ☒ C<{GROUP_SEL_NOTES}> * ☒ C<{GROUP_SEL_PATH}> * ☒ C<{GROUP_SEL}> @@ -990,7 +1058,7 @@ strings or auto-complete key sequences. If the name of the placeholder ends in a colon, then it is expected to receive an argument. During expansion, everything after the colon and before the end of the placeholder is passed to your placeholder handler -subroutine. So if the placeholder is C<{MY_PLACEHOLDER:whatever}>, C<$arg> will have the value C<whatever>. +subroutine. So if the placeholder is C<{MY_PLACEHOLDER:whatever}>, C<$arg> will have the value B<whatever>. An argument is required for placeholders than take one. I.e. The placeholder handler won't be called if there is no argument. If you want a placeholder to support an optional argument, you'll need to set the placeholder