File Coverage

blib/lib/File/KDBX/IO/HmacBlock.pm
Criterion Covered Total %
statement 116 119 97.4
branch 39 58 67.2
condition 11 15 73.3
subroutine 20 20 100.0
pod 1 1 100.0
total 187 213 87.7


line stmt bran cond sub pod time code
1             package File::KDBX::IO::HmacBlock;
2             # ABSTRACT: HMAC block stream IO handle
3              
4 3     3   204552 use warnings;
  3         7  
  3         94  
5 3     3   17 use strict;
  3         5  
  3         93  
6              
7 3     3   811 use Crypt::Digest qw(digest_data);
  3         1559  
  3         141  
8 3     3   751 use Crypt::Mac::HMAC qw(hmac);
  3         2152  
  3         123  
9 3     3   841 use Errno;
  3         2415  
  3         115  
10 3     3   86 use File::KDBX::Error;
  3         5  
  3         150  
11 3     3   17 use File::KDBX::Util qw(:class :int :io);
  3         6  
  3         500  
12 3     3   18 use namespace::clean;
  3         6  
  3         27  
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 3     3   1342 no strict 'refs'; ## no critic (ProhibitNoStrict)
  3         7  
  3         3654  
30             *$attr = sub {
31 567     567   771 my $self = shift;
32 567 100       1102 *$self->{$attr} = shift if @_;
33 567 100 100     2310 *$self->{$attr} //= (ref $default eq 'CODE') ? $default->($self) : $default;
34             };
35             }
36              
37              
38             sub new {
39 22     22 1 36595 my $class = shift;
40 22 50       230 my %args = @_ % 2 == 1 ? (fh => shift, @_) : @_;
41 22         141 my $self = $class->SUPER::new;
42 22 50       127 $self->_fh($args{fh}) or throw 'IO handle required';
43 22 50       96 $self->key($args{key}) or throw 'Key required';
44 22         113 $self->block_size($args{block_size});
45 22         96 $self->_buffer;
46 22         69 return $self;
47             }
48              
49             sub _FILL {
50 54     54   123 my ($self, $fh) = @_;
51              
52 54 50       155 $ENV{DEBUG_STREAM} and print STDERR "FILL\t$self\n";
53 54 100       128 return if $self->_finished;
54              
55 46         110 my $block = eval { $self->_read_hashed_block($fh) };
  46         154  
56 46 100       147 if (my $err = $@) {
57 1         6 $self->_set_error($err);
58 1         8 return;
59             }
60 45 100       239 if (length($block) == 0) {
61 11         55 $self->_finished(1);
62 11         35 return;
63             }
64 34         628 return $block;
65             }
66              
67             sub _WRITE {
68 17     17   14368 my ($self, $buf, $fh) = @_;
69              
70 17 50       82 $ENV{DEBUG_STREAM} and print STDERR "WRITE\t$self ($fh)\n";
71 17 50       55 return 0 if $self->_finished;
72              
73 17         32 ${*$self->{_buffer}} .= $buf;
  17         13239  
74              
75 17         95 $self->_FLUSH($fh); # TODO only if autoflush?
76              
77 17         1456 return length($buf);
78             }
79              
80             sub _POPPED {
81 22     22   87 my ($self, $fh) = @_;
82              
83 22 50       66 $ENV{DEBUG_STREAM} and print STDERR "POPPED\t$self ($fh)\n";
84 22 100       56 return if $self->_mode ne 'w';
85              
86 10         45 $self->_FLUSH($fh);
87 10         16 eval {
88 10         44 $self->_write_next_hmac_block($fh); # partial block with remaining content
89 10         32 $self->_write_final_hmac_block($fh); # terminating block
90             };
91 10 50       44 $self->_set_error($@) if $@;
92             }
93              
94             sub _FLUSH {
95 27     27   53 my ($self, $fh) = @_;
96              
97 27 50       65 $ENV{DEBUG_STREAM} and print STDERR "FLUSH\t$self ($fh)\n";
98 27 50       64 return if $self->_mode ne 'w';
99              
100 27         54 eval {
101 27         71 while ($self->block_size <= length(${*$self->{_buffer}})) {
  52         196  
102 25         110 $self->_write_next_hmac_block($fh);
103             }
104             };
105 27 50       78 if (my $err = $@) {
106 0         0 $self->_set_error($err);
107 0         0 return -1;
108             }
109              
110 27         66 return 0;
111             }
112              
113             sub _set_error {
114 1     1   3 my $self = shift;
115 1 50       4 $ENV{DEBUG_STREAM} and print STDERR "err\t$self\n";
116 1 50       15 if (exists &Errno::EPROTO) {
    0          
117 1         13 $! = &Errno::EPROTO;
118             }
119             elsif (exists &Errno::EIO) {
120 0         0 $! = &Errno::EIO;
121             }
122 1         6 $self->_error($ERROR = error(@_));
123             }
124              
125             ##############################################################################
126              
127             sub _read_hashed_block {
128 46     46   100 my $self = shift;
129 46         73 my $fh = shift;
130              
131 46 100       202 read_all $fh, my $hmac, 32 or throw 'Failed to read HMAC';
132              
133 45 50       135 read_all $fh, my $packed_size, 4 or throw 'Failed to read HMAC block size';
134 45         197 my ($size) = unpack('L<', $packed_size);
135              
136 45         103 my $block = '';
137 45 100       119 if (0 < $size) {
138 34 50       82 read_all $fh, $block, $size
139             or throw 'Failed to read HMAC block', index => $self->_block_index, size => $size;
140             }
141              
142 45         217 my $packed_index = pack_Ql($self->_block_index);
143 45         145 my $got_hmac = hmac('SHA256', $self->_hmac_key,
144             $packed_index,
145             $packed_size,
146             $block,
147             );
148              
149 45 50       397 $hmac eq $got_hmac
150             or throw 'Block authentication failed', index => $self->_block_index, got => $got_hmac, expected => $hmac;
151              
152 45         197 *$self->{_block_index}++;
153 45         200 return $block;
154             }
155              
156             sub _write_next_hmac_block {
157 45     45   84 my $self = shift;
158 45         86 my $fh = shift;
159 45   66     196 my $buffer = shift // $self->_buffer;
160 45         97 my $allow_empty = shift;
161              
162 45         94 my $size = length($$buffer);
163 45 100       86 $size = $self->block_size if $self->block_size < $size;
164 45 100 100     161 return 0 if $size == 0 && !$allow_empty;
165              
166 43         79 my $block = '';
167 43 100       7053 $block = substr($$buffer, 0, $size, '') if 0 < $size;
168              
169 43         173 my $packed_index = pack_Ql($self->_block_index);
170 43         117 my $packed_size = pack('L<', $size);
171 43         134 my $hmac = hmac('SHA256', $self->_hmac_key,
172             $packed_index,
173             $packed_size,
174             $block,
175             );
176              
177 43 50       520 $fh->print($hmac, $packed_size, $block)
178             or throw 'Failed to write HMAC block', hmac => $hmac, block_size => $size;
179              
180 43         185291 *$self->{_block_index}++;
181 43         255 return 0;
182             }
183              
184             sub _write_final_hmac_block {
185 10     10   25 my $self = shift;
186 10         14 my $fh = shift;
187              
188 10         25 $self->_write_next_hmac_block($fh, \'', 1);
189             }
190              
191             sub _hmac_key {
192 88     88   183 my $self = shift;
193 88   33     343 my $key = shift // $self->key;
194 88   66     281 my $index = shift // $self->_block_index;
195              
196 88         204 my $packed_index = pack_Ql($index);
197 88         699 my $hmac_key = digest_data('SHA512', $packed_index, $key);
198 88         216331 return $hmac_key;
199             }
200              
201             1;
202              
203             __END__