X-Git-Url: https://git.dogcows.com/gitweb?p=chaz%2Fp5-File-KDBX;a=blobdiff_plain;f=lib%2FFile%2FKDBX%2FDumper.pm;h=6f8d8bb120936ab361606df3bf8157ac171c4f49;hp=553b1f19600c0585b5baca9277db06bd80afbf49;hb=63d73bf382edfb0089b36a45193fc2835cb58b6d;hpb=f63182fc62b25269b1c38588dca2b3535ed1a1a2 diff --git a/lib/File/KDBX/Dumper.pm b/lib/File/KDBX/Dumper.pm index 553b1f1..6f8d8bb 100644 --- a/lib/File/KDBX/Dumper.pm +++ b/lib/File/KDBX/Dumper.pm @@ -7,6 +7,7 @@ use strict; 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; @@ -92,7 +93,7 @@ sub _rebless { $dumper = $dumper->reset; -Set a L to a blank state, ready to dumper another KDBX file. +Set a L to a blank state, ready to dump another KDBX file. =cut @@ -110,7 +111,7 @@ sub reset { Dump a KDBX file. -The C<$key> is either a L or a primitive that can be converted to a Key object. +The C<$key> is either a L or a primitive that can be cast to a Key object. =cut @@ -169,36 +170,29 @@ sub dump_file { 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; } @@ -208,7 +202,7 @@ sub dump_file { $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 @@ -244,27 +238,56 @@ sub kdbx { =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 +* C +* C +* C (only used if explicitly set) +* C (only used if explicitly set) -=attr min_version +B 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. +=attr inner_format -=cut +Get the format of the data inside the KDBX envelope. This only applies to C and C formats. Possible +formats: + +=for :list +* C - Write the database groups and entries as XML (default) +* C - Write L 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' } @@ -276,7 +299,7 @@ sub _dump { 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); @@ -322,7 +345,7 @@ sub _write_magic_numbers { 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);