]>
Dogcows Code - chaz/p5-File-KDBX/blob - lib/File/KDBX/IO/HmacBlock.pm
be4902d9af8b7aea027024ccaaafb7254ccac7ae
1 package File
::KDBX
::IO
::HmacBlock
;
2 # ABSTRACT: HMAC block stream IO handle
7 use Crypt
::Digest
qw(digest_data);
8 use Crypt
::Mac
::HMAC
qw(hmac);
10 use File
::KDBX
::Error
;
11 use File
::KDBX
::Util
qw(:class :int :io);
14 extends
'File::KDBX::IO';
16 our $VERSION = '0.903'; # VERSION
17 our $BLOCK_SIZE = 1048576; # 1MiB
22 _block_index
=> int64
(0),
23 _buffer
=> sub { \
(my $buf = '') },
25 block_size
=> sub { $BLOCK_SIZE },
28 while (my ($attr, $default) = each %ATTRS) {
29 no strict
'refs'; ## no critic (ProhibitNoStrict)
32 *$self->{$attr} = shift if @_;
33 *$self->{$attr} //= (ref $default eq 'CODE') ? $default->($self) : $default;
40 my %args = @_ % 2 == 1 ? (fh
=> shift, @_) : @_;
41 my $self = $class->SUPER::new
;
42 $self->_fh($args{fh
}) or throw
'IO handle required';
43 $self->key($args{key
}) or throw
'Key required';
44 $self->block_size($args{block_size
});
52 $ENV{DEBUG_STREAM
} and print STDERR
"FILL\t$self\n";
53 return if $self->_finished;
55 my $block = eval { $self->_read_hashed_block($fh) };
57 $self->_set_error($err);
60 if (length($block) == 0) {
68 my ($self, $buf, $fh) = @_;
70 $ENV{DEBUG_STREAM
} and print STDERR
"WRITE\t$self ($fh)\n";
71 return 0 if $self->_finished;
73 ${*$self->{_buffer
}} .= $buf;
75 $self->_FLUSH($fh); # TODO only if autoflush?
83 $ENV{DEBUG_STREAM
} and print STDERR
"POPPED\t$self ($fh)\n";
84 return if $self->_mode ne 'w';
88 $self->_write_next_hmac_block($fh); # partial block with remaining content
89 $self->_write_final_hmac_block($fh); # terminating block
91 $self->_set_error($@) if $@;
97 $ENV{DEBUG_STREAM
} and print STDERR
"FLUSH\t$self ($fh)\n";
98 return if $self->_mode ne 'w';
101 while ($self->block_size <= length(${*$self->{_buffer
}})) {
102 $self->_write_next_hmac_block($fh);
106 $self->_set_error($err);
115 $ENV{DEBUG_STREAM
} and print STDERR
"err\t$self\n";
116 if (exists &Errno
::EPROTO
) {
119 elsif (exists &Errno
::EIO
) {
122 $self->_error($ERROR = error
(@_));
125 ##############################################################################
127 sub _read_hashed_block
{
131 read_all
$fh, my $hmac, 32 or throw
'Failed to read HMAC';
133 read_all
$fh, my $packed_size, 4 or throw
'Failed to read HMAC block size';
134 my ($size) = unpack('L<', $packed_size);
138 read_all
$fh, $block, $size
139 or throw
'Failed to read HMAC block', index => $self->_block_index, size
=> $size;
142 my $packed_index = pack_Ql
($self->_block_index);
143 my $got_hmac = hmac
('SHA256', $self->_hmac_key,
150 or throw
'Block authentication failed', index => $self->_block_index, got
=> $got_hmac, expected
=> $hmac;
152 *$self->{_block_index
}++;
156 sub _write_next_hmac_block
{
159 my $buffer = shift // $self->_buffer;
160 my $allow_empty = shift;
162 my $size = length($$buffer);
163 $size = $self->block_size if $self->block_size < $size;
164 return 0 if $size == 0 && !$allow_empty;
167 $block = substr($$buffer, 0, $size, '') if 0 < $size;
169 my $packed_index = pack_Ql
($self->_block_index);
170 my $packed_size = pack('L<', $size);
171 my $hmac = hmac
('SHA256', $self->_hmac_key,
177 $fh->print($hmac, $packed_size, $block)
178 or throw
'Failed to write HMAC block', hmac
=> $hmac, block_size
=> $size;
180 *$self->{_block_index
}++;
184 sub _write_final_hmac_block
{
188 $self->_write_next_hmac_block($fh, \'', 1);
193 my $key = shift // $self->key;
194 my $index = shift // $self->_block_index;
196 my $packed_index = pack_Ql($index);
197 my $hmac_key = digest_data('SHA512
', $packed_index, $key);
211 File::KDBX::IO::HmacBlock - HMAC block stream IO handle
219 Writing to a HMAC-block stream handle will transform the data into a series of blocks. An HMAC is calculated
220 for each block and is included in the output.
222 Reading from a handle, each block will be verified and authenticated as the blocks are disassembled back into
225 This format helps ensure data integrity and authenticity of KDBX4 files.
227 Each block is encoded thusly:
233 HMAC - 32 bytes, calculated over [block index (increments starting with 0), block size and data]
237 Block size - Little-endian unsigned 32-bit (counting only the data)
241 Data - String of bytes
245 The terminating block is an empty block encoded as usual but block size is 0 and there is no data.
251 Desired block size when writing (default: C<$File::KDBX::IO::HmacBlock::BLOCK_SIZE> or 1,048,576 bytes)
255 HMAC-SHA256 key for authenticating the data stream (required)
261 $fh = File::KDBX::IO::HmacBlock->new(%attributes);
262 $fh = File::KDBX::IO::HmacBlock->new($fh, %attributes);
264 Construct a new HMAC-block stream IO handle.
268 Please report any bugs or feature requests on the bugtracker website
269 L<https://github.com/chazmcgarvey/File-KDBX/issues>
271 When submitting a bug or request, please include a test-file or a
272 patch to an existing test-file that illustrates the bug or desired
277 Charles McGarvey <ccm@cpan.org>
279 =head1 COPYRIGHT AND LICENSE
281 This software is copyright (c) 2022 by Charles McGarvey.
283 This is free software; you can redistribute it and/or modify it under
284 the same terms as the Perl 5 programming language system itself.
This page took 0.046295 seconds and 3 git commands to generate.