--- /dev/null
+package File::KDBX::IO::HmacBlock;
+# ABSTRACT: HMAC block stream IO handle
+
+use warnings;
+use strict;
+
+use Crypt::Digest qw(digest_data);
+use Crypt::Mac::HMAC qw(hmac);
+use Errno;
+use File::KDBX::Error;
+use File::KDBX::Util qw(:io assert_64bit);
+use namespace::clean;
+
+use parent 'File::KDBX::IO';
+
+our $VERSION = '999.999'; # VERSION
+our $BLOCK_SIZE = 1048576; # 1MiB
+our $ERROR;
+
+=method new
+
+ $fh = File::KDBX::IO::HmacBlock->new(%attributes);
+ $fh = File::KDBX::IO::HmacBlock->new($fh, %attributes);
+
+Construct a new HMAC-block stream IO handle.
+
+=cut
+
+sub new {
+ assert_64bit;
+
+ my $class = shift;
+ my %args = @_ % 2 == 1 ? (fh => shift, @_) : @_;
+ my $self = $class->SUPER::new;
+ $self->_fh($args{fh}) or throw 'IO handle required';
+ $self->key($args{key}) or throw 'Key required';
+ $self->block_size($args{block_size});
+ $self->_buffer;
+ return $self;
+}
+
+=attr block_size
+
+Desired block size when writing (default: C<$File::KDBX::IO::HmacBlock::BLOCK_SIZE> or 1,048,576 bytes)
+
+=attr key
+
+HMAC-SHA256 key for authenticating the data stream (required)
+
+=cut
+
+my %ATTRS = (
+ _block_index => 0,
+ _buffer => \(my $buf = ''),
+ _finished => 0,
+ block_size => sub { $BLOCK_SIZE },
+ key => undef,
+);
+while (my ($attr, $default) = each %ATTRS) {
+ no strict 'refs'; ## no critic (ProhibitNoStrict)
+ *$attr = sub {
+ my $self = shift;
+ *$self->{$attr} = shift if @_;
+ *$self->{$attr} //= (ref $default eq 'CODE') ? $default->($self) : $default;
+ };
+}
+
+sub _FILL {
+ my ($self, $fh) = @_;
+
+ $ENV{DEBUG_STREAM} and print STDERR "FILL\t$self\n";
+ return if $self->_finished;
+
+ my $block = eval { $self->_read_hashed_block($fh) };
+ if (my $err = $@) {
+ $self->_set_error($err);
+ return;
+ }
+ if (length($block) == 0) {
+ $self->_finished(1);
+ return;
+ }
+ return $block;
+}
+
+sub _WRITE {
+ my ($self, $buf, $fh) = @_;
+
+ $ENV{DEBUG_STREAM} and print STDERR "WRITE\t$self ($fh)\n";
+ return 0 if $self->_finished;
+
+ ${*$self->{_buffer}} .= $buf;
+
+ $self->_FLUSH($fh); # TODO only if autoflush?
+
+ return length($buf);
+}
+
+sub _POPPED {
+ my ($self, $fh) = @_;
+
+ $ENV{DEBUG_STREAM} and print STDERR "POPPED\t$self ($fh)\n";
+ return if $self->_mode ne 'w';
+
+ $self->_FLUSH($fh);
+ eval {
+ $self->_write_next_hmac_block($fh); # partial block with remaining content
+ $self->_write_final_hmac_block($fh); # terminating block
+ };
+ $self->_set_error($@) if $@;
+}
+
+sub _FLUSH {
+ my ($self, $fh) = @_;
+
+ $ENV{DEBUG_STREAM} and print STDERR "FLUSH\t$self ($fh)\n";
+ return if $self->_mode ne 'w';
+
+ eval {
+ while ($self->block_size <= length(${*$self->{_buffer}})) {
+ $self->_write_next_hmac_block($fh);
+ }
+ };
+ if (my $err = $@) {
+ $self->_set_error($err);
+ return -1;
+ }
+
+ return 0;
+}
+
+sub _set_error {
+ my $self = shift;
+ $ENV{DEBUG_STREAM} and print STDERR "err\t$self\n";
+ if (exists &Errno::EPROTO) {
+ $! = &Errno::EPROTO;
+ }
+ elsif (exists &Errno::EIO) {
+ $! = &Errno::EIO;
+ }
+ $self->_error($ERROR = error(@_));
+}
+
+##############################################################################
+
+sub _read_hashed_block {
+ my $self = shift;
+ my $fh = shift;
+
+ read_all $fh, my $hmac, 32 or throw 'Failed to read HMAC';
+
+ read_all $fh, my $packed_size, 4 or throw 'Failed to read HMAC block size';
+ my ($size) = unpack('L<', $packed_size);
+
+ my $block = '';
+ if (0 < $size) {
+ read_all $fh, $block, $size
+ or throw 'Failed to read HMAC block', index => $self->_block_index, size => $size;
+ }
+
+ my $packed_index = pack('Q<', $self->_block_index);
+ my $got_hmac = hmac('SHA256', $self->_hmac_key,
+ $packed_index,
+ $packed_size,
+ $block,
+ );
+
+ $hmac eq $got_hmac
+ or throw 'Block authentication failed', index => $self->_block_index, got => $got_hmac, expected => $hmac;
+
+ *$self->{_block_index}++;
+ return $block;
+}
+
+sub _write_next_hmac_block {
+ my $self = shift;
+ my $fh = shift;
+ my $buffer = shift // $self->_buffer;
+ my $allow_empty = shift;
+
+ my $size = length($$buffer);
+ $size = $self->block_size if $self->block_size < $size;
+ return 0 if $size == 0 && !$allow_empty;
+
+ my $block = '';
+ $block = substr($$buffer, 0, $size, '') if 0 < $size;
+
+ my $packed_index = pack('Q<', $self->_block_index);
+ my $packed_size = pack('L<', $size);
+ my $hmac = hmac('SHA256', $self->_hmac_key,
+ $packed_index,
+ $packed_size,
+ $block,
+ );
+
+ $fh->print($hmac, $packed_size, $block)
+ or throw 'Failed to write HMAC block', hmac => $hmac, block_size => $size;
+
+ *$self->{_block_index}++;
+ return 0;
+}
+
+sub _write_final_hmac_block {
+ my $self = shift;
+ my $fh = shift;
+
+ $self->_write_next_hmac_block($fh, \'', 1);
+}
+
+sub _hmac_key {
+ my $self = shift;
+ my $key = shift // $self->key;
+ my $index = shift // $self->_block_index;
+
+ my $packed_index = pack('Q<', $index);
+ my $hmac_key = digest_data('SHA512', $packed_index, $key);
+ return $hmac_key;
+}
+
+1;
+__END__
+
+=head1 DESCRIPTION
+
+Writing to a HMAC-block stream handle will transform the data into a series of blocks. An HMAC is calculated
+for each block and is included in the output.
+
+Reading from a handle, each block will be verified and authenticated as the blocks are disassembled back into
+a data stream.
+
+This format helps ensure data integrity and authenticity of KDBX4 files.
+
+Each block is encoded thusly:
+
+=for :list
+* HMAC - 32 bytes, calculated over [block index (increments starting with 0), block size and data]
+* Block size - Little-endian unsigned 32-bit (counting only the data)
+* Data - String of bytes
+
+The terminating block is an empty block encoded as usual but block size is 0 and there is no data.
+
+=cut
projects / chaz / p5-File-KDBX / blobdiff