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