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