-package PerlIO::via::File::KDBX::HashBlock;
-# ABSTRACT: Hash block stream PerlIO layer
+package File::KDBX::IO::HashBlock;
+# ABSTRACT: Hash block stream IO handle
use warnings;
use strict;
use IO::Handle;
use namespace::clean;
+use parent 'File::KDBX::IO';
+
our $VERSION = '999.999'; # VERSION
our $ALGORITHM = 'SHA256';
-our $BLOCK_SIZE = 1048576;
+our $BLOCK_SIZE = 1048576; # 1MiB
our $ERROR;
-=method push
+=method new
- PerlIO::via::File::KDBX::HashBlock->push($fh, %attributes);
+ $fh = File::KDBX::IO::HashBlock->new(%attributes);
+ $fh = File::KDBX::IO::HashBlock->new($fh, %attributes);
-Push a new HashBlock layer, optionally with attributes.
+Construct a new hash-block stream IO handle.
-This is identical to:
+=cut
- binmode($fh, ':via(File::KDBX::HashBlock)');
+sub new {
+ my $class = shift;
+ my %args = @_ % 2 == 1 ? (fh => shift, @_) : @_;
+ my $self = $class->SUPER::new;
+ $self->_fh($args{fh}) or throw 'IO handle required';
+ $self->algorithm($args{algorithm});
+ $self->block_size($args{block_size});
+ $self->_buffer;
+ return $self;
+}
-except this allows you to customize the process with attributes.
+=attr algorithm
-B<WARNING:> When writing, you mustn't close the filehandle before popping this layer (using
-C<binmode($fh, ':pop')>) or the stream will be truncated. The layer needs to know when there is no more data
-before the filehandle closes so it can write the final block (which will likely be shorter than the other
-blocks), and the way to indicate that is by popping the layer.
+Digest algorithm in hash-blocking the stream (default: C<SHA-256>)
-=cut
+=attr block_size
-my %PUSHED_ARGS;
-sub push {
- %PUSHED_ARGS and throw 'Pushing Hash layer would stomp existing arguments';
- my $class = shift;
- my $fh = shift;
- %PUSHED_ARGS = @_;
- binmode($fh, ':via(' . __PACKAGE__ . ')');
-}
+Desired block size when writing (default: C<$File::KDBX::IO::HashBlock::BLOCK_SIZE> or 1,048,576 bytes)
-sub PUSHED {
- my ($class, $mode) = @_;
-
- $ENV{DEBUG_STREAM} and print STDERR "PUSHED\t$class (mode: $mode)\n";
- my $self = bless {
- algorithm => $PUSHED_ARGS{algorithm} || $ALGORITHM,
- block_index => 0,
- block_size => $PUSHED_ARGS{block_size} || $BLOCK_SIZE,
- buffer => \(my $buf = ''),
- eof => 0,
- mode => $mode,
- }, $class;
- %PUSHED_ARGS = ();
- return $self;
+=cut
+
+my %ATTRS = (
+ _block_index => 0,
+ _buffer => \(my $buf = ''),
+ _finished => 0,
+ algorithm => sub { $ALGORITHM },
+ block_size => sub { $BLOCK_SIZE },
+);
+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 {
+sub _FILL {
my ($self, $fh) = @_;
$ENV{DEBUG_STREAM} and print STDERR "FILL\t$self\n";
- return if $self->EOF($fh);
+ return if $self->_finished;
my $block = eval { $self->_read_hash_block($fh) };
if (my $err = $@) {
return $$block if defined $block;
}
-sub WRITE {
+sub _WRITE {
my ($self, $buf, $fh) = @_;
$ENV{DEBUG_STREAM} and print STDERR "WRITE\t$self\n";
- return 0 if $self->EOF($fh);
+ return 0 if $self->_finished;
- ${$self->{buffer}} .= $buf;
+ ${$self->_buffer} .= $buf;
- $self->FLUSH($fh);
+ $self->_FLUSH($fh);
return length($buf);
}
-sub POPPED {
+sub _POPPED {
my ($self, $fh) = @_;
$ENV{DEBUG_STREAM} and print STDERR "POPPED\t$self\n";
- return if $self->EOF($fh) || $self->mode !~ /^w/;
+ return if $self->_mode ne 'w';
- $self->FLUSH($fh);
+ $self->_FLUSH($fh);
eval {
$self->_write_next_hash_block($fh); # partial block with remaining content
$self->_write_final_hash_block($fh); # terminating block
$self->_set_error($@) if $@;
}
-sub FLUSH {
+sub _FLUSH {
my ($self, $fh) = @_;
$ENV{DEBUG_STREAM} and print STDERR "FLUSH\t$self\n";
- return 0 if !ref $self;
+ return if $self->_mode ne 'w';
eval {
- while ($self->block_size <= length(${$self->{buffer}})) {
+ while ($self->block_size <= length(${*$self->{_buffer}})) {
$self->_write_next_hash_block($fh);
}
};
return 0;
}
-sub EOF {
- $ENV{DEBUG_STREAM} and print STDERR "EOF\t$_[0]\n";
- $_[0]->{eof} || $_[0]->ERROR($_[1]);
-}
-sub ERROR {
- $ENV{DEBUG_STREAM} and print STDERR "ERROR\t$_[0] : ", $_[0]->{error} // 'ok', "\n";
- $ERROR = $_[0]->{error} if $_[0]->{error};
- $_[0]->{error} ? 1 : 0;
-}
-sub CLEARERR {
- $ENV{DEBUG_STREAM} and print STDERR "CLEARERR\t$_[0]\n";
- # delete $_[0]->{error};
-}
-
-=attr algorithm
-
- $algo = $hash_block->algorithm;
-
-Get the hash algorithm. Default is C<SHA256>.
-
-=cut
-
-sub algorithm { $_[0]->{algorithm} //= $ALGORITHM }
-
-=attr block_size
-
- $size = $hash_block->block_size;
-
-Get the block size. Default is C<$PerlIO::via::File::KDBX::HashBlock::BLOCK_SIZE>.
-
-This only matters in write mode. When reading, block size is detected from the stream.
-
-=cut
-
-sub block_size { $_[0]->{block_size} //= $BLOCK_SIZE }
-
-=attr block_index
-
-=attr buffer
-
-=attr mode
-
-Internal attributes.
-
-=cut
-
-sub block_index { $_[0]->{block_index} ||= 0 }
-sub buffer { $_[0]->{buffer} }
-sub mode { $_[0]->{mode} }
+##############################################################################
sub _read_hash_block {
my $self = shift;
read_all $fh, my $buf, 4 or throw 'Failed to read hash block index';
my ($index) = unpack('L<', $buf);
- $index == $self->block_index
- or throw 'Invalid block index', index => $index;
+ $index == $self->_block_index or throw 'Invalid block index', index => $index;
read_all $fh, my $hash, 32 or throw 'Failed to read hash';
my ($size) = unpack('L<', $buf);
if ($size == 0) {
- $hash eq ("\0" x 32)
- or throw 'Invalid final block hash', hash => $hash;
- $self->{eof} = 1;
+ $hash eq ("\0" x 32) or throw 'Invalid final block hash', hash => $hash;
+ $self->_finished(1);
return undef;
}
read_all $fh, my $block, $size or throw 'Failed to read hash block', index => $index, size => $size;
- my $got_hash = digest_data('SHA256', $block);
+ my $got_hash = digest_data($self->algorithm, $block);
$hash eq $got_hash
or throw 'Hash mismatch', index => $index, size => $size, got => $got_hash, expected => $hash;
- $self->{block_index}++;
+ *$self->{_block_index}++;
return \$block;
}
my $self = shift;
my $fh = shift;
- my $size = length(${$self->buffer});
+ my $size = length(${$self->_buffer});
$size = $self->block_size if $self->block_size < $size;
return 0 if $size == 0;
- my $block = substr(${$self->buffer}, 0, $size, '');
+ my $block = substr(${$self->_buffer}, 0, $size, '');
- my $buf = pack('L<', $self->block_index);
+ my $buf = pack('L<', $self->_block_index);
print $fh $buf or throw 'Failed to write hash block index';
- my $hash = digest_data('SHA256', $block);
+ my $hash = digest_data($self->algorithm, $block);
print $fh $hash or throw 'Failed to write hash';
$buf = pack('L<', length($block));
# $fh->write($block, $size) or throw 'Failed to hash write block';
print $fh $block or throw 'Failed to hash write block';
- $self->{block_index}++;
+ *$self->{_block_index}++;
return 0;
}
my $self = shift;
my $fh = shift;
- my $buf = pack('L<', $self->block_index);
+ my $buf = pack('L<', $self->_block_index);
print $fh $buf or throw 'Failed to write hash block index';
my $hash = "\0" x 32;
$buf = pack('L<', 0);
print $fh $buf or throw 'Failed to write hash block size';
- $self->{eof} = 1;
+ $self->_finished(1);
return 0;
}
elsif (exists &Errno::EIO) {
$! = &Errno::EIO;
}
- $self->{error} = $ERROR = File::KDBX::Error->new(@_);
+ $self->_error($ERROR = error(@_));
}
1;
=head1 DESCRIPTION
-Writing to a handle with this layer will transform the data in a series of blocks. Each block is hashed, and
-the hash is included with the block in the stream.
+Writing to a hash-block handle will transform the data into a series of blocks. Each block is hashed, and the
+hash is included with the block in the stream.
Reading from a handle, each hash block will be verified as the blocks are disassembled back into a data
stream.
+This format helps ensure data integrity of KDBX3 files.
+
Each block is encoded thusly:
=for :list
projects / chaz / p5-File-KDBX / blobdiff