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