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 # TODO create a KPX_CUSTOM_ICONS_4 meta stream. FKP itself handles KPX_GROUP_TREE_STATE
34 substr($k->header->{seed_rand
}, 16) = '';
36 $key = $self->kdbx->composite_key($key, keep_primitive
=> 1);
38 my $dump = eval { $k->gen_db(File
::KDBX
::Loader
::KDB
::_convert_kdbx_to_keepass_master_key
($key)) };
40 throw
'Failed to generate KDB file', error
=> $err;
43 $self->kdbx->key($key);
48 sub _write_custom_icons
{
53 return if $kdbx->sig2 != KDBX_SIG2_1
;
54 return if $k->find_entries({
58 comment
=> 'KPX_CUSTOM_ICONS_4',
61 my @icons; # icon data
62 my %icons; # icon uuid -> index
63 my %entries; # id -> index
64 my %groups; # id -> index
67 for my $icon (@{$kdbx->custom_icons}) {
68 my $uuid = $icon->{uuid
};
69 my $data = $icon->{data
} or next;
71 $icons{$uuid} = $#icons;
73 for my $entry ($k->find_entries({})) {
74 my $icon_uuid = $entry->{custom_icon_uuid
} // next;
75 my $icon_index = $icons{$icon_uuid} // next;
77 $entry->{id
} //= generate_uuid
;
78 next if $entries{$entry->{id
}};
80 $entries{$entry->{id
}} = $icon_index;
82 for my $group ($k->find_groups({})) {
83 $gid{$group->{id
} || ''}++;
84 my $icon_uuid = $group->{custom_icon_uuid
} // next;
85 my $icon_index = $icons{$icon_uuid} // next;
87 if ($group->{id
} =~ /^[A-Fa-f0-9]{16}$/) {
88 $group->{id
} = hex($group->{id
});
90 elsif ($group->{id
} !~ /^\d+$/) {
93 } while $gid{$group->{id
}};
96 next if $groups{$group->{id
}};
98 $groups{$group->{id
}} = $icon_index;
104 $stream .= pack('L<3', scalar @icons, scalar keys %entries, scalar keys %groups);
105 for (my $i = 0; $i < @icons; ++$i) {
106 $stream .= pack('L<', length($icons[$i]));
107 $stream .= $icons[$i];
109 while (my ($id, $icon_index) = each %entries) {
110 $stream .= pack('a16 L<', $id, $icon_index);
112 while (my ($id, $icon_index) = each %groups) {
113 $stream .= pack('L<2', $id, $icon_index);
117 comment
=> 'KPX_CUSTOM_ICONS_4',
118 title
=> 'Meta-Info',
119 username
=> 'SYSTEM',
123 binary
=> {'bin-stream' => $stream},
132 Dump older KDB (KeePass 1) files. This feature requires additional modules to be installed:
136 * L<File::KeePass::KDBX>