1 package File
::KDBX
::Loader
::XML
;
2 # ABSTRACT: Load unencrypted XML KeePass files
7 use Crypt
::Misc
0.029 qw(decode_b64);
9 use File
::KDBX
::Constants
qw(:version :time);
10 use File
::KDBX
::Error
;
12 use File
::KDBX
::Util
qw(:class :text assert_64bit gunzip erase_scoped);
13 use Scalar
::Util
qw(looks_like_number);
15 use XML
::LibXML
::Reader
;
19 extends
'File::KDBX::Loader';
21 our $VERSION = '999.999'; # VERSION
23 has '_reader', is => 'ro';
24 has '_safe', is => 'ro', default => sub { File
::KDBX
::Safe-
>new(cipher
=> $_[0]->kdbx->random_stream) };
30 $self->_read_inner_body($fh);
33 sub _read_inner_body
{
37 my $reader = $self->{_reader
} = XML
::LibXML
::Reader-
>new(IO
=> $fh);
39 delete $self->{_safe
};
42 my $pattern = XML
::LibXML
::Pattern-
>new('/KeePassFile/Meta|/KeePassFile/Root');
43 while ($reader->nextPatternMatch($pattern) == 1) {
44 next if $reader->nodeType != XML_READER_TYPE_ELEMENT
;
45 my $name = $reader->localName;
46 if ($name eq 'Meta') {
47 $self->_read_xml_meta;
49 elsif ($name eq 'Root') {
51 alert
'Ignoring extra Root element in KeePass XML file', line
=> $reader->lineNumber;
54 $self->_read_xml_root;
59 if ($reader->readState == XML_READER_ERROR
) {
60 throw
'Failed to parse KeePass XML';
63 $self->kdbx->_safe($self->_safe) if $self->{_safe
};
65 $self->_resolve_binary_refs;
71 $self->_read_xml_element($self->kdbx->meta,
73 HeaderHash
=> 'binary',
74 DatabaseName
=> 'text',
75 DatabaseNameChanged
=> 'datetime',
76 DatabaseDescription
=> 'text',
77 DatabaseDescriptionChanged
=> 'datetime',
78 DefaultUserName
=> 'text',
79 DefaultUserNameChanged
=> 'datetime',
80 MaintenanceHistoryDays
=> 'number',
82 MasterKeyChanged
=> 'datetime',
83 MasterKeyChangeRec
=> 'number',
84 MasterKeyChangeForce
=> 'number',
85 MemoryProtection
=> \
&_read_xml_memory_protection
,
86 CustomIcons
=> \
&_read_xml_custom_icons
,
87 RecycleBinEnabled
=> 'bool',
88 RecycleBinUUID
=> 'uuid',
89 RecycleBinChanged
=> 'datetime',
90 EntryTemplatesGroup
=> 'uuid',
91 EntryTemplatesGroupChanged
=> 'datetime',
92 LastSelectedGroup
=> 'uuid',
93 LastTopVisibleGroup
=> 'uuid',
94 HistoryMaxItems
=> 'number',
95 HistoryMaxSize
=> 'number',
96 SettingsChanged
=> 'datetime',
97 Binaries
=> \
&_read_xml_binaries
,
98 CustomData
=> \
&_read_xml_custom_data
,
102 sub _read_xml_memory_protection
{
104 my $meta = shift // $self->kdbx->meta;
106 return $self->_read_xml_element(
107 ProtectTitle
=> 'bool',
108 ProtectUserName
=> 'bool',
109 ProtectPassword
=> 'bool',
110 ProtectURL
=> 'bool',
111 ProtectNotes
=> 'bool',
112 AutoEnableVisualHiding
=> 'bool',
116 sub _read_xml_binaries
{
118 my $kdbx = $self->kdbx;
120 my $binaries = $self->_read_xml_element(
123 my $id = $self->_read_xml_attribute('ID');
124 my $compressed = $self->_read_xml_attribute('Compressed', 'bool', false
);
125 my $protected = $self->_read_xml_attribute('Protected', 'bool', false
);
126 my $data = $self->_read_xml_content('binary');
130 $protected ? (protect
=> true
) : (),
134 # if compressed, decompress later when the safe is unlocked
135 $self->_safe->add_protected($compressed ? \
&gunzip
: (), $binary);
137 elsif ($compressed) {
138 $binary->{value
} = gunzip
($data);
145 $kdbx->binaries({%{$kdbx->binaries}, %$binaries});
146 return (); # do not add to meta
149 sub _read_xml_custom_data
{
152 return $self->_read_xml_element(
155 my $item = $self->_read_xml_element(
158 LastModificationTime
=> 'datetime', # KDBX4.1
160 $item->{key
} => $item;
165 sub _read_xml_custom_icons
{
168 return $self->_read_xml_element(
171 my $icon = $self->_read_xml_element(
174 Name
=> 'text', # KDBX4.1
175 LastModificationTime
=> 'datetime', # KDBX4.1
177 $icon->{uuid
} => $icon;
184 my $kdbx = $self->kdbx;
186 my $root = $self->_read_xml_element(
187 Group
=> \
&_read_xml_group
,
188 DeletedObjects
=> \
&_read_xml_deleted_objects
,
191 $kdbx->deleted_objects($root->{deleted_objects
});
192 $kdbx->root($root->{group
}) if $root->{group
};
195 sub _read_xml_group
{
198 return $self->_read_xml_element({entries
=> [], groups
=> []},
202 Tags
=> 'text', # KDBX4.1
204 CustomIconUUID
=> 'uuid',
205 Times
=> \
&_read_xml_times
,
206 IsExpanded
=> 'bool',
207 DefaultAutoTypeSequence
=> 'text',
208 EnableAutoType
=> 'tristate',
209 EnableSearching
=> 'tristate',
210 LastTopVisibleEntry
=> 'uuid',
211 CustomData
=> \
&_read_xml_custom_data
, # KDBX4
212 PreviousParentGroup
=> 'uuid', # KDBX4.1
213 Entry
=> [entries
=> \
&_read_xml_entry
],
214 Group
=> [groups
=> \
&_read_xml_group
],
218 sub _read_xml_entry
{
221 my $entry = $self->_read_xml_element({strings
=> [], binaries
=> []},
224 CustomIconUUID
=> 'uuid',
225 ForegroundColor
=> 'text',
226 BackgroundColor
=> 'text',
227 OverrideURL
=> 'text',
229 Times
=> \
&_read_xml_times
,
230 AutoType
=> \
&_read_xml_entry_auto_type
,
231 PreviousParentGroup
=> 'uuid', # KDBX4.1
232 QualityCheck
=> 'bool', # KDBX4.1
233 String
=> [strings
=> \
&_read_xml_entry_string
],
234 Binary
=> [binaries
=> \
&_read_xml_entry_binary
],
235 CustomData
=> \
&_read_xml_custom_data
, # KDBX4
238 return $self->_read_xml_element([],
239 Entry
=> \
&_read_xml_entry
,
245 for my $string (@{$entry->{strings
} || []}) {
246 $strings{$string->{key
}} = $string->{value
};
248 $entry->{strings
} = \
%strings;
251 for my $binary (@{$entry->{binaries
} || []}) {
252 $binaries{$binary->{key
}} = $binary->{value
};
254 $entry->{binaries
} = \
%binaries;
259 sub _read_xml_times
{
262 return $self->_read_xml_element(
263 LastModificationTime
=> 'datetime',
264 CreationTime
=> 'datetime',
265 LastAccessTime
=> 'datetime',
266 ExpiryTime
=> 'datetime',
268 UsageCount
=> 'number',
269 LocationChanged
=> 'datetime',
273 sub _read_xml_entry_string
{
276 return $self->_read_xml_element(
281 my $protected = $self->_read_xml_attribute('Protected', 'bool', false
);
282 my $protect_in_memory = $self->_read_xml_attribute('ProtectInMemory', 'bool', false
);
283 my $protect = $protected || $protect_in_memory;
285 my $val = $self->_read_xml_content($protected ? 'binary' : 'text');
289 $protect ? (protect
=> true
) : (),
292 $self->_safe->add_protected(sub { decode
('UTF-8', $_[0]) }, $string) if $protected;
299 sub _read_xml_entry_binary
{
302 return $self->_read_xml_element(
307 my $ref = $self->_read_xml_attribute('Ref');
308 my $compressed = $self->_read_xml_attribute('Compressed', 'bool', false
);
309 my $protected = $self->_read_xml_attribute('Protected', 'bool', false
);
313 $binary->{ref} = $ref;
316 $binary->{value
} = $self->_read_xml_content('binary');
317 $binary->{protect
} = true
if $protected;
320 # if compressed, decompress later when the safe is unlocked
321 $self->_safe->add_protected($compressed ? \
&gunzip
: (), $binary);
323 elsif ($compressed) {
324 $binary->{value
} = gunzip
($binary->{value
});
333 sub _read_xml_entry_auto_type
{
336 return $self->_read_xml_element({associations
=> []},
338 DataTransferObfuscation
=> 'number',
339 DefaultSequence
=> 'text',
340 Association
=> [associations
=> sub {
342 return $self->_read_xml_element(
344 KeystrokeSequence
=> 'text',
350 sub _read_xml_deleted_objects
{
353 return $self->_read_xml_element(
354 DeletedObject
=> sub {
356 my $object = $self->_read_xml_element(
358 DeletionTime
=> 'datetime',
360 $object->{uuid
} => $object;
365 ##############################################################################
367 sub _resolve_binary_refs
{
369 my $kdbx = $self->kdbx;
371 my $entries = $kdbx->all_entries(history
=> 1);
372 my $pool = $kdbx->binaries;
374 for my $entry (@$entries) {
375 while (my ($key, $binary) = each %{$entry->binaries}) {
376 my $ref = $binary->{ref} // next;
377 next if defined $binary->{value
};
379 my $data = $pool->{$ref};
380 if (!defined $data || !defined $data->{value
}) {
381 alert
"Found a reference to a missing binary: $key", key
=> $key, ref => $ref;
384 $binary->{value
} = $data->{value
};
385 $binary->{protect
} = true
if $data->{protect
};
386 delete $binary->{ref};
391 ##############################################################################
393 sub _read_xml_element
{
395 my $args = @_ % 2 == 1 ? shift : {};
398 my $reader = $self->_reader;
399 my $path = $reader->nodePath;
400 $path =~ s!\Q/text()\E$!!;
402 return $args if $reader->isEmptyElement;
404 my $store = ref $args eq 'CODE' ? $args
405 : ref $args eq 'HASH' ? sub {
406 my ($key, $val) = @_;
407 if (ref $args->{$key} eq 'HASH') {
408 $args->{$key}{$key} = $val;
410 elsif (ref $args->{$key} eq 'ARRAY') {
411 push @{$args->{$key}}, $val;
415 and alert
'Overwriting value', node
=> $reader->nodePath, line
=> $reader->lineNumber;
416 $args->{$key} = $val;
418 } : ref $args eq 'ARRAY' ? sub {
419 my ($key, $val) = @_;
423 my $pattern = XML
::LibXML
::Pattern-
>new("${path}|${path}/*");
424 while ($reader->nextPatternMatch($pattern) == 1) {
425 last if $reader->nodePath eq $path && $reader->nodeType == XML_READER_TYPE_END_ELEMENT
;
426 next if $reader->nodeType != XML_READER_TYPE_ELEMENT
;
428 my $name = $reader->localName;
429 my $key = snakify
($name);
430 my $type = $spec{$name};
431 ($key, $type) = @$type if ref $type eq 'ARRAY';
433 if (!defined $type) {
434 exists $spec{$name} or alert
"Ignoring unknown element: $name",
435 node
=> $reader->nodePath,
436 line
=> $reader->lineNumber;
440 if (ref $type eq 'CODE') {
441 my @result = $self->$type($args, $reader->nodePath);
445 elsif (@result == 1) {
446 $store->($key, @result);
450 $store->($key, $self->_read_xml_content($type));
457 sub _read_xml_attribute
{
460 my $type = shift // 'text';
462 my $reader = $self->_reader;
464 return $default if !$reader->hasAttributes;
466 my $value = trim
($reader->getAttribute($name));
467 if (!defined $value) {
468 # try again after reading in all the attributes
469 $reader->moveToFirstAttribute;
470 while ($self->_reader->readAttributeValue == 1) {}
471 $reader->moveToElement;
473 $value = trim
($reader->getAttribute($name));
476 return $default if !defined $value;
478 my $decoded = eval { _decode_primitive
($value, $type) };
480 ref $err and $err->details(attribute
=> $name, node
=> $reader->nodePath, line
=> $reader->lineNumber);
487 sub _read_xml_content
{
490 my $reader = $self->_reader;
492 $reader->read if !$reader->isEmptyElement; # step into element
493 return '' if !$reader->hasValue;
495 my $content = trim
($reader->value);
497 my $decoded = eval { _decode_primitive
($content, $type) };
499 ref $err and $err->details(node
=> $reader->nodePath, line
=> $reader->lineNumber);
506 ##############################################################################
508 sub _decode_primitive
{ goto &{__PACKAGE__
."::_decode_$_[1]"} }
512 return '' if !defined || (ref && !defined $$_);
513 $_ = eval { decode_b64
(ref $_ ? $$_ : $_) };
515 my $cleanup = erase_scoped
$_;
516 $err and throw
'Failed to parse binary', error
=> $err;
522 return true
if /^True$/i;
523 return false
if /^False$/i;
524 return false
if length($_) == 0;
525 throw
'Expected boolean', text
=> $_;
528 sub _decode_datetime
{
531 if (/^[A-Za-z0-9\+\/\
=]+$/) {
532 my $binary = eval { decode_b64
($_) };
534 throw
'Failed to parse binary datetime', text
=> $_, error
=> $err;
538 $binary .= \
0 x
(8 - length($binary)) if length($binary) < 8;
539 my ($seconds_since_ad1) = unpack('Q<', $binary);
540 my $epoch = $seconds_since_ad1 - TIME_SECONDS_AD1_TO_UNIX_EPOCH
;
541 return Time
::Piece-
>new($epoch);
545 my $dt = eval { Time
::Piece-
>strptime($_, '%Y-%m-%dT%H:%M:%SZ') };
547 throw
'Failed to parse datetime', text
=> $_, error
=> $err;
552 sub _decode_tristate
{
554 return undef if /^null$/i;
555 my $tristate = eval { _decode_bool
($_) };
556 $@ and throw
'Expected tristate', text
=> $_, error
=> $@;
562 $_ = _decode_text
($_);
563 looks_like_number
($_) or throw
'Expected number', text
=> $_;
569 return '' if !defined;
575 my $uuid = eval { _decode_binary
($_) };
576 $@ and throw
'Expected UUID', text
=> $_, error
=> $@;
577 length($uuid) == 16 or throw
'Invalid UUID size', size
=> length($uuid);