X-Git-Url: https://git.dogcows.com/gitweb?a=blobdiff_plain;ds=inline;f=lib%2FFile%2FKDBX.pm;h=d26779a03bf5493e6be3631c837cc25c53a748b3;hb=HEAD;hp=255958afb60f92123b73089d5dfcbce71bbdcf3a;hpb=84a35b3fe4421abbe930586dd3a214cbb15da9b7;p=chaz%2Fp5-File-KDBX diff --git a/lib/File/KDBX.pm b/lib/File/KDBX.pm index 255958a..d26779a 100644 --- a/lib/File/KDBX.pm +++ b/lib/File/KDBX.pm @@ -1,6 +1,7 @@ package File::KDBX; # ABSTRACT: Encrypted database to store secret text and files +use 5.010; use warnings; use strict; @@ -15,7 +16,7 @@ use Hash::Util::FieldHash qw(fieldhashes); use List::Util qw(any first); use Ref::Util qw(is_ref is_arrayref is_plain_hashref); use Scalar::Util qw(blessed); -use Time::Piece; +use Time::Piece 1.33; use boolean; use namespace::clean; @@ -39,9 +40,12 @@ sub new { # copy constructor return $_[0]->clone if @_ == 1 && blessed $_[0] && $_[0]->isa($class); - my $self = bless {}, $class; + my $data; + $data = shift if is_plain_hashref($_[0]); + + my $self = bless $data // {}, $class; $self->init(@_); - $self->_set_nonlazy_attributes if empty $self; + $self->_set_nonlazy_attributes if !$data; return $self; } @@ -237,10 +241,12 @@ has raw => coerce => \&to_string; # HEADERS has 'headers.comment' => '', coerce => \&to_string; -has 'headers.cipher_id' => CIPHER_UUID_CHACHA20, coerce => \&to_uuid; +has 'headers.cipher_id' => sub { $_[0]->version < KDBX_VERSION_4_0 ? CIPHER_UUID_AES256 : CIPHER_UUID_CHACHA20 }, + coerce => \&to_uuid; has 'headers.compression_flags' => COMPRESSION_GZIP, coerce => \&to_compression_constant; has 'headers.master_seed' => sub { random_bytes(32) }, coerce => \&to_string; -has 'headers.encryption_iv' => sub { random_bytes(16) }, coerce => \&to_string; +has 'headers.encryption_iv' => sub { random_bytes($_[0]->version < KDBX_VERSION_4_0 ? 16 : 12) }, + coerce => \&to_string; has 'headers.stream_start_bytes' => sub { random_bytes(32) }, coerce => \&to_string; has 'headers.kdf_parameters' => sub { +{ @@ -341,7 +347,7 @@ might increase this value. For example, setting the KDF to Argon2 will increase least C (i.e. C<0x00040000>) because Argon2 was introduced with KDBX4. This method never returns less than C (i.e. C<0x00030001>). That file version is so -ubiquitious and well-supported, there are seldom reasons to dump in a lesser format nowadays. +ubiquitous and well-supported, there are seldom reasons to dump in a lesser format nowadays. B If you dump a database with a minimum version higher than the current L, the dumper will typically issue a warning and automatically upgrade the database. This seems like the safest behavior in order @@ -636,7 +642,7 @@ sub groups { my %args = @_ % 2 == 0 ? @_ : (base => shift, @_); my $base = delete $args{base} // $self->root; - return $base->groups_deeply(%args); + return $base->all_groups(%args); } ############################################################################## @@ -646,7 +652,7 @@ sub groups { $kdbx->add_entry($entry, %options); $kdbx->add_entry(%entry_attributes, %options); -Add a entry to a database. This is equivalent to identifying a parent group and calling +Add an entry to a database. This is equivalent to identifying a parent group and calling L on the parent group, forwarding the arguments. Available options: =for :list @@ -694,7 +700,7 @@ sub entries { my %args = @_ % 2 == 0 ? @_ : (base => shift, @_); my $base = delete $args{base} // $self->root; - return $base->entries_deeply(%args); + return $base->all_entries(%args); } ############################################################################## @@ -715,7 +721,7 @@ sub objects { my %args = @_ % 2 == 0 ? @_ : (base => shift, @_); my $base = delete $args{base} // $self->root; - return $base->objects_deeply(%args); + return $base->all_objects(%args); } sub __iter__ { $_[0]->objects } @@ -1175,16 +1181,24 @@ sub _remove_safe { delete $SAFE{$_[0]} } sub lock { my $self = shift; - $self->_safe and return $self; - + # Find things to lock: my @strings; - $self->entries(history => 1)->each(sub { - push @strings, grep { $_->{protect} } values %{$_->strings}, values %{$_->binaries}; + my $strings = $_->strings; + for my $string_key (keys %$strings) { + my $string = $strings->{$string_key}; + push @strings, $string if $string->{protect} // $self->memory_protection($string_key); + } + push @strings, grep { $_->{protect} } values %{$_->binaries}; }); + return $self if !@strings; # nothing to do - $self->_safe(File::KDBX::Safe->new(\@strings)); - + if (my $safe = $self->_safe) { + $safe->add(\@strings); + } + else { + $self->_safe(File::KDBX::Safe->new(\@strings)); + } return $self; } @@ -1367,7 +1381,8 @@ Remove just as many older historical entries as necessary to get under certain l limit: -1) * C - Maximum total size (in bytes) of historical entries to keep (default: value of L, no limit: -1) -* C - Maximum age (in days) of historical entries to keep (default: 365, no limit: -1) +* C - Maximum age (in days) of historical entries to keep (default: value of + L, no limit: -1) =cut @@ -1405,13 +1420,15 @@ secure the database when dumped. The attributes that will be randomized are: * L Randomizing these values has no effect on a loaded database. These are only used when a database is dumped. -You normally do not need to call this method explicitly because the dumper does it explicitly by default. +You normally do not need to call this method explicitly because the dumper does it for you by default. =cut sub randomize_seeds { my $self = shift; - $self->encryption_iv(random_bytes(16)); + my $iv_size = 16; + $iv_size = $self->cipher(key => "\0" x 32)->iv_size if KDBX_VERSION_4_0 <= $self->version; + $self->encryption_iv(random_bytes($iv_size)); $self->inner_random_stream_key(random_bytes(64)); $self->master_seed(random_bytes(32)); $self->stream_start_bytes(random_bytes(32)); @@ -1427,8 +1444,8 @@ sub randomize_seeds { $key = $kdbx->key($primitive); Get or set a L. This is the master key (e.g. a password or a key file that can decrypt -a database). You can also pass a primitive that can be cast to a B. See L for an -explanation of what the primitive can be. +a database). You can also pass a primitive castable to a B. See L for an explanation +of what the primitive can be. You generally don't need to call this directly because you can provide the key directly to the loader or dumper when loading or dumping a KDBX file. @@ -1480,7 +1497,6 @@ sub kdf { my %args = @_ % 2 == 1 ? (params => shift, @_) : @_; my $params = $args{params}; - my $compat = $args{compatible} // 1; $params //= $self->kdf_parameters; $params = {%{$params || {}}}; @@ -1506,18 +1522,22 @@ sub kdf { sub transform_seed { my $self = shift; + my $param = KDF_PARAM_AES_SEED; # Short cut: Argon2 uses the same parameter name ("S") $self->headers->{+HEADER_TRANSFORM_SEED} = - $self->headers->{+HEADER_KDF_PARAMETERS}{+KDF_PARAM_AES_SEED} = shift if @_; + $self->headers->{+HEADER_KDF_PARAMETERS}{$param} = shift if @_; $self->headers->{+HEADER_TRANSFORM_SEED} = - $self->headers->{+HEADER_KDF_PARAMETERS}{+KDF_PARAM_AES_SEED} //= random_bytes(32); + $self->headers->{+HEADER_KDF_PARAMETERS}{$param} //= random_bytes(32); } sub transform_rounds { my $self = shift; + require File::KDBX::KDF; + my $info = $File::KDBX::KDF::ROUNDS_INFO{$self->kdf_parameters->{+KDF_PARAM_UUID} // ''} // + $File::KDBX::KDF::DEFAULT_ROUNDS_INFO; $self->headers->{+HEADER_TRANSFORM_ROUNDS} = - $self->headers->{+HEADER_KDF_PARAMETERS}{+KDF_PARAM_AES_ROUNDS} = shift if @_; + $self->headers->{+HEADER_KDF_PARAMETERS}{$info->{p}} = shift if @_; $self->headers->{+HEADER_TRANSFORM_ROUNDS} = - $self->headers->{+HEADER_KDF_PARAMETERS}{+KDF_PARAM_AES_ROUNDS} //= 100_000; + $self->headers->{+HEADER_KDF_PARAMETERS}{$info->{p}} //= $info->{d}; } =method cipher @@ -1542,8 +1562,8 @@ sub cipher { my $self = shift; my %args = @_; - $args{uuid} //= $self->headers->{+HEADER_CIPHER_ID}; - $args{iv} //= $self->headers->{+HEADER_ENCRYPTION_IV}; + $args{uuid} //= $self->cipher_id; + $args{iv} //= $self->encryption_iv; require File::KDBX::Cipher; return File::KDBX::Cipher->new(%args); @@ -1710,13 +1730,13 @@ L. =attr comment -A text string associated with the database. Often unset. +A text string associated with the database stored unencrypted in the file header. Often unset. =attr cipher_id The UUID of a cipher used to encrypt the database when stored as a file. -See L. +See L. =attr compression_flags @@ -1741,7 +1761,7 @@ The transform seed I be changed each time the database is saved to file. =attr transform_rounds The number of rounds or iterations used in the key derivation function. Increasing this number makes loading -and saving the database slower by design in order to make dictionary and brute force attacks more costly. +and saving the database slower in order to make dictionary and brute force attacks more costly. =attr encryption_iv @@ -1821,7 +1841,7 @@ Number of days until the agent should prompt to recommend changing the master ke Number of days until the agent should prompt to force changing the master key. Note: This is purely advisory. It is up to the individual agent software to actually enforce it. -C does NOT enforce it. +B does NOT enforce it. =attr custom_icons @@ -1908,23 +1928,27 @@ __END__ use File::KDBX; + # Create a new database from scratch my $kdbx = File::KDBX->new; + # Add some objects to the database my $group = $kdbx->add_group( name => 'Passwords', ); - my $entry = $group->add_entry( title => 'My Bank', + username => 'mreynolds', password => 's3cr3t', ); - $kdbx->dump_file('passwords.kdbx', 'M@st3rP@ssw0rd!'); + # Save the database to the filesystem + $kdbx->dump_file('passwords.kdbx', 'masterpw changeme'); - $kdbx = File::KDBX->load_file('passwords.kdbx', 'M@st3rP@ssw0rd!'); + # Load the database from the filesystem into a new database instance + my $kdbx2 = File::KDBX->load_file('passwords.kdbx', 'masterpw changeme'); - $kdbx->entries->each(sub { - my ($entry) = @_; + # Iterate over database entries, print entry titles + $kdbx2->entries->each(sub($entry, @) { say 'Entry: ', $entry->title; }); @@ -2006,8 +2030,7 @@ across different websites. See L for an overview of security consider my $kdbx = File::KDBX->load_file('mypasswords.kdbx', 'master password CHANGEME'); $kdbx->unlock; # cause $entry->password below to be defined - $kdbx->entries->each(sub { - my ($entry) = @_; + $kdbx->entries->each(sub($entry, @) { say 'Found password for: ', $entry->title; say ' Username: ', $entry->username; say ' Password: ', $entry->password; @@ -2074,7 +2097,7 @@ The first factor is up to you. This module does not enforce strong master keys. generate strong keys. The KDBX format allows for the key derivation function to be tuned. The idea is that you want each single -brute-foce attempt to be expensive (in terms of time, CPU usage or memory usage), so that making a lot of +brute-force attempt to be expensive (in terms of time, CPU usage or memory usage), so that making a lot of attempts (which would be required if you have a strong master key) gets I expensive. How expensive you want to make each attempt is up to you and can depend on the application. @@ -2209,7 +2232,7 @@ expression. For example, to search for any entry that has been used at least fiv It helps to read it right-to-left, like "usage_count is greater than or equal to 5". -If you find the disambiguating structures to be distracting or confusing, you can also the +If you find the disambiguating structures to be distracting or confusing, you can also use the L function as a more intuitive alternative. The following example is equivalent to the previous: @@ -2258,7 +2281,7 @@ icon: Note: L is just a constant from L. It isn't special to this example or to queries generally. We could have just used a literal number. -The important thing to notice here is how we wrapped the condition in another arrayref with a single key-value +The important thing to notice here is how we wrapped the condition in another hashref with a single key-value pair where the key is the name of an operator and the value is the thing to match against. The supported operators are: @@ -2380,7 +2403,7 @@ your own query logic, like this: Iterators are the built-in way to navigate or walk the database tree. You get an iterator from L, L and L. You can specify the search algorithm to iterate over objects in different orders -using the C option, which can be one of these L: +using the C option, which can be one of these L: =for :list * C - Iterative deepening search (default) @@ -2419,12 +2442,12 @@ B - This is a planned feature, not yet implemented. =head1 ERRORS Errors in this package are constructed as L objects and propagated using perl's built-in -mechanisms. Fatal errors are propagated using L and non-fatal errors (a.k.a. warnings) are -propagated using L while adhering to perl's L system. If you're already familiar -with these mechanisms, you can skip this section. +mechanisms. Fatal errors are propagated using L and non-fatal errors (a.k.a. warnings) +are propagated using L while adhering to perl's L system. If you're already +familiar with these mechanisms, you can skip this section. -You can catch fatal errors using L (or something like L) and non-fatal errors using -C<$SIG{__WARN__}> (see L). Examples: +You can catch fatal errors using L (or something like L) and non-fatal +errors using C<$SIG{__WARN__}> (see L). Examples: use File::KDBX::Error qw(error); @@ -2485,13 +2508,6 @@ This software will alter its behavior depending on the value of certain environm * C - Do not use L if true (default: false) * C - Do not fork if true (default: false) -=head1 CAVEATS - -Some features (e.g. parsing) require 64-bit perl. It should be possible and actually pretty easy to make it -work using L, but I need to build a 32-bit perl in order to test it and frankly I'm still -figuring out how. I'm sure it's simple so I'll mark this one "TODO", but for now an exception will be thrown -when trying to use such features with undersized IVs. - =head1 SEE ALSO =for :list