1 package File
::KDBX
::Loader
;
2 # ABSTRACT: Load KDBX files
7 use File
::KDBX
::Constants
qw(:magic :header :version);
9 use File
::KDBX
::Util
qw(:class :io);
13 use Ref
::Util
qw(is_ref is_scalarref);
14 use Scalar
::Util
qw(looks_like_number openhandle);
17 our $VERSION = '999.999'; # VERSION
21 $loader = File
::KDBX
::Loader-
>new(%attributes);
23 Construct a new L
<File
::KDBX
::Loader
>.
29 my $self = bless {}, $class;
35 $loader = $loader->init(%attributes);
37 Initialize a L
<File
::KDBX
::Loader
> with a new set of attributes
.
39 This
is called by L
</new
>.
47 @$self{keys %args} = values %args;
54 my $format = shift // $self->format;
56 my $sig2 = $self->kdbx->sig2;
57 my $version = $self->kdbx->version;
61 if (defined $format) {
64 elsif (defined $sig2 && $sig2 == KDBX_SIG2_1
) {
67 elsif (looks_like_number
($version)) {
68 my $major = $version & KDBX_VERSION_MAJOR_MASK
;
70 KDBX_VERSION_2_0
() => 'V3',
71 KDBX_VERSION_3_0
() => 'V3',
72 KDBX_VERSION_4_0
() => 'V4',
74 $subclass = $subclasses{$major}
75 or throw
sprintf('Unsupported KDBX file version: %x', $version), version
=> $version;
78 throw
sprintf('Unknown file version: %s', $version), version
=> $version;
81 Module
::Load
::load
"File::KDBX::Loader::$subclass";
82 bless $self, "File::KDBX::Loader::$subclass";
87 $loader = $loader->reset;
89 Set a L
<File
::KDBX
::Loader
> to a blank
state, ready to load another KDBX file
.
101 $kdbx = File
::KDBX
::Loader-
>load(\
$string, %options);
102 $kdbx = File
::KDBX
::Loader-
>load(\
$string, $key);
103 $kdbx = File
::KDBX
::Loader-
>load(*IO
, %options);
104 $kdbx = File
::KDBX
::Loader-
>load(*IO
, $key);
105 $kdbx = File
::KDBX
::Loader-
>load($filepath, %options);
106 $kdbx = File
::KDBX
::Loader-
>load($filepath, $key);
108 Load a KDBX file
. This works as an instance
or a
class method. The C
<$key> is either
109 a L
<File
::KDBX
::Key
> or a primitive castable to a Key object
. Available options
:
112 * C<key> - Alternative way to specify C<$key>
119 return $self->load_handle($src, @_) if openhandle
($src) || $src eq '-';
120 return $self->load_string($src, @_) if is_scalarref
($src);
121 return $self->load_file($src, @_) if !is_ref
($src) && defined $src;
122 throw
'Programmer error: Must pass a stringref, filepath or IO handle to read';
127 $kdbx = File
::KDBX
::Loader-
>load_string($string, %options);
128 $kdbx = File
::KDBX
::Loader-
>load_string($string, $key);
129 $kdbx = File
::KDBX
::Loader-
>load_string(\
$string, %options);
130 $kdbx = File
::KDBX
::Loader-
>load_string(\
$string, $key);
132 Load a KDBX file from a string
/ memory buffer
. This works as an instance
or class method. Available options
:
135 * C<key> - Alternative way to specify C<$key>
141 my $str = shift or throw
'Expected string to load';
142 my %args = @_ % 2 == 0 ? @_ : (key
=> shift, @_);
144 my $key = delete $args{key
};
145 $args{kdbx
} //= $self->kdbx;
147 my $ref = is_scalarref
($str) ? $str : \
$str;
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)->_read($fh, $key);
158 $kdbx = File
::KDBX
::Loader-
>load_file($filepath, %options);
159 $kdbx = File
::KDBX
::Loader-
>load_file($filepath, $key);
161 Read a KDBX file from a filesystem
. This works as an instance
or class method. Available options
:
164 * C<key> - Alternative way to specify C<$key>
170 my $filepath = shift;
171 my %args = @_ % 2 == 0 ? @_ : (key
=> shift, @_);
173 my $key = delete $args{key
};
174 $args{kdbx
} //= $self->kdbx;
176 open(my $fh, '<:raw', $filepath) or throw
'Open file failed', filepath
=> $filepath;
178 $self = $self->new if !ref $self;
179 $self->init(%args, fh
=> $fh, filepath
=> $filepath)->_read($fh, $key);
185 $kdbx = File
::KDBX
::Loader-
>load_handle($fh, %options);
186 $kdbx = File
::KDBX
::Loader-
>load_handle($fh, $key);
187 $kdbx = File
::KDBX
::Loader-
>load_handle(*IO
, %options);
188 $kdbx = File
::KDBX
::Loader-
>load_handle(*IO
, $key);
190 Read a KDBX file from an input stream
/ file handle
. This works as an instance
or class method. Available
194 * C<key> - Alternative way to specify C<$key>
201 my %args = @_ % 2 == 0 ? @_ : (key
=> shift, @_);
203 $fh = *STDIN
if $fh eq '-';
205 my $key = delete $args{key
};
206 $args{kdbx
} //= $self->kdbx;
208 $self = $self->new if !ref $self;
209 $self->init(%args, fh
=> $fh)->_read($fh, $key);
215 $kdbx = $loader->kdbx;
216 $loader->kdbx($kdbx);
218 Get
or set the L
<File
::KDBX
> instance
for storing the loaded data into
.
224 return File
::KDBX-
>new if !ref $self;
225 $self->{kdbx
} = shift if @_;
226 $self->{kdbx
} //= File
::KDBX-
>new;
231 Get the file format used
for reading the database
. Normally the format
is auto-detected from the data stream
.
232 This auto-detection works well
, so there
's not really a good reason to explicitly specify the format.
244 Get the format of the data inside the KDBX envelope. This only applies to C<V3> and C<V4> formats. Possible
248 * C<XML> - Read the database groups and entries as XML (default)
249 * C<Raw> - Read and store the result in L<File::KDBX/raw> without parsing
253 has format => undef, is => 'ro
';
254 has inner_format => 'XML
', is => 'ro
';
256 =method read_magic_numbers
258 $magic = File::KDBX::Loader->read_magic_numbers($fh);
259 ($sig1, $sig2, $version, $magic) = File::KDBX::Loader->read_magic_numbers($fh);
261 $magic = $loader->read_magic_numbers($fh);
262 ($sig1, $sig2, $version, $magic) = $loader->read_magic_numbers($fh);
264 Read exactly 12 bytes from an IO handle and parse them into the three magic numbers that begin
265 a KDBX file. This is a quick way to determine if a file is actually a KDBX file.
267 C<$sig1> should always be C<KDBX_SIG1> if reading an actual KDB or KDBX file.
269 C<$sig2> should be C<KDBX_SIG2_1> for KeePass 1 files and C<KDBX_SIG2_2> for KeePass 2 files.
271 C<$version> is the file version (e.g. C<0x00040001>).
273 C<$magic> is the raw 12 bytes read from the IO handle.
275 If called on an instance, the C<sig1>, C<sig2> and C<version> attributes will be set in the L</kdbx>
276 and the instance will be blessed into the correct loader subclass.
280 sub read_magic_numbers {
283 my $kdbx = shift // $self->kdbx;
285 read_all $fh, my $magic, 12 or throw 'Failed to
read file signature
';
287 my ($sig1, $sig2, $version) = unpack('L
<3', $magic);
292 $kdbx->version($version);
293 $self->_rebless if ref $self;
296 return wantarray ? ($sig1, $sig2, $version, $magic) : $magic;
299 sub _fh { $_[0]->{fh} or throw 'IO handle
not set
' }
306 my $kdbx = $self->kdbx;
307 $key //= $kdbx->key ? $kdbx->key->reload : undef;
310 read_all $fh, my $buf, 1 or throw 'Failed to
read the first byte
', type => 'parser
';
311 my $first = ord($buf);
313 if ($first != KDBX_SIG1_FIRST_BYTE) {
314 # not a KDBX file... try skipping the outer layer
315 return $self->_read_inner_body($fh);
318 my $magic = $self->read_magic_numbers($fh, $kdbx);
319 $kdbx->sig1 == KDBX_SIG1 or throw 'Invalid file signature
', type => 'parser
', sig1 => $kdbx->sig1;
321 if (ref($self) =~ /::(?:KDB|V[34])$/) {
322 defined $key or throw 'Must provide a master key
', type => 'key
.missing
';
325 my $headers = $self->_read_headers($fh);
328 $self->_read_body($fh, $key, "$magic$headers");
331 throw "Failed to load KDBX file: $err",
333 compression_error => $IO::Uncompress::Gunzip::GunzipError,
334 crypt_error => $File::KDBX::IO::Crypt::ERROR,
335 hash_error => $File::KDBX::IO::HashBLock::ERROR,
336 hmac_error => $File::KDBX::IO::HmacBLock::ERROR;
344 my $headers = $self->kdbx->headers;
347 while (my ($type, $val, $raw) = $self->_read_header($fh)) {
349 last if $type == HEADER_END;
350 $headers->{$type} = $val;
356 sub _read_body { die "Not implemented" }
358 sub _read_inner_body {
361 my $current_pkg = ref $self;
362 require Scope::Guard;
363 my $guard = Scope::Guard->new(sub { bless $self, $current_pkg });
365 $self->_rebless($self->inner_format);
366 $self->_read_inner_body(@_);