1 package File
::KDBX
::Dumper
::KDB
;
2 # ABSTRACT: Write KDB files
7 use Crypt
::PRNG
qw(irand);
9 use File
::KDBX
::Constants
qw(:magic);
10 use File
::KDBX
::Error
;
11 use File
::KDBX
::Loader
::KDB
;
12 use File
::KDBX
::Util
qw(:class :uuid load_optional);
15 extends
'File::KDBX::Dumper';
17 our $VERSION = '999.999'; # VERSION
19 sub _write_magic_numbers
{ '' }
20 sub _write_headers
{ '' }
27 load_optional
(qw{File::KeePass File::KeePass::KDBX});
29 my $k = File
::KeePass
::KDBX-
>new($self->kdbx)->to_fkp;
30 $self->_write_custom_icons($self->kdbx, $k);
32 substr($k->header->{seed_rand
}, 16) = '';
34 $key = $self->kdbx->composite_key($key, keep_primitive
=> 1);
36 my $dump = eval { $k->gen_db(File
::KDBX
::Loader
::KDB
::_convert_kdbx_to_keepass_master_key
($key)) };
38 throw
'Failed to generate KDB file', error
=> $err;
41 $self->kdbx->key($key);
46 sub _write_custom_icons
{
51 return if $kdbx->sig2 != KDBX_SIG2_1
;
52 return if $k->find_entries({
56 comment
=> 'KPX_CUSTOM_ICONS_4',
59 my @icons; # icon data
60 my %icons; # icon uuid -> index
61 my %entries; # id -> index
62 my %groups; # id -> index
65 for my $icon (@{$kdbx->custom_icons}) {
66 my $uuid = $icon->{uuid
};
67 my $data = $icon->{data
} or next;
69 $icons{$uuid} = $#icons;
71 for my $entry ($k->find_entries({})) {
72 my $icon_uuid = $entry->{custom_icon_uuid
} // next;
73 my $icon_index = $icons{$icon_uuid} // next;
75 $entry->{id
} //= generate_uuid
;
76 next if $entries{$entry->{id
}};
78 $entries{$entry->{id
}} = $icon_index;
80 for my $group ($k->find_groups({})) {
81 $gid{$group->{id
} || ''}++;
82 my $icon_uuid = $group->{custom_icon_uuid
} // next;
83 my $icon_index = $icons{$icon_uuid} // next;
85 if ($group->{id
} =~ /^[A-Fa-f0-9]{16}$/) {
86 $group->{id
} = hex($group->{id
});
88 elsif ($group->{id
} !~ /^\d+$/) {
91 } while $gid{$group->{id
}};
94 next if $groups{$group->{id
}};
96 $groups{$group->{id
}} = $icon_index;
102 $stream .= pack('L<3', scalar @icons, scalar keys %entries, scalar keys %groups);
103 for (my $i = 0; $i < @icons; ++$i) {
104 $stream .= pack('L<', length($icons[$i]));
105 $stream .= $icons[$i];
107 while (my ($id, $icon_index) = each %entries) {
108 $stream .= pack('a16 L<', $id, $icon_index);
110 while (my ($id, $icon_index) = each %groups) {
111 $stream .= pack('L<2', $id, $icon_index);
115 comment
=> 'KPX_CUSTOM_ICONS_4',
116 title
=> 'Meta-Info',
117 username
=> 'SYSTEM',
121 binary
=> {'bin-stream' => $stream},
130 Dump older KDB (KeePass 1) files. This feature requires additional modules to be installed:
134 * L<File::KeePass::KDBX>