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

   1 package PerlIO::via::File::KDBX::HashBlock;
   2 # ABSTRACT: Hash block stream PerlIO layer
   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 our $VERSION = '999.999'; # VERSION
  15 our $ALGORITHM = 'SHA256';
  16 our $BLOCK_SIZE = 1048576;
  17 our $ERROR;
  18
  19 =method push
  20
  21     PerlIO::via::File::KDBX::HashBlock->push($fh, %attributes);
  22
  23 Push a new HashBlock layer, optionally with attributes.
  24
  25 This is identical to:
  26
  27     binmode($fh, ':via(File::KDBX::HashBlock)');
  28
  29 except this allows you to customize the process with attributes.
  30
  31 B<WARNING:> When writing, you mustn't close the filehandle before popping this layer (using
  32 C<binmode($fh, ':pop')>) or the stream will be truncated. The layer needs to know when there is no more data
  33 before the filehandle closes so it can write the final block (which will likely be shorter than the other
  34 blocks), and the way to indicate that is by popping the layer.
  35
  36 =cut
  37
  38 my %PUSHED_ARGS;
  39 sub push {
  40     %PUSHED_ARGS and throw 'Pushing Hash layer would stomp existing arguments';
  41     my $class = shift;
  42     my $fh = shift;
  43     %PUSHED_ARGS = @_;
  44     binmode($fh, ':via(' . __PACKAGE__ . ')');
  45 }
  46
  47 sub PUSHED {
  48     my ($class, $mode) = @_;
  49
  50     $ENV{DEBUG_STREAM} and print STDERR "PUSHED\t$class (mode: $mode)\n";
  51     my $self = bless {
  52         algorithm   => $PUSHED_ARGS{algorithm} || $ALGORITHM,
  53         block_index => 0,
  54         block_size  => $PUSHED_ARGS{block_size} || $BLOCK_SIZE,
  55         buffer      => \(my $buf = ''),
  56         eof         => 0,
  57         mode        => $mode,
  58     }, $class;
  59     %PUSHED_ARGS = ();
  60     return $self;
  61 }
  62
  63 sub FILL {
  64     my ($self, $fh) = @_;
  65
  66     $ENV{DEBUG_STREAM} and print STDERR "FILL\t$self\n";
  67     return if $self->EOF($fh);
  68
  69     my $block = eval { $self->_read_hash_block($fh) };
  70     if (my $err = $@) {
  71         $self->_set_error($err);
  72         return;
  73     }
  74     return $$block if defined $block;
  75 }
  76
  77 sub WRITE {
  78     my ($self, $buf, $fh) = @_;
  79
  80     $ENV{DEBUG_STREAM} and print STDERR "WRITE\t$self\n";
  81     return 0 if $self->EOF($fh);
  82
  83     ${$self->{buffer}} .= $buf;
  84
  85     $self->FLUSH($fh);
  86
  87     return length($buf);
  88 }
  89
  90 sub POPPED {
  91     my ($self, $fh) = @_;
  92
  93     $ENV{DEBUG_STREAM} and print STDERR "POPPED\t$self\n";
  94     return if $self->EOF($fh) || $self->mode !~ /^w/;
  95
  96     $self->FLUSH($fh);
  97     eval {
  98         $self->_write_next_hash_block($fh);     # partial block with remaining content
  99         $self->_write_final_hash_block($fh);    # terminating block
 100     };
 101     $self->_set_error($@) if $@;
 102 }
 103
 104 sub FLUSH {
 105     my ($self, $fh) = @_;
 106
 107     $ENV{DEBUG_STREAM} and print STDERR "FLUSH\t$self\n";
 108     return 0 if !ref $self;
 109
 110     eval {
 111         while ($self->block_size <= length(${$self->{buffer}})) {
 112             $self->_write_next_hash_block($fh);
 113         }
 114     };
 115     if (my $err = $@) {
 116         $self->_set_error($err);
 117         return -1;
 118     }
 119
 120     return 0;
 121 }
 122
 123 sub EOF {
 124     $ENV{DEBUG_STREAM} and print STDERR "EOF\t$_[0]\n";
 125     $_[0]->{eof} || $_[0]->ERROR($_[1]);
 126 }
 127 sub ERROR {
 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;
 131 }
 132 sub CLEARERR {
 133     $ENV{DEBUG_STREAM} and print STDERR "CLEARERR\t$_[0]\n";
 134     # delete $_[0]->{error};
 135 }
 136
 137 =attr algorithm
 138
 139     $algo = $hash_block->algorithm;
 140
 141 Get the hash algorithm. Default is C<SHA256>.
 142
 143 =cut
 144
 145 sub algorithm { $_[0]->{algorithm} //= $ALGORITHM }
 146
 147 =attr block_size
 148
 149     $size = $hash_block->block_size;
 150
 151 Get the block size. Default is C<$PerlIO::via::File::KDBX::HashBlock::BLOCK_SIZE>.
 152
 153 This only matters in write mode. When reading, block size is detected from the stream.
 154
 155 =cut
 156
 157 sub block_size  { $_[0]->{block_size} //= $BLOCK_SIZE }
 158
 159 =attr block_index
 160
 161 =attr buffer
 162
 163 =attr mode
 164
 165 Internal attributes.
 166
 167 =cut
 168
 169 sub block_index { $_[0]->{block_index} ||= 0 }
 170 sub buffer      { $_[0]->{buffer} }
 171 sub mode        { $_[0]->{mode} }
 172
 173 sub _read_hash_block {
 174     my $self = shift;
 175     my $fh = shift;
 176
 177     read_all $fh, my $buf, 4 or throw 'Failed to read hash block index';
 178     my ($index) = unpack('L<', $buf);
 179
 180     $index == $self->block_index
 181         or throw 'Invalid block index', index => $index;
 182
 183     read_all $fh, my $hash, 32 or throw 'Failed to read hash';
 184
 185     read_all $fh, $buf, 4 or throw 'Failed to read hash block size';
 186     my ($size) = unpack('L<', $buf);
 187
 188     if ($size == 0) {
 189         $hash eq ("\0" x 32)
 190             or throw 'Invalid final block hash', hash => $hash;
 191         $self->{eof} = 1;
 192         return undef;
 193     }
 194
 195     read_all $fh, my $block, $size or throw 'Failed to read hash block', index => $index, size => $size;
 196
 197     my $got_hash = digest_data('SHA256', $block);
 198     $hash eq $got_hash
 199         or throw 'Hash mismatch', index => $index, size => $size, got => $got_hash, expected => $hash;
 200
 201     $self->{block_index}++;
 202     return \$block;
 203 }
 204
 205 sub _write_next_hash_block {
 206     my $self = shift;
 207     my $fh = shift;
 208
 209     my $size = length(${$self->buffer});
 210     $size = $self->block_size if $self->block_size < $size;
 211     return 0 if $size == 0;
 212
 213     my $block = substr(${$self->buffer}, 0, $size, '');
 214
 215     my $buf = pack('L<', $self->block_index);
 216     print $fh $buf or throw 'Failed to write hash block index';
 217
 218     my $hash = digest_data('SHA256', $block);
 219     print $fh $hash or throw 'Failed to write hash';
 220
 221     $buf = pack('L<', length($block));
 222     print $fh $buf or throw 'Failed to write hash block size';
 223
 224     # $fh->write($block, $size) or throw 'Failed to hash write block';
 225     print $fh $block or throw 'Failed to hash write block';
 226
 227     $self->{block_index}++;
 228     return 0;
 229 }
 230
 231 sub _write_final_hash_block {
 232     my $self = shift;
 233     my $fh = shift;
 234
 235     my $buf = pack('L<', $self->block_index);
 236     print $fh $buf or throw 'Failed to write hash block index';
 237
 238     my $hash = "\0" x 32;
 239     print $fh $hash or throw 'Failed to write hash';
 240
 241     $buf = pack('L<', 0);
 242     print $fh $buf or throw 'Failed to write hash block size';
 243
 244     $self->{eof} = 1;
 245     return 0;
 246 }
 247
 248 sub _set_error {
 249     my $self = shift;
 250     $ENV{DEBUG_STREAM} and print STDERR "err\t$self\n";
 251     if (exists &Errno::EPROTO) {
 252         $! = &Errno::EPROTO;
 253     }
 254     elsif (exists &Errno::EIO) {
 255         $! = &Errno::EIO;
 256     }
 257     $self->{error} = $ERROR = File::KDBX::Error->new(@_);
 258 }
 259
 260 1;
 261 __END__
 262
 263 =head1 DESCRIPTION
 264
 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.
 267
 268 Reading from a handle, each hash block will be verified as the blocks are disassembled back into a data
 269 stream.
 270
 271 Each block is encoded thusly:
 272
 273 =for :list
 274 * Block index - Little-endian unsigned 32-bit integer, increments starting with 0
 275 * Hash - 32 bytes
 276 * Block size - Little-endian unsigned 32-bit (counting only the data)
 277 * Data - String of bytes
 278
 279 The terminating block is an empty block where hash is 32 null bytes, block size is 0 and there is no data.
 280
 281 =cut