1 package PerlIO
::via
::File
::KDBX
::HashBlock
;
2 # ABSTRACT: Hash block stream PerlIO layer
7 use Crypt
::Digest
qw(digest_data);
9 use File
::KDBX
::Util
qw(:io);
13 our $VERSION = '999.999'; # VERSION
14 our $ALGORITHM = 'SHA256';
15 our $BLOCK_SIZE = 1048576;
20 PerlIO
::via
::File
::KDBX
::HashBlock-
>push($fh, %attributes);
22 Push a new HashBlock layer
, optionally with attributes
.
26 binmode($fh, ':via(File::KDBX::HashBlock)');
28 except this allows you to customize the process with attributes
.
30 B
<WARNING
:> When writing
, you mustn
't close the filehandle before popping this layer (using
31 C<binmode($fh, ':pop')>) or the stream will be truncated. The layer needs to know when there is no more data
32 before the filehandle closes so it can write the final block (which will likely be shorter than the other
33 blocks), and the way to indicate that is by popping the layer.
39 %PUSHED_ARGS and throw 'Pushing Hash layer would stomp existing arguments
';
43 binmode($fh, ':via
(' . __PACKAGE__ . ')');
47 my ($class, $mode) = @_;
49 $ENV{DEBUG_STREAM} and print STDERR "PUSHED\t$class\n";
52 algorithm => $PUSHED_ARGS{algorithm} || $ALGORITHM,
54 block_size => $PUSHED_ARGS{block_size} || $BLOCK_SIZE,
66 $ENV{DEBUG_STREAM} and print STDERR "FILL\t$self\n";
67 return if $self->EOF($fh);
69 my $block = eval { $self->_read_hash_block($fh) };
71 $self->_set_error($err);
74 return $$block if defined $block;
78 my ($self, $buf, $fh) = @_;
80 $ENV{DEBUG_STREAM} and print STDERR "WRITE\t$self\n";
81 return 0 if $self->EOF($fh);
83 ${$self->{buffer}} .= $buf;
93 $ENV{DEBUG_STREAM} and print STDERR "POPPED\t$self\n";
94 return if $self->EOF($fh) || $self->mode !~ /^w/;
98 $self->_write_next_hash_block($fh); # partial block with remaining content
99 $self->_write_final_hash_block($fh); # terminating block
101 $self->_set_error($@) if $@;
105 my ($self, $fh) = @_;
107 $ENV{DEBUG_STREAM} and print STDERR "FLUSH\t$self\n";
108 return 0 if !ref $self;
111 while ($self->block_size <= length(${$self->{buffer}})) {
112 $self->_write_next_hash_block($fh);
116 $self->_set_error($err);
124 $ENV{DEBUG_STREAM} and print STDERR "EOF\t$_[0]\n";
125 $_[0]->{eof} || $_[0]->ERROR($_[1]);
128 $ENV{DEBUG_STREAM} and print STDERR "ERROR\t$_[0] : ", $_[0]->{error} // 'ok
', "\n";
129 $ERROR = $_[0]->{error} if $_[0]->{error};
130 $_[0]->{error} ? 1 : 0;
133 $ENV{DEBUG_STREAM} and print STDERR "CLEARERR\t$_[0]\n";
134 # delete $_[0]->{error};
139 $algo = $hash_block->algorithm;
141 Get the hash algorithm. Default is C<SHA256>.
145 sub algorithm { $_[0]->{algorithm} //= $ALGORITHM }
149 $size = $hash_block->block_size;
151 Get the block size. Default is C<$PerlIO::via::File::KDBX::HashBlock::BLOCK_SIZE>.
153 This only matters in write mode. When reading, block size is detected from the stream.
157 sub block_size { $_[0]->{block_size} //= $BLOCK_SIZE }
169 sub block_index { $_[0]->{block_index} ||= 0 }
170 sub buffer { $_[0]->{buffer} }
171 sub mode { $_[0]->{mode} }
173 sub _read_hash_block {
177 read_all $fh, my $buf, 4 or throw 'Failed to
read hash block
index';
178 my ($index) = unpack('L
<', $buf);
180 $index == $self->block_index
181 or throw 'Invalid block
index', index => $index;
183 read_all $fh, my $hash, 32 or throw 'Failed to
read hash
';
185 read_all $fh, $buf, 4 or throw 'Failed to
read hash block size
';
186 my ($size) = unpack('L
<', $buf);
190 or throw 'Invalid final block hash
', hash => $hash;
195 read_all $fh, my $block, $size or throw 'Failed to
read hash block
', index => $index, size => $size;
197 my $got_hash = digest_data('SHA256
', $block);
199 or throw 'Hash mismatch
', index => $index, size => $size, got => $got_hash, expected => $hash;
201 $self->{block_index}++;
205 sub _write_next_hash_block {
209 my $size = length(${$self->buffer});
210 $size = $self->block_size if $self->block_size < $size;
211 return 0 if $size == 0;
213 my $block = substr(${$self->buffer}, 0, $size, '');
215 my $buf = pack('L
<', $self->block_index);
216 print $fh $buf or throw 'Failed to
write hash block
index';
218 my $hash = digest_data('SHA256
', $block);
219 print $fh $hash or throw 'Failed to
write hash
';
221 $buf = pack('L
<', length($block));
222 print $fh $buf or throw 'Failed to
write hash block size
';
224 # $fh->write($block, $size) or throw 'Failed to hash
write block
';
225 print $fh $block or throw 'Failed to hash
write block
';
227 $self->{block_index}++;
231 sub _write_final_hash_block {
235 my $buf = pack('L
<', $self->block_index);
236 print $fh $buf or throw 'Failed to
write hash block
index';
238 my $hash = "\0" x 32;
239 print $fh $hash or throw 'Failed to
write hash
';
241 $buf = pack('L
<', 0);
242 print $fh $buf or throw 'Failed to
write hash block size
';
250 $ENV{DEBUG_STREAM} and print STDERR "err\t$self\n";
251 if (exists &Errno::EPROTO) {
254 elsif (exists &Errno::EIO) {
257 $self->{error} = $ERROR = File::KDBX::Error->new(@_);
265 Writing to a handle with this layer will transform the data in a series of blocks. Each block is hashed, and
266 the hash is included with the block in the stream.
268 Reading from a handle, each hash block will be verified as the blocks are disassembled back into a data
271 Each block is encoded thusly:
274 * Block index - Little-endian unsigned 32-bit integer, increments starting with 0
276 * Block size - Little-endian unsigned 32-bit (counting only the data)
277 * Data - String of bytes
279 The terminating block is an empty block where hash is 32 null bytes, block size is 0 and there is no data.