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(:class :io);
  11 use IO::Handle;
  12 use namespace::clean;
  13
  14 extends 'File::KDBX::IO';
  15
  16 our $VERSION = '0.904'; # VERSION
  17 our $ALGORITHM = 'SHA256';
  18 our $BLOCK_SIZE = 1048576;  # 1MiB
  19 our $ERROR;
  20
  21
  22 my %ATTRS = (
  23     _block_index    => 0,
  24     _buffer         => sub { \(my $buf = '') },
  25     _finished       => 0,
  26     algorithm       => sub { $ALGORITHM },
  27     block_size      => sub { $BLOCK_SIZE },
  28 );
  29 while (my ($attr, $default) = each %ATTRS) {
  30     no strict 'refs'; ## no critic (ProhibitNoStrict)
  31     *$attr = sub {
  32         my $self = shift;
  33         *$self->{$attr} = shift if @_;
  34         *$self->{$attr} //= (ref $default eq 'CODE') ? $default->($self) : $default;
  35     };
  36 }
  37
  38
  39 sub new {
  40     my $class = shift;
  41     my %args = @_ % 2 == 1 ? (fh => shift, @_) : @_;
  42     my $self = $class->SUPER::new;
  43     $self->_fh($args{fh}) or throw 'IO handle required';
  44     $self->algorithm($args{algorithm});
  45     $self->block_size($args{block_size});
  46     $self->_buffer;
  47     return $self;
  48 }
  49
  50 sub _FILL {
  51     my ($self, $fh) = @_;
  52
  53     $ENV{DEBUG_STREAM} and print STDERR "FILL\t$self\n";
  54     return if $self->_finished;
  55
  56     my $block = eval { $self->_read_hash_block($fh) };
  57     if (my $err = $@) {
  58         $self->_set_error($err);
  59         return;
  60     }
  61     return $$block if defined $block;
  62 }
  63
  64 sub _WRITE {
  65     my ($self, $buf, $fh) = @_;
  66
  67     $ENV{DEBUG_STREAM} and print STDERR "WRITE\t$self\n";
  68     return 0 if $self->_finished;
  69
  70     ${$self->_buffer} .= $buf;
  71
  72     $self->_FLUSH($fh);
  73
  74     return length($buf);
  75 }
  76
  77 sub _POPPED {
  78     my ($self, $fh) = @_;
  79
  80     $ENV{DEBUG_STREAM} and print STDERR "POPPED\t$self\n";
  81     return if $self->_mode ne 'w';
  82
  83     $self->_FLUSH($fh);
  84     eval {
  85         $self->_write_next_hash_block($fh);     # partial block with remaining content
  86         $self->_write_final_hash_block($fh);    # terminating block
  87     };
  88     $self->_set_error($@) if $@;
  89 }
  90
  91 sub _FLUSH {
  92     my ($self, $fh) = @_;
  93
  94     $ENV{DEBUG_STREAM} and print STDERR "FLUSH\t$self\n";
  95     return if $self->_mode ne 'w';
  96
  97     eval {
  98         while ($self->block_size <= length(${*$self->{_buffer}})) {
  99             $self->_write_next_hash_block($fh);
 100         }
 101     };
 102     if (my $err = $@) {
 103         $self->_set_error($err);
 104         return -1;
 105     }
 106
 107     return 0;
 108 }
 109
 110 ##############################################################################
 111
 112 sub _read_hash_block {
 113     my $self = shift;
 114     my $fh = shift;
 115
 116     read_all $fh, my $buf, 4 or throw 'Failed to read hash block index';
 117     my ($index) = unpack('L<', $buf);
 118
 119     $index == $self->_block_index or throw 'Invalid block index', index => $index;
 120
 121     read_all $fh, my $hash, 32 or throw 'Failed to read hash';
 122
 123     read_all $fh, $buf, 4 or throw 'Failed to read hash block size';
 124     my ($size) = unpack('L<', $buf);
 125
 126     if ($size == 0) {
 127         $hash eq ("\0" x 32) or throw 'Invalid final block hash', hash => $hash;
 128         $self->_finished(1);
 129         return undef;
 130     }
 131
 132     read_all $fh, my $block, $size or throw 'Failed to read hash block', index => $index, size => $size;
 133
 134     my $got_hash = digest_data($self->algorithm, $block);
 135     $hash eq $got_hash
 136         or throw 'Hash mismatch', index => $index, size => $size, got => $got_hash, expected => $hash;
 137
 138     *$self->{_block_index}++;
 139     return \$block;
 140 }
 141
 142 sub _write_next_hash_block {
 143     my $self = shift;
 144     my $fh = shift;
 145
 146     my $size = length(${$self->_buffer});
 147     $size = $self->block_size if $self->block_size < $size;
 148     return 0 if $size == 0;
 149
 150     my $block = substr(${$self->_buffer}, 0, $size, '');
 151
 152     my $buf = pack('L<', $self->_block_index);
 153     print $fh $buf or throw 'Failed to write hash block index';
 154
 155     my $hash = digest_data($self->algorithm, $block);
 156     print $fh $hash or throw 'Failed to write hash';
 157
 158     $buf = pack('L<', length($block));
 159     print $fh $buf or throw 'Failed to write hash block size';
 160
 161     # $fh->write($block, $size) or throw 'Failed to hash write block';
 162     print $fh $block or throw 'Failed to hash write block';
 163
 164     *$self->{_block_index}++;
 165     return 0;
 166 }
 167
 168 sub _write_final_hash_block {
 169     my $self = shift;
 170     my $fh = shift;
 171
 172     my $buf = pack('L<', $self->_block_index);
 173     print $fh $buf or throw 'Failed to write hash block index';
 174
 175     my $hash = "\0" x 32;
 176     print $fh $hash or throw 'Failed to write hash';
 177
 178     $buf = pack('L<', 0);
 179     print $fh $buf or throw 'Failed to write hash block size';
 180
 181     $self->_finished(1);
 182     return 0;
 183 }
 184
 185 sub _set_error {
 186     my $self = shift;
 187     $ENV{DEBUG_STREAM} and print STDERR "err\t$self\n";
 188     if (exists &Errno::EPROTO) {
 189         $! = &Errno::EPROTO;
 190     }
 191     elsif (exists &Errno::EIO) {
 192         $! = &Errno::EIO;
 193     }
 194     $self->_error($ERROR = error(@_));
 195 }
 196
 197 1;
 198
 199 __END__
 200
 201 =pod
 202
 203 =encoding UTF-8
 204
 205 =head1 NAME
 206
 207 File::KDBX::IO::HashBlock - Hash block stream IO handle
 208
 209 =head1 VERSION
 210
 211 version 0.904
 212
 213 =head1 DESCRIPTION
 214
 215 Writing to a hash-block handle will transform the data into a series of blocks. Each block is hashed, and the
 216 hash is included with the block in the stream.
 217
 218 Reading from a handle, each hash block will be verified as the blocks are disassembled back into a data
 219 stream.
 220
 221 This format helps ensure data integrity of KDBX3 files.
 222
 223 Each block is encoded thusly:
 224
 225 =over 4
 226
 227 =item *
 228
 229 Block index - Little-endian unsigned 32-bit integer, increments starting with 0
 230
 231 =item *
 232
 233 Hash - 32 bytes
 234
 235 =item *
 236
 237 Block size - Little-endian unsigned 32-bit (counting only the data)
 238
 239 =item *
 240
 241 Data - String of bytes
 242
 243 =back
 244
 245 The terminating block is an empty block where hash is 32 null bytes, block size is 0 and there is no data.
 246
 247 =head1 ATTRIBUTES
 248
 249 =head2 algorithm
 250
 251 Digest algorithm in hash-blocking the stream (default: C<SHA-256>)
 252
 253 =head2 block_size
 254
 255 Desired block size when writing (default: C<$File::KDBX::IO::HashBlock::BLOCK_SIZE> or 1,048,576 bytes)
 256
 257 =head1 METHODS
 258
 259 =head2 new
 260
 261     $fh = File::KDBX::IO::HashBlock->new(%attributes);
 262     $fh = File::KDBX::IO::HashBlock->new($fh, %attributes);
 263
 264 Construct a new hash-block stream IO handle.
 265
 266 =head1 BUGS
 267
 268 Please report any bugs or feature requests on the bugtracker website
 269 L<https://github.com/chazmcgarvey/File-KDBX/issues>
 270
 271 When submitting a bug or request, please include a test-file or a
 272 patch to an existing test-file that illustrates the bug or desired
 273 feature.
 274
 275 =head1 AUTHOR
 276
 277 Charles McGarvey <ccm@cpan.org>
 278
 279 =head1 COPYRIGHT AND LICENSE
 280
 281 This software is copyright (c) 2022 by Charles McGarvey.
 282
 283 This is free software; you can redistribute it and/or modify it under
 284 the same terms as the Perl 5 programming language system itself.
 285
 286 =cut