Dogcows Code - chaz/p5-File-KDBX/blob - lib/File/KDBX/IO/HashBlock.pm

   1 package File::KDBX::IO::HashBlock;
   2 # ABSTRACT: Hash block stream IO handle
   3
   4 use warnings;
   5 use strict;
   6
   7 use Crypt::Digest qw(digest_data);
   8 use Errno;
   9 use File::KDBX::Error;
  10 use File::KDBX::Util qw(:io);
  11 use IO::Handle;
  12 use namespace::clean;
  13
  14 use parent 'File::KDBX::IO';
  15
  16 our $VERSION = '999.999'; # VERSION
  17 our $ALGORITHM = 'SHA256';
  18 our $BLOCK_SIZE = 1048576;  # 1MiB
  19 our $ERROR;
  20
  21 =method new
  22
  23     $fh = File::KDBX::IO::HashBlock->new(%attributes);
  24     $fh = File::KDBX::IO::HashBlock->new($fh, %attributes);
  25
  26 Construct a new hash-block stream IO handle.
  27
  28 =cut
  29
  30 sub new {
  31     my $class = shift;
  32     my %args = @_ % 2 == 1 ? (fh => shift, @_) : @_;
  33     my $self = $class->SUPER::new;
  34     $self->_fh($args{fh}) or throw 'IO handle required';
  35     $self->algorithm($args{algorithm});
  36     $self->block_size($args{block_size});
  37     $self->_buffer;
  38     return $self;
  39 }
  40
  41 =attr algorithm
  42
  43 Digest algorithm in hash-blocking the stream (default: C<SHA-256>)
  44
  45 =attr block_size
  46
  47 Desired block size when writing (default: C<$File::KDBX::IO::HashBlock::BLOCK_SIZE> or 1,048,576 bytes)
  48
  49 =cut
  50
  51 my %ATTRS = (
  52     _block_index    => 0,
  53     _buffer         => \(my $buf = ''),
  54     _finished       => 0,
  55     algorithm       => sub { $ALGORITHM },
  56     block_size      => sub { $BLOCK_SIZE },
  57 );
  58 while (my ($attr, $default) = each %ATTRS) {
  59     no strict 'refs'; ## no critic (ProhibitNoStrict)
  60     *$attr = sub {
  61         my $self = shift;
  62         *$self->{$attr} = shift if @_;
  63         *$self->{$attr} //= (ref $default eq 'CODE') ? $default->($self) : $default;
  64     };
  65 }
  66
  67 sub _FILL {
  68     my ($self, $fh) = @_;
  69
  70     $ENV{DEBUG_STREAM} and print STDERR "FILL\t$self\n";
  71     return if $self->_finished;
  72
  73     my $block = eval { $self->_read_hash_block($fh) };
  74     if (my $err = $@) {
  75         $self->_set_error($err);
  76         return;
  77     }
  78     return $$block if defined $block;
  79 }
  80
  81 sub _WRITE {
  82     my ($self, $buf, $fh) = @_;
  83
  84     $ENV{DEBUG_STREAM} and print STDERR "WRITE\t$self\n";
  85     return 0 if $self->_finished;
  86
  87     ${$self->_buffer} .= $buf;
  88
  89     $self->_FLUSH($fh);
  90
  91     return length($buf);
  92 }
  93
  94 sub _POPPED {
  95     my ($self, $fh) = @_;
  96
  97     $ENV{DEBUG_STREAM} and print STDERR "POPPED\t$self\n";
  98     return if $self->_mode ne 'w';
  99
 100     $self->_FLUSH($fh);
 101     eval {
 102         $self->_write_next_hash_block($fh);     # partial block with remaining content
 103         $self->_write_final_hash_block($fh);    # terminating block
 104     };
 105     $self->_set_error($@) if $@;
 106 }
 107
 108 sub _FLUSH {
 109     my ($self, $fh) = @_;
 110
 111     $ENV{DEBUG_STREAM} and print STDERR "FLUSH\t$self\n";
 112     return if $self->_mode ne 'w';
 113
 114     eval {
 115         while ($self->block_size <= length(${*$self->{_buffer}})) {
 116             $self->_write_next_hash_block($fh);
 117         }
 118     };
 119     if (my $err = $@) {
 120         $self->_set_error($err);
 121         return -1;
 122     }
 123
 124     return 0;
 125 }
 126
 127 ##############################################################################
 128
 129 sub _read_hash_block {
 130     my $self = shift;
 131     my $fh = shift;
 132
 133     read_all $fh, my $buf, 4 or throw 'Failed to read hash block index';
 134     my ($index) = unpack('L<', $buf);
 135
 136     $index == $self->_block_index or throw 'Invalid block index', index => $index;
 137
 138     read_all $fh, my $hash, 32 or throw 'Failed to read hash';
 139
 140     read_all $fh, $buf, 4 or throw 'Failed to read hash block size';
 141     my ($size) = unpack('L<', $buf);
 142
 143     if ($size == 0) {
 144         $hash eq ("\0" x 32) or throw 'Invalid final block hash', hash => $hash;
 145         $self->_finished(1);
 146         return undef;
 147     }
 148
 149     read_all $fh, my $block, $size or throw 'Failed to read hash block', index => $index, size => $size;
 150
 151     my $got_hash = digest_data($self->algorithm, $block);
 152     $hash eq $got_hash
 153         or throw 'Hash mismatch', index => $index, size => $size, got => $got_hash, expected => $hash;
 154
 155     *$self->{_block_index}++;
 156     return \$block;
 157 }
 158
 159 sub _write_next_hash_block {
 160     my $self = shift;
 161     my $fh = shift;
 162
 163     my $size = length(${$self->_buffer});
 164     $size = $self->block_size if $self->block_size < $size;
 165     return 0 if $size == 0;
 166
 167     my $block = substr(${$self->_buffer}, 0, $size, '');
 168
 169     my $buf = pack('L<', $self->_block_index);
 170     print $fh $buf or throw 'Failed to write hash block index';
 171
 172     my $hash = digest_data($self->algorithm, $block);
 173     print $fh $hash or throw 'Failed to write hash';
 174
 175     $buf = pack('L<', length($block));
 176     print $fh $buf or throw 'Failed to write hash block size';
 177
 178     # $fh->write($block, $size) or throw 'Failed to hash write block';
 179     print $fh $block or throw 'Failed to hash write block';
 180
 181     *$self->{_block_index}++;
 182     return 0;
 183 }
 184
 185 sub _write_final_hash_block {
 186     my $self = shift;
 187     my $fh = shift;
 188
 189     my $buf = pack('L<', $self->_block_index);
 190     print $fh $buf or throw 'Failed to write hash block index';
 191
 192     my $hash = "\0" x 32;
 193     print $fh $hash or throw 'Failed to write hash';
 194
 195     $buf = pack('L<', 0);
 196     print $fh $buf or throw 'Failed to write hash block size';
 197
 198     $self->_finished(1);
 199     return 0;
 200 }
 201
 202 sub _set_error {
 203     my $self = shift;
 204     $ENV{DEBUG_STREAM} and print STDERR "err\t$self\n";
 205     if (exists &Errno::EPROTO) {
 206         $! = &Errno::EPROTO;
 207     }
 208     elsif (exists &Errno::EIO) {
 209         $! = &Errno::EIO;
 210     }
 211     $self->_error($ERROR = error(@_));
 212 }
 213
 214 1;
 215 __END__
 216
 217 =head1 DESCRIPTION
 218
 219 Writing to a hash-block handle will transform the data into a series of blocks. Each block is hashed, and the
 220 hash is included with the block in the stream.
 221
 222 Reading from a handle, each hash block will be verified as the blocks are disassembled back into a data
 223 stream.
 224
 225 This format helps ensure data integrity of KDBX3 files.
 226
 227 Each block is encoded thusly:
 228
 229 =for :list
 230 * Block index - Little-endian unsigned 32-bit integer, increments starting with 0
 231 * Hash - 32 bytes
 232 * Block size - Little-endian unsigned 32-bit (counting only the data)
 233 * Data - String of bytes
 234
 235 The terminating block is an empty block where hash is 32 null bytes, block size is 0 and there is no data.
 236
 237 =cut