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(:text assert_64bit gunzip erase_scoped);
13 use Scalar
::Util
qw(looks_like_number);
15 use XML
::LibXML
::Reader
;
19 use parent
'File::KDBX::Loader';
21 our $VERSION = '999.999'; # VERSION
23 sub _reader
{ $_[0]->{_reader
} }
25 sub _binaries
{ $_[0]->{binaries
} //= {} }
27 sub _safe
{ $_[0]->{safe
} //= File
::KDBX
::Safe-
>new(cipher
=> $_[0]->kdbx->random_stream) }
33 $self->_read_inner_body($fh);
36 sub _read_inner_body
{
40 # print do { local $/; <$fh> };
42 my $reader = $self->{_reader
} = XML
::LibXML
::Reader-
>new(IO
=> $fh);
47 my $pattern = XML
::LibXML
::Pattern-
>new('/KeePassFile/Meta|/KeePassFile/Root');
48 while ($reader->nextPatternMatch($pattern) == 1) {
49 next if $reader->nodeType != XML_READER_TYPE_ELEMENT
;
50 my $name = $reader->localName;
51 if ($name eq 'Meta') {
52 $self->_read_xml_meta;
54 elsif ($name eq 'Root') {
56 alert
'Ignoring extra Root element in KeePass XML file', line
=> $reader->lineNumber;
59 $self->_read_xml_root;
64 if ($reader->readState == XML_READER_ERROR
) {
65 throw
'Failed to parse KeePass XML';
68 $self->kdbx->_safe($self->_safe) if $self->{safe
};
70 $self->_resolve_binary_refs;
76 $self->_read_xml_element($self->kdbx->meta,
78 HeaderHash
=> 'binary',
79 DatabaseName
=> 'text',
80 DatabaseNameChanged
=> 'datetime',
81 DatabaseDescription
=> 'text',
82 DatabaseDescriptionChanged
=> 'datetime',
83 DefaultUserName
=> 'text',
84 DefaultUserNameChanged
=> 'datetime',
85 MaintenanceHistoryDays
=> 'number',
87 MasterKeyChanged
=> 'datetime',
88 MasterKeyChangeRec
=> 'number',
89 MasterKeyChangeForce
=> 'number',
90 MemoryProtection
=> \
&_read_xml_memory_protection
,
91 CustomIcons
=> \
&_read_xml_custom_icons
,
92 RecycleBinEnabled
=> 'bool',
93 RecycleBinUUID
=> 'uuid',
94 RecycleBinChanged
=> 'datetime',
95 EntryTemplatesGroup
=> 'uuid',
96 EntryTemplatesGroupChanged
=> 'datetime',
97 LastSelectedGroup
=> 'uuid',
98 LastTopVisibleGroup
=> 'uuid',
99 HistoryMaxItems
=> 'number',
100 HistoryMaxSize
=> 'number',
101 SettingsChanged
=> 'datetime',
102 Binaries
=> \
&_read_xml_binaries
,
103 CustomData
=> \
&_read_xml_custom_data
,
107 sub _read_xml_memory_protection
{
109 my $meta = shift // $self->kdbx->meta;
111 return $self->_read_xml_element(
112 ProtectTitle
=> 'bool',
113 ProtectUserName
=> 'bool',
114 ProtectPassword
=> 'bool',
115 ProtectURL
=> 'bool',
116 ProtectNotes
=> 'bool',
117 AutoEnableVisualHiding
=> 'bool',
121 sub _read_xml_binaries
{
123 my $kdbx = $self->kdbx;
125 my $binaries = $self->_read_xml_element(
128 my $id = $self->_read_xml_attribute('ID');
129 my $compressed = $self->_read_xml_attribute('Compressed', 'bool', false
);
130 my $protected = $self->_read_xml_attribute('Protected', 'bool', false
);
131 my $data = $self->_read_xml_content('binary');
135 $protected ? (protect
=> true
) : (),
139 # if compressed, decompress later when the safe is unlocked
140 $self->_safe->add_protected($compressed ? \
&gunzip
: (), $binary);
142 elsif ($compressed) {
143 $binary->{value
} = gunzip
($data);
150 $kdbx->binaries({%{$kdbx->binaries}, %$binaries});
151 return (); # do not add to meta
154 sub _read_xml_custom_data
{
157 return $self->_read_xml_element(
160 my $item = $self->_read_xml_element(
163 LastModificationTime
=> 'datetime', # KDBX4.1
165 $item->{key
} => $item;
170 sub _read_xml_custom_icons
{
173 return $self->_read_xml_element(
176 my $icon = $self->_read_xml_element(
179 Name
=> 'text', # KDBX4.1
180 LastModificationTime
=> 'datetime', # KDBX4.1
182 $icon->{uuid
} => $icon;
189 my $kdbx = $self->kdbx;
191 my $root = $self->_read_xml_element(
192 Group
=> \
&_read_xml_group
,
193 DeletedObjects
=> \
&_read_xml_deleted_objects
,
196 $kdbx->deleted_objects($root->{deleted_objects
});
197 $kdbx->root($root->{group
}) if $root->{group
};
200 sub _read_xml_group
{
203 return $self->_read_xml_element({entries
=> [], groups
=> []},
207 Tags
=> 'text', # KDBX4.1
209 CustomIconUUID
=> 'uuid',
210 Times
=> \
&_read_xml_times
,
211 IsExpanded
=> 'bool',
212 DefaultAutoTypeSequence
=> 'text',
213 EnableAutoType
=> 'tristate',
214 EnableSearching
=> 'tristate',
215 LastTopVisibleEntry
=> 'uuid',
216 CustomData
=> \
&_read_xml_custom_data
, # KDBX4
217 PreviousParentGroup
=> 'uuid', # KDBX4.1
218 Entry
=> [entries
=> \
&_read_xml_entry
],
219 Group
=> [groups
=> \
&_read_xml_group
],
223 sub _read_xml_entry
{
226 my $entry = $self->_read_xml_element({strings
=> [], binaries
=> []},
229 CustomIconUUID
=> 'uuid',
230 ForegroundColor
=> 'text',
231 BackgroundColor
=> 'text',
232 OverrideURL
=> 'text',
234 Times
=> \
&_read_xml_times
,
235 AutoType
=> \
&_read_xml_entry_auto_type
,
236 PreviousParentGroup
=> 'uuid', # KDBX4.1
237 QualityCheck
=> 'bool', # KDBX4.1
238 String
=> [strings
=> \
&_read_xml_entry_string
],
239 Binary
=> [binaries
=> \
&_read_xml_entry_binary
],
240 CustomData
=> \
&_read_xml_custom_data
, # KDBX4
243 return $self->_read_xml_element([],
244 Entry
=> \
&_read_xml_entry
,
250 for my $string (@{$entry->{strings
} || []}) {
251 $strings{$string->{key
}} = $string->{value
};
253 $entry->{strings
} = \
%strings;
256 for my $binary (@{$entry->{binaries
} || []}) {
257 $binaries{$binary->{key
}} = $binary->{value
};
259 $entry->{binaries
} = \
%binaries;
264 sub _read_xml_times
{
267 return $self->_read_xml_element(
268 LastModificationTime
=> 'datetime',
269 CreationTime
=> 'datetime',
270 LastAccessTime
=> 'datetime',
271 ExpiryTime
=> 'datetime',
273 UsageCount
=> 'number',
274 LocationChanged
=> 'datetime',
278 sub _read_xml_entry_string
{
281 return $self->_read_xml_element(
286 my $protected = $self->_read_xml_attribute('Protected', 'bool', false
);
287 my $protect_in_memory = $self->_read_xml_attribute('ProtectInMemory', 'bool', false
);
288 my $protect = $protected || $protect_in_memory;
290 my $val = $self->_read_xml_content($protected ? 'binary' : 'text');
294 $protect ? (protect
=> true
) : (),
297 $self->_safe->add_protected(sub { decode
('UTF-8', $_[0]) }, $string) if $protected;
304 sub _read_xml_entry_binary
{
307 return $self->_read_xml_element(
312 my $ref = $self->_read_xml_attribute('Ref');
313 my $compressed = $self->_read_xml_attribute('Compressed', 'bool', false
);
314 my $protected = $self->_read_xml_attribute('Protected', 'bool', false
);
318 $binary->{ref} = $ref;
321 $binary->{value
} = $self->_read_xml_content('binary');
322 $binary->{protect
} = true
if $protected;
325 # if compressed, decompress later when the safe is unlocked
326 $self->_safe->add_protected($compressed ? \
&gunzip
: (), $binary);
328 elsif ($compressed) {
329 $binary->{value
} = gunzip
($binary->{value
});
338 sub _read_xml_entry_auto_type
{
341 return $self->_read_xml_element({associations
=> []},
343 DataTransferObfuscation
=> 'number',
344 DefaultSequence
=> 'text',
345 Association
=> [associations
=> sub {
347 return $self->_read_xml_element(
349 KeystrokeSequence
=> 'text',
355 sub _read_xml_deleted_objects
{
358 return $self->_read_xml_element(
359 DeletedObject
=> sub {
361 my $object = $self->_read_xml_element(
363 DeletionTime
=> 'datetime',
365 $object->{uuid
} => $object;
370 ##############################################################################
372 sub _resolve_binary_refs
{
374 my $kdbx = $self->kdbx;
376 my $entries = $kdbx->all_entries(history
=> 1);
377 my $pool = $kdbx->binaries;
379 for my $entry (@$entries) {
380 while (my ($key, $binary) = each %{$entry->binaries}) {
381 my $ref = $binary->{ref} // next;
382 next if defined $binary->{value
};
384 my $data = $pool->{$ref};
385 if (!defined $data || !defined $data->{value
}) {
386 alert
"Found a reference to a missing binary: $key", key
=> $key, ref => $ref;
389 $binary->{value
} = $data->{value
};
390 $binary->{protect
} = true
if $data->{protect
};
391 delete $binary->{ref};
396 ##############################################################################
398 sub _read_xml_element
{
400 my $args = @_ % 2 == 1 ? shift : {};
403 my $reader = $self->_reader;
404 my $path = $reader->nodePath;
405 $path =~ s!\Q/text()\E$!!;
407 return $args if $reader->isEmptyElement;
409 my $store = ref $args eq 'CODE' ? $args
410 : ref $args eq 'HASH' ? sub {
411 my ($key, $val) = @_;
412 if (ref $args->{$key} eq 'HASH') {
413 $args->{$key}{$key} = $val;
415 elsif (ref $args->{$key} eq 'ARRAY') {
416 push @{$args->{$key}}, $val;
420 and alert
'Overwriting value', node
=> $reader->nodePath, line
=> $reader->lineNumber;
421 $args->{$key} = $val;
423 } : ref $args eq 'ARRAY' ? sub {
424 my ($key, $val) = @_;
428 my $pattern = XML
::LibXML
::Pattern-
>new("${path}|${path}/*");
429 while ($reader->nextPatternMatch($pattern) == 1) {
430 last if $reader->nodePath eq $path && $reader->nodeType == XML_READER_TYPE_END_ELEMENT
;
431 next if $reader->nodeType != XML_READER_TYPE_ELEMENT
;
433 my $name = $reader->localName;
434 my $key = snakify
($name);
435 my $type = $spec{$name};
436 ($key, $type) = @$type if ref $type eq 'ARRAY';
438 if (!defined $type) {
439 exists $spec{$name} or alert
"Ignoring unknown element: $name",
440 node
=> $reader->nodePath,
441 line
=> $reader->lineNumber;
445 if (ref $type eq 'CODE') {
446 my @result = $self->$type($args, $reader->nodePath);
450 elsif (@result == 1) {
451 $store->($key, @result);
455 $store->($key, $self->_read_xml_content($type));
462 sub _read_xml_attribute
{
465 my $type = shift // 'text';
467 my $reader = $self->_reader;
469 return $default if !$reader->hasAttributes;
471 my $value = trim
($reader->getAttribute($name));
472 if (!defined $value) {
473 # try again after reading in all the attributes
474 $reader->moveToFirstAttribute;
475 while ($self->_reader->readAttributeValue == 1) {}
476 $reader->moveToElement;
478 $value = trim
($reader->getAttribute($name));
481 return $default if !defined $value;
483 my $decoded = eval { _decode_primitive
($value, $type) };
485 ref $err and $err->details(attribute
=> $name, node
=> $reader->nodePath, line
=> $reader->lineNumber);
492 sub _read_xml_content
{
495 my $reader = $self->_reader;
497 $reader->read if !$reader->isEmptyElement; # step into element
498 return '' if !$reader->hasValue;
500 my $content = trim
($reader->value);
502 my $decoded = eval { _decode_primitive
($content, $type) };
504 ref $err and $err->details(node
=> $reader->nodePath, line
=> $reader->lineNumber);
511 ##############################################################################
513 sub _decode_primitive
{ goto &{__PACKAGE__
."::_decode_$_[1]"} }
517 return '' if !defined || (ref && !defined $$_);
518 $_ = eval { decode_b64
(ref $_ ? $$_ : $_) };
520 my $cleanup = erase_scoped
$_;
521 $err and throw
'Failed to parse binary', error
=> $err;
527 return true
if /^True$/i;
528 return false
if /^False$/i;
529 return false
if length($_) == 0;
530 throw
'Expected boolean', text
=> $_;
533 sub _decode_datetime
{
536 if (/^[A-Za-z0-9\+\/\
=]+$/) {
537 my $binary = eval { decode_b64
($_) };
539 throw
'Failed to parse binary datetime', text
=> $_, error
=> $err;
543 $binary .= \
0 x
(8 - length($binary)) if length($binary) < 8;
544 my ($seconds_since_ad1) = unpack('Q<', $binary);
545 my $epoch = $seconds_since_ad1 - TIME_SECONDS_AD1_TO_UNIX_EPOCH
;
546 return Time
::Piece-
>new($epoch);
550 my $dt = eval { Time
::Piece-
>strptime($_, '%Y-%m-%dT%H:%M:%SZ') };
552 throw
'Failed to parse datetime', text
=> $_, error
=> $err;
557 sub _decode_tristate
{
559 return undef if /^null$/i;
560 my $tristate = eval { _decode_bool
($_) };
561 $@ and throw
'Expected tristate', text
=> $_, error
=> $@;
567 $_ = _decode_text
($_);
568 looks_like_number
($_) or throw
'Expected number', text
=> $_;
574 return '' if !defined;
580 my $uuid = eval { _decode_binary
($_) };
581 $@ and throw
'Expected UUID', text
=> $_, error
=> $@;
582 length($uuid) == 16 or throw
'Invalid UUID size', size
=> length($uuid);