X-Git-Url: https://git.dogcows.com/gitweb?a=blobdiff_plain;f=lib%2FFile%2FKDBX%2FEntry.pm;h=4e5d7a4e44479c68f519204e95c95cc6cbbbcee6;hb=ed23544f026c074e2aeed0028cacee6409b48c77;hp=0ad08a0c898c69010db4b98bafcf749357af3c89;hpb=4dc2a1996dfcf2dfda3c554daa2f5f59fa763494;p=chaz%2Fp5-File-KDBX

diff --git a/lib/File/KDBX/Entry.pm b/lib/File/KDBX/Entry.pm
index 0ad08a0..4e5d7a4 100644
--- a/lib/File/KDBX/Entry.pm
+++ b/lib/File/KDBX/Entry.pm
@@ -9,10 +9,10 @@ use Devel::GlobalDestruction;
 use Encode qw(encode);
 use File::KDBX::Constants qw(:history :icon);
 use File::KDBX::Error;
-use File::KDBX::Util qw(:class :coercion :function :uri generate_uuid load_optional);
+use File::KDBX::Util qw(:class :coercion :erase :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 Ref::Util qw(is_coderef is_hashref is_plain_hashref);
 use Scalar::Util qw(looks_like_number);
 use Storable qw(dclone);
 use Time::Piece;
@@ -73,6 +73,22 @@ Auto-type details.
         ],
     }
 
+=attr auto_type_enabled
+
+Whether or not the entry is eligible to be matched for auto-typing.
+
+=attr auto_type_data_transfer_obfuscation
+
+TODO
+
+=attr auto_type_default_sequence
+
+The default auto-type keystroke sequence.
+
+=attr auto_type_associations
+
+An array of window title / keystroke sequence associations.
+
 =attr previous_parent_group
 
 128-bit UUID identifying a group within the database.
@@ -199,6 +215,13 @@ has expires                 => false,          store => 'times', coerce => \&to_
 has usage_count             => 0,              store => 'times', coerce => \&to_number;
 has location_changed        => sub { gmtime }, store => 'times', coerce => \&to_time;
 
+# has 'auto_type.auto_type_enabled'                   => true, coerce => \&to_bool;
+has 'auto_type_data_transfer_obfuscation' => 0, path => 'auto_type.data_transfer_obfuscation',
+    coerce => \&to_number;
+has 'auto_type_default_sequence'          => '{USERNAME}{TAB}{PASSWORD}{ENTER}',
+    path => 'auto_type.default_sequence', coerce => \&to_string;
+has 'auto_type_associations'              => [], path => 'auto_type.associations';
+
 my %ATTRS_STRINGS = (
     title                   => 'Title',
     username                => 'UserName',
@@ -212,7 +235,7 @@ while (my ($attr, $string_key) = each %ATTRS_STRINGS) {
     *{"expanded_${attr}"} = sub { shift->expanded_string_value($string_key, @_) };
 }
 
-my @ATTRS = qw(uuid custom_data history);
+my @ATTRS = qw(uuid custom_data history auto_type_enabled);
 sub _set_nonlazy_attributes {
     my $self = shift;
     $self->$_ for @ATTRS, keys %ATTRS_STRINGS, list_attributes(ref $self);
@@ -303,9 +326,15 @@ sub _protect {
 
 =method string_value
 
-    $string = $entry->string_value;
+    $string = $entry->string_value($string_key);
+
+Access a string value directly. The arguments are the same as for L</string>. Returns C<undef> if the string
+is not set or is currently memory-protected. This is just a shortcut for:
 
-Access a string value directly. Returns C<undef> if the string is not set.
+    my $string = do {
+        my $s = $entry->string(...);
+        defined $s ? $s->{value} : undef;
+    };
 
 =cut
 
@@ -324,8 +353,8 @@ do not expand to values are left as-is.
 
 See L</Placeholders>.
 
-Some placeholders (notably field references) require the entry be associated with a database and will throw an
-error if there is no association.
+Some placeholders (notably field references) require the entry be connected to a database and will throw an
+error if it is not.
 
 =cut
 
@@ -374,7 +403,8 @@ sub _expand_string {
 
 sub expanded_string_value {
     my $self = shift;
-    my $str  = $self->string_value(@_) // return undef;
+    my $str  = $self->string_peek(@_) // return undef;
+    my $cleanup = erase_scoped $str;
     return $self->_expand_string($str);
 }
 
@@ -396,51 +426,131 @@ sub other_strings {
     return join($delim, @strings);
 }
 
+=method string_peek
+
+    $string = $entry->string_peek($string_key);
+
+Same as L</string_value> but can also retrieve the value from protected-memory if the value is currently
+protected.
+
+=cut
+
 sub string_peek {
     my $self = shift;
     my $string = $self->string(@_);
     return defined $string->{value} ? $string->{value} : $self->kdbx->peek($string);
 }
 
-sub password_peek { $_[0]->string_peek('Password') }
+##############################################################################
+
+sub add_auto_type_association {
+    my $self        = shift;
+    my $association = shift;
+    push @{$self->auto_type_associations}, $association;
+}
+
+sub expand_keystroke_sequence {
+    my $self = shift;
+    my $association = shift;
+
+    my $keys = is_hashref($association) && exists $association->{keystroke_sequence} ?
+        $association->{keystroke_sequence} : defined $association ? $association : '';
+
+    $keys = $self->auto_type_default_sequence if !$keys;
+    # TODO - Fall back to getting default sequence from parent group, which probably means we shouldn't be
+    # setting a default value in the entry..
+
+    return $self->_expand_string($keys);
+}
 
 ##############################################################################
 
+=method binary
+
+    \%binary = $entry->binary($binary_key);
+
+    $entry->binary($binary_key, \%binary);
+    $entry->binary($binary_key, %attributes);
+    $entry->binary($binary_key, $value); # same as: value => $value
+
+Get or set a binary. Every binary has a unique (to the entry) key and flags and so are returned as a hash
+structure. For example:
+
+    $binary = {
+        value   => 'Password',
+        protect => true,    # optional
+    };
+
+Every binary 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 binary value should be memory-protected.
+
+=cut
+
 sub binary {
     my $self = shift;
-    my $key  = shift or throw 'Must provide a binary key to access';
-    if (@_) {
-        my $arg = @_ == 1 ? shift : undef;
-        my %args;
-        @args{keys %$arg} = values %$arg if ref $arg eq 'HASH';
-        $args{value} = $arg if !ref $arg;
-        while (my ($field, $value) = each %args) {
-            $self->{binaries}{$key}{$field} = $value;
+    my %args = @_     == 2 ? (key => shift, value => shift)
+             : @_ % 2 == 1 ? (key => shift, @_) : @_;
+
+    if (!defined $args{key} && !defined $args{value}) {
+        my %standard = (value => 1, protect => 1);
+        my @other_keys = grep { !$standard{$_} } keys %args;
+        if (@other_keys == 1) {
+            my $key = $args{key} = $other_keys[0];
+            $args{value} = delete $args{$key};
         }
     }
-    my $binary = $self->{binaries}{$key} //= {value => ''};
-    if (defined (my $ref = $binary->{ref})) {
-        $binary = $self->{binaries}{$key} = dclone($self->kdbx->binaries->{$ref});
+
+    my $key = delete $args{key} or throw 'Must provide a binary key to access';
+
+    return $self->{binaries}{$key} = $args{value} if is_plain_hashref($args{value});
+
+    while (my ($field, $value) = each %args) {
+        $self->{binaries}{$key}{$field} = $value;
     }
-    return $binary;
+    return $self->{binaries}{$key};
 }
 
-sub binary_novivify {
-    my $self = shift;
-    my $binary_key = shift;
-    return if !$self->{binaries}{$binary_key} && !@_;
-    return $self->binary($binary_key, @_);
-}
+=method binary_value
+
+    $binary = $entry->binary_value($binary_key);
+
+Access a binary value directly. The arguments are the same as for L</binary>. Returns C<undef> if the binary
+is not set or is currently memory-protected. This is just a shortcut for:
+
+    my $binary = do {
+        my $b = $entry->binary(...);
+        defined $b ? $b->{value} : undef;
+    };
+
+=cut
 
 sub binary_value {
     my $self = shift;
-    my $binary = $self->binary_novivify(@_) // return undef;
+    my $binary = $self->binary(@_) // return undef;
     return $binary->{value};
 }
 
+##############################################################################
+
+sub searching_enabled {
+    my $self = shift;
+    my $parent = $self->group;
+    return $parent->effective_enable_searching if $parent;
+    return true;
+}
+
 sub auto_type_enabled {
-    my $entry = shift;
-    # TODO
+    my $self = shift;
+    $self->auto_type->{enabled} = to_bool(shift) if @_;
+    $self->auto_type->{enabled} //= true;
+    return false if !$self->auto_type->{enabled};
+    return true if !$self->is_connected;
+    my $parent = $self->group;
+    return $parent->effective_enable_auto_type if $parent;
+    return true;
 }
 
 ##############################################################################
@@ -744,7 +854,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 associated database (if any) or can be overridden with C<%options>:
+from the connected 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)
@@ -801,7 +911,7 @@ Get an entry's current entry. If the entry itself is current (not historical), i
 
 sub current_entry {
     my $self    = shift;
-    my $group   = $self->parent;
+    my $group   = $self->group;
 
     if ($group) {
         my $id = $self->uuid;