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

   1 package File::KDBX::Loader::KDB;
   2 # ABSTRACT: Read KDB files
   3
   4 use warnings;
   5 use strict;
   6
   7 use Encode qw(encode);
   8 use File::KDBX::Constants qw(:header :cipher :random_stream :icon);
   9 use File::KDBX::Error;
  10 use File::KDBX::Util qw(:class :empty :io :uuid load_optional);
  11 use File::KDBX;
  12 use Ref::Util qw(is_arrayref is_hashref);
  13 use Scalar::Util qw(looks_like_number);
  14 use Time::Piece;
  15 use boolean;
  16 use namespace::clean;
  17
  18 extends 'File::KDBX::Loader';
  19
  20 our $VERSION = '999.999'; # VERSION
  21
  22 my $DEFAULT_EXPIRATION = Time::Piece->new(32503677839); # 2999-12-31 23:59:59
  23
  24 sub _read_headers { '' }
  25
  26 sub _read_body {
  27     my $self = shift;
  28     my $fh = shift;
  29     my $key = shift;
  30     my $buf = shift;
  31
  32     load_optional('File::KeePass');
  33
  34     $buf .= do { local $/; <$fh> };
  35
  36     $key = $self->kdbx->composite_key($key, keep_primitive => 1);
  37
  38     my $k = eval { File::KeePass->new->parse_db(\$buf, _convert_kdbx_to_keepass_master_key($key)) };
  39     if (my $err = $@) {
  40         throw 'Failed to parse KDB file', error => $err;
  41     }
  42
  43     $k->unlock;
  44     $self->kdbx->key($key);
  45
  46     return convert_keepass_to_kdbx($k, $self->kdbx);
  47 }
  48
  49 # This is also used by File::KDBX::Dumper::KDB.
  50 sub _convert_kdbx_to_keepass_master_key {
  51     my $key = shift;
  52
  53     my @keys = @{$key->keys};
  54     if (@keys == 1 && !$keys[0]->can('filepath')) {
  55         return [encode('CP-1252', $keys[0]->{primitive})];     # just a password
  56     }
  57     elsif (@keys == 1) {
  58         return [undef, \$keys[0]->raw_key]; # just a keyfile
  59     }
  60     elsif (@keys == 2 && !$keys[0]->can('filepath') && $keys[1]->can('filepath')) {
  61         return [encode('CP-1252', $keys[0]->{primitive}), \$keys[1]->raw_key];
  62     }
  63     throw 'Cannot use this key to load a KDB file', key => $key;
  64 }
  65
  66 =func convert_keepass_to_kdbx
  67
  68     $kdbx = convert_keepass_to_kdbx($keepass);
  69     $kdbx = convert_keepass_to_kdbx($keepass, $kdbx);
  70
  71 Convert a L<File::KeePass> to a L<File::KDBX>.
  72
  73 =cut
  74
  75 sub convert_keepass_to_kdbx {
  76     my $k    = shift;
  77     my $kdbx = shift // File::KDBX->new;
  78
  79     $kdbx->{headers} //= {};
  80     _convert_keepass_to_kdbx_headers($k->{header}, $kdbx);
  81
  82     my @groups = @{$k->{groups} || []};
  83     if (@groups == 1) {
  84         $kdbx->{root} = _convert_keepass_to_kdbx_group($k->{groups}[0]);
  85     }
  86     elsif (1 < @groups) {
  87         my $root = $kdbx->{root} = {%{File::KDBX->_implicit_root}};
  88         for my $group (@groups) {
  89             push @{$root->{groups} //= []}, _convert_keepass_to_kdbx_group($group);
  90         }
  91     }
  92
  93     for my $entry ($kdbx->find_entries({
  94         title       => 'Meta-Info',
  95         username    => 'SYSTEM',
  96         url         => '$',
  97         icon_id     => 0,
  98         -nonempty   => 'notes',
  99     })) {
 100         _read_meta_stream($kdbx, $entry);
 101         $entry->remove;
 102     }
 103
 104     return $kdbx;
 105 }
 106
 107 sub _read_meta_stream {
 108     my $kdbx    = shift;
 109     my $entry   = shift;
 110
 111     my $type = $entry->notes;
 112     my $data = $entry->binary_value('bin-stream');
 113     open(my $fh, '<', \$data) or throw "Failed to open memory buffer for reading: $!";
 114
 115     if ($type eq 'KPX_GROUP_TREE_STATE') {
 116         read_all $fh, my $buf, 4 or goto PARSE_ERROR;
 117         my ($num) = unpack('L<', $buf);
 118         $num * 5 + 4 == length($data) or goto PARSE_ERROR;
 119         for (my $i = 0; $i < $num; ++$i) {
 120             read_all $fh, $buf, 5 or goto PARSE_ERROR;
 121             my ($group_id, $expanded) = unpack('L< C', $buf);
 122             my $uuid = _decode_uuid($group_id) // next;
 123             my ($group) = $kdbx->find_groups({uuid => $uuid});
 124             $group->is_expanded($expanded) if $group;
 125         }
 126     }
 127     elsif ($type eq 'KPX_CUSTOM_ICONS_4') {
 128         read_all $fh, my $buf, 12 or goto PARSE_ERROR;
 129         my ($num_icons, $num_entries, $num_groups) = unpack('L<3', $buf);
 130         my @icons;
 131         for (my $i = 0; $i < $num_icons; ++$i) {
 132             read_all $fh, $buf, 4 or goto PARSE_ERROR;
 133             my ($icon_size) = unpack('L<', $buf);
 134             read_all $fh, $buf, $icon_size or goto PARSE_ERROR;
 135             my $uuid = $kdbx->add_custom_icon($buf);
 136             push @icons, $uuid;
 137         }
 138         for (my $i = 0; $i < $num_entries; ++$i) {
 139             read_all $fh, $buf, 20 or goto PARSE_ERROR;
 140             my ($uuid, $icon_index) = unpack('a16 L<', $buf);
 141             next if !$icons[$icon_index];
 142             my ($entry) = $kdbx->find_entries({uuid => $uuid});
 143             $entry->custom_icon_uuid($icons[$icon_index]) if $entry;
 144         }
 145         for (my $i = 0; $i < $num_groups; ++$i) {
 146             read_all $fh, $buf, 8 or goto PARSE_ERROR;
 147             my ($group_id, $icon_index) = unpack('L<2', $buf);
 148             next if !$icons[$icon_index];
 149             my $uuid = _decode_uuid($group_id) // next;
 150             my ($group) = $kdbx->find_groups({uuid => $uuid});
 151             $group->custom_icon_uuid($icons[$icon_index]) if $group;
 152         }
 153     }
 154     else {
 155         alert "Ignoring unknown meta stream: $type\n", type => $type;
 156         return;
 157     }
 158
 159     return;
 160
 161     PARSE_ERROR:
 162     alert "Ignoring unparsable meta stream: $type\n", type => $type;
 163 }
 164
 165 sub _convert_keepass_to_kdbx_headers {
 166     my $from = shift;
 167     my $kdbx = shift;
 168
 169     my $headers = $kdbx->{headers} //= {};
 170     my $meta = $kdbx->{meta} //= {};
 171
 172     $kdbx->{sig1}       = $from->{sig1};
 173     $kdbx->{sig2}       = $from->{sig2};
 174     $kdbx->{version}    = $from->{vers};
 175
 176     my %enc_type = (
 177         rijndael    => CIPHER_UUID_AES256,
 178         aes         => CIPHER_UUID_AES256,
 179         twofish     => CIPHER_UUID_TWOFISH,
 180         chacha20    => CIPHER_UUID_CHACHA20,
 181         salsa20     => CIPHER_UUID_SALSA20,
 182         serpent     => CIPHER_UUID_SERPENT,
 183     );
 184     my $cipher_uuid = $enc_type{$from->{cipher} || ''} // $enc_type{$from->{enc_type} || ''};
 185
 186     my %protected_stream = (
 187         rc4         => STREAM_ID_RC4_VARIANT,
 188         salsa20     => STREAM_ID_SALSA20,
 189         chacha20    => STREAM_ID_CHACHA20,
 190     );
 191     my $protected_stream_id = $protected_stream{$from->{protected_stream} || ''} || STREAM_ID_SALSA20;
 192
 193     $headers->{+HEADER_COMMENT}                 = $from->{comment};
 194     $headers->{+HEADER_CIPHER_ID}               = $cipher_uuid if $cipher_uuid;
 195     $headers->{+HEADER_MASTER_SEED}             = $from->{seed_rand};
 196     $headers->{+HEADER_COMPRESSION_FLAGS}       = $from->{compression} // 0;
 197     $headers->{+HEADER_TRANSFORM_SEED}          = $from->{seed_key};
 198     $headers->{+HEADER_TRANSFORM_ROUNDS}        = $from->{rounds};
 199     $headers->{+HEADER_ENCRYPTION_IV}           = $from->{enc_iv};
 200     $headers->{+HEADER_INNER_RANDOM_STREAM_ID}  = $protected_stream_id;
 201     $headers->{+HEADER_INNER_RANDOM_STREAM_KEY} = $from->{protected_stream_key};
 202     $headers->{+HEADER_STREAM_START_BYTES}      = $from->{start_bytes} // '';
 203
 204     # TODO for KeePass 1 files these are all not available. Leave undefined or set default values?
 205     $meta->{memory_protection}{protect_notes}       = boolean($from->{protect_notes});
 206     $meta->{memory_protection}{protect_password}    = boolean($from->{protect_password});
 207     $meta->{memory_protection}{protect_username}    = boolean($from->{protect_username});
 208     $meta->{memory_protection}{protect_url}         = boolean($from->{protect_url});
 209     $meta->{memory_protection}{protect_title}       = boolean($from->{protect_title});
 210     $meta->{generator}                              = $from->{generator} // '';
 211     $meta->{header_hash}                            = $from->{header_hash};
 212     $meta->{database_name}                          = $from->{database_name} // '';
 213     $meta->{database_name_changed}                  = _decode_datetime($from->{database_name_changed});
 214     $meta->{database_description}                   = $from->{database_description} // '';
 215     $meta->{database_description_changed}           = _decode_datetime($from->{database_description_changed});
 216     $meta->{default_username}                       = $from->{default_user_name} // '';
 217     $meta->{default_username_changed}               = _decode_datetime($from->{default_user_name_changed});
 218     $meta->{maintenance_history_days}               = $from->{maintenance_history_days};
 219     $meta->{color}                                  = $from->{color};
 220     $meta->{master_key_changed}                     = _decode_datetime($from->{master_key_changed});
 221     $meta->{master_key_change_rec}                  = $from->{master_key_change_rec};
 222     $meta->{master_key_change_force}                = $from->{master_key_change_force};
 223     $meta->{recycle_bin_enabled}                    = boolean($from->{recycle_bin_enabled});
 224     $meta->{recycle_bin_uuid}                       = $from->{recycle_bin_uuid};
 225     $meta->{recycle_bin_changed}                    = _decode_datetime($from->{recycle_bin_changed});
 226     $meta->{entry_templates_group}                  = $from->{entry_templates_group};
 227     $meta->{entry_templates_group_changed}          = _decode_datetime($from->{entry_templates_group_changed});
 228     $meta->{last_selected_group}                    = $from->{last_selected_group};
 229     $meta->{last_top_visible_group}                 = $from->{last_top_visible_group};
 230     $meta->{history_max_items}                      = $from->{history_max_items};
 231     $meta->{history_max_size}                       = $from->{history_max_size};
 232     $meta->{settings_changed}                       = _decode_datetime($from->{settings_changed});
 233
 234     while (my ($key, $value) = each %{$from->{custom_icons} || {}}) {
 235         push @{$meta->{custom_icons} //= []}, {uuid => $key, data => $value};
 236     }
 237     while (my ($key, $value) = each %{$from->{custom_data} || {}}) {
 238         $meta->{custom_data}{$key} = {value => $value};
 239     }
 240
 241     return $kdbx;
 242 }
 243
 244 sub _convert_keepass_to_kdbx_group {
 245     my $from = shift;
 246     my $to   = shift // {};
 247     my %args = @_;
 248
 249     $to->{times}{last_access_time}          = _decode_datetime($from->{accessed});
 250     $to->{times}{usage_count}               = $from->{usage_count} || 0;
 251     $to->{times}{expiry_time}               = _decode_datetime($from->{expires}, $DEFAULT_EXPIRATION);
 252     $to->{times}{expires}                   = defined $from->{expires_enabled}
 253                                                 ? boolean($from->{expires_enabled})
 254                                                 : boolean($to->{times}{expiry_time} <= gmtime);
 255     $to->{times}{creation_time}             = _decode_datetime($from->{created});
 256     $to->{times}{last_modification_time}    = _decode_datetime($from->{modified});
 257     $to->{times}{location_changed}          = _decode_datetime($from->{location_changed});
 258     $to->{notes}                            = $from->{notes} // '';
 259     $to->{uuid}                             = _decode_uuid($from->{id});
 260     $to->{is_expanded}                      = boolean($from->{expanded});
 261     $to->{icon_id}                          = $from->{icon} // ICON_FOLDER;
 262     $to->{name}                             = $from->{title} // '';
 263     $to->{default_auto_type_sequence}       = $from->{auto_type_default} // '';
 264     $to->{enable_auto_type}                 = _decode_tristate($from->{auto_type_enabled});
 265     $to->{enable_searching}                 = _decode_tristate($from->{enable_searching});
 266     $to->{groups}                           = [];
 267     $to->{entries}                          = [];
 268
 269     if (!$args{shallow}) {
 270         for my $group (@{$from->{groups} || []}) {
 271             push @{$to->{groups}}, _convert_keepass_to_kdbx_group($group);
 272         }
 273         for my $entry (@{$from->{entries} || []}) {
 274             push @{$to->{entries}}, _convert_keepass_to_kdbx_entry($entry);
 275         }
 276     }
 277
 278     return $to;
 279 }
 280
 281 sub _convert_keepass_to_kdbx_entry {
 282     my $from = shift;
 283     my $to   = shift // {};
 284     my %args = @_;
 285
 286     $to->{times}{last_access_time}          = _decode_datetime($from->{accessed});
 287     $to->{times}{usage_count}               = $from->{usage_count} || 0;
 288     $to->{times}{expiry_time}               = _decode_datetime($from->{expires}, $DEFAULT_EXPIRATION);
 289     $to->{times}{expires}                   = defined $from->{expires_enabled}
 290                                                 ? boolean($from->{expires_enabled})
 291                                                 : boolean($to->{times}{expiry_time} <= gmtime);
 292     $to->{times}{creation_time}             = _decode_datetime($from->{created});
 293     $to->{times}{last_modification_time}    = _decode_datetime($from->{modified});
 294     $to->{times}{location_changed}          = _decode_datetime($from->{location_changed});
 295
 296     $to->{auto_type}{data_transfer_obfuscation} = $from->{auto_type_munge} || false;
 297     $to->{auto_type}{enabled}                   = boolean($from->{auto_type_enabled} // 1);
 298
 299     my $comment = $from->{comment};
 300     my @auto_type = is_arrayref($from->{auto_type}) ? @{$from->{auto_type}} : ();
 301
 302     if (!@auto_type && nonempty $from->{auto_type} && nonempty $from->{auto_type_window}
 303         && !is_hashref($from->{auto_type})) {
 304         @auto_type = ({window => $from->{auto_type_window}, keys => $from->{auto_type}});
 305     }
 306     if (nonempty $comment) {
 307         my @AT;
 308         my %atw = my @atw = $comment =~ m{ ^Auto-Type-Window((?:-?\d+)?): [\t ]* (.*?) [\t ]*$ }mxg;
 309         my %atk = my @atk = $comment =~ m{ ^Auto-Type((?:-?\d+)?): [\t ]* (.*?) [\t ]*$ }mxg;
 310         $comment =~ s{ ^Auto-Type(?:-Window)?(?:-?\d+)?: .* \n? }{}mxg;
 311         while (@atw) {
 312             my ($n, $w) = (shift(@atw), shift(@atw));
 313             push @AT, {window => $w, keys => exists($atk{$n}) ? $atk{$n} : $atk{''}};
 314         }
 315         while (@atk) {
 316             my ($n, $k) = (shift(@atk), shift(@atk));
 317             push @AT, {keys => $k, window => exists($atw{$n}) ? $atw{$n} : $atw{''}};
 318         }
 319         for (@AT) {
 320             $_->{'window'} //= '';
 321             $_->{'keys'} //= '';
 322         }
 323         my %uniq;
 324         @AT = grep {!$uniq{"$_->{'window'}\e$_->{'keys'}"}++} @AT;
 325         push @auto_type, @AT;
 326     }
 327     $to->{auto_type}{associations} = [
 328         map { +{window => $_->{window}, keystroke_sequence => $_->{keys}} } @auto_type,
 329     ];
 330
 331     $to->{strings}{Notes}{value}        = $comment;
 332     $to->{strings}{UserName}{value}     = $from->{username};
 333     $to->{strings}{Password}{value}     = $from->{password};
 334     $to->{strings}{URL}{value}          = $from->{url};
 335     $to->{strings}{Title}{value}        = $from->{title};
 336     $to->{strings}{Notes}{protect}      = true if defined $from->{protected}{comment};
 337     $to->{strings}{UserName}{protect}   = true if defined $from->{protected}{username};
 338     $to->{strings}{Password}{protect}   = true if $from->{protected}{password} // 1;
 339     $to->{strings}{URL}{protect}        = true if defined $from->{protected}{url};
 340     $to->{strings}{Title}{protect}      = true if defined $from->{protected}{title};
 341
 342     # other strings
 343     while (my ($key, $value) = each %{$from->{strings} || {}}) {
 344         $to->{strings}{$key} = {
 345             value => $value,
 346             $from->{protected}{$key} ? (protect => true) : (),
 347         };
 348     }
 349
 350     $to->{override_url}     = $from->{override_url};
 351     $to->{tags}             = $from->{tags} // '';
 352     $to->{icon_id}          = $from->{icon} // ICON_PASSWORD;
 353     $to->{uuid}             = _decode_uuid($from->{id});
 354     $to->{foreground_color} = $from->{foreground_color} // '';
 355     $to->{background_color} = $from->{background_color} // '';
 356     $to->{custom_icon_uuid} = $from->{custom_icon_uuid};
 357     $to->{history}          = [];
 358
 359     local $from->{binary} = {$from->{binary_name} => $from->{binary}}
 360         if nonempty $from->{binary} && nonempty $from->{binary_name} && !is_hashref($from->{binary});
 361     while (my ($key, $value) = each %{$from->{binary} || {}}) {
 362         $to->{binaries}{$key} = {value => $value};
 363     }
 364
 365     if (!$args{shallow}) {
 366         for my $entry (@{$from->{history} || []}) {
 367             my $new_entry = {};
 368             push @{$to->{entries}}, _convert_keepass_to_kdbx_entry($entry, $new_entry);
 369         }
 370     }
 371
 372     return $to;
 373 }
 374
 375 sub _decode_datetime {
 376     local $_ = shift // return shift // gmtime;
 377     return Time::Piece->strptime($_, '%Y-%m-%d %H:%M:%S');
 378 }
 379
 380 sub _decode_uuid {
 381     local $_ = shift // return;
 382     # Group IDs in KDB files are 32-bit integers
 383     return sprintf('%016x', $_) if length($_) != 16 && looks_like_number($_);
 384     return $_;
 385 }
 386
 387 sub _decode_tristate {
 388     local $_ = shift // return;
 389     return boolean($_);
 390 }
 391
 392 1;
 393 __END__
 394
 395 =head1 DESCRIPTION
 396
 397 Read older KDB (KeePass 1) files. This feature requires an additional module to be installed:
 398
 399 =for :list
 400 * L<File::KeePass>
 401
 402 =cut