1 package File
::KDBX
::Dumper
;
2 # ABSTRACT: Write KDBX files
7 use Crypt
::Digest
qw(digest_data);
8 use File
::KDBX
::Constants
qw(:magic :header :version :random_stream);
10 use File
::KDBX
::Util
qw(:class);
14 use Ref
::Util
qw(is_ref is_scalarref);
15 use Scalar
::Util
qw(looks_like_number openhandle);
18 our $VERSION = '999.999'; # VERSION
22 $dumper = File
::KDBX
::Dumper-
>new(%attributes);
24 Construct a new L
<File
::KDBX
::Dumper
>.
30 my $self = bless {}, $class;
36 $dumper = $dumper->init(%attributes);
38 Initialize a L
<File
::KDBX
::Dumper
> with a new set of attributes
.
40 This
is called by L
</new
>.
48 @$self{keys %args} = values %args;
55 my $format = shift // $self->format;
57 my $version = $self->kdbx->version;
61 if (defined $format) {
64 elsif (!defined $version) {
67 elsif ($self->kdbx->sig2 == KDBX_SIG2_1
) {
70 elsif (looks_like_number
($version)) {
71 my $major = $version & KDBX_VERSION_MAJOR_MASK
;
73 KDBX_VERSION_2_0
() => 'V3',
74 KDBX_VERSION_3_0
() => 'V3',
75 KDBX_VERSION_4_0
() => 'V4',
77 if ($major == KDBX_VERSION_2_0
) {
78 alert
sprintf("Upgrading KDBX version %x to version %x\n", $version, KDBX_VERSION_3_1
);
79 $self->kdbx->version(KDBX_VERSION_3_1
);
81 $subclass = $subclasses{$major}
82 or throw
sprintf('Unsupported KDBX file version: %x', $version), version
=> $version;
85 throw
sprintf('Unknown file version: %s', $version), version
=> $version;
88 load
"File::KDBX::Dumper::$subclass";
89 bless $self, "File::KDBX::Dumper::$subclass";
94 $dumper = $dumper->reset;
96 Set a L
<File
::KDBX
::Dumper
> to a blank
state, ready to dumper another KDBX file
.
108 $dumper->dump(\
$string, $key);
109 $dumper->dump(*IO
, $key);
110 $dumper->dump($filepath, $key);
114 The C
<$key> is either a L
<File
::KDBX
::Key
> or a primitive that can be converted to a Key object
.
121 return $self->dump_handle($dst, @_) if openhandle
($dst);
122 return $self->dump_string($dst, @_) if is_scalarref
($dst);
123 return $self->dump_file($dst, @_) if defined $dst && !is_ref
($dst);
124 throw
'Programmer error: Must pass a stringref, filepath or IO handle to dump';
129 $dumper->dump_string(\
$string, $key);
130 \
$string = $dumper->dump_string($key);
132 Dump a KDBX file to a string
/ memory buffer
.
138 my $ref = is_scalarref
($_[0]) ? shift : undef;
139 my %args = @_ % 2 == 0 ? @_ : (key
=> shift, @_);
141 my $key = delete $args{key
};
142 $args{kdbx
} //= $self->kdbx;
149 open(my $fh, '>', $ref) or throw
"Failed to open string buffer: $!";
151 $self = $self->new if !ref $self;
152 $self->init(%args, fh
=> $fh)->_dump($fh, $key);
159 $dumper->dump_file($filepath, $key);
161 Dump a KDBX file to a filesystem
.
167 my $filepath = shift;
168 my %args = @_ % 2 == 0 ? @_ : (key
=> shift, @_);
170 my $key = delete $args{key
};
171 $args{kdbx
} //= $self->kdbx;
174 my ($fh, $filepath_temp) = eval { File
::Temp
::tempfile
("${filepath}-XXXXXX", CLEANUP
=> 1) };
175 if (!$fh or my $err = $@) {
176 $err //= 'Unknown error';
177 throw
sprintf('Open file failed (%s): %s', $filepath_temp, $err),
179 filepath
=> $filepath_temp;
183 $self = $self->new if !ref $self;
184 $self->init(%args, fh
=> $fh, filepath
=> $filepath);
185 $self->_dump($fh, $key);
188 my ($file_mode, $file_uid, $file_gid) = (stat($filepath))[2, 4, 5];
190 my $mode = $args{mode
} // $file_mode // do { my $m = umask; defined $m ? oct(666) &~ $m : undef };
191 my $uid = $args{uid
} // $file_uid // -1;
192 my $gid = $args{gid
} // $file_gid // -1;
193 chmod($mode, $filepath_temp) if defined $mode;
194 chown($uid, $gid, $filepath_temp);
195 rename($filepath_temp, $filepath) or throw
"Failed to write file ($filepath): $!", filepath
=> $filepath;
202 $dumper->dump_handle($fh, $key);
203 $dumper->dump_handle(*IO
, $key);
205 Dump a KDBX file to an input stream
/ file handle
.
212 my %args = @_ % 2 == 0 ? @_ : (key
=> shift, @_);
214 $fh = *STDOUT
if $fh eq '-';
216 my $key = delete $args{key
};
217 $args{kdbx
} //= $self->kdbx;
219 $self = $self->new if !ref $self;
220 $self->init(%args, fh
=> $fh)->_dump($fh, $key);
225 $kdbx = $dumper->kdbx;
226 $dumper->kdbx($kdbx);
228 Get
or set the L
<File
::KDBX
> instance with the data to be dumped
.
234 return File
::KDBX-
>new if !ref $self;
235 $self->{kdbx
} = shift if @_;
236 $self->{kdbx
} //= File
::KDBX-
>new;
241 Get the file format used
for writing the database
. Normally the format
is auto-detected from the database
,
242 which
is the safest choice
. Possible formats
:
248 * C<XML> (only used if explicitly set)
249 * C<Raw> (only used if explicitly set)
251 B<WARNING:> There is a potential for data loss if you explicitly use a format that doesn't support the
252 features used by the KDBX database being written.
254 The most common reason to explicitly specify the file format is to save a database as an unencrypted XML file:
256 $kdbx->dump_file('database.xml', format => 'XML');
260 Get the format of the data inside the KDBX envelope. This only applies to C<V3> and C<V4> formats. Possible
264 * C<XML> - Write the database groups and entries as XML (default)
265 * C<Raw> - Write L<File::KDBX/raw> instead of the actual database contents
269 $bool = $dumper->allow_upgrade;
271 Whether or not to allow implicitly upgrading a database to a newer version. When enabled, in order to avoid
272 potential data loss, the database can be upgraded as-needed in cases where the database file format version is
273 too low to support new features being used.
275 The default is to allow upgrading.
277 =attr randomize_seeds
279 $bool = $dumper->randomize_seeds;
281 Whether or not to randomize seeds in a database before writing. The default is to randomize seeds, and there's
282 not often a good reason not to do so. If disabled, the seeds associated with the KDBX database will be used as
287 has 'format', is => 'ro';
288 has 'inner_format', is => 'ro', default => 'XML';
289 has 'allow_upgrade', is => 'ro', default => 1;
290 has 'randomize_seeds', is => 'ro', default => 1;
294 $min_version = File
::KDBX
::Dumper-
>min_version;
296 Get the minimum KDBX file version supported
, which
is 3.0 or C
<0x00030000> as
299 To generate older KDBX files unsupported by this module
, try L
<File
::KeePass
>.
303 sub min_version
{ KDBX_VERSION_OLDEST
}
305 sub _fh
{ $_[0]->{fh
} or throw
'IO handle not set' }
312 my $kdbx = $self->kdbx;
314 my $min_version = $kdbx->minimum_version;
315 if ($kdbx->version < $min_version && $self->allow_upgrade) {
316 alert
sprintf("Implicitly upgrading database from %x to %x\n", $kdbx->version, $min_version),
317 version
=> $kdbx->version, min_version
=> $min_version;
318 $kdbx->version($min_version);
322 if (ref($self) =~ /::(?:KDB|V[34])$/) {
323 $key //= $kdbx->key ? $kdbx->key->reload : undef;
324 defined $key or throw
'Must provide a master key', type
=> 'key.missing';
329 my $magic = $self->_write_magic_numbers($fh);
330 my $headers = $self->_write_headers($fh);
334 $self->_write_body($fh, $key, "$magic$headers");
341 my $kdbx = $self->kdbx;
343 if ($kdbx->version < KDBX_VERSION_4_0
) {
344 # force Salsa20 inner random stream
345 $kdbx->inner_random_stream_id(STREAM_ID_SALSA20
);
346 my $key = $kdbx->inner_random_stream_key;
347 substr($key, 32) = '';
348 $kdbx->inner_random_stream_key($key);
351 $kdbx->randomize_seeds if $self->randomize_seeds;
354 sub _write_magic_numbers
{
358 my $kdbx = $self->kdbx;
360 $kdbx->sig1 == KDBX_SIG1
or throw
'Invalid file signature', sig1
=> $kdbx->sig1;
361 $kdbx->version < $self->min_version || KDBX_VERSION_LATEST
< $kdbx->version
362 and throw
'Unsupported file version', version
=> $kdbx->version;
364 my @magic = ($kdbx->sig1, $kdbx->sig2, $kdbx->version);
366 my $buf = pack('L<3', @magic);
367 $fh->print($buf) or throw
'Failed to write file signature';
372 sub _write_headers
{ die "Not implemented" }
374 sub _write_body
{ die "Not implemented" }
376 sub _write_inner_body
{
379 my $current_pkg = ref $self;
380 require Scope
::Guard
;
381 my $guard = Scope
::Guard-
>new(sub { bless $self, $current_pkg });
383 $self->_rebless($self->inner_format);
384 $self->_write_inner_body(@_);