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 my $reader = $self->{_reader
} = XML
::LibXML
::Reader-
>new(IO
=> $fh);
45 my $pattern = XML
::LibXML
::Pattern-
>new('/KeePassFile/Meta|/KeePassFile/Root');
46 while ($reader->nextPatternMatch($pattern) == 1) {
47 next if $reader->nodeType != XML_READER_TYPE_ELEMENT
;
48 my $name = $reader->localName;
49 if ($name eq 'Meta') {
50 $self->_read_xml_meta;
52 elsif ($name eq 'Root') {
54 alert
'Ignoring extra Root element in KeePass XML file', line
=> $reader->lineNumber;
57 $self->_read_xml_root;
62 if ($reader->readState == XML_READER_ERROR
) {
63 throw
'Failed to parse KeePass XML';
66 $self->kdbx->_safe($self->_safe) if $self->{safe
};
68 $self->_resolve_binary_refs;
74 $self->_read_xml_element($self->kdbx->meta,
76 HeaderHash
=> 'binary',
77 DatabaseName
=> 'text',
78 DatabaseNameChanged
=> 'datetime',
79 DatabaseDescription
=> 'text',
80 DatabaseDescriptionChanged
=> 'datetime',
81 DefaultUserName
=> 'text',
82 DefaultUserNameChanged
=> 'datetime',
83 MaintenanceHistoryDays
=> 'number',
85 MasterKeyChanged
=> 'datetime',
86 MasterKeyChangeRec
=> 'number',
87 MasterKeyChangeForce
=> 'number',
88 MemoryProtection
=> \
&_read_xml_memory_protection
,
89 CustomIcons
=> \
&_read_xml_custom_icons
,
90 RecycleBinEnabled
=> 'bool',
91 RecycleBinUUID
=> 'uuid',
92 RecycleBinChanged
=> 'datetime',
93 EntryTemplatesGroup
=> 'uuid',
94 EntryTemplatesGroupChanged
=> 'datetime',
95 LastSelectedGroup
=> 'uuid',
96 LastTopVisibleGroup
=> 'uuid',
97 HistoryMaxItems
=> 'number',
98 HistoryMaxSize
=> 'number',
99 SettingsChanged
=> 'datetime',
100 Binaries
=> \
&_read_xml_binaries
,
101 CustomData
=> \
&_read_xml_custom_data
,
105 sub _read_xml_memory_protection
{
107 my $meta = shift // $self->kdbx->meta;
109 return $self->_read_xml_element(
110 ProtectTitle
=> 'bool',
111 ProtectUserName
=> 'bool',
112 ProtectPassword
=> 'bool',
113 ProtectURL
=> 'bool',
114 ProtectNotes
=> 'bool',
115 AutoEnableVisualHiding
=> 'bool',
119 sub _read_xml_binaries
{
121 my $kdbx = $self->kdbx;
123 my $binaries = $self->_read_xml_element(
126 my $id = $self->_read_xml_attribute('ID');
127 my $compressed = $self->_read_xml_attribute('Compressed', 'bool', false
);
128 my $protected = $self->_read_xml_attribute('Protected', 'bool', false
);
129 my $data = $self->_read_xml_content('binary');
133 $protected ? (protect
=> true
) : (),
137 # if compressed, decompress later when the safe is unlocked
138 $self->_safe->add_protected($compressed ? \
&gunzip
: (), $binary);
140 elsif ($compressed) {
141 $binary->{value
} = gunzip
($data);
148 $kdbx->binaries({%{$kdbx->binaries}, %$binaries});
149 return (); # do not add to meta
152 sub _read_xml_custom_data
{
155 return $self->_read_xml_element(
158 my $item = $self->_read_xml_element(
161 LastModificationTime
=> 'datetime', # KDBX4.1
163 $item->{key
} => $item;
168 sub _read_xml_custom_icons
{
171 return $self->_read_xml_element(
174 my $icon = $self->_read_xml_element(
177 Name
=> 'text', # KDBX4.1
178 LastModificationTime
=> 'datetime', # KDBX4.1
180 $icon->{uuid
} => $icon;
187 my $kdbx = $self->kdbx;
189 my $root = $self->_read_xml_element(
190 Group
=> \
&_read_xml_group
,
191 DeletedObjects
=> \
&_read_xml_deleted_objects
,
194 $kdbx->deleted_objects($root->{deleted_objects
});
195 $kdbx->root($root->{group
}) if $root->{group
};
198 sub _read_xml_group
{
201 return $self->_read_xml_element({entries
=> [], groups
=> []},
205 Tags
=> 'text', # KDBX4.1
207 CustomIconUUID
=> 'uuid',
208 Times
=> \
&_read_xml_times
,
209 IsExpanded
=> 'bool',
210 DefaultAutoTypeSequence
=> 'text',
211 EnableAutoType
=> 'tristate',
212 EnableSearching
=> 'tristate',
213 LastTopVisibleEntry
=> 'uuid',
214 CustomData
=> \
&_read_xml_custom_data
, # KDBX4
215 PreviousParentGroup
=> 'uuid', # KDBX4.1
216 Entry
=> [entries
=> \
&_read_xml_entry
],
217 Group
=> [groups
=> \
&_read_xml_group
],
221 sub _read_xml_entry
{
224 my $entry = $self->_read_xml_element({strings
=> [], binaries
=> []},
227 CustomIconUUID
=> 'uuid',
228 ForegroundColor
=> 'text',
229 BackgroundColor
=> 'text',
230 OverrideURL
=> 'text',
232 Times
=> \
&_read_xml_times
,
233 AutoType
=> \
&_read_xml_entry_auto_type
,
234 PreviousParentGroup
=> 'uuid', # KDBX4.1
235 QualityCheck
=> 'bool', # KDBX4.1
236 String
=> [strings
=> \
&_read_xml_entry_string
],
237 Binary
=> [binaries
=> \
&_read_xml_entry_binary
],
238 CustomData
=> \
&_read_xml_custom_data
, # KDBX4
241 return $self->_read_xml_element([],
242 Entry
=> \
&_read_xml_entry
,
248 for my $string (@{$entry->{strings
} || []}) {
249 $strings{$string->{key
}} = $string->{value
};
251 $entry->{strings
} = \
%strings;
254 for my $binary (@{$entry->{binaries
} || []}) {
255 $binaries{$binary->{key
}} = $binary->{value
};
257 $entry->{binaries
} = \
%binaries;
262 sub _read_xml_times
{
265 return $self->_read_xml_element(
266 LastModificationTime
=> 'datetime',
267 CreationTime
=> 'datetime',
268 LastAccessTime
=> 'datetime',
269 ExpiryTime
=> 'datetime',
271 UsageCount
=> 'number',
272 LocationChanged
=> 'datetime',
276 sub _read_xml_entry_string
{
279 return $self->_read_xml_element(
284 my $protected = $self->_read_xml_attribute('Protected', 'bool', false
);
285 my $protect_in_memory = $self->_read_xml_attribute('ProtectInMemory', 'bool', false
);
286 my $protect = $protected || $protect_in_memory;
288 my $val = $self->_read_xml_content($protected ? 'binary' : 'text');
292 $protect ? (protect
=> true
) : (),
295 $self->_safe->add_protected(sub { decode
('UTF-8', $_[0]) }, $string) if $protected;
302 sub _read_xml_entry_binary
{
305 return $self->_read_xml_element(
310 my $ref = $self->_read_xml_attribute('Ref');
311 my $compressed = $self->_read_xml_attribute('Compressed', 'bool', false
);
312 my $protected = $self->_read_xml_attribute('Protected', 'bool', false
);
316 $binary->{ref} = $ref;
319 $binary->{value
} = $self->_read_xml_content('binary');
320 $binary->{protect
} = true
if $protected;
323 # if compressed, decompress later when the safe is unlocked
324 $self->_safe->add_protected($compressed ? \
&gunzip
: (), $binary);
326 elsif ($compressed) {
327 $binary->{value
} = gunzip
($binary->{value
});
336 sub _read_xml_entry_auto_type
{
339 return $self->_read_xml_element({associations
=> []},
341 DataTransferObfuscation
=> 'number',
342 DefaultSequence
=> 'text',
343 Association
=> [associations
=> sub {
345 return $self->_read_xml_element(
347 KeystrokeSequence
=> 'text',
353 sub _read_xml_deleted_objects
{
356 return $self->_read_xml_element(
357 DeletedObject
=> sub {
359 my $object = $self->_read_xml_element(
361 DeletionTime
=> 'datetime',
363 $object->{uuid
} => $object;
368 ##############################################################################
370 sub _resolve_binary_refs
{
372 my $kdbx = $self->kdbx;
374 my $entries = $kdbx->all_entries(history
=> 1);
375 my $pool = $kdbx->binaries;
377 for my $entry (@$entries) {
378 while (my ($key, $binary) = each %{$entry->binaries}) {
379 my $ref = $binary->{ref} // next;
380 next if defined $binary->{value
};
382 my $data = $pool->{$ref};
383 if (!defined $data || !defined $data->{value
}) {
384 alert
"Found a reference to a missing binary: $key", key
=> $key, ref => $ref;
387 $binary->{value
} = $data->{value
};
388 $binary->{protect
} = true
if $data->{protect
};
389 delete $binary->{ref};
394 ##############################################################################
396 sub _read_xml_element
{
398 my $args = @_ % 2 == 1 ? shift : {};
401 my $reader = $self->_reader;
402 my $path = $reader->nodePath;
403 $path =~ s!\Q/text()\E$!!;
405 return $args if $reader->isEmptyElement;
407 my $store = ref $args eq 'CODE' ? $args
408 : ref $args eq 'HASH' ? sub {
409 my ($key, $val) = @_;
410 if (ref $args->{$key} eq 'HASH') {
411 $args->{$key}{$key} = $val;
413 elsif (ref $args->{$key} eq 'ARRAY') {
414 push @{$args->{$key}}, $val;
418 and alert
'Overwriting value', node
=> $reader->nodePath, line
=> $reader->lineNumber;
419 $args->{$key} = $val;
421 } : ref $args eq 'ARRAY' ? sub {
422 my ($key, $val) = @_;
426 my $pattern = XML
::LibXML
::Pattern-
>new("${path}|${path}/*");
427 while ($reader->nextPatternMatch($pattern) == 1) {
428 last if $reader->nodePath eq $path && $reader->nodeType == XML_READER_TYPE_END_ELEMENT
;
429 next if $reader->nodeType != XML_READER_TYPE_ELEMENT
;
431 my $name = $reader->localName;
432 my $key = snakify
($name);
433 my $type = $spec{$name};
434 ($key, $type) = @$type if ref $type eq 'ARRAY';
436 if (!defined $type) {
437 exists $spec{$name} or alert
"Ignoring unknown element: $name",
438 node
=> $reader->nodePath,
439 line
=> $reader->lineNumber;
443 if (ref $type eq 'CODE') {
444 my @result = $self->$type($args, $reader->nodePath);
448 elsif (@result == 1) {
449 $store->($key, @result);
453 $store->($key, $self->_read_xml_content($type));
460 sub _read_xml_attribute
{
463 my $type = shift // 'text';
465 my $reader = $self->_reader;
467 return $default if !$reader->hasAttributes;
469 my $value = trim
($reader->getAttribute($name));
470 if (!defined $value) {
471 # try again after reading in all the attributes
472 $reader->moveToFirstAttribute;
473 while ($self->_reader->readAttributeValue == 1) {}
474 $reader->moveToElement;
476 $value = trim
($reader->getAttribute($name));
479 return $default if !defined $value;
481 my $decoded = eval { _decode_primitive
($value, $type) };
483 ref $err and $err->details(attribute
=> $name, node
=> $reader->nodePath, line
=> $reader->lineNumber);
490 sub _read_xml_content
{
493 my $reader = $self->_reader;
495 $reader->read if !$reader->isEmptyElement; # step into element
496 return '' if !$reader->hasValue;
498 my $content = trim
($reader->value);
500 my $decoded = eval { _decode_primitive
($content, $type) };
502 ref $err and $err->details(node
=> $reader->nodePath, line
=> $reader->lineNumber);
509 ##############################################################################
511 sub _decode_primitive
{ goto &{__PACKAGE__
."::_decode_$_[1]"} }
515 return '' if !defined || (ref && !defined $$_);
516 $_ = eval { decode_b64
(ref $_ ? $$_ : $_) };
518 my $cleanup = erase_scoped
$_;
519 $err and throw
'Failed to parse binary', error
=> $err;
525 return true
if /^True$/i;
526 return false
if /^False$/i;
527 return false
if length($_) == 0;
528 throw
'Expected boolean', text
=> $_;
531 sub _decode_datetime
{
534 if (/^[A-Za-z0-9\+\/\
=]+$/) {
535 my $binary = eval { decode_b64
($_) };
537 throw
'Failed to parse binary datetime', text
=> $_, error
=> $err;
541 $binary .= \
0 x
(8 - length($binary)) if length($binary) < 8;
542 my ($seconds_since_ad1) = unpack('Q<', $binary);
543 my $epoch = $seconds_since_ad1 - TIME_SECONDS_AD1_TO_UNIX_EPOCH
;
544 return Time
::Piece-
>new($epoch);
548 my $dt = eval { Time
::Piece-
>strptime($_, '%Y-%m-%dT%H:%M:%SZ') };
550 throw
'Failed to parse datetime', text
=> $_, error
=> $err;
555 sub _decode_tristate
{
557 return undef if /^null$/i;
558 my $tristate = eval { _decode_bool
($_) };
559 $@ and throw
'Expected tristate', text
=> $_, error
=> $@;
565 $_ = _decode_text
($_);
566 looks_like_number
($_) or throw
'Expected number', text
=> $_;
572 return '' if !defined;
578 my $uuid = eval { _decode_binary
($_) };
579 $@ and throw
'Expected UUID', text
=> $_, error
=> $@;
580 length($uuid) == 16 or throw
'Invalid UUID size', size
=> length($uuid);