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   90691 use warnings;
  1         2  
  1         29  
5 1     1   4 use strict;
  1         2  
  1         20  
6              
7 1     1   4 use File::KDBX::Constants qw(:yubikey);
  1         29  
  1         273  
8 1     1   7 use File::KDBX::Error;
  1         2  
  1         60  
9 1     1   7 use File::KDBX::Util qw(:class :io pad_pkcs7);
  1         2  
  1         116  
10 1     1   579 use IPC::Cmd 0.84 qw(run_forked);
  1         43105  
  1         57  
11 1     1   8 use Ref::Util qw(is_arrayref);
  1         2  
  1         33  
12 1     1   5 use Symbol qw(gensym);
  1         1  
  1         28  
13 1     1   4 use namespace::clean;
  1         2  
  1         9  
14              
15             extends 'File::KDBX::Key::ChallengeResponse';
16              
17             our $VERSION = '0.906'; # 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 879 my $self = shift;
28 8         21 my $challenge = shift;
29 8         21 my %args = @_;
30              
31 8   66     52 my $device = $args{device} // $self->device;
32 8   33     86 my $slot = $args{slot} // $self->slot;
33 8   100     35 my $timeout = $args{timeout} // $self->timeout;
34 8         29 local $self->{device} = $device;
35 8         20 local $self->{slot} = $slot;
36 8         16 local $self->{timeout} = $timeout;
37              
38 8         20 my $hooks = $challenge ne 'test';
39 8 100 100     37 if ($hooks and my $hook = $self->{pre_challenge}) {
40 1         4 $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         17 my $r;
46 8         27 my $try = 0;
47             TRY:
48             {
49 8 100       13 $r = $self->_run_ykpers(\@cmd, {
  8         123  
50             (0 < $timeout ? (timeout => $timeout) : ()),
51             child_stdin => pad_pkcs7($challenge, 64),
52             terminate_on_parent_sudden_death => 1,
53             });
54              
55 7 100       131 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         20 my $exit_code = $r->{exit_code};
64 6 100       29 if ($exit_code != 0) {
65 3         23 my $err = $r->{stderr};
66 3         18 chomp $err;
67 3         21 my $yk_errno = _yk_errno($err);
68 3 50 66     40 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     70 throw 'Failed to receive challenge response: ' . ($err ? $err : 'Something happened'),
73             error => $err,
74             yk_errno => $yk_errno || 0;
75             }
76             }
77              
78 3         11 my $resp = $r->{stdout};
79 3         23 chomp $resp;
80 3 50       48 $resp =~ /^[A-Fa-f0-9]+$/ or throw 'Unexpected response from challenge', response => $resp, result => $r;
81 3         184 $resp = pack('H*', $resp);
82              
83             # HMAC-SHA1 response is only 20 bytes
84 3         12 substr($resp, 20) = '';
85              
86 3 100 100     32 if ($hooks and my $hook = $self->{post_challenge}) {
87 1         10 $hook->($self, $challenge, $resp);
88             }
89              
90 3         118 return $resp;
91             }
92              
93              
94             sub scan {
95 1     1 1 27 my $self = shift;
96 1         2 my %args = @_;
97              
98 1   50     11 my $limit = delete $args{limit} // 4;
99              
100 1         2 my @keys;
101 1         5 for (my $device = 0; $device < $limit; ++$device) {
102 3 100       52 my %info = $self->_get_yubikey_info($device) or last;
103              
104 2         25 for (my $slot = 1; $slot <= 2; ++$slot) {
105 4   50     20 my $config = $CONFIG_VALID[$slot] // next;
106 4 100       30 next unless $info{touch_level} & $config;
107              
108 1         50 my $key = $self->new(%args, device => $device, slot => $slot, %info);
109 1 50       15 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         4 eval { $key->challenge('test', timeout => 0) };
  1         18  
116 1 50       22 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         16 return @keys;
132 9 50   9 1 48 }
133 9 50   12 1 37  
  12 50       54  
134 9 50 66 13 1 78  
  12 100       61  
  13         64  
135 12 100 66 0 1 103 has device => 0;
  10 0       32  
  0         0  
136 10 0 66 0 1 54 has slot => 1;
  0 0       0  
  0         0  
137 0 0 0 8 1 0 has timeout => 10;
  0 50       0  
  8         43  
138 0 50 0 4 1 0 has pre_challenge => undef;
  8 100       19  
  4         34  
139 8 50 100     52 has post_challenge => undef;
  1         6  
140 1   50     20 has ykchalresp => sub { $ENV{YKCHALRESP} || 'ykchalresp' };
141 4 50   4 1 36 has ykinfo => sub { $ENV{YKINFO} || 'ykinfo' };
142 4 50   2 1 11  
  2 50       8  
143 4 50 50 2 1 26  
  2 50       4  
  2         9  
144 2 50 50 2 1 17 has serial => sub { $_[0]->_set_yubikey_info; $_[0]->{serial} };
  2 50       24  
  2         25  
145 2 50 50 2 1 12 has version => sub { $_[0]->_set_yubikey_info; $_[0]->{version} };
  2 50       18  
  2         20  
146 2 50 100     41 has touch_level => sub { $_[0]->_set_yubikey_info; $_[0]->{touch_level} };
  2         10  
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     30 my $name = _product_name($self->vendor_id, $self->product_id // return);
154 2         9 my $serial = $self->serial;
155 2   50     9 my $version = $self->version || '?';
156 2         25 my $slot = $self->slot;
157 2 100       7 my $touch = $self->requires_interaction ? ' - Interaction required' : '';
158 2         57 return sprintf('%s v%s [%d] (slot #%d)', $name, $version, $serial, $slot);
159             }
160              
161              
162             sub requires_interaction {
163 2     2 1 4 my $self = shift;
164 2   50     9 my $touch = $self->touch_level // return;
165 2         18 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   16 my $self = shift;
173 4         7 my $device = shift;
174              
175 4         35 my $timeout = $self->timeout;
176 4         15 my @cmd = ($self->_program('ykinfo'), "-n$device", qw{-a});
177              
178 4         19 my $r;
179 4         12 my $try = 0;
180             TRY:
181             {
182 4 50       16 $r = $self->_run_ykpers(\@cmd, {
  4         42  
183             (0 < $timeout ? (timeout => $timeout) : ()),
184             terminate_on_parent_sudden_death => 1,
185             });
186              
187 4         41 my $exit_code = $r->{exit_code};
188 4 100       28 if ($exit_code != 0) {
189 1         19 my $err = $r->{stderr};
190 1         6 chomp $err;
191 1         14 my $yk_errno = _yk_errno($err);
192 1 50       31 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         19 my $out = $r->{stdout};
205 3         13 chomp $out;
206 3 50       16 if (!$out) {
207 0         0 alert 'Failed to get YubiKey device info: no output';
208 0         0 return;
209             }
210              
211 3         7 my %info = map { $_ => ($out =~ /^\Q$_\E: (.+)$/m)[0] }
  15         352  
212             qw(serial version touch_level vendor_id product_id);
213 3 50       26 $info{vendor_id} = hex($info{vendor_id}) if defined $info{vendor_id};
214 3 50       17 $info{product_id} = hex($info{product_id}) if defined $info{product_id};
215              
216 3         69 return %info;
217             }
218              
219             ### Set the YubiKey information as attributes of a Key object
220             sub _set_yubikey_info {
221 1     1   4 my $self = shift;
222 1         4 my %info = $self->_get_yubikey_info($self->device);
223 1         21 @$self{keys %info} = values %info;
224             }
225              
226             sub _program {
227 12     12   22 my $self = shift;
228 12         49 my $name = shift;
229 12   33     118 my @cmd = $self->$name // $name;
230 12         33 my $name_uc = uc($name);
231 12         93 my $flags = $ENV{"${name_uc}_FLAGS"};
232 12 100       95 push @cmd, split(/\h+/, $flags) if $flags;
233 12         81 return @cmd;
234             }
235              
236             sub _run_ykpers {
237 12     12   28 my $self = shift;
238 12         27 my $ppid = $$;
239 12         23 my $r = eval { run_forked(@_) };
  12         46  
240 12         3452807 my $err = $@;
241 12 50       233 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     306 if ($err || ($r->{exit_code} == 0 && $r->{err_msg} eq '' && $r->{stdout} eq '' && $r->{stderr} eq '')) {
      66        
      66        
      33        
248 1   50     15 $err //= 'No output';
249 1         14 my $prog = $_[0][0];
250 1         28 throw "Failed to run $prog - Make sure you have the YubiKey Personalization Tool (CLI) package installed.\n",
251             error => $err;
252             }
253 11         176 return $r;
254             }
255              
256             sub _yk_errno {
257 4 50   4   26 local $_ = shift or return 0;
258 4 100       51 return YK_EUSBERR if $_ =~ YK_EUSBERR;
259 3 50       21 return YK_EWRONGSIZ if $_ =~ YK_EWRONGSIZ;
260 3 50       15 return YK_EWRITEERR if $_ =~ YK_EWRITEERR;
261 3 50       16 return YK_ETIMEOUT if $_ =~ YK_ETIMEOUT;
262 3 100       34 return YK_ENOKEY if $_ =~ YK_ENOKEY;
263 2 50       10 return YK_EFIRMWARE if $_ =~ YK_EFIRMWARE;
264 2 50       16 return YK_ENOMEM if $_ =~ YK_ENOMEM;
265 2 50       12 return YK_ENOSTATUS if $_ =~ YK_ENOSTATUS;
266 2 100       25 return YK_ENOTYETIMPL if $_ =~ YK_ENOTYETIMPL;
267 1 50       13 return YK_ECHECKSUM if $_ =~ YK_ECHECKSUM;
268 1 50       27 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   20 sub _product_name { $PIDS{$_[1]} // 'Unknown' }
284              
285             1;
286              
287             __END__