]> Dogcows Code - chaz/p5-File-KDBX/blob - lib/File/KDBX/Dumper/KDB.pm
d2cb891e8b83e0603b6981de5e0b5a9fc8b606df
[chaz/p5-File-KDBX] / lib / File / KDBX / Dumper / KDB.pm
1 package File::KDBX::Dumper::KDB;
2 # ABSTRACT: Write KDB files
3
4 use warnings;
5 use strict;
6
7 use Crypt::PRNG qw(irand);
8 use Encode qw(encode);
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);
13 use namespace::clean;
14
15 extends 'File::KDBX::Dumper';
16
17 our $VERSION = '999.999'; # VERSION
18
19 sub _write_magic_numbers { '' }
20 sub _write_headers { '' }
21
22 sub _write_body {
23 my $self = shift;
24 my $fh = shift;
25 my $key = shift;
26
27 load_optional(qw{File::KeePass File::KeePass::KDBX});
28
29 my $k = File::KeePass::KDBX->new($self->kdbx)->to_fkp;
30 $self->_write_custom_icons($self->kdbx, $k);
31
32 # TODO create a KPX_CUSTOM_ICONS_4 meta stream. FKP itself handles KPX_GROUP_TREE_STATE
33
34 substr($k->header->{seed_rand}, 16) = '';
35
36 $key = $self->kdbx->composite_key($key, keep_primitive => 1);
37
38 my $dump = eval { $k->gen_db(File::KDBX::Loader::KDB::_convert_kdbx_to_keepass_master_key($key)) };
39 if (my $err = $@) {
40 throw 'Failed to generate KDB file', error => $err;
41 }
42
43 $self->kdbx->key($key);
44
45 print $fh $dump;
46 }
47
48 sub _write_custom_icons {
49 my $self = shift;
50 my $kdbx = shift;
51 my $k = shift;
52
53 return if $kdbx->sig2 != KDBX_SIG2_1;
54 return if $k->find_entries({
55 title => 'Meta-Info',
56 username => 'SYSTEM',
57 url => '$',
58 comment => 'KPX_CUSTOM_ICONS_4',
59 });
60
61 my @icons; # icon data
62 my %icons; # icon uuid -> index
63 my %entries; # id -> index
64 my %groups; # id -> index
65 my %gid;
66
67 for my $icon (@{$kdbx->custom_icons}) {
68 my $uuid = $icon->{uuid};
69 my $data = $icon->{data} or next;
70 push @icons, $data;
71 $icons{$uuid} = $#icons;
72 }
73 for my $entry ($k->find_entries({})) {
74 my $icon_uuid = $entry->{custom_icon_uuid} // next;
75 my $icon_index = $icons{$icon_uuid} // next;
76
77 $entry->{id} //= generate_uuid;
78 next if $entries{$entry->{id}};
79
80 $entries{$entry->{id}} = $icon_index;
81 }
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;
86
87 if ($group->{id} =~ /^[A-Fa-f0-9]{16}$/) {
88 $group->{id} = hex($group->{id});
89 }
90 elsif ($group->{id} !~ /^\d+$/) {
91 do {
92 $group->{id} = irand;
93 } while $gid{$group->{id}};
94 }
95 $gid{$group->{id}}++;
96 next if $groups{$group->{id}};
97
98 $groups{$group->{id}} = $icon_index;
99 }
100
101 return if !@icons;
102
103 my $stream = '';
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];
108 }
109 while (my ($id, $icon_index) = each %entries) {
110 $stream .= pack('a16 L<', $id, $icon_index);
111 }
112 while (my ($id, $icon_index) = each %groups) {
113 $stream .= pack('L<2', $id, $icon_index);
114 }
115
116 $k->add_entry({
117 comment => 'KPX_CUSTOM_ICONS_4',
118 title => 'Meta-Info',
119 username => 'SYSTEM',
120 url => '$',
121 id => '0' x 16,
122 icon => 0,
123 binary => {'bin-stream' => $stream},
124 });
125 }
126
127 1;
128 __END__
129
130 =head1 DESCRIPTION
131
132 Dump older KDB (KeePass 1) files. This feature requires additional modules to be installed:
133
134 =for :list
135 * L<File::KeePass>
136 * L<File::KeePass::KDBX>
137
138 =cut
This page took 0.04327 seconds and 3 git commands to generate.