1 package File
::KDBX
::Key
::YubiKey
;
2 # ABSTRACT: A Yubico challenge-response key
7 use File
::KDBX
::Constants
qw(:yubikey);
9 use File
::KDBX
::Util
qw(:class :io pad_pkcs7);
10 use IPC
::Cmd
0.52 qw(run_forked);
11 use Ref
::Util
qw(is_arrayref);
12 use Symbol
qw(gensym);
15 extends
'File::KDBX::Key::ChallengeResponse';
17 our $VERSION = '999.999'; # VERSION
19 # It can take some time for the USB device to be ready again, so we can retry a few times.
21 our $RETRY_INTERVAL = 0.1;
23 my @CONFIG_VALID = (0, CONFIG1_VALID
, CONFIG2_VALID
);
24 my @CONFIG_TOUCH = (0, CONFIG1_TOUCH
, CONFIG2_TOUCH
);
28 my $challenge = shift;
31 my $device = $args{device
} // $self->device;
32 my $slot = $args{slot
} // $self->slot;
33 my $timeout = $args{timeout
} // $self->timeout;
34 local $self->{device
} = $device;
35 local $self->{slot
} = $slot;
36 local $self->{timeout
} = $timeout;
38 my $hooks = $challenge ne 'test';
39 if ($hooks and my $hook = $self->{pre_challenge
}) {
40 $hook->($self, $challenge);
43 my @cmd = ($self->_program('ykchalresp'), "-n$device", "-$slot", qw{-H -i-}, $timeout == 0 ? '-N' : ());
49 $r = $self->_run_ykpers(\
@cmd, {
50 (0 < $timeout ? (timeout
=> $timeout) : ()),
51 child_stdin
=> pad_pkcs7
($challenge, 64),
52 terminate_on_parent_sudden_death
=> 1,
55 if (my $t = $r->{timeout
}) {
56 throw
'Timed out while waiting for challenge response',
58 challenge
=> $challenge,
63 my $exit_code = $r->{exit_code
};
64 if ($exit_code != 0) {
65 my $err = $r->{stderr
};
67 my $yk_errno = _yk_errno
($err);
68 if ($yk_errno == YK_EUSBERR
&& $err =~ /resource busy/i && ++$try <= $RETRY_COUNT) {
69 sleep $RETRY_INTERVAL;
72 throw
'Failed to receive challenge response: ' . ($err ? $err : 'Something happened'),
74 yk_errno
=> $yk_errno || 0;
78 my $resp = $r->{stdout
};
80 $resp =~ /^[A-Fa-f0-9]+$/ or throw
'Unexpected response from challenge', response
=> $resp, result
=> $r;
81 $resp = pack('H*', $resp);
83 # HMAC-SHA1 response is only 20 bytes
84 substr($resp, 20) = '';
86 if ($hooks and my $hook = $self->{post_challenge
}) {
87 $hook->($self, $challenge, $resp);
95 @keys = File
::KDBX
::Key
::YubiKey-
>scan(%options);
97 Find connected
, configured YubiKeys that are capable of responding to a challenge
. This can
take several
103 * C<limit> - Scan for only up to this many YubiKeys (default: 4)
105 Other options are passed as-is as attributes to the key constructors of found keys (if any).
113 my $limit = delete $args{limit
} // 4;
116 for (my $device = 0; $device < $limit; ++$device) {
117 my %info = $self->_get_yubikey_info($device) or last;
119 for (my $slot = 1; $slot <= 2; ++$slot) {
120 my $config = $CONFIG_VALID[$slot] // next;
121 next unless $info{touch_level
} & $config;
123 my $key = $self->new(%args, device
=> $device, slot
=> $slot, %info);
124 if ($info{product_id
} <= NEO_OTP_U2F_CCID_PID
) {
125 # NEO and earlier always require touch, so forego testing
126 $key->touch_level($info{touch_level
} | $CONFIG_TOUCH[$slot]);
130 eval { $key->challenge('test', timeout
=> 0) };
132 my $yk_errno = ref $err && $err->details->{yk_errno
} || 0;
133 if ($yk_errno == YK_EWOULDBLOCK
) {
134 $key->touch_level($info{touch_level
} | $CONFIG_TOUCH[$slot]);
136 elsif ($yk_errno != 0) {
151 $device = $key->device($device);
153 Get
or set the device number
, which
is the
index number starting
and incrementing from zero assigned
154 to the YubiKey device
. If there
is only one detected YubiKey device
, it
's number is C<0>.
160 $slot = $key->slot($slot);
162 Get or set the slot number, which is a number starting and incrementing from one. A YubiKey can have
163 multiple slots (often just two) which can be independently configured.
169 $timeout = $key->timeout($timeout);
171 Get or set the timeout, in seconds. If the challenge takes longer than this, the challenge will be
172 cancelled and an error is thrown.
174 If the timeout is zero, the challenge is non-blocking; an error is thrown if the challenge would
175 block. If the timeout is negative, timeout is disabled and the challenge will block forever or until
176 a response is received.
182 $callback = $key->pre_challenge($callback);
184 Get or set a callback function that will be called immediately before any challenge is issued. This might be
185 used to prompt the user so they are aware that they are expected to interact with their YubiKey.
187 $key->pre_challenge(sub {
188 my ($key, $challenge) = @_;
190 if ($key->requires_interaction) {
191 say 'Please touch your key device to proceed with decrypting your KDBX file
.';
193 say 'Key
: ', $key->name;
194 if (0 < $key->timeout) {
195 say 'Key access request expires
: ' . localtime(time + $key->timeout);
199 You can throw from this subroutine to abort the challenge. If the challenge is part of loading or dumping
200 a KDBX database, the entire load/dump will be aborted.
204 $callback = $key->post_challenge($callback);
206 Get or set a callback function that will be called immediately after a challenge response has been received.
208 You can throw from this subroutine to abort the challenge. If the challenge is part of loading or dumping
209 a KDBX database, the entire load/dump will be aborted.
213 $program = $key->ykchalresp;
215 Get or set the L<ykchalresp(1)> program name or filepath. Defaults to C<$ENV{YKCHALRESP}> or C<ykchalresp>.
219 $program = $key->ykinfo;
221 Get or set the L<ykinfo(1)> program name or filepath. Defaults to C<$ENV{YKINFO}> or C<ykinfo>.
228 has pre_challenge => undef;
229 has post_challenge => undef;
230 has ykchalresp => sub { $ENV{YKCHALRESP} || 'ykchalresp
' };
231 has ykinfo => sub { $ENV{YKINFO} || 'ykinfo
' };
235 Get the device serial number, as a number, or C<undef> if there is no such device.
239 Get the device firmware version (or C<undef>).
243 Get the "touch level" value for the device associated with this key (or C<undef>).
249 Get the vendor ID or product ID for the device associated with this key (or C<undef>).
253 has serial => sub { $_[0]->_set_yubikey_info; $_[0]->{serial} };
254 has version => sub { $_[0]->_set_yubikey_info; $_[0]->{version} };
255 has touch_level => sub { $_[0]->_set_yubikey_info; $_[0]->{touch_level} };
256 has vendor_id => sub { $_[0]->_set_yubikey_info; $_[0]->{vendor_id} };
257 has product_id => sub { $_[0]->_set_yubikey_info; $_[0]->{product_id} };
263 Get a human-readable string identifying the YubiKey (or C<undef>).
269 my $name = _product_name($self->vendor_id, $self->product_id // return);
270 my $serial = $self->serial;
271 my $version = $self->version || '?';
272 my $slot = $self->slot;
273 my $touch = $self->requires_interaction ? ' - Interaction required
' : '';
274 return sprintf('%s v
%s [%d] (slot
#%d)', $name, $version, $serial, $slot);
277 =method requires_interaction
279 Get whether
or not the key requires interaction
(e
.g
. a touch
) to provide a challenge response
(or C
<undef>).
283 sub requires_interaction
{
285 my $touch = $self->touch_level // return;
286 return $touch & $CONFIG_TOUCH[$self->slot];
289 ##############################################################################
291 ### Call ykinfo to get some information about a YubiKey
292 sub _get_yubikey_info
{
296 my $timeout = $self->timeout;
297 my @cmd = ($self->_program('ykinfo'), "-n$device", qw{-a});
303 $r = $self->_run_ykpers(\
@cmd, {
304 (0 < $timeout ? (timeout
=> $timeout) : ()),
305 terminate_on_parent_sudden_death
=> 1,
308 my $exit_code = $r->{exit_code
};
309 if ($exit_code != 0) {
310 my $err = $r->{stderr
};
312 my $yk_errno = _yk_errno
($err);
313 return if $yk_errno == YK_ENOKEY
;
314 if ($yk_errno == YK_EWOULDBLOCK
&& ++$try <= $RETRY_COUNT) {
315 sleep $RETRY_INTERVAL;
318 alert
'Failed to get YubiKey device info: ' . ($err ? $err : 'Something happened'),
320 yk_errno
=> $yk_errno || 0;
325 my $out = $r->{stdout
};
328 alert
'Failed to get YubiKey device info: no output';
332 my %info = map { $_ => ($out =~ /^\Q$_\E: (.+)$/m)[0] }
333 qw(serial version touch_level vendor_id product_id);
334 $info{vendor_id
} = hex($info{vendor_id
}) if defined $info{vendor_id
};
335 $info{product_id
} = hex($info{product_id
}) if defined $info{product_id
};
340 ### Set the YubiKey information as attributes of a Key object
341 sub _set_yubikey_info
{
343 my %info = $self->_get_yubikey_info($self->device);
344 @$self{keys %info} = values %info;
350 my @cmd = $self->$name // $name;
351 my $name_uc = uc($name);
352 my $flags = $ENV{"${name_uc}_FLAGS"};
353 push @cmd, split(/\h+/, $flags) if $flags;
360 my $r = eval { run_forked
(@_) };
363 # Work around IPC::Cmd bug where child can return from run_forked.
364 # https://rt.cpan.org/Public/Bug/Display.html?id=127372
368 if ($err || ($r->{exit_code
} == 0 && $r->{err_msg
} eq '' && $r->{stdout
} eq '' && $r->{stderr
} eq '')) {
369 $err //= 'No output';
371 throw
"Failed to run $prog - Make sure you have the YubiKey Personalization Tool (CLI) package installed.\n",
378 local $_ = shift or return 0;
379 return YK_EUSBERR
if $_ =~ YK_EUSBERR
;
380 return YK_EWRONGSIZ
if $_ =~ YK_EWRONGSIZ
;
381 return YK_EWRITEERR
if $_ =~ YK_EWRITEERR
;
382 return YK_ETIMEOUT
if $_ =~ YK_ETIMEOUT
;
383 return YK_ENOKEY
if $_ =~ YK_ENOKEY
;
384 return YK_EFIRMWARE
if $_ =~ YK_EFIRMWARE
;
385 return YK_ENOMEM
if $_ =~ YK_ENOMEM
;
386 return YK_ENOSTATUS
if $_ =~ YK_ENOSTATUS
;
387 return YK_ENOTYETIMPL
if $_ =~ YK_ENOTYETIMPL
;
388 return YK_ECHECKSUM
if $_ =~ YK_ECHECKSUM
;
389 return YK_EWOULDBLOCK
if $_ =~ YK_EWOULDBLOCK
;
390 return YK_EINVALIDCMD
if $_ =~ YK_EINVALIDCMD
;
391 return YK_EMORETHANONE
if $_ =~ YK_EMORETHANONE
;
392 return YK_ENODATA
if $_ =~ YK_ENODATA
;
398 YUBIKEY_PID
, NEO_OTP_PID
, NEO_OTP_CCID_PID
, NEO_CCID_PID
, NEO_U2F_PID
, NEO_OTP_U2F_PID
, NEO_U2F_CCID_PID
,
399 NEO_OTP_U2F_CCID_PID
, YK4_OTP_PID
, YK4_U2F_PID
, YK4_OTP_U2F_PID
, YK4_CCID_PID
, YK4_OTP_CCID_PID
,
400 YK4_U2F_CCID_PID
, YK4_OTP_U2F_CCID_PID
, PLUS_U2F_OTP_PID
, ONLYKEY_PID
,
402 $PIDS{$pid} = $PIDS{0+$pid} = $pid;
404 sub _product_name
{ $PIDS{$_[1]} // 'Unknown' }
411 use File::KDBX::Key::YubiKey;
414 my $yubikey = File::KDBX::Key::YubiKey->new(%attributes);
416 my $kdbx = File::KDBX->load_file('database.kdbx', $yubikey);
418 my $kdbx = File::KDBX->load_file('database.kdbx', ['password', $yubikey]);
420 # Scan for USB YubiKeys:
421 my ($first_key, @other_keys) = File::KDBX::Key::YubiKey->scan;
423 my $response = $first_key->challenge('hello');
427 A L<File::KDBX::Key::YubiKey> is a type of challenge-response key. This module follows the KeePassXC-style
428 challenge-response implementation, so this might not work at all with incompatible challenge-response
429 implementations (e.g. KeeChallenge).
431 Inherets methods and attributes from L<File::KDBX::Key::ChallengeResponse>.
433 To use this type of key to secure a L<File::KDBX> database, you also need to install the
434 L<YubiKey Personalization Tool (CLI)|https://developers.yubico.com/yubikey-personalization/> and configure at
435 least one of the slots on your YubiKey for HMAC-SHA1 challenge response mode. You can use the YubiKey
436 Personalization Tool GUI to do this.
438 See L<https://keepassxc.org/docs/#faq-yubikey-howto> for more information.
443 * C<YKCHALRESP> - Path to the L<ykchalresp(1)> program
444 * C<YKINFO> - Path to the L<ykinfo(1)> program
445 * C<YKCHALRESP_FLAGS> - Extra arguments to the B<ykchalresp(1)> program
446 * C<YKINFO_FLAGS> - Extra arguments to the B<ykinfo(1)> program
448 B<YubiKey> searches for these programs in the same way perl typically searches for executables (using the
449 C<PATH> environment variable on many platforms). If the programs aren't installed normally, or if you want to
450 override the default programs, these environment variables can be used.
454 This doesn't work yet on Windows, probably. The hangup is pretty silly: IPC. Theoretically it would work if
455 C<run_forked> from L<IPC::Cmd> worked in Windows, but it probably doesn't. I spent a couple hours applying
456 various quirks to L<IPC::Open3> and L<IPC::Cmd> implementations but never quite got it to worked reliably
457 without deadlocks. Maybe I'll revisit this later. Hit me up so I know if there's demand.
459 It would also be possible to implement this is an XS module that incorporated ykcore, using libusb-1 which
460 would probably make it more portable with Windows. Perhaps if I get around to it.