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 $self->_read_xml_element(
174 Name
=> 'text', # KDBX4.1
175 LastModificationTime
=> 'datetime', # KDBX4.1
183 my $kdbx = $self->kdbx;
185 my $root = $self->_read_xml_element(
186 Group
=> \
&_read_xml_group
,
187 DeletedObjects
=> \
&_read_xml_deleted_objects
,
190 $kdbx->deleted_objects($root->{deleted_objects
});
191 $kdbx->root($root->{group
}) if $root->{group
};
194 sub _read_xml_group
{
197 return $self->_read_xml_element({entries
=> [], groups
=> []},
201 Tags
=> 'text', # KDBX4.1
203 CustomIconUUID
=> 'uuid',
204 Times
=> \
&_read_xml_times
,
205 IsExpanded
=> 'bool',
206 DefaultAutoTypeSequence
=> 'text',
207 EnableAutoType
=> 'tristate',
208 EnableSearching
=> 'tristate',
209 LastTopVisibleEntry
=> 'uuid',
210 CustomData
=> \
&_read_xml_custom_data
, # KDBX4
211 PreviousParentGroup
=> 'uuid', # KDBX4.1
212 Entry
=> [entries
=> \
&_read_xml_entry
],
213 Group
=> [groups
=> \
&_read_xml_group
],
217 sub _read_xml_entry
{
220 my $entry = $self->_read_xml_element({strings
=> [], binaries
=> []},
223 CustomIconUUID
=> 'uuid',
224 ForegroundColor
=> 'text',
225 BackgroundColor
=> 'text',
226 OverrideURL
=> 'text',
228 Times
=> \
&_read_xml_times
,
229 AutoType
=> \
&_read_xml_entry_auto_type
,
230 PreviousParentGroup
=> 'uuid', # KDBX4.1
231 QualityCheck
=> 'bool', # KDBX4.1
232 String
=> [strings
=> \
&_read_xml_entry_string
],
233 Binary
=> [binaries
=> \
&_read_xml_entry_binary
],
234 CustomData
=> \
&_read_xml_custom_data
, # KDBX4
237 return $self->_read_xml_element([],
238 Entry
=> \
&_read_xml_entry
,
244 for my $string (@{$entry->{strings
} || []}) {
245 $strings{$string->{key
}} = $string->{value
};
247 $entry->{strings
} = \
%strings;
250 for my $binary (@{$entry->{binaries
} || []}) {
251 $binaries{$binary->{key
}} = $binary->{value
};
253 $entry->{binaries
} = \
%binaries;
258 sub _read_xml_times
{
261 return $self->_read_xml_element(
262 LastModificationTime
=> 'datetime',
263 CreationTime
=> 'datetime',
264 LastAccessTime
=> 'datetime',
265 ExpiryTime
=> 'datetime',
267 UsageCount
=> 'number',
268 LocationChanged
=> 'datetime',
272 sub _read_xml_entry_string
{
275 return $self->_read_xml_element(
280 my $protected = $self->_read_xml_attribute('Protected', 'bool', false
);
281 my $protect_in_memory = $self->_read_xml_attribute('ProtectInMemory', 'bool', false
);
282 my $protect = $protected || $protect_in_memory;
284 my $val = $self->_read_xml_content($protected ? 'binary' : 'text');
288 $protect ? (protect
=> true
) : (),
291 $self->_safe->add_protected(sub { decode
('UTF-8', $_[0]) }, $string) if $protected;
298 sub _read_xml_entry_binary
{
301 return $self->_read_xml_element(
306 my $ref = $self->_read_xml_attribute('Ref');
307 my $compressed = $self->_read_xml_attribute('Compressed', 'bool', false
);
308 my $protected = $self->_read_xml_attribute('Protected', 'bool', false
);
312 $binary->{ref} = $ref;
315 $binary->{value
} = $self->_read_xml_content('binary');
316 $binary->{protect
} = true
if $protected;
319 # if compressed, decompress later when the safe is unlocked
320 $self->_safe->add_protected($compressed ? \
&gunzip
: (), $binary);
322 elsif ($compressed) {
323 $binary->{value
} = gunzip
($binary->{value
});
332 sub _read_xml_entry_auto_type
{
335 return $self->_read_xml_element({associations
=> []},
337 DataTransferObfuscation
=> 'number',
338 DefaultSequence
=> 'text',
339 Association
=> [associations
=> sub {
341 return $self->_read_xml_element(
343 KeystrokeSequence
=> 'text',
349 sub _read_xml_deleted_objects
{
352 return $self->_read_xml_element(
353 DeletedObject
=> sub {
355 my $object = $self->_read_xml_element(
357 DeletionTime
=> 'datetime',
359 $object->{uuid
} => $object;
364 ##############################################################################
366 sub _resolve_binary_refs
{
368 my $kdbx = $self->kdbx;
370 my $pool = $kdbx->binaries;
372 my $entries = $kdbx->entries(history
=> 1);
373 while (my $entry = $entries->next) {
374 while (my ($key, $binary) = each %{$entry->binaries}) {
375 my $ref = $binary->{ref} // next;
376 next if defined $binary->{value
};
378 my $data = $pool->{$ref};
379 if (!defined $data || !defined $data->{value
}) {
380 alert
"Found a reference to a missing binary: $key", key
=> $key, ref => $ref;
383 $binary->{value
} = $data->{value
};
384 $binary->{protect
} = true
if $data->{protect
};
385 delete $binary->{ref};
390 ##############################################################################
392 sub _read_xml_element
{
394 my $args = @_ % 2 == 1 ? shift : {};
397 my $reader = $self->_reader;
398 my $path = $reader->nodePath;
399 $path =~ s!\Q/text()\E$!!;
401 return $args if $reader->isEmptyElement;
403 my $store = ref $args eq 'CODE' ? $args
404 : ref $args eq 'HASH' ? sub {
405 my ($key, $val) = @_;
406 if (ref $args->{$key} eq 'HASH') {
407 $args->{$key}{$key} = $val;
409 elsif (ref $args->{$key} eq 'ARRAY') {
410 push @{$args->{$key}}, $val;
414 and alert
'Overwriting value', node
=> $reader->nodePath, line
=> $reader->lineNumber;
415 $args->{$key} = $val;
417 } : ref $args eq 'ARRAY' ? sub {
418 my ($key, $val) = @_;
422 my $pattern = XML
::LibXML
::Pattern-
>new("${path}|${path}/*");
423 while ($reader->nextPatternMatch($pattern) == 1) {
424 last if $reader->nodePath eq $path && $reader->nodeType == XML_READER_TYPE_END_ELEMENT
;
425 next if $reader->nodeType != XML_READER_TYPE_ELEMENT
;
427 my $name = $reader->localName;
428 my $key = snakify
($name);
429 my $type = $spec{$name};
430 ($key, $type) = @$type if ref $type eq 'ARRAY';
432 if (!defined $type) {
433 exists $spec{$name} or alert
"Ignoring unknown element: $name",
434 node
=> $reader->nodePath,
435 line
=> $reader->lineNumber;
439 if (ref $type eq 'CODE') {
440 my @result = $self->$type($args, $reader->nodePath);
444 elsif (@result == 1) {
445 $store->($key, @result);
449 $store->($key, $self->_read_xml_content($type));
456 sub _read_xml_attribute
{
459 my $type = shift // 'text';
461 my $reader = $self->_reader;
463 return $default if !$reader->hasAttributes;
465 my $value = trim
($reader->getAttribute($name));
466 if (!defined $value) {
467 # try again after reading in all the attributes
468 $reader->moveToFirstAttribute;
469 while ($self->_reader->readAttributeValue == 1) {}
470 $reader->moveToElement;
472 $value = trim
($reader->getAttribute($name));
475 return $default if !defined $value;
477 my $decoded = eval { _decode_primitive
($value, $type) };
479 ref $err and $err->details(attribute
=> $name, node
=> $reader->nodePath, line
=> $reader->lineNumber);
486 sub _read_xml_content
{
489 my $reader = $self->_reader;
491 $reader->read if !$reader->isEmptyElement; # step into element
492 return '' if !$reader->hasValue;
494 my $content = trim
($reader->value);
496 my $decoded = eval { _decode_primitive
($content, $type) };
498 ref $err and $err->details(node
=> $reader->nodePath, line
=> $reader->lineNumber);
505 ##############################################################################
507 sub _decode_primitive
{ goto &{__PACKAGE__
."::_decode_$_[1]"} }
511 return '' if !defined || (ref && !defined $$_);
512 $_ = eval { decode_b64
(ref $_ ? $$_ : $_) };
514 my $cleanup = erase_scoped
$_;
515 $err and throw
'Failed to parse binary', error
=> $err;
521 return true
if /^True$/i;
522 return false
if /^False$/i;
523 return false
if length($_) == 0;
524 throw
'Expected boolean', text
=> $_;
527 sub _decode_datetime
{
530 if (/^[A-Za-z0-9\+\/\
=]+$/) {
531 my $binary = eval { decode_b64
($_) };
533 throw
'Failed to parse binary datetime', text
=> $_, error
=> $err;
537 $binary .= \
0 x
(8 - length($binary)) if length($binary) < 8;
538 my ($seconds_since_ad1) = unpack('Q<', $binary);
539 my $epoch = $seconds_since_ad1 - TIME_SECONDS_AD1_TO_UNIX_EPOCH
;
540 return Time
::Piece-
>new($epoch);
544 my $dt = eval { Time
::Piece-
>strptime($_, '%Y-%m-%dT%H:%M:%SZ') };
546 throw
'Failed to parse datetime', text
=> $_, error
=> $err;
551 sub _decode_tristate
{
553 return undef if /^null$/i;
554 my $tristate = eval { _decode_bool
($_) };
555 $@ and throw
'Expected tristate', text
=> $_, error
=> $@;
561 $_ = _decode_text
($_);
562 looks_like_number
($_) or throw
'Expected number', text
=> $_;
568 return '' if !defined;
574 my $uuid = eval { _decode_binary
($_) };
575 $@ and throw
'Expected UUID', text
=> $_, error
=> $@;
576 length($uuid) == 16 or throw
'Invalid UUID size', size
=> length($uuid);