File Coverage

blib/lib/File/KDBX/Key/YubiKey.pm
Criterion Covered Total %
statement 173 200 86.5
branch 72 132 54.5
condition 47 86 54.6
subroutine 29 31 93.5
pod 16 16 100.0
total 337 465 72.4


line stmt bran cond sub pod time code
1             package File::KDBX::Key::YubiKey;
2             # ABSTRACT: A Yubico challenge-response key
3              
4 1     1   94246 use warnings;
  1         4  
  1         27  
5 1     1   5 use strict;
  1         3  
  1         21  
6              
7 1     1   5 use File::KDBX::Constants qw(:yubikey);
  1         23  
  1         271  
8 1     1   7 use File::KDBX::Error;
  1         2  
  1         48  
9 1     1   5 use File::KDBX::Util qw(:class :io pad_pkcs7);
  1         1  
  1         115  
10 1     1   577 use IPC::Cmd 0.84 qw(run_forked);
  1         45172  
  1         65  
11 1     1   10 use Ref::Util qw(is_arrayref);
  1         3  
  1         73  
12 1     1   7 use Symbol qw(gensym);
  1         2  
  1         37  
13 1     1   5 use namespace::clean;
  1         1  
  1         10  
14              
15             extends 'File::KDBX::Key::ChallengeResponse';
16              
17             our $VERSION = '0.905'; # VERSION
18              
19             # It can take some time for the USB device to be ready again, so we can retry a few times.
20             our $RETRY_COUNT = 5;
21             our $RETRY_INTERVAL = 0.1;
22              
23             my @CONFIG_VALID = (0, CONFIG1_VALID, CONFIG2_VALID);
24             my @CONFIG_TOUCH = (0, CONFIG1_TOUCH, CONFIG2_TOUCH);
25              
26             sub challenge {
27 8     8 1 825 my $self = shift;
28 8         17 my $challenge = shift;
29 8         25 my %args = @_;
30              
31 8   66     86 my $device = $args{device} // $self->device;
32 8   33     71 my $slot = $args{slot} // $self->slot;
33 8   100     45 my $timeout = $args{timeout} // $self->timeout;
34 8         22 local $self->{device} = $device;
35 8         20 local $self->{slot} = $slot;
36 8         14 local $self->{timeout} = $timeout;
37              
38 8         20 my $hooks = $challenge ne 'test';
39 8 100 100     39 if ($hooks and my $hook = $self->{pre_challenge}) {
40 1         3 $hook->($self, $challenge);
41             }
42              
43 8 100       50 my @cmd = ($self->_program('ykchalresp'), "-n$device", "-$slot", qw{-H -i-}, $timeout == 0 ? '-N' : ());
44              
45 8         20 my $r;
46 8         14 my $try = 0;
47             TRY:
48             {
49 8 100       18 $r = $self->_run_ykpers(\@cmd, {
  8         164  
50             (0 < $timeout ? (timeout => $timeout) : ()),
51             child_stdin => pad_pkcs7($challenge, 64),
52             terminate_on_parent_sudden_death => 1,
53             });
54              
55 7 100       102 if (my $t = $r->{timeout}) {
56 1         40 throw 'Timed out while waiting for challenge response',
57             command => \@cmd,
58             challenge => $challenge,
59             timeout => $t,
60             result => $r;
61             }
62              
63 6         25 my $exit_code = $r->{exit_code};
64 6 100       32 if ($exit_code != 0) {
65 3         18 my $err = $r->{stderr};
66 3         11 chomp $err;
67 3         21 my $yk_errno = _yk_errno($err);
68 3 50 66     51 if ($yk_errno == YK_EUSBERR && $err =~ /resource busy/i && ++$try <= $RETRY_COUNT) {
      33        
69 0         0 sleep $RETRY_INTERVAL;
70 0         0 goto TRY;
71             }
72 3 50 50     77 throw 'Failed to receive challenge response: ' . ($err ? $err : 'Something happened'),
73             error => $err,
74             yk_errno => $yk_errno || 0;
75             }
76             }
77              
78 3         7 my $resp = $r->{stdout};
79 3         22 chomp $resp;
80 3 50       51 $resp =~ /^[A-Fa-f0-9]+$/ or throw 'Unexpected response from challenge', response => $resp, result => $r;
81 3         182 $resp = pack('H*', $resp);
82              
83             # HMAC-SHA1 response is only 20 bytes
84 3         13 substr($resp, 20) = '';
85              
86 3 100 100     35 if ($hooks and my $hook = $self->{post_challenge}) {
87 1         13 $hook->($self, $challenge, $resp);
88             }
89              
90 3         89 return $resp;
91             }
92              
93              
94             sub scan {
95 1     1 1 80 my $self = shift;
96 1         4 my %args = @_;
97              
98 1   50     11 my $limit = delete $args{limit} // 4;
99              
100 1         3 my @keys;
101 1         9 for (my $device = 0; $device < $limit; ++$device) {
102 3 100       48 my %info = $self->_get_yubikey_info($device) or last;
103              
104 2         23 for (my $slot = 1; $slot <= 2; ++$slot) {
105 4   50     24 my $config = $CONFIG_VALID[$slot] // next;
106 4 100       28 next unless $info{touch_level} & $config;
107              
108 1         47 my $key = $self->new(%args, device => $device, slot => $slot, %info);
109 1 50       17 if ($info{product_id} <= NEO_OTP_U2F_CCID_PID) {
110             # NEO and earlier always require touch, so forego testing
111 0         0 $key->touch_level($info{touch_level} | $CONFIG_TOUCH[$slot]);
112 0         0 push @keys, $key;
113             }
114             else {
115 1         8 eval { $key->challenge('test', timeout => 0) };
  1         19  
116 1 50       24 if (my $err = $@) {
117 0   0     0 my $yk_errno = ref $err && $err->details->{yk_errno} || 0;
118 0 0       0 if ($yk_errno == YK_EWOULDBLOCK) {
    0          
119 0         0 $key->touch_level($info{touch_level} | $CONFIG_TOUCH[$slot]);
120             }
121             elsif ($yk_errno != 0) {
122             # alert $err;
123 0         0 next;
124             }
125             }
126 1         24 push @keys, $key;
127             }
128             }
129             }
130              
131 1         14 return @keys;
132 9 50   9 1 50 }
133 9 50   12 1 33  
  12 50       81  
134 9 50 66 13 1 67  
  12 100       35  
  13         60  
135 12 100 66 0 1 68 has device => 0;
  10 0       31  
  0         0  
136 10 0 66 0 1 39 has slot => 1;
  0 0       0  
  0         0  
137 0 0 0 8 1 0 has timeout => 10;
  0 50       0  
  8         39  
138 0 50 0 4 1 0 has pre_challenge => undef;
  8 100       26  
  4         21  
139 8 50 100     57 has post_challenge => undef;
  1         8  
140 1   50     25 has ykchalresp => sub { $ENV{YKCHALRESP} || 'ykchalresp' };
141 4 50   4 1 35 has ykinfo => sub { $ENV{YKINFO} || 'ykinfo' };
142 4 50   2 1 14  
  2 50       14  
143 4 50 50 2 1 29  
  2 50       10  
  2         12  
144 2 50 50 2 1 16 has serial => sub { $_[0]->_set_yubikey_info; $_[0]->{serial} };
  2 50       5  
  2         18  
145 2 50 50 2 1 15 has version => sub { $_[0]->_set_yubikey_info; $_[0]->{version} };
  2 50       12  
  2         23  
146 2 50 100     37 has touch_level => sub { $_[0]->_set_yubikey_info; $_[0]->{touch_level} };
  2         17  
147 2   50     22 has vendor_id => sub { $_[0]->_set_yubikey_info; $_[0]->{vendor_id} };
148             has product_id => sub { $_[0]->_set_yubikey_info; $_[0]->{product_id} };
149              
150              
151             sub name {
152 2     2 1 32 my $self = shift;
153 2   50     38 my $name = _product_name($self->vendor_id, $self->product_id // return);
154 2         19 my $serial = $self->serial;
155 2   50     18 my $version = $self->version || '?';
156 2         24 my $slot = $self->slot;
157 2 100       14 my $touch = $self->requires_interaction ? ' - Interaction required' : '';
158 2         51 return sprintf('%s v%s [%d] (slot #%d)', $name, $version, $serial, $slot);
159             }
160              
161              
162             sub requires_interaction {
163 2     2 1 6 my $self = shift;
164 2   50     16 my $touch = $self->touch_level // return;
165 2         6 return $touch & $CONFIG_TOUCH[$self->slot];
166             }
167              
168             ##############################################################################
169              
170             ### Call ykinfo to get some information about a YubiKey
171             sub _get_yubikey_info {
172 4     4   14 my $self = shift;
173 4         13 my $device = shift;
174              
175 4         35 my $timeout = $self->timeout;
176 4         22 my @cmd = ($self->_program('ykinfo'), "-n$device", qw{-a});
177              
178 4         12 my $r;
179 4         8 my $try = 0;
180             TRY:
181             {
182 4 50       10 $r = $self->_run_ykpers(\@cmd, {
  4         37  
183             (0 < $timeout ? (timeout => $timeout) : ()),
184             terminate_on_parent_sudden_death => 1,
185             });
186              
187 4         38 my $exit_code = $r->{exit_code};
188 4 100       36 if ($exit_code != 0) {
189 1         19 my $err = $r->{stderr};
190 1         11 chomp $err;
191 1         16 my $yk_errno = _yk_errno($err);
192 1 50       28 return if $yk_errno == YK_ENOKEY;
193 0 0 0     0 if ($yk_errno == YK_EWOULDBLOCK && ++$try <= $RETRY_COUNT) {
194 0         0 sleep $RETRY_INTERVAL;
195 0         0 goto TRY;
196             }
197 0 0 0     0 alert 'Failed to get YubiKey device info: ' . ($err ? $err : 'Something happened'),
198             error => $err,
199             yk_errno => $yk_errno || 0;
200 0         0 return;
201             }
202             }
203              
204 3         20 my $out = $r->{stdout};
205 3         9 chomp $out;
206 3 50       18 if (!$out) {
207 0         0 alert 'Failed to get YubiKey device info: no output';
208 0         0 return;
209             }
210              
211 3         14 my %info = map { $_ => ($out =~ /^\Q$_\E: (.+)$/m)[0] }
  15         300  
212             qw(serial version touch_level vendor_id product_id);
213 3 50       30 $info{vendor_id} = hex($info{vendor_id}) if defined $info{vendor_id};
214 3 50       10 $info{product_id} = hex($info{product_id}) if defined $info{product_id};
215              
216 3         71 return %info;
217             }
218              
219             ### Set the YubiKey information as attributes of a Key object
220             sub _set_yubikey_info {
221 1     1   7 my $self = shift;
222 1         13 my %info = $self->_get_yubikey_info($self->device);
223 1         23 @$self{keys %info} = values %info;
224             }
225              
226             sub _program {
227 12     12   58 my $self = shift;
228 12         56 my $name = shift;
229 12   33     100 my @cmd = $self->$name // $name;
230 12         32 my $name_uc = uc($name);
231 12         59 my $flags = $ENV{"${name_uc}_FLAGS"};
232 12 100       79 push @cmd, split(/\h+/, $flags) if $flags;
233 12         105 return @cmd;
234             }
235              
236             sub _run_ykpers {
237 12     12   31 my $self = shift;
238 12         34 my $ppid = $$;
239 12         21 my $r = eval { run_forked(@_) };
  12         52  
240 12         3450908 my $err = $@;
241 12 50       211 if ($$ != $ppid) {
242             # Work around IPC::Cmd bug where child can return from run_forked.
243             # https://rt.cpan.org/Public/Bug/Display.html?id=127372
244 0         0 require POSIX;
245 0         0 POSIX::_exit(0);
246             }
247 12 50 100     290 if ($err || ($r->{exit_code} == 0 && $r->{err_msg} eq '' && $r->{stdout} eq '' && $r->{stderr} eq '')) {
      66        
      66        
      33        
248 1   50     17 $err //= 'No output';
249 1         11 my $prog = $_[0][0];
250 1         18 throw "Failed to run $prog - Make sure you have the YubiKey Personalization Tool (CLI) package installed.\n",
251             error => $err;
252             }
253 11         149 return $r;
254             }
255              
256             sub _yk_errno {
257 4 50   4   33 local $_ = shift or return 0;
258 4 100       56 return YK_EUSBERR if $_ =~ YK_EUSBERR;
259 3 50       16 return YK_EWRONGSIZ if $_ =~ YK_EWRONGSIZ;
260 3 50       20 return YK_EWRITEERR if $_ =~ YK_EWRITEERR;
261 3 50       19 return YK_ETIMEOUT if $_ =~ YK_ETIMEOUT;
262 3 100       43 return YK_ENOKEY if $_ =~ YK_ENOKEY;
263 2 50       9 return YK_EFIRMWARE if $_ =~ YK_EFIRMWARE;
264 2 50       12 return YK_ENOMEM if $_ =~ YK_ENOMEM;
265 2 50       8 return YK_ENOSTATUS if $_ =~ YK_ENOSTATUS;
266 2 100       24 return YK_ENOTYETIMPL if $_ =~ YK_ENOTYETIMPL;
267 1 50       21 return YK_ECHECKSUM if $_ =~ YK_ECHECKSUM;
268 1 50       26 return YK_EWOULDBLOCK if $_ =~ YK_EWOULDBLOCK;
269 0 0       0 return YK_EINVALIDCMD if $_ =~ YK_EINVALIDCMD;
270 0 0       0 return YK_EMORETHANONE if $_ =~ YK_EMORETHANONE;
271 0 0       0 return YK_ENODATA if $_ =~ YK_ENODATA;
272 0         0 return -1;
273             }
274              
275             my %PIDS;
276             for my $pid (
277             YUBIKEY_PID, NEO_OTP_PID, NEO_OTP_CCID_PID, NEO_CCID_PID, NEO_U2F_PID, NEO_OTP_U2F_PID, NEO_U2F_CCID_PID,
278             NEO_OTP_U2F_CCID_PID, YK4_OTP_PID, YK4_U2F_PID, YK4_OTP_U2F_PID, YK4_CCID_PID, YK4_OTP_CCID_PID,
279             YK4_U2F_CCID_PID, YK4_OTP_U2F_CCID_PID, PLUS_U2F_OTP_PID, ONLYKEY_PID,
280             ) {
281             $PIDS{$pid} = $PIDS{0+$pid} = $pid;
282             }
283 2   50 2   23 sub _product_name { $PIDS{$_[1]} // 'Unknown' }
284              
285             1;
286              
287             __END__