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