use Crypt::Digest qw(digest_data);
use File::KDBX::Constants qw(:magic :header :version :random_stream);
use File::KDBX::Error;
+use File::KDBX::Util qw(:class);
use File::KDBX;
use IO::Handle;
use Module::Load;
$dumper = $dumper->reset;
-Set a L<File::KDBX::Dumper> to a blank state, ready to dumper another KDBX file.
+Set a L<File::KDBX::Dumper> to a blank state, ready to dump another KDBX file.
=cut
Dump a KDBX file.
-The C<$key> is either a L<File::KDBX::Key> or a primitive that can be converted to a Key object.
+The C<$key> is either a L<File::KDBX::Key> or a primitive that can be cast to a Key object.
=cut
my $key = delete $args{key};
$args{kdbx} //= $self->kdbx;
- # require File::Temp;
- # # my ($fh, $filepath_temp) = eval { File::Temp::tempfile("${filepath}-XXXXXX", CLEANUP => 1) };
- # my $fh = eval { File::Temp->new(TEMPLATE => "${filepath}-XXXXXX", CLEANUP => 1) };
- # my $filepath_temp = $fh->filename;
- # if (!$fh or my $err = $@) {
- # $err //= 'Unknown error';
- # throw sprintf('Open file failed (%s): %s', $filepath_temp, $err),
- # error => $err,
- # filepath => $filepath_temp;
- # }
- open(my $fh, '>:raw', $filepath) or die "open failed ($filepath): $!";
- binmode($fh);
- # $fh->autoflush(1);
+ 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;
+ }
+ $fh->autoflush(1);
$self = $self->new if !ref $self;
$self->init(%args, fh => $fh, filepath => $filepath);
- # binmode($fh);
$self->_dump($fh, $key);
+ close($fh);
- # binmode($fh, ':raw');
- # close($fh);
-
- # my ($file_mode, $file_uid, $file_gid) = (stat($filepath))[2, 4, 5];
+ 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;
+ 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;
return $self;
}
$dumper->dump_handle($fh, $key);
$dumper->dump_handle(*IO, $key);
-Dump a KDBX file to an input stream / file handle.
+Dump a KDBX file to an output stream / file handle.
=cut
=attr format
-=cut
+Get the file format used for writing the database. Normally the format is auto-detected from the database,
+which is the safest choice. Possible formats:
-sub format { $_[0]->{format} }
-sub inner_format { $_[0]->{inner_format} // 'XML' }
+=for :list
+* C<V3>
+* C<V4>
+* C<KDB>
+* C<XML> (only used if explicitly set)
+* C<Raw> (only used if explicitly set)
-=attr min_version
+B<WARNING:> There is a potential for data loss if you explicitly use a format that doesn't support the
+features used by the KDBX database being written.
- $min_version = File::KDBX::Dumper->min_version;
+The most common reason to explicitly specify the file format is to save a database as an unencrypted XML file:
-Get the minimum KDBX file version supported, which is 3.0 or C<0x00030000> as
-it is encoded.
+ $kdbx->dump_file('database.xml', format => 'XML');
-To generate older KDBX files unsupported by this module, try L<File::KeePass>.
+=attr inner_format
-=cut
+Get the format of the data inside the KDBX envelope. This only applies to C<V3> and C<V4> formats. Possible
+formats:
+
+=for :list
+* C<XML> - Write the database groups and entries as XML (default)
+* C<Raw> - Write L<File::KDBX/raw> instead of the actual database contents
+
+=attr allow_upgrade
-sub min_version { KDBX_VERSION_OLDEST }
+ $bool = $dumper->allow_upgrade;
-sub upgrade { $_[0]->{upgrade} // 1 }
+Whether or not to allow implicitly upgrading a database to a newer version. When enabled, in order to avoid
+potential data loss, the database can be upgraded as-needed in cases where the database file format version is
+too low to support new features being used.
+
+The default is to allow upgrading.
+
+=attr randomize_seeds
+
+ $bool = $dumper->randomize_seeds;
+
+Whether or not to randomize seeds in a database before writing. The default is to randomize seeds, and there's
+not often a good reason not to do so. If disabled, the seeds associated with the KDBX database will be used as
+they are.
+
+=cut
-sub randomize_seeds { $_[0]->{randomize_seeds} // 1 }
+has 'format', is => 'ro';
+has 'inner_format', is => 'ro', default => 'XML';
+has 'allow_upgrade', is => 'ro', default => 1;
+has 'randomize_seeds', is => 'ro', default => 1;
sub _fh { $_[0]->{fh} or throw 'IO handle not set' }
my $kdbx = $self->kdbx;
my $min_version = $kdbx->minimum_version;
- if ($kdbx->version < $min_version && $self->upgrade) {
+ if ($kdbx->version < $min_version && $self->allow_upgrade) {
alert sprintf("Implicitly upgrading database from %x to %x\n", $kdbx->version, $min_version),
version => $kdbx->version, min_version => $min_version;
$kdbx->version($min_version);
my $kdbx = $self->kdbx;
$kdbx->sig1 == KDBX_SIG1 or throw 'Invalid file signature', sig1 => $kdbx->sig1;
- $kdbx->version < $self->min_version || KDBX_VERSION_LATEST < $kdbx->version
+ $kdbx->version < KDBX_VERSION_OLDEST || KDBX_VERSION_LATEST < $kdbx->version
and throw 'Unsupported file version', version => $kdbx->version;
my @magic = ($kdbx->sig1, $kdbx->sig2, $kdbx->version);
projects / chaz / p5-File-KDBX / blobdiff