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(: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 use parent
'File::KDBX::Key::ChallengeResponse';
17 our $VERSION = '999.999'; # VERSION
19 my @CONFIG_VALID = (0, CONFIG1_VALID
, CONFIG2_VALID
);
20 my @CONFIG_TOUCH = (0, CONFIG1_TOUCH
, CONFIG2_TOUCH
);
24 my $challenge = shift;
27 my $device = $args{device
} // $self->device;
28 my $slot = $args{slot
} // $self->slot;
29 my $timeout = $args{timeout
} // $self->timeout;
30 local $self->{device
} = $device;
31 local $self->{slot
} = $slot;
32 local $self->{timeout
} = $timeout;
34 my $hooks = $challenge ne 'test';
35 if ($hooks and my $hook = $self->{pre_challenge
}) {
36 $hook->($self, $challenge);
39 my @cmd = ($self->_program('ykchalresp'), "-n$device", "-$slot", qw{-H -i-}, $timeout == 0 ? '-N' : ());
40 my $r = $self->_run_ykpers(\
@cmd, {
41 (0 < $timeout ? (timeout
=> $timeout) : ()),
42 child_stdin
=> pad_pkcs7
($challenge, 64),
43 terminate_on_parent_sudden_death
=> 1,
46 if (my $t = $r->{timeout
}) {
47 throw
'Timed out while waiting for challenge response',
49 challenge
=> $challenge,
54 my $exit_code = $r->{exit_code
};
55 if ($exit_code != 0) {
56 my $err = $r->{stderr
};
58 my $yk_errno = _yk_errno
($err);
59 throw
'Failed to receive challenge response: ' . ($err ? $err : ''),
61 yk_errno
=> $yk_errno || 0;
64 my $resp = $r->{stdout
};
66 $resp =~ /^[A-Fa-f0-9]+$/ or throw
'Unexpected response from challenge', response
=> $resp, result
=> $r;
67 $resp = pack('H*', $resp);
69 # HMAC-SHA1 response is only 20 bytes
70 substr($resp, 20) = '';
72 if ($hooks and my $hook = $self->{post_challenge
}) {
73 $hook->($self, $challenge, $resp);
81 @keys = File
::KDBX
::Key
::YubiKey-
>scan(%options);
83 Find connected
, configured YubiKeys that are capable of responding to a challenge
. This can
take several
89 * C<limit> - Scan for only up to this many YubiKeys (default: 4)
91 Other options are passed as-is as attributes to the key constructors of found keys (if any).
99 my $limit = delete $args{limit
} // 4;
102 for (my $device = 0; $device < $limit; ++$device) {
103 my %info = $self->_get_yubikey_info($device) or last;
105 for (my $slot = 1; $slot <= 2; ++$slot) {
106 my $config = $CONFIG_VALID[$slot] // next;
107 next unless $info{touch_level
} & $config;
109 my $key = $self->new(%args, device
=> $device, slot
=> $slot, %info);
110 if ($info{product_id
} <= NEO_OTP_U2F_CCID_PID
) {
111 # NEO and earlier always require touch, so forego testing
112 $key->touch_level($info{touch_level
} | $CONFIG_TOUCH[$slot]);
116 eval { $key->challenge('test', timeout
=> 0) };
118 my $yk_errno = ref $err && $err->details->{yk_errno
} || 0;
119 if ($yk_errno == YK_EWOULDBLOCK
) {
120 $key->touch_level($info{touch_level
} | $CONFIG_TOUCH[$slot]);
122 elsif ($yk_errno != 0) {
137 $device = $key->device($device);
139 Get
or set the device number
, which
is the
index number starting
and incrementing from zero assigned
140 to the YubiKey device
. If there
is only one detected YubiKey device
, it
's number is C<0>.
146 $slot = $key->slot($slot);
148 Get or set the slot number, which is a number starting and incrementing from one. A YubiKey can have
149 multiple slots (often just two) which can be independently configured.
155 $timeout = $key->timeout($timeout);
157 Get or set the timeout, in seconds. If the challenge takes longer than this, the challenge will be
158 cancelled and an error is thrown.
160 If the timeout is zero, the challenge is non-blocking; an error is thrown if the challenge would
161 block. If the timeout is negative, timeout is disabled and the challenge will block forever or until
162 a response is received.
168 $callback = $key->pre_challenge($callback);
170 Get or set a callback function that will be called immediately before any challenge is issued. This might be
171 used to prompt the user so they are aware that they are expected to interact with their YubiKey.
173 $key->pre_challenge(sub {
174 my ($key, $challenge) = @_;
176 if ($key->requires_interaction) {
177 say 'Please touch your key device to proceed with decrypting your KDBX file
.';
179 say 'Key
: ', $key->name;
180 if (0 < $key->timeout) {
181 say 'Key access request expires
: ' . localtime(time + $key->timeout);
185 You can throw from this subroutine to abort the challenge. If the challenge is part of loading or dumping
186 a KDBX database, the entire load/dump will be aborted.
190 $callback = $key->post_challenge($callback);
192 Get or set a callback function that will be called immediately after a challenge response has been received.
194 You can throw from this subroutine to abort the challenge. If the challenge is part of loading or dumping
195 a KDBX database, the entire load/dump will be aborted.
199 $program = $key->ykchalresp;
201 Get or set the L<ykchalresp(1)> program name or filepath. Defaults to C<$ENV{YKCHALRESP}> or C<ykchalresp>.
205 $program = $key->ykinfo;
207 Get or set the L<ykinfo(1)> program name or filepath. Defaults to C<$ENV{YKINFO}> or C<ykinfo>.
215 pre_challenge => undef,
216 post_challenge => undef,
217 ykchalresp => sub { $ENV{YKCHALRESP} || 'ykchalresp
' },
218 ykinfo => sub { $ENV{YKINFO} || 'ykinfo
' },
220 while (my ($subname, $default) = each %ATTRS) {
221 no strict 'refs
'; ## no critic (ProhibitNoStrict)
224 $self->{$subname} = shift if @_;
225 $self->{$subname} //= (ref $default eq 'CODE
') ? $default->($self) : $default;
232 touch_level => undef,
236 while (my ($subname, $default) = each %INFO) {
237 no strict 'refs
'; ## no critic (ProhibitNoStrict)
240 $self->{$subname} = shift if @_;
241 defined $self->{$subname} or $self->_set_yubikey_info;
242 $self->{$subname} // $default;
248 Get the device serial number, as a number, or C<undef> if there is no such device.
252 Get the device firmware version (or C<undef>).
256 Get the "touch level" value for the device associated with this key (or C<undef>).
262 Get the vendor ID or product ID for the device associated with this key (or C<undef>).
268 Get a human-readable string identifying the YubiKey (or C<undef>).
274 my $name = _product_name($self->vendor_id, $self->product_id // return);
275 my $serial = $self->serial;
276 my $version = $self->version || '?';
277 my $slot = $self->slot;
278 my $touch = $self->requires_interaction ? ' - Interaction required
' : '';
279 return sprintf('%s v
%s [%d] (slot
#%d)', $name, $version, $serial, $slot);
282 =method requires_interaction
284 Get whether
or not the key requires interaction
(e
.g
. a touch
) to provide a challenge response
(or C
<undef>).
288 sub requires_interaction
{
290 my $touch = $self->touch_level // return;
291 return $touch & $CONFIG_TOUCH[$self->slot];
294 ##############################################################################
296 ### Call ykinfo to get some information about a YubiKey
297 sub _get_yubikey_info
{
301 my $timeout = $self->timeout;
302 my @cmd = ($self->_program('ykinfo'), "-n$device", qw{-a});
306 my $r = $self->_run_ykpers(\
@cmd, {
307 (0 < $timeout ? (timeout
=> $timeout) : ()),
308 terminate_on_parent_sudden_death
=> 1,
311 my $exit_code = $r->{exit_code
};
312 if ($exit_code != 0) {
313 my $err = $r->{stderr
};
315 my $yk_errno = _yk_errno
($err);
316 return if $yk_errno == YK_ENOKEY
;
317 if ($yk_errno == YK_EWOULDBLOCK
&& ++$try <= 3) {
321 alert
'Failed to get YubiKey device info: ' . ($err ? $err : 'Something happened'),
323 yk_errno
=> $yk_errno || 0;
327 my $out = $r->{stdout
};
330 alert
'Failed to get YubiKey device info: no output';
334 my %info = map { $_ => ($out =~ /^\Q$_\E: (.+)$/m)[0] }
335 qw(serial version touch_level vendor_id product_id);
336 $info{vendor_id
} = hex($info{vendor_id
}) if defined $info{vendor_id
};
337 $info{product_id
} = hex($info{product_id
}) if defined $info{product_id
};
342 ### Set the YubiKey information as attributes of a Key object
343 sub _set_yubikey_info
{
345 my %info = $self->_get_yubikey_info($self->device);
346 @$self{keys %info} = values %info;
352 my @cmd = $self->$name // $name;
353 my $name_uc = uc($name);
354 my $flags = $ENV{"${name_uc}_FLAGS"};
355 push @cmd, split(/\h+/, $flags) if $flags;
362 my $r = eval { run_forked
(@_) };
365 # Work around IPC::Cmd bug where child can return from run_forked.
366 # https://rt.cpan.org/Public/Bug/Display.html?id=127372
370 if ($err || ($r->{exit_code
} == 0 && $r->{err_msg
} eq '' && $r->{stdout
} eq '' && $r->{stderr
} eq '')) {
371 $err //= 'No output';
373 throw
"Failed to run $prog - Make sure you have the YubiKey Personalization Tool (CLI) package installed.\n",
380 local $_ = shift or return 0;
381 return YK_EUSBERR
if $_ =~ YK_EUSBERR
;
382 return YK_EWRONGSIZ
if $_ =~ YK_EWRONGSIZ
;
383 return YK_EWRITEERR
if $_ =~ YK_EWRITEERR
;
384 return YK_ETIMEOUT
if $_ =~ YK_ETIMEOUT
;
385 return YK_ENOKEY
if $_ =~ YK_ENOKEY
;
386 return YK_EFIRMWARE
if $_ =~ YK_EFIRMWARE
;
387 return YK_ENOMEM
if $_ =~ YK_ENOMEM
;
388 return YK_ENOSTATUS
if $_ =~ YK_ENOSTATUS
;
389 return YK_ENOTYETIMPL
if $_ =~ YK_ENOTYETIMPL
;
390 return YK_ECHECKSUM
if $_ =~ YK_ECHECKSUM
;
391 return YK_EWOULDBLOCK
if $_ =~ YK_EWOULDBLOCK
;
392 return YK_EINVALIDCMD
if $_ =~ YK_EINVALIDCMD
;
393 return YK_EMORETHANONE
if $_ =~ YK_EMORETHANONE
;
394 return YK_ENODATA
if $_ =~ YK_ENODATA
;
400 YUBIKEY_PID
, NEO_OTP_PID
, NEO_OTP_CCID_PID
, NEO_CCID_PID
, NEO_U2F_PID
, NEO_OTP_U2F_PID
, NEO_U2F_CCID_PID
,
401 NEO_OTP_U2F_CCID_PID
, YK4_OTP_PID
, YK4_U2F_PID
, YK4_OTP_U2F_PID
, YK4_CCID_PID
, YK4_OTP_CCID_PID
,
402 YK4_U2F_CCID_PID
, YK4_OTP_U2F_CCID_PID
, PLUS_U2F_OTP_PID
, ONLYKEY_PID
,
404 $PIDS{$pid} = $PIDS{0+$pid} = $pid;
406 sub _product_name
{ $PIDS{$_[1]} // 'Unknown' }
413 use File::KDBX::Key::YubiKey;
416 my $yubikey = File::KDBX::Key::YubiKey->new(%attributes);
418 my $kdbx = File::KDBX->load_file('database.kdbx', $yubikey);
420 my $kdbx = File::KDBX->load_file('database.kdbx', ['password', $yubikey]);
422 # Scan for USB YubiKeys:
423 my ($first_key, @other_keys) = File::KDBX::Key::YubiKey->scan;
425 my $response = $first_key->challenge('hello');
429 A L<File::KDBX::Key::YubiKey> is a type of challenge-response key. This module follows the KeePassXC-style
430 challenge-response implementation, so this might not work at all with incompatible challenge-response
431 implementations (e.g. KeeChallenge).
433 Inherets methods and attributes from L<File::KDBX::Key::ChallengeResponse>.
435 To use this type of key to secure a L<File::KDBX> database, you also need to install the
436 L<YubiKey Personalization Tool (CLI)|https://developers.yubico.com/yubikey-personalization/> and configure at
437 least one of the slots on your YubiKey for HMAC-SHA1 challenge response mode. You can use the YubiKey
438 Personalization Tool GUI to do this.
440 See L<https://keepassxc.org/docs/#faq-yubikey-howto> for more information.
445 * C<YKCHALRESP> - Path to the L<ykchalresp(1)> program
446 * C<YKINFO> - Path to the L<ykinfo(1)> program
447 * C<YKCHALRESP_FLAGS> - Extra arguments to the B<ykchalresp(1)> program
448 * C<YKINFO_FLAGS> - Extra arguments to the B<ykinfo(1)> program
450 B<YubiKey> searches for these programs in the same way perl typically searches for executables (using the
451 C<PATH> environment variable on many platforms). If the programs aren't installed normally, or if you want to
452 override the default programs, these environment variables can be used.
456 This doesn't work yet on Windows, probably. The hangup is pretty silly: IPC. Theoretically it would work if
457 C<run_forked> from L<IPC::Cmd> worked in Windows, but it probably doesn't. I spent a couple hours applying
458 various quirks to L<IPC::Open3> and L<IPC::Cmd> implementations but never quite got it to worked reliably
459 without deadlocks. Maybe I'll revisit this later. Hit me up so I know if there's demand.
461 It would also be possible to implement this is an XS module that incorporated ykcore, using libusb-1 which
462 would probably make it more portable with Windows. Perhaps if I get around to it.