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             my $icon = $self->_read_xml_element(
 172                 UUID                    => 'uuid',
 173                 Data                    => 'binary',
 174                 Name                    => 'text',      # KDBX4.1
 175                 LastModificationTime    => 'datetime',  # KDBX4.1
 176             );
 177             $icon->{uuid} => $icon;
 178         },
 179     );
 180 }
 181
 182 sub _read_xml_root {
 183     my $self = shift;
 184     my $kdbx = $self->kdbx;
 185
 186     my $root = $self->_read_xml_element(
 187         Group           => \&_read_xml_group,
 188         DeletedObjects  => \&_read_xml_deleted_objects,
 189     );
 190
 191     $kdbx->deleted_objects($root->{deleted_objects});
 192     $kdbx->root($root->{group}) if $root->{group};
 193 }
 194
 195 sub _read_xml_group {
 196     my $self = shift;
 197
 198     return $self->_read_xml_element({entries => [], groups => []},
 199         UUID                    => 'uuid',
 200         Name                    => 'text',
 201         Notes                   => 'text',
 202         Tags                    => 'text',  # KDBX4.1
 203         IconID                  => 'number',
 204         CustomIconUUID          => 'uuid',
 205         Times                   => \&_read_xml_times,
 206         IsExpanded              => 'bool',
 207         DefaultAutoTypeSequence => 'text',
 208         EnableAutoType          => 'tristate',
 209         EnableSearching         => 'tristate',
 210         LastTopVisibleEntry     => 'uuid',
 211         CustomData              => \&_read_xml_custom_data, # KDBX4
 212         PreviousParentGroup     => 'uuid',  # KDBX4.1
 213         Entry                   => [entries => \&_read_xml_entry],
 214         Group                   => [groups  => \&_read_xml_group],
 215     );
 216 }
 217
 218 sub _read_xml_entry {
 219     my $self = shift;
 220
 221     my $entry = $self->_read_xml_element({strings => [], binaries => []},
 222         UUID                => 'uuid',
 223         IconID              => 'number',
 224         CustomIconUUID      => 'uuid',
 225         ForegroundColor     => 'text',
 226         BackgroundColor     => 'text',
 227         OverrideURL         => 'text',
 228         Tags                => 'text',
 229         Times               => \&_read_xml_times,
 230         AutoType            => \&_read_xml_entry_auto_type,
 231         PreviousParentGroup => 'uuid',  # KDBX4.1
 232         QualityCheck        => 'bool',  # KDBX4.1
 233         String              => [strings  => \&_read_xml_entry_string],
 234         Binary              => [binaries => \&_read_xml_entry_binary],
 235         CustomData          => \&_read_xml_custom_data, # KDBX4
 236         History             => sub {
 237             my $self = shift;
 238             return $self->_read_xml_element([],
 239                 Entry   => \&_read_xml_entry,
 240             );
 241         },
 242     );
 243
 244     my %strings;
 245     for my $string (@{$entry->{strings} || []}) {
 246         $strings{$string->{key}} = $string->{value};
 247     }
 248     $entry->{strings} = \%strings;
 249
 250     my %binaries;
 251     for my $binary (@{$entry->{binaries} || []}) {
 252         $binaries{$binary->{key}} = $binary->{value};
 253     }
 254     $entry->{binaries} = \%binaries;
 255
 256     return $entry;
 257 }
 258
 259 sub _read_xml_times {
 260     my $self = shift;
 261
 262     return $self->_read_xml_element(
 263         LastModificationTime    => 'datetime',
 264         CreationTime            => 'datetime',
 265         LastAccessTime          => 'datetime',
 266         ExpiryTime              => 'datetime',
 267         Expires                 => 'bool',
 268         UsageCount              => 'number',
 269         LocationChanged         => 'datetime',
 270     );
 271 }
 272
 273 sub _read_xml_entry_string {
 274     my $self = shift;
 275
 276     return $self->_read_xml_element(
 277         Key     => 'text',
 278         Value   => sub {
 279             my $self = shift;
 280
 281             my $protected           = $self->_read_xml_attribute('Protected', 'bool', false);
 282             my $protect_in_memory   = $self->_read_xml_attribute('ProtectInMemory', 'bool', false);
 283             my $protect             = $protected || $protect_in_memory;
 284
 285             my $val = $self->_read_xml_content($protected ? 'binary' : 'text');
 286
 287             my $string = {
 288                 value   => $val,
 289                 $protect ? (protect => true) : (),
 290             };
 291
 292             $self->_safe->add_protected(sub { decode('UTF-8', $_[0]) }, $string) if $protected;
 293
 294             $string;
 295         },
 296     );
 297 }
 298
 299 sub _read_xml_entry_binary {
 300     my $self = shift;
 301
 302     return $self->_read_xml_element(
 303         Key     => 'text',
 304         Value   => sub {
 305             my $self = shift;
 306
 307             my $ref = $self->_read_xml_attribute('Ref');
 308             my $compressed  = $self->_read_xml_attribute('Compressed', 'bool', false);
 309             my $protected = $self->_read_xml_attribute('Protected', 'bool', false);
 310             my $binary = {};
 311
 312             if (defined $ref) {
 313                 $binary->{ref} = $ref;
 314             }
 315             else {
 316                 $binary->{value} = $self->_read_xml_content('binary');
 317                 $binary->{protect} = true if $protected;
 318
 319                 if ($protected) {
 320                     # if compressed, decompress later when the safe is unlocked
 321                     $self->_safe->add_protected($compressed ? \&gunzip : (), $binary);
 322                 }
 323                 elsif ($compressed) {
 324                     $binary->{value} = gunzip($binary->{value});
 325                 }
 326             }
 327
 328             $binary;
 329         },
 330     );
 331 }
 332
 333 sub _read_xml_entry_auto_type {
 334     my $self = shift;
 335
 336     return $self->_read_xml_element({associations => []},
 337         Enabled                 => 'bool',
 338         DataTransferObfuscation => 'number',
 339         DefaultSequence         => 'text',
 340         Association             => [associations => sub {
 341             my $self = shift;
 342             return $self->_read_xml_element(
 343                 Window              => 'text',
 344                 KeystrokeSequence   => 'text',
 345             );
 346         }],
 347     );
 348 }
 349
 350 sub _read_xml_deleted_objects {
 351     my $self = shift;
 352
 353     return $self->_read_xml_element(
 354         DeletedObject   => sub {
 355             my $self = shift;
 356             my $object = $self->_read_xml_element(
 357                 UUID            => 'uuid',
 358                 DeletionTime    => 'datetime',
 359             );
 360             $object->{uuid} => $object;
 361         }
 362     );
 363 }
 364
 365 ##############################################################################
 366
 367 sub _resolve_binary_refs {
 368     my $self = shift;
 369     my $kdbx = $self->kdbx;
 370
 371     my $entries = $kdbx->all_entries(history => 1);
 372     my $pool = $kdbx->binaries;
 373
 374     for my $entry (@$entries) {
 375         while (my ($key, $binary) = each %{$entry->binaries}) {
 376             my $ref = $binary->{ref} // next;
 377             next if defined $binary->{value};
 378
 379             my $data = $pool->{$ref};
 380             if (!defined $data || !defined $data->{value}) {
 381                 alert "Found a reference to a missing binary: $key", key => $key, ref => $ref;
 382                 next;
 383             }
 384             $binary->{value} = $data->{value};
 385             $binary->{protect} = true if $data->{protect};
 386             delete $binary->{ref};
 387         }
 388     }
 389 }
 390
 391 ##############################################################################
 392
 393 sub _read_xml_element {
 394     my $self = shift;
 395     my $args = @_ % 2 == 1 ? shift : {};
 396     my %spec = @_;
 397
 398     my $reader = $self->_reader;
 399     my $path = $reader->nodePath;
 400     $path =~ s!\Q/text()\E$!!;
 401
 402     return $args if $reader->isEmptyElement;
 403
 404     my $store = ref $args eq 'CODE' ? $args
 405     : ref $args eq 'HASH' ? sub {
 406         my ($key, $val) = @_;
 407         if (ref $args->{$key} eq 'HASH') {
 408             $args->{$key}{$key} = $val;
 409         }
 410         elsif (ref $args->{$key} eq 'ARRAY') {
 411             push @{$args->{$key}}, $val;
 412         }
 413         else {
 414             exists $args->{$key}
 415                 and alert 'Overwriting value', node => $reader->nodePath, line => $reader->lineNumber;
 416             $args->{$key} = $val;
 417         }
 418     } : ref $args eq 'ARRAY' ? sub {
 419         my ($key, $val) = @_;
 420         push @$args, $val;
 421     } : sub {};
 422
 423     my $pattern = XML::LibXML::Pattern->new("${path}|${path}/*");
 424     while ($reader->nextPatternMatch($pattern) == 1) {
 425         last if $reader->nodePath eq $path && $reader->nodeType == XML_READER_TYPE_END_ELEMENT;
 426         next if $reader->nodeType != XML_READER_TYPE_ELEMENT;
 427
 428         my $name = $reader->localName;
 429         my $key  = snakify($name);
 430         my $type = $spec{$name};
 431         ($key, $type) = @$type if ref $type eq 'ARRAY';
 432
 433         if (!defined $type) {
 434             exists $spec{$name} or alert "Ignoring unknown element: $name",
 435                 node => $reader->nodePath,
 436                 line => $reader->lineNumber;
 437             next;
 438         }
 439
 440         if (ref $type eq 'CODE') {
 441             my @result = $self->$type($args, $reader->nodePath);
 442             if (@result == 2) {
 443                 $store->(@result);
 444             }
 445             elsif (@result == 1) {
 446                 $store->($key, @result);
 447             }
 448         }
 449         else {
 450             $store->($key, $self->_read_xml_content($type));
 451         }
 452     }
 453
 454     return $args;
 455 }
 456
 457 sub _read_xml_attribute {
 458     my $self = shift;
 459     my $name = shift;
 460     my $type = shift // 'text';
 461     my $default = shift;
 462     my $reader = $self->_reader;
 463
 464     return $default if !$reader->hasAttributes;
 465
 466     my $value = trim($reader->getAttribute($name));
 467     if (!defined $value) {
 468         # try again after reading in all the attributes
 469         $reader->moveToFirstAttribute;
 470         while ($self->_reader->readAttributeValue == 1) {}
 471         $reader->moveToElement;
 472
 473         $value = trim($reader->getAttribute($name));
 474     }
 475
 476     return $default if !defined $value;
 477
 478     my $decoded = eval { _decode_primitive($value, $type) };
 479     if (my $err = $@) {
 480         ref $err and $err->details(attribute => $name, node => $reader->nodePath, line => $reader->lineNumber);
 481         throw $err
 482     }
 483
 484     return $decoded;
 485 }
 486
 487 sub _read_xml_content {
 488     my $self = shift;
 489     my $type = shift;
 490     my $reader = $self->_reader;
 491
 492     $reader->read if !$reader->isEmptyElement;  # step into element
 493     return '' if !$reader->hasValue;
 494
 495     my $content = trim($reader->value);
 496
 497     my $decoded = eval { _decode_primitive($content, $type) };
 498     if (my $err = $@) {
 499         ref $err and $err->details(node => $reader->nodePath, line => $reader->lineNumber);
 500         throw $err
 501     }
 502
 503     return $decoded;
 504 }
 505
 506 ##############################################################################
 507
 508 sub _decode_primitive { goto &{__PACKAGE__."::_decode_$_[1]"} }
 509
 510 sub _decode_binary {
 511     local $_ = shift;
 512     return '' if !defined || (ref && !defined $$_);
 513     $_ = eval { decode_b64(ref $_ ? $$_ : $_) };
 514     my $err = $@;
 515     my $cleanup = erase_scoped $_;
 516     $err and throw 'Failed to parse binary', error => $err;
 517     return $_;
 518 }
 519
 520 sub _decode_bool {
 521     local $_ = shift;
 522     return true  if /^True$/i;
 523     return false if /^False$/i;
 524     return false if length($_) == 0;
 525     throw 'Expected boolean', text => $_;
 526 }
 527
 528 sub _decode_datetime {
 529     local $_ = shift;
 530
 531     if (/^[A-Za-z0-9\+\/\=]+$/) {
 532         my $binary = eval { decode_b64($_) };
 533         if (my $err = $@) {
 534             throw 'Failed to parse binary datetime', text => $_, error => $err;
 535         }
 536         throw $@ if $@;
 537         assert_64bit;
 538         $binary .= \0 x (8 - length($binary)) if length($binary) < 8;
 539         my ($seconds_since_ad1) = unpack('Q<', $binary);
 540         my $epoch = $seconds_since_ad1 - TIME_SECONDS_AD1_TO_UNIX_EPOCH;
 541         return Time::Piece->new($epoch);
 542     }
 543
 544
 545     my $dt = eval { Time::Piece->strptime($_, '%Y-%m-%dT%H:%M:%SZ') };
 546     if (my $err = $@) {
 547         throw 'Failed to parse datetime', text => $_, error => $err;
 548     }
 549     return $dt;
 550 }
 551
 552 sub _decode_tristate {
 553     local $_ = shift;
 554     return undef if /^null$/i;
 555     my $tristate = eval { _decode_bool($_) };
 556     $@ and throw 'Expected tristate', text => $_, error => $@;
 557     return $tristate;
 558 }
 559
 560 sub _decode_number {
 561     local $_ = shift;
 562     $_ = _decode_text($_);
 563     looks_like_number($_) or throw 'Expected number', text => $_;
 564     return $_+0;
 565 }
 566
 567 sub _decode_text {
 568     local $_ = shift;
 569     return '' if !defined;
 570     return $_;
 571 }
 572
 573 sub _decode_uuid {
 574     local $_ = shift;
 575     my $uuid = eval { _decode_binary($_) };
 576     $@ and throw 'Expected UUID', text => $_, error => $@;
 577     length($uuid) == 16 or throw 'Invalid UUID size', size => length($uuid);
 578     return $uuid;
 579 }
 580
 581 1;