1 package PerlIO
::via
::File
::KDBX
::HmacBlock
;
2 # ABSTRACT: HMAC block-stream PerlIO layer
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(:io assert_64bit);
14 our $VERSION = '999.999'; # VERSION
15 our $BLOCK_SIZE = 1048576;
20 PerlIO
::via
::File
::KDBX
::HmacBlock-
>push($fh, key
=> $key);
21 PerlIO
::via
::File
::KDBX
::HmacBlock-
>push($fh, key
=> $key, block_size
=> $size);
23 Push a new HMAC-block layer with arguments
. A key
is required
.
25 B
<WARNING
:> You mustn
't push this layer using C<binmode> directly because the layer needs to be initialized
26 with the key and any other desired attributes.
28 B<WARNING:> When writing, you mustn't
close the filehandle before popping this layer
(using
29 C
<binmode($fh, ':pop')>) or the stream will be truncated
. The layer needs to know
when there
is no more data
30 before the filehandle closes so it can
write the final block
(which will likely be shorter than the other
31 blocks
), and the way to indicate that
is by popping the layer
.
39 %PUSHED_ARGS and throw
'Pushing HmacBlock layer would stomp existing arguments';
43 my %args = @_ % 2 == 0 ? @_ : (key
=> @_);
44 $args{key
} or throw
'Must pass a key';
46 my $key_size = length($args{key
});
47 $key_size == 64 or throw
'Key must be 64 bytes in length', size
=> $key_size;
50 binmode($fh, ':via(' . __PACKAGE__
. ')');
54 my ($class, $mode) = @_;
56 %PUSHED_ARGS or throw
'Programmer error: Use PerlIO::via::File::KDBX::HmacBlock->push instead of binmode';
58 $ENV{DEBUG_STREAM
} and print STDERR
"PUSHED\t$class (mode: $mode)\n";
61 block_size
=> $PUSHED_ARGS{block_size
} || $BLOCK_SIZE,
62 buffer
=> \
(my $buf = ''),
63 key
=> $PUSHED_ARGS{key
},
73 $ENV{DEBUG_STREAM
} and print STDERR
"FILL\t$self\n";
74 return if $self->EOF($fh);
76 my $block = eval { $self->_read_hashed_block($fh) };
78 $self->_set_error($err);
81 if (length($block) == 0) {
89 my ($self, $buf, $fh) = @_;
91 $ENV{DEBUG_STREAM
} and print STDERR
"WRITE\t$self\n";
92 return 0 if $self->EOF($fh);
94 ${$self->{buffer
}} .= $buf;
102 my ($self, $fh) = @_;
104 $ENV{DEBUG_STREAM
} and print STDERR
"POPPED\t$self\n";
105 return if $self->mode !~ /^w/;
109 $self->_write_next_hmac_block($fh); # partial block with remaining content
110 $self->_write_final_hmac_block($fh); # terminating block
112 $self->_set_error($@) if $@;
116 my ($self, $fh) = @_;
118 $ENV{DEBUG_STREAM
} and print STDERR
"FLUSH\t$self\n";
119 return 0 if !ref $self;
122 while ($self->block_size <= length(${$self->{buffer
}})) {
123 $self->_write_next_hmac_block($fh);
127 $self->_set_error($err);
135 $ENV{DEBUG_STREAM
} and print STDERR
"EOF\t$_[0]\n";
136 $_[0]->{eof} || $_[0]->ERROR($_[1]);
139 $ENV{DEBUG_STREAM
} and print STDERR
"ERROR\t$_[0] : ", $_[0]->{error
} // 'ok', "\n";
140 $ERROR = $_[0]->{error
} if $_[0]->{error
};
141 $_[0]->{error
} ? 1 : 0;
144 $ENV{DEBUG_STREAM
} and print STDERR
"CLEARERR\t$_[0]\n";
145 # delete $_[0]->{error};
150 $key = $hmac_block->key;
152 Get the key used
for authentication
. The key must be exactly
64 bytes
in size
.
156 sub key
{ $_[0]->{key
} or throw
'Key is not set' }
160 $size = $hmac_block->block_size;
162 Get the block size
. Default
is C
<$PerlIO::via
::File
::KDBX
::HmacBlock
::BLOCK_SIZE
>.
164 This only matters
in write mode
. When reading
, block size
is detected from the stream
.
168 sub block_size
{ $_[0]->{block_size
} ||= $BLOCK_SIZE }
180 sub block_index
{ $_[0]->{block_index
} ||= 0 }
181 sub buffer
{ $_[0]->{buffer
} }
182 sub mode
{ $_[0]->{mode
} }
184 sub _read_hashed_block
{
188 read_all
$fh, my $hmac, 32 or throw
'Failed to read HMAC';
190 read_all
$fh, my $size_buf, 4 or throw
'Failed to read HMAC block size';
191 my ($size) = unpack('L<', $size_buf);
195 read_all
$fh, $block, $size
196 or throw
'Failed to read HMAC block', index => $self->block_index, size
=> $size;
199 my $index_buf = pack('Q<', $self->block_index);
200 my $got_hmac = hmac
('SHA256', $self->_hmac_key,
207 or throw
'Block authentication failed', index => $self->block_index, got
=> $got_hmac, expected
=> $hmac;
209 $self->{block_index
}++;
214 sub _write_next_hmac_block
{
217 my $buffer = shift // $self->buffer;
218 my $allow_empty = shift;
220 my $size = length($$buffer);
221 $size = $self->block_size if $self->block_size < $size;
222 return 0 if $size == 0 && !$allow_empty;
225 $block = substr($$buffer, 0, $size, '') if 0 < $size;
227 my $index_buf = pack('Q<', $self->block_index);
228 my $size_buf = pack('L<', $size);
229 my $hmac = hmac
('SHA256', $self->_hmac_key,
235 print $fh $hmac, $size_buf, $block
236 or throw
'Failed to write HMAC block', hmac
=> $hmac, block_size
=> $size, err
=> $fh->error;
238 $self->{block_index
}++;
242 sub _write_final_hmac_block
{
246 $self->_write_next_hmac_block($fh, \'', 1);
251 my $key = shift // $self->key;
252 my $index = shift // $self->block_index;
254 my $index_buf = pack('Q
<', $index);
255 my $hmac_key = digest_data('SHA512
', $index_buf, $key);
261 $ENV{DEBUG_STREAM} and print STDERR "err\t$self\n";
262 if (exists &Errno::EPROTO) {
265 elsif (exists &Errno::EIO) {
268 $self->{error} = $ERROR = File::KDBX::Error->new(@_);
276 Writing to a handle with this layer will transform the data in a series of blocks. An HMAC is calculated for
277 each block and is included in the output.
279 Reading from a handle, each block will be verified and authenticated as the blocks are disassembled back into
282 Each block is encoded thusly:
285 * HMAC - 32 bytes, calculated over [block index (increments starting with 0), block size and data]
286 * Block size - Little-endian unsigned 32-bit (counting only the data)
287 * Data - String of bytes
289 The terminating block is an empty block encoded as usual but block size is 0 and there is no data.