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(: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, $key);
102 $kdbx = File
::KDBX
::Loader-
>load(*IO
, $key);
103 $kdbx = File
::KDBX
::Loader-
>load($filepath, $key);
104 $kdbx = $loader->load(...); # also instance method
108 The C
<$key> is either a L
<File
::KDBX
::Key
> or a primitive that can be converted to a Key object
.
115 return $self->load_handle($src, @_) if openhandle
($src) || $src eq '-';
116 return $self->load_string($src, @_) if is_scalarref
($src);
117 return $self->load_file($src, @_) if !is_ref
($src) && defined $src;
118 throw
'Programmer error: Must pass a stringref, filepath or IO handle to read';
123 $kdbx = File
::KDBX
::Loader-
>load_string($string, $key);
124 $kdbx = File
::KDBX
::Loader-
>load_string(\
$string, $key);
125 $kdbx = $loader->load_string(...); # also instance method
127 Load a KDBX file from a string
/ memory buffer
.
133 my $str = shift or throw
'Expected string to load';
134 my %args = @_ % 2 == 0 ? @_ : (key
=> shift, @_);
136 my $key = delete $args{key
};
137 $args{kdbx
} //= $self->kdbx;
139 my $ref = is_scalarref
($str) ? $str : \
$str;
141 open(my $fh, '<', $ref) or throw
"Failed to open string buffer: $!";
143 $self = $self->new if !ref $self;
144 $self->init(%args, fh
=> $fh)->_read($fh, $key);
150 $kdbx = File
::KDBX
::Loader-
>load_file($filepath, $key);
151 $kdbx = $loader->load_file(...); # also instance method
153 Read a KDBX file from a filesystem
.
159 my $filepath = shift;
160 my %args = @_ % 2 == 0 ? @_ : (key
=> shift, @_);
162 my $key = delete $args{key
};
163 $args{kdbx
} //= $self->kdbx;
165 open(my $fh, '<:raw', $filepath) or throw
'Open file failed', filepath
=> $filepath;
167 $self = $self->new if !ref $self;
168 $self->init(%args, fh
=> $fh, filepath
=> $filepath)->_read($fh, $key);
174 $kdbx = File
::KDBX
::Loader-
>load_handle($fh, $key);
175 $kdbx = File
::KDBX
::Loader-
>load_handle(*IO
, $key);
176 $kdbx->load_handle(...); # also instance method
178 Read a KDBX file from an input stream
/ file handle
.
185 my %args = @_ % 2 == 0 ? @_ : (key
=> shift, @_);
187 $fh = *STDIN
if $fh eq '-';
189 my $key = delete $args{key
};
190 $args{kdbx
} //= $self->kdbx;
192 $self = $self->new if !ref $self;
193 $self->init(%args, fh
=> $fh)->_read($fh, $key);
199 $kdbx = $loader->kdbx;
200 $loader->kdbx($kdbx);
202 Get
or set the L
<File
::KDBX
> instance
for storing the loaded data into
.
208 return File
::KDBX-
>new if !ref $self;
209 $self->{kdbx
} = shift if @_;
210 $self->{kdbx
} //= File
::KDBX-
>new;
219 sub format
{ $_[0]->{format
} }
220 sub inner_format
{ $_[0]->{inner_format
} // 'XML' }
224 $min_version = File
::KDBX
::Loader-
>min_version;
226 Get the minimum KDBX file version supported
, which
is 3.0 or C
<0x00030000> as
229 To
read older KDBX files unsupported by this module
, try L
<File
::KeePass
>.
233 sub min_version
{ KDBX_VERSION_OLDEST
}
235 =method read_magic_numbers
237 $magic = File
::KDBX
::Loader-
>read_magic_numbers($fh);
238 ($sig1, $sig2, $version, $magic) = File
::KDBX
::Loader-
>read_magic_numbers($fh);
240 $magic = $loader->read_magic_numbers($fh);
241 ($sig1, $sig2, $version, $magic) = $loader->read_magic_numbers($fh);
243 Read exactly
12 bytes from an IO handle
and parse them into the three magic numbers that begin
244 a KDBX file
. This
is a quick way to determine
if a file
is actually a KDBX file
.
246 C
<$sig1> should always be C
<KDBX_SIG1
> if reading an actual KDB
or KDBX file
.
248 C
<$sig2> should be C
<KDBX_SIG2_1
> for KeePass
1 files
and C
<KDBX_SIG2_2
> for KeePass
2 files
.
250 C
<$version> is the file version
(e
.g
. C
<0x00040001>).
252 C
<$magic> is the raw
12 bytes
read from the IO handle
.
254 If called on an instance
, the C
<sig1
>, C
<sig2
> and C
<version
> attributes will be set
in the L
</kdbx
>
255 and the instance will be blessed into the correct loader subclass
.
259 sub read_magic_numbers
{
262 my $kdbx = shift // $self->kdbx;
264 read_all
$fh, my $magic, 12 or throw
'Failed to read file signature';
266 my ($sig1, $sig2, $version) = unpack('L<3', $magic);
271 $kdbx->version($version);
272 $self->_rebless if ref $self;
275 return wantarray ? ($sig1, $sig2, $version, $magic) : $magic;
278 sub _fh
{ $_[0]->{fh
} or throw
'IO handle not set' }
285 my $kdbx = $self->kdbx;
286 $key //= $kdbx->key ? $kdbx->key->reload : undef;
289 read_all
$fh, my $buf, 1 or throw
'Failed to read the first byte', type
=> 'parser';
290 my $first = ord($buf);
292 if ($first != KDBX_SIG1_FIRST_BYTE
) {
293 # not a KDBX file... try skipping the outer layer
294 return $self->_read_inner_body($fh);
297 my $magic = $self->read_magic_numbers($fh, $kdbx);
298 $kdbx->sig1 == KDBX_SIG1
or throw
'Invalid file signature', type
=> 'parser', sig1
=> $kdbx->sig1;
300 if (ref($self) =~ /::(?:KDB|V[34])$/) {
301 defined $key or throw
'Must provide a master key', type
=> 'key.missing';
304 my $headers = $self->_read_headers($fh);
307 $self->_read_body($fh, $key, "$magic$headers");
310 throw
"Failed to load KDBX file: $err",
312 compression_error
=> $IO::Uncompress
::Gunzip
::GunzipError
,
313 crypt_error
=> $File::KDBX
::IO
::Crypt
::ERROR
,
314 hash_error
=> $File::KDBX
::IO
::HashBLock
::ERROR
,
315 hmac_error
=> $File::KDBX
::IO
::HmacBLock
::ERROR
;
323 my $headers = $self->kdbx->headers;
326 while (my ($type, $val, $raw) = $self->_read_header($fh)) {
328 last if $type == HEADER_END
;
329 $headers->{$type} = $val;
335 sub _read_body
{ die "Not implemented" }
337 sub _read_inner_body
{
340 my $current_pkg = ref $self;
341 require Scope
::Guard
;
342 my $guard = Scope
::Guard-
>new(sub { bless $self, $current_pkg });
344 $self->_rebless($self->inner_format);
345 $self->_read_inner_body(@_);