use warnings;
use strict;
-use Crypt::Misc 0.029 qw(encode_b32r decode_b64);
+use Crypt::Misc 0.029 qw(decode_b64 encode_b32r);
use Devel::GlobalDestruction;
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 File::KDBX::Util qw(:class :coercion :function :uri generate_uuid load_optional);
+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;
use namespace::clean;
-use parent 'File::KDBX::Object';
+extends 'File::KDBX::Object';
our $VERSION = '999.999'; # VERSION
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.
=attr usage_count
-The number of times an entry has been used, which typically means how many times the C<Password> string has
+The number of times an entry has been used, which typically means how many times the B<Password> string has
been accessed.
=attr location_changed
=attr notes
-Alias for the C<Notes> string value.
+Alias for the B<Notes> string value.
=attr password
-Alias for the C<Password> string value.
+Alias for the B<Password> string value.
=attr title
-Alias for the C<Title> 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
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};
}
-my @ATTRS = qw(uuid custom_data history);
-my %ATTRS = (
- # uuid => sub { generate_uuid(printable => 1) },
- icon_id => ICON_PASSWORD,
- custom_icon_uuid => undef,
- foreground_color => '',
- background_color => '',
- override_url => '',
- tags => '',
- auto_type => sub { +{} },
- previous_parent_group => undef,
- quality_check => true,
- strings => sub { +{} },
- binaries => sub { +{} },
- # custom_data => sub { +{} },
- # history => sub { +[] },
-);
-my %ATTRS_TIMES = (
- last_modification_time => sub { gmtime },
- creation_time => sub { gmtime },
- last_access_time => sub { gmtime },
- expiry_time => sub { gmtime },
- expires => false,
- usage_count => 0,
- location_changed => sub { gmtime },
-);
+# has uuid => sub { generate_uuid(printable => 1) };
+has icon_id => ICON_PASSWORD, coerce => \&to_icon_constant;
+has custom_icon_uuid => undef, coerce => \&to_uuid;
+has foreground_color => '', coerce => \&to_string;
+has background_color => '', coerce => \&to_string;
+has override_url => '', coerce => \&to_string;
+has tags => '', coerce => \&to_string;
+has auto_type => {};
+has previous_parent_group => undef, coerce => \&to_uuid;
+has quality_check => true, coerce => \&to_bool;
+has strings => {};
+has binaries => {};
+has times => {};
+# has custom_data => {};
+# has history => [];
+
+has last_modification_time => sub { gmtime }, store => 'times', coerce => \&to_time;
+has creation_time => sub { gmtime }, store => 'times', coerce => \&to_time;
+has last_access_time => sub { gmtime }, store => 'times', coerce => \&to_time;
+has expiry_time => sub { gmtime }, store => 'times', coerce => \&to_time;
+has expires => false, store => 'times', coerce => \&to_bool;
+has usage_count => 0, store => 'times', coerce => \&to_number;
+has location_changed => sub { gmtime }, store => 'times', coerce => \&to_time;
+
my %ATTRS_STRINGS = (
title => 'Title',
username => 'UserName',
url => 'URL',
notes => 'Notes',
);
-
-while (my ($attr, $default) = each %ATTRS) {
- no strict 'refs'; ## no critic (ProhibitNoStrict)
- *{$attr} = sub {
- my $self = shift;
- $self->{$attr} = shift if @_;
- $self->{$attr} //= (ref $default eq 'CODE') ? $default->($self) : $default;
- };
-}
-while (my ($attr, $default) = each %ATTRS_TIMES) {
- no strict 'refs'; ## no critic (ProhibitNoStrict)
- *{$attr} = sub {
- my $self = shift;
- $self->{times} //= {};
- $self->{times}{$attr} = shift if @_;
- $self->{times}{$attr} //= (ref $default eq 'CODE') ? $default->($self) : $default;
- };
-}
while (my ($attr, $string_key) = each %ATTRS_STRINGS) {
no strict 'refs'; ## no critic (ProhibitNoStrict)
*{$attr} = sub { shift->string_value($string_key, @_) };
*{"expanded_${attr}"} = sub { shift->expanded_string_value($string_key, @_) };
}
-sub _set_default_attributes {
+my @ATTRS = qw(uuid custom_data history);
+sub _set_nonlazy_attributes {
my $self = shift;
- $self->$_ for @ATTRS, keys %ATTRS, keys %ATTRS_TIMES, keys %ATTRS_STRINGS;
+ $self->$_ for @ATTRS, keys %ATTRS_STRINGS, list_attributes(ref $self);
}
sub init {
return $self;
}
-sub label { shift->title(@_) }
-
##############################################################################
=method string
$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.
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, @_) : @_;
}
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 {
return $binary->{value};
}
+sub auto_type_enabled {
+ my $entry = shift;
+ # TODO
+}
+
##############################################################################
=method hmac_otp
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
$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)
}
}
-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__
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.
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.
* ☑ 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
* ☒ 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}>
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