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