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

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