X-Git-Url: https://git.dogcows.com/gitweb?p=chaz%2Fp5-File-KDBX;a=blobdiff_plain;f=lib%2FFile%2FKDBX%2FIO%2FHashBlock.pm;fp=lib%2FPerlIO%2Fvia%2FFile%2FKDBX%2FHashBlock.pm;h=adb1cc6f28e60f7fc36c76bbb2328675fabd38c6;hp=e4a772bac55f546c39007024bddb5fd2ff66fc73;hb=50f1a929d9224b9072b5fae39162a5d943323c5d;hpb=52cf8dbcf4ded14b1582e905cf034749385624b3 diff --git a/lib/PerlIO/via/File/KDBX/HashBlock.pm b/lib/File/KDBX/IO/HashBlock.pm similarity index 50% rename from lib/PerlIO/via/File/KDBX/HashBlock.pm rename to lib/File/KDBX/IO/HashBlock.pm index e4a772b..adb1cc6 100644 --- a/lib/PerlIO/via/File/KDBX/HashBlock.pm +++ b/lib/File/KDBX/IO/HashBlock.pm @@ -1,5 +1,5 @@ -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; @@ -11,60 +11,64 @@ use File::KDBX::Util qw(:io); 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 When writing, you mustn't close the filehandle before popping this layer (using -C) 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) -=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 = $@) { @@ -74,26 +78,26 @@ sub FILL { 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 @@ -101,14 +105,14 @@ sub POPPED { $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); } }; @@ -120,55 +124,7 @@ sub FLUSH { 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. - -=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; @@ -177,8 +133,7 @@ sub _read_hash_block { 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'; @@ -186,19 +141,18 @@ sub _read_hash_block { 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; } @@ -206,16 +160,16 @@ sub _write_next_hash_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)); @@ -224,7 +178,7 @@ sub _write_next_hash_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; } @@ -232,7 +186,7 @@ sub _write_final_hash_block { 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; @@ -241,7 +195,7 @@ sub _write_final_hash_block { $buf = pack('L<', 0); print $fh $buf or throw 'Failed to write hash block size'; - $self->{eof} = 1; + $self->_finished(1); return 0; } @@ -254,7 +208,7 @@ sub _set_error { elsif (exists &Errno::EIO) { $! = &Errno::EIO; } - $self->{error} = $ERROR = File::KDBX::Error->new(@_); + $self->_error($ERROR = error(@_)); } 1; @@ -262,12 +216,14 @@ __END__ =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