From 796fdad82448b51f9c990ca461df647341a84b7e Mon Sep 17 00:00:00 2001 From: Charles McGarvey Date: Mon, 2 May 2022 01:06:36 -0600 Subject: [PATCH] Don't open already-open files on Windows --- Changes | 8 ++-- lib/File/KDBX.pm | 14 +++--- lib/File/KDBX/Dumper.pm | 97 ++++++++++++++++++++++++++++----------- lib/File/KDBX/Key/File.pm | 21 ++++++--- lib/File/KDBX/Loader.pm | 34 ++++++++++---- lib/File/KDBX/Util.pm | 4 +- t/database.t | 21 +++++++++ t/hash-block.t | 6 +-- t/hmac-block.t | 6 +-- t/keys.t | 6 +-- 10 files changed, 154 insertions(+), 63 deletions(-) diff --git a/Changes b/Changes index 1f54ece..0debc4f 100644 --- a/Changes +++ b/Changes @@ -2,8 +2,10 @@ Revision history for File-KDBX. {{$NEXT}} - * Fix a bug where peeking at memory-protected strings and binaries does not - work without unlocking the database at least once. + * Fixed a bug where peeking at memory-protected strings and binaries does + not work without unlocking the database at least once. + * Added an option for writing files non-atomically. + * Fixed broken tests on Windows. 0.900 2022-05-01 12:55:59-0600 @@ -12,7 +14,7 @@ Revision history for File-KDBX. * Now use the database maintenance_history_days value as the default "max_age" value in prune_history method. * Fixed distribution prereq issues. - * Clean up a lot of pod typos and other inaccuracies. + * Cleaned up a lot of pod typos and other inaccuracies. 0.800 2022-04-30 21:14:30-0600 diff --git a/lib/File/KDBX.pm b/lib/File/KDBX.pm index 255958a..4768eef 100644 --- a/lib/File/KDBX.pm +++ b/lib/File/KDBX.pm @@ -1427,8 +1427,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. @@ -2419,12 +2419,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); diff --git a/lib/File/KDBX/Dumper.pm b/lib/File/KDBX/Dumper.pm index 6f8d8bb..39d4782 100644 --- a/lib/File/KDBX/Dumper.pm +++ b/lib/File/KDBX/Dumper.pm @@ -105,13 +105,23 @@ sub reset { =method dump - $dumper->dump(\$string, $key); - $dumper->dump(*IO, $key); - $dumper->dump($filepath, $key); + $dumper->dump(\$string, %options); + $dumper->dump(\$string, $key, %options); + $dumper->dump(*IO, %options); + $dumper->dump(*IO, $key, %options); + $dumper->dump($filepath, %options); + $dumper->dump($filepath, $key, %options); Dump a KDBX file. -The C<$key> is either a L or a primitive that can be cast to a Key object. +The C<$key> is either a L or a primitive castable to a Key object. Available options: + +=for :list +* C - Database to dump (default: value of L) +* C - Alternative way to specify C<$key> (default: value of L) + +Other options are supported depending on the first argument. See L, L and +L. =cut @@ -126,10 +136,16 @@ sub dump { =method dump_string - $dumper->dump_string(\$string, $key); - \$string = $dumper->dump_string($key); + $dumper->dump_string(\$string, %options); + $dumper->dump_string(\$string, $key, %options); + \$string = $dumper->dump_string(%options); + \$string = $dumper->dump_string($key, %options); + +Dump a KDBX file to a string / memory buffer. Available options: -Dump a KDBX file to a string / memory buffer. +=for :list +* C - Database to dump (default: value of L) +* C - Alternative way to specify C<$key> (default: value of L) =cut @@ -156,9 +172,18 @@ sub dump_string { =method dump_file - $dumper->dump_file($filepath, $key); + $dumper->dump_file($filepath, %options); + $dumper->dump_file($filepath, $key, %options); + +Dump a KDBX file to a filesystem. Available options: -Dump a KDBX file to a filesystem. +=for :list +* C - Database to dump (default: value of L) +* C - Alternative way to specify C<$key> (default: value of L) +* C - File mode / permissions (see L +* C - User ID (see L) +* C - Group ID (see L) +* C - Write to the filepath atomically (default: true) =cut @@ -167,16 +192,27 @@ sub dump_file { my $filepath = shift; my %args = @_ % 2 == 0 ? @_ : (key => shift, @_); - my $key = delete $args{key}; + my $key = delete $args{key}; + my $mode = delete $args{mode}; + my $uid = delete $args{uid}; + my $gid = delete $args{gid}; + my $atomic = delete $args{atomic} // 1; + $args{kdbx} //= $self->kdbx; - require File::Temp; - my ($fh, $filepath_temp) = eval { File::Temp::tempfile("${filepath}-XXXXXX", CLEANUP => 1) }; - if (!$fh or my $err = $@) { - $err //= 'Unknown error'; - throw sprintf('Open file failed (%s): %s', $filepath_temp, $err), - error => $err, - filepath => $filepath_temp; + my ($fh, $filepath_temp); + if ($atomic) { + require File::Temp; + ($fh, $filepath_temp) = eval { File::Temp::tempfile("${filepath}-XXXXXX", UNLINK => 1) }; + if (!$fh or my $err = $@) { + $err //= 'Unknown error'; + throw sprintf('Open file failed (%s): %s', $filepath_temp, $err), + error => $err, + filepath => $filepath_temp; + } + } + else { + open($fh, '>:raw', $filepath) or throw "Open file failed ($filepath): $!", filepath => $filepath; } $fh->autoflush(1); @@ -187,22 +223,31 @@ sub dump_file { my ($file_mode, $file_uid, $file_gid) = (stat($filepath))[2, 4, 5]; - my $mode = $args{mode} // $file_mode // do { my $m = umask; defined $m ? oct(666) &~ $m : undef }; - my $uid = $args{uid} // $file_uid // -1; - my $gid = $args{gid} // $file_gid // -1; - chmod($mode, $filepath_temp) if defined $mode; - chown($uid, $gid, $filepath_temp); - rename($filepath_temp, $filepath) or throw "Failed to write file ($filepath): $!", filepath => $filepath; + if ($filepath_temp) { + $mode //= $file_mode // do { my $m = umask; defined $m ? oct(666) &~ $m : undef }; + $uid //= $file_uid // -1; + $gid //= $file_gid // -1; + chmod($mode, $filepath_temp) if defined $mode; + chown($uid, $gid, $filepath_temp); + rename($filepath_temp, $filepath) or throw "Failed to write file ($filepath): $!", + filepath => $filepath; + } return $self; } =method dump_handle - $dumper->dump_handle($fh, $key); - $dumper->dump_handle(*IO, $key); + $dumper->dump_handle($fh, %options); + $dumper->dump_handle(*IO, $key, %options); + $dumper->dump_handle($fh, %options); + $dumper->dump_handle(*IO, $key, %options); + +Dump a KDBX file to an output stream / file handle. Available options: -Dump a KDBX file to an output stream / file handle. +=for :list +* C - Database to dump (default: value of L) +* C - Alternative way to specify C<$key> (default: value of L) =cut diff --git a/lib/File/KDBX/Key/File.pm b/lib/File/KDBX/Key/File.pm index 335b31e..0b6093f 100644 --- a/lib/File/KDBX/Key/File.pm +++ b/lib/File/KDBX/Key/File.pm @@ -140,6 +140,7 @@ Write a key file. Available options: * C - Where to save the file (default: value of L) * C - IO handle to write to (overrides C, one of which must be defined) * C - Raw key (default: value of L) +* C - Write to the filepath atomically (default: true) =cut @@ -156,18 +157,24 @@ sub save { my $version = $args{version} // $self->version // 2; my $filepath = $args{filepath} // $self->filepath; my $fh = $args{fh}; + my $atomic = $args{atomic} // 1; my $filepath_temp; if (!openhandle($fh)) { $filepath or throw 'Must specify where to safe the key file to'; - require File::Temp; - ($fh, $filepath_temp) = eval { File::Temp::tempfile("${filepath}-XXXXXX", CLEANUP => 1) }; - if (!$fh or my $err = $@) { - $err //= 'Unknown error'; - throw sprintf('Open file failed (%s): %s', $filepath_temp, $err), - error => $err, - filepath => $filepath_temp; + if ($atomic) { + require File::Temp; + ($fh, $filepath_temp) = eval { File::Temp::tempfile("${filepath}-XXXXXX", UNLINK => 1) }; + if (!$fh or my $err = $@) { + $err //= 'Unknown error'; + throw sprintf('Open file failed (%s): %s', $filepath_temp, $err), + error => $err, + filepath => $filepath_temp; + } + } + else { + open($fh, '>:raw', $filepath) or throw "Open file failed ($filepath): $!", filepath => $filepath; } } diff --git a/lib/File/KDBX/Loader.pm b/lib/File/KDBX/Loader.pm index 628fe98..3a3c184 100644 --- a/lib/File/KDBX/Loader.pm +++ b/lib/File/KDBX/Loader.pm @@ -98,14 +98,18 @@ sub reset { =method load + $kdbx = File::KDBX::Loader->load(\$string, %options); $kdbx = File::KDBX::Loader->load(\$string, $key); + $kdbx = File::KDBX::Loader->load(*IO, %options); $kdbx = File::KDBX::Loader->load(*IO, $key); + $kdbx = File::KDBX::Loader->load($filepath, %options); $kdbx = File::KDBX::Loader->load($filepath, $key); - $kdbx = $loader->load(...); # also instance method -Load a KDBX file. +Load a KDBX file. This works as an instance or a class method. The C<$key> is either +a L or a primitive castable to a Key object. Available options: -The C<$key> is either a L or a primitive that can be cast to a Key object. +=for :list +* C - Alternative way to specify C<$key> =cut @@ -120,11 +124,15 @@ sub load { =method load_string + $kdbx = File::KDBX::Loader->load_string($string, %options); $kdbx = File::KDBX::Loader->load_string($string, $key); + $kdbx = File::KDBX::Loader->load_string(\$string, %options); $kdbx = File::KDBX::Loader->load_string(\$string, $key); - $kdbx = $loader->load_string(...); # also instance method -Load a KDBX file from a string / memory buffer. +Load a KDBX file from a string / memory buffer. This works as an instance or class method. Available options: + +=for :list +* C - Alternative way to specify C<$key> =cut @@ -147,10 +155,13 @@ sub load_string { =method load_file + $kdbx = File::KDBX::Loader->load_file($filepath, %options); $kdbx = File::KDBX::Loader->load_file($filepath, $key); - $kdbx = $loader->load_file(...); # also instance method -Read a KDBX file from a filesystem. +Read a KDBX file from a filesystem. This works as an instance or class method. Available options: + +=for :list +* C - Alternative way to specify C<$key> =cut @@ -171,11 +182,16 @@ sub load_file { =method load_handle + $kdbx = File::KDBX::Loader->load_handle($fh, %options); $kdbx = File::KDBX::Loader->load_handle($fh, $key); + $kdbx = File::KDBX::Loader->load_handle(*IO, %options); $kdbx = File::KDBX::Loader->load_handle(*IO, $key); - $kdbx->load_handle(...); # also instance method -Read a KDBX file from an input stream / file handle. +Read a KDBX file from an input stream / file handle. This works as an instance or class method. Available +options: + +=for :list +* C - Alternative way to specify C<$key> =cut diff --git a/lib/File/KDBX/Util.pm b/lib/File/KDBX/Util.pm index 5645b4c..a27f4dd 100644 --- a/lib/File/KDBX/Util.pm +++ b/lib/File/KDBX/Util.pm @@ -716,8 +716,8 @@ sub query_any { $size = read_all($fh, my $buffer, $size); $size = read_all($fh, my $buffer, $size, $offset); -Like L but returns C if not all C<$size> bytes are read. This is considered an error, -distinguishable from other errors by C<$!> not being set. +Like L but returns C if not all C<$size> bytes are +read. This is considered an error, distinguishable from other errors by C<$!> not being set. =cut diff --git a/t/database.t b/t/database.t index d4edfb2..8bed335 100644 --- a/t/database.t +++ b/t/database.t @@ -9,6 +9,7 @@ use lib "$Bin/lib"; use TestCommon; use File::KDBX; +use File::Temp qw(tempfile); use Test::Deep; use Test::More; use Time::Piece; @@ -170,4 +171,24 @@ subtest 'Maintenance' => sub { is $entry->custom_icon_uuid, $icon_uuid, 'Uses of removed icon change'; }; +subtest 'Dumping to filesystem' => sub { + my $kdbx = File::KDBX->new; + $kdbx->add_entry(title => 'Foo', password => 'whatever'); + + my ($fh, $filepath) = tempfile('kdbx-XXXXXX', TMPDIR => 1, UNLINK => 1); + close($fh); + + $kdbx->dump($filepath, 'a'); + + my $kdbx2 = File::KDBX->load($filepath, 'a'); + my $entry = $kdbx2->entries->map(sub { $_->title.'/'.$_->expand_password })->next; + is $entry, 'Foo/whatever', 'Dump and load an entry'; + + $kdbx->dump($filepath, key => 'a', atomic => 0); + + $kdbx2 = File::KDBX->load($filepath, 'a'); + $entry = $kdbx2->entries->map(sub { $_->title.'/'.$_->expand_password })->next; + is $entry, 'Foo/whatever', 'Dump and load an entry (non-atomic)'; +}; + done_testing; diff --git a/t/hash-block.t b/t/hash-block.t index b42aa23..3bf3261 100644 --- a/t/hash-block.t +++ b/t/hash-block.t @@ -40,9 +40,9 @@ SKIP: { $write = File::KDBX::IO::HashBlock->new($write); print $write $expected_plaintext; close($write) or die "close failed: $!"; - # exit; - require POSIX; - POSIX::_exit(0); + exit; + # require POSIX; + # POSIX::_exit(0); } $read = File::KDBX::IO::HashBlock->new($read); diff --git a/t/hmac-block.t b/t/hmac-block.t index 87f2809..035d433 100644 --- a/t/hmac-block.t +++ b/t/hmac-block.t @@ -44,9 +44,9 @@ SKIP: { $write = File::KDBX::IO::HmacBlock->new($write, key => $KEY); print $write $expected_plaintext; close($write) or die "close failed: $!"; - # exit; - require POSIX; - POSIX::_exit(0); + exit; + # require POSIX; + # POSIX::_exit(0); } $read = File::KDBX::IO::HmacBlock->new($read, key => $KEY); diff --git a/t/keys.t b/t/keys.t index 65658e5..601260c 100644 --- a/t/keys.t +++ b/t/keys.t @@ -55,7 +55,8 @@ for my $test ( subtest "Save $type key file" => sub { my ($type, $filename, $expected_key, $version) = @_; - my ($fh, $filepath) = tempfile('keyfile-XXXXXX', TMPDIR => 1, UNLINK => 1, SUFFIX => '.key'); + my ($fh, $filepath) = tempfile('keyfile-XXXXXX', TMPDIR => 1, UNLINK => 1); + close($fh); note $filepath; my $key = File::KDBX::Key::File->new( filepath => $filepath, @@ -65,7 +66,6 @@ for my $test ( ); my $e = exception { $key->save }; - close($fh); if ($type == KEY_FILE_TYPE_HASHED) { like $e, qr/invalid type/i, "Cannot save $type file"; @@ -88,7 +88,7 @@ subtest 'IO handle key files' => sub { 'Can calculate raw key from file handle' or diag encode_b64($key->raw_key); is $key->type, 'hashed', 'file type is detected as hashed'; - my ($fh_save, $filepath) = tempfile('keyfile-XXXXXX', TMPDIR => 1, UNLINK => 1, SUFFIX => '.key'); + my ($fh_save, $filepath) = tempfile('keyfile-XXXXXX', TMPDIR => 1, UNLINK => 1); is exception { $key->save(fh => $fh_save, type => KEY_FILE_TYPE_XML) }, undef, 'Save key file using IO handle'; close($fh_save); -- 2.45.2