Dogcows Code - chaz/p5-File-KDBX/blob - lib/File/KDBX/Loader/XML.pm

   1 package File::KDBX::Loader::XML;
   2 # ABSTRACT: Load unencrypted XML KeePass files
   3
   4 use warnings;
   5 use strict;
   6
   7 use Crypt::Misc 0.029 qw(decode_b64);
   8 use Encode qw(decode);
   9 use File::KDBX::Constants qw(:version :time);
  10 use File::KDBX::Error;
  11 use File::KDBX::Safe;
  12 use File::KDBX::Util qw(:text assert_64bit gunzip erase_scoped);
  13 use Scalar::Util qw(looks_like_number);
  14 use Time::Piece;
  15 use XML::LibXML::Reader;
  16 use boolean;
  17 use namespace::clean;
  18
  19 use parent 'File::KDBX::Loader';
  20
  21 our $VERSION = '999.999'; # VERSION
  22
  23 sub _reader { $_[0]->{_reader} }
  24
  25 sub _binaries { $_[0]->{binaries} //= {} }
  26
  27 sub _safe { $_[0]->{safe} //= File::KDBX::Safe->new(cipher => $_[0]->kdbx->random_stream) }
  28
  29 sub _read {
  30     my $self = shift;
  31     my $fh   = shift;
  32
  33     $self->_read_inner_body($fh);
  34 }
  35
  36 sub _read_inner_body {
  37     my $self = shift;
  38     my $fh   = shift;
  39
  40     # print do  { local $/; <$fh> };
  41     # exit;
  42     my $reader = $self->{_reader} = XML::LibXML::Reader->new(IO => $fh);
  43
  44     delete $self->{safe};
  45     my $root_done;
  46
  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;
  53         }
  54         elsif ($name eq 'Root') {
  55             if ($root_done) {
  56                 alert 'Ignoring extra Root element in KeePass XML file', line => $reader->lineNumber;
  57                 next;
  58             }
  59             $self->_read_xml_root;
  60             $root_done = 1;
  61         }
  62     }
  63
  64     if ($reader->readState == XML_READER_ERROR) {
  65         throw 'Failed to parse KeePass XML';
  66     }
  67
  68     $self->kdbx->_safe($self->_safe) if $self->{safe};
  69
  70     $self->_resolve_binary_refs;
  71 }
  72
  73 sub _read_xml_meta {
  74     my $self = shift;
  75
  76     $self->_read_xml_element($self->kdbx->meta,
  77         Generator                   => 'text',
  78         HeaderHash                  => 'binary',
  79         DatabaseName                => 'text',
  80         DatabaseNameChanged         => 'datetime',
  81         DatabaseDescription         => 'text',
  82         DatabaseDescriptionChanged  => 'datetime',
  83         DefaultUserName             => 'text',
  84         DefaultUserNameChanged      => 'datetime',
  85         MaintenanceHistoryDays      => 'number',
  86         Color                       => 'text',
  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,
 104     );
 105 }
 106
 107 sub _read_xml_memory_protection {
 108     my $self = shift;
 109     my $meta = shift // $self->kdbx->meta;
 110
 111     return $self->_read_xml_element(
 112         ProtectTitle            => 'bool',
 113         ProtectUserName         => 'bool',
 114         ProtectPassword         => 'bool',
 115         ProtectURL              => 'bool',
 116         ProtectNotes            => 'bool',
 117         AutoEnableVisualHiding  => 'bool',
 118     );
 119 }
 120
 121 sub _read_xml_binaries {
 122     my $self = shift;
 123     my $kdbx = $self->kdbx;
 124
 125     my $binaries = $self->_read_xml_element(
 126         Binary  => sub {
 127             my $self = shift;
 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');
 132
 133             my $binary = {
 134                 value   => $data,
 135                 $protected ? (protect => true) : (),
 136             };
 137
 138             if ($protected) {
 139                 # if compressed, decompress later when the safe is unlocked
 140                 $self->_safe->add_protected($compressed ? \&gunzip : (), $binary);
 141             }
 142             elsif ($compressed) {
 143                 $binary->{value} = gunzip($data);
 144             }
 145
 146             $id => $binary;
 147         },
 148     );
 149
 150     $kdbx->binaries({%{$kdbx->binaries}, %$binaries});
 151     return (); # do not add to meta
 152 }
 153
 154 sub _read_xml_custom_data {
 155     my $self = shift;
 156
 157     return $self->_read_xml_element(
 158         Item    => sub {
 159             my $self = shift;
 160             my $item = $self->_read_xml_element(
 161                 Key                     => 'text',
 162                 Value                   => 'text',
 163                 LastModificationTime    => 'datetime',  # KDBX4.1
 164             );
 165             $item->{key} => $item;
 166         },
 167     );
 168 }
 169
 170 sub _read_xml_custom_icons {
 171     my $self = shift;
 172
 173     return $self->_read_xml_element(
 174         Icon    => sub {
 175             my $self = shift;
 176             my $icon = $self->_read_xml_element(
 177                 UUID                    => 'uuid',
 178                 Data                    => 'binary',
 179                 Name                    => 'text',      # KDBX4.1
 180                 LastModificationTime    => 'datetime',  # KDBX4.1
 181             );
 182             $icon->{uuid} => $icon;
 183         },
 184     );
 185 }
 186
 187 sub _read_xml_root {
 188     my $self = shift;
 189     my $kdbx = $self->kdbx;
 190
 191     my $root = $self->_read_xml_element(
 192         Group           => \&_read_xml_group,
 193         DeletedObjects  => \&_read_xml_deleted_objects,
 194     );
 195
 196     $kdbx->deleted_objects($root->{deleted_objects});
 197     $kdbx->root($root->{group}) if $root->{group};
 198 }
 199
 200 sub _read_xml_group {
 201     my $self = shift;
 202
 203     return $self->_read_xml_element({entries => [], groups => []},
 204         UUID                    => 'uuid',
 205         Name                    => 'text',
 206         Notes                   => 'text',
 207         Tags                    => 'text',  # KDBX4.1
 208         IconID                  => 'number',
 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],
 220     );
 221 }
 222
 223 sub _read_xml_entry {
 224     my $self = shift;
 225
 226     my $entry = $self->_read_xml_element({strings => [], binaries => []},
 227         UUID                => 'uuid',
 228         IconID              => 'number',
 229         CustomIconUUID      => 'uuid',
 230         ForegroundColor     => 'text',
 231         BackgroundColor     => 'text',
 232         OverrideURL         => 'text',
 233         Tags                => '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
 241         History             => sub {
 242             my $self = shift;
 243             return $self->_read_xml_element([],
 244                 Entry   => \&_read_xml_entry,
 245             );
 246         },
 247     );
 248
 249     my %strings;
 250     for my $string (@{$entry->{strings} || []}) {
 251         $strings{$string->{key}} = $string->{value};
 252     }
 253     $entry->{strings} = \%strings;
 254
 255     my %binaries;
 256     for my $binary (@{$entry->{binaries} || []}) {
 257         $binaries{$binary->{key}} = $binary->{value};
 258     }
 259     $entry->{binaries} = \%binaries;
 260
 261     return $entry;
 262 }
 263
 264 sub _read_xml_times {
 265     my $self = shift;
 266
 267     return $self->_read_xml_element(
 268         LastModificationTime    => 'datetime',
 269         CreationTime            => 'datetime',
 270         LastAccessTime          => 'datetime',
 271         ExpiryTime              => 'datetime',
 272         Expires                 => 'bool',
 273         UsageCount              => 'number',
 274         LocationChanged         => 'datetime',
 275     );
 276 }
 277
 278 sub _read_xml_entry_string {
 279     my $self = shift;
 280
 281     return $self->_read_xml_element(
 282         Key     => 'text',
 283         Value   => sub {
 284             my $self = shift;
 285
 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;
 289
 290             my $val = $self->_read_xml_content($protected ? 'binary' : 'text');
 291
 292             my $string = {
 293                 value   => $val,
 294                 $protect ? (protect => true) : (),
 295             };
 296
 297             $self->_safe->add_protected(sub { decode('UTF-8', $_[0]) }, $string) if $protected;
 298
 299             $string;
 300         },
 301     );
 302 }
 303
 304 sub _read_xml_entry_binary {
 305     my $self = shift;
 306
 307     return $self->_read_xml_element(
 308         Key     => 'text',
 309         Value   => sub {
 310             my $self = shift;
 311
 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);
 315             my $binary = {};
 316
 317             if (defined $ref) {
 318                 $binary->{ref} = $ref;
 319             }
 320             else {
 321                 $binary->{value} = $self->_read_xml_content('binary');
 322                 $binary->{protect} = true if $protected;
 323
 324                 if ($protected) {
 325                     # if compressed, decompress later when the safe is unlocked
 326                     $self->_safe->add_protected($compressed ? \&gunzip : (), $binary);
 327                 }
 328                 elsif ($compressed) {
 329                     $binary->{value} = gunzip($binary->{value});
 330                 }
 331             }
 332
 333             $binary;
 334         },
 335     );
 336 }
 337
 338 sub _read_xml_entry_auto_type {
 339     my $self = shift;
 340
 341     return $self->_read_xml_element({associations => []},
 342         Enabled                 => 'bool',
 343         DataTransferObfuscation => 'number',
 344         DefaultSequence         => 'text',
 345         Association             => [associations => sub {
 346             my $self = shift;
 347             return $self->_read_xml_element(
 348                 Window              => 'text',
 349                 KeystrokeSequence   => 'text',
 350             );
 351         }],
 352     );
 353 }
 354
 355 sub _read_xml_deleted_objects {
 356     my $self = shift;
 357
 358     return $self->_read_xml_element(
 359         DeletedObject   => sub {
 360             my $self = shift;
 361             my $object = $self->_read_xml_element(
 362                 UUID            => 'uuid',
 363                 DeletionTime    => 'datetime',
 364             );
 365             $object->{uuid} => $object;
 366         }
 367     );
 368 }
 369
 370 ##############################################################################
 371
 372 sub _resolve_binary_refs {
 373     my $self = shift;
 374     my $kdbx = $self->kdbx;
 375
 376     my $entries = $kdbx->all_entries(history => 1);
 377     my $pool = $kdbx->binaries;
 378
 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};
 383
 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;
 387                 next;
 388             }
 389             $binary->{value} = $data->{value};
 390             $binary->{protect} = true if $data->{protect};
 391             delete $binary->{ref};
 392         }
 393     }
 394 }
 395
 396 ##############################################################################
 397
 398 sub _read_xml_element {
 399     my $self = shift;
 400     my $args = @_ % 2 == 1 ? shift : {};
 401     my %spec = @_;
 402
 403     my $reader = $self->_reader;
 404     my $path = $reader->nodePath;
 405     $path =~ s!\Q/text()\E$!!;
 406
 407     return $args if $reader->isEmptyElement;
 408
 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;
 414         }
 415         elsif (ref $args->{$key} eq 'ARRAY') {
 416             push @{$args->{$key}}, $val;
 417         }
 418         else {
 419             exists $args->{$key}
 420                 and alert 'Overwriting value', node => $reader->nodePath, line => $reader->lineNumber;
 421             $args->{$key} = $val;
 422         }
 423     } : ref $args eq 'ARRAY' ? sub {
 424         my ($key, $val) = @_;
 425         push @$args, $val;
 426     } : sub {};
 427
 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;
 432
 433         my $name = $reader->localName;
 434         my $key  = snakify($name);
 435         my $type = $spec{$name};
 436         ($key, $type) = @$type if ref $type eq 'ARRAY';
 437
 438         if (!defined $type) {
 439             exists $spec{$name} or alert "Ignoring unknown element: $name",
 440                 node => $reader->nodePath,
 441                 line => $reader->lineNumber;
 442             next;
 443         }
 444
 445         if (ref $type eq 'CODE') {
 446             my @result = $self->$type($args, $reader->nodePath);
 447             if (@result == 2) {
 448                 $store->(@result);
 449             }
 450             elsif (@result == 1) {
 451                 $store->($key, @result);
 452             }
 453         }
 454         else {
 455             $store->($key, $self->_read_xml_content($type));
 456         }
 457     }
 458
 459     return $args;
 460 }
 461
 462 sub _read_xml_attribute {
 463     my $self = shift;
 464     my $name = shift;
 465     my $type = shift // 'text';
 466     my $default = shift;
 467     my $reader = $self->_reader;
 468
 469     return $default if !$reader->hasAttributes;
 470
 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;
 477
 478         $value = trim($reader->getAttribute($name));
 479     }
 480
 481     return $default if !defined $value;
 482
 483     my $decoded = eval { _decode_primitive($value, $type) };
 484     if (my $err = $@) {
 485         ref $err and $err->details(attribute => $name, node => $reader->nodePath, line => $reader->lineNumber);
 486         throw $err
 487     }
 488
 489     return $decoded;
 490 }
 491
 492 sub _read_xml_content {
 493     my $self = shift;
 494     my $type = shift;
 495     my $reader = $self->_reader;
 496
 497     $reader->read if !$reader->isEmptyElement;  # step into element
 498     return '' if !$reader->hasValue;
 499
 500     my $content = trim($reader->value);
 501
 502     my $decoded = eval { _decode_primitive($content, $type) };
 503     if (my $err = $@) {
 504         ref $err and $err->details(node => $reader->nodePath, line => $reader->lineNumber);
 505         throw $err
 506     }
 507
 508     return $decoded;
 509 }
 510
 511 ##############################################################################
 512
 513 sub _decode_primitive { goto &{__PACKAGE__."::_decode_$_[1]"} }
 514
 515 sub _decode_binary {
 516     local $_ = shift;
 517     return '' if !defined || (ref && !defined $$_);
 518     $_ = eval { decode_b64(ref $_ ? $$_ : $_) };
 519     my $err = $@;
 520     my $cleanup = erase_scoped $_;
 521     $err and throw 'Failed to parse binary', error => $err;
 522     return $_;
 523 }
 524
 525 sub _decode_bool {
 526     local $_ = shift;
 527     return true  if /^True$/i;
 528     return false if /^False$/i;
 529     return false if length($_) == 0;
 530     throw 'Expected boolean', text => $_;
 531 }
 532
 533 sub _decode_datetime {
 534     local $_ = shift;
 535
 536     if (/^[A-Za-z0-9\+\/\=]+$/) {
 537         my $binary = eval { decode_b64($_) };
 538         if (my $err = $@) {
 539             throw 'Failed to parse binary datetime', text => $_, error => $err;
 540         }
 541         throw $@ if $@;
 542         assert_64bit;
 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);
 547     }
 548
 549
 550     my $dt = eval { Time::Piece->strptime($_, '%Y-%m-%dT%H:%M:%SZ') };
 551     if (my $err = $@) {
 552         throw 'Failed to parse datetime', text => $_, error => $err;
 553     }
 554     return $dt;
 555 }
 556
 557 sub _decode_tristate {
 558     local $_ = shift;
 559     return undef if /^null$/i;
 560     my $tristate = eval { _decode_bool($_) };
 561     $@ and throw 'Expected tristate', text => $_, error => $@;
 562     return $tristate;
 563 }
 564
 565 sub _decode_number {
 566     local $_ = shift;
 567     $_ = _decode_text($_);
 568     looks_like_number($_) or throw 'Expected number', text => $_;
 569     return $_+0;
 570 }
 571
 572 sub _decode_text {
 573     local $_ = shift;
 574     return '' if !defined;
 575     return $_;
 576 }
 577
 578 sub _decode_uuid {
 579     local $_ = shift;
 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);
 583     return $uuid;
 584 }
 585
 586 1;