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(pad_pkcs7);
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;
29 my $device = $args{device
} // $self->device;
30 my $slot = $args{slot
} // $self->slot;
31 my $timeout = $args{timeout
} // $self->timeout;
32 local $self->{device
} = $device;
33 local $self->{slot
} = $slot;
34 local $self->{timeout
} = $timeout;
36 my $hooks = $challenge ne 'test';
37 if ($hooks and my $hook = $self->{pre_challenge
}) {
38 $hook->($self, $challenge);
41 my @cmd = ($self->ykchalresp, "-n$device", "-$slot", qw{-H -i-}, $timeout == 0 ? '-N' : ());
42 my ($pid, $child_in, $child_out, $child_err) = _run_ykpers
(@cmd);
43 push @cleanup, Scope
::Guard-
>new(sub { kill $pid if defined $pid });
45 # Set up an alarm [mostly] safely
47 local $SIG{ALRM
} = sub {
48 $prev_alarm -= $timeout;
49 throw
'Timed out while waiting for challenge response',
51 challenge
=> $challenge,
54 $prev_alarm = alarm $timeout if 0 < $timeout;
55 push @cleanup, Scope
::Guard-
>new(sub { alarm($prev_alarm < 1 ? 1 : $prev_alarm) }) if $prev_alarm;
57 local $SIG{PIPE
} = 'IGNORE';
59 print $child_in pad_pkcs7
($challenge, 64);
64 my $resp = do { local $/; <$child_out> };
65 my $err = do { local $/; <$child_err> };
70 my $exit_status = $? >> 8;
73 my $yk_errno = _yk_errno
($err);
74 $exit_status == 0 or throw
'Failed to receive challenge response: ' . ($err ? $err : ''),
76 yk_errno
=> $yk_errno || 0;
78 $resp =~ /^[A-Fa-f0-9]+$/ or throw
'Unexpected response from challenge', response
=> $resp;
79 $resp = pack('H*', $resp);
81 # HMAC-SHA1 response is only 20 bytes
82 substr($resp, 20) = '';
84 if ($hooks and my $hook = $self->{post_challenge
}) {
85 $hook->($self, $challenge, $resp);
93 @keys = File
::KDBX
::Key
::YubiKey-
>scan(%options);
95 Find connected
, configured YubiKeys that are capable of responding to a challenge
. This can
take several
101 * C<limit> - Scan for only up to this many YubiKeys (default: 4)
103 Other options are passed as-is as attributes to the key constructors of found keys (if any).
111 my $limit = delete $args{limit
} // 4;
114 for (my $device = 0; $device < $limit; ++$device) {
115 my %info = $self->_get_yubikey_info($device) or last;
117 for (my $slot = 1; $slot <= 2; ++$slot) {
118 my $config = $CONFIG_VALID[$slot] // next;
119 next unless $info{touch_level
} & $config;
121 my $key = $self->new(%args, device
=> $device, slot
=> $slot, %info);
122 if ($info{product_id
} <= NEO_OTP_U2F_CCID_PID
) {
123 # NEO and earlier always require touch, so forego testing
124 $key->touch_level($info{touch_level
} | $CONFIG_TOUCH[$slot]);
128 eval { $key->challenge('test', timeout
=> 0) };
130 my $yk_errno = ref $err && $err->details->{yk_errno
} || 0;
131 if ($yk_errno == YK_EWOULDBLOCK
) {
132 $key->touch_level($info{touch_level
} | $CONFIG_TOUCH[$slot]);
134 elsif ($yk_errno != 0) {
149 $device = $key->device($device);
151 Get
or set the device number
, which
is the
index number starting
and incrementing from zero assigned
152 to the YubiKey device
. If there
is only one detected YubiKey device
, it
's number is C<0>.
158 $slot = $key->slot($slot);
160 Get or set the slot number, which is a number starting and incrementing from one. A YubiKey can have
161 multiple slots (often just two) which can be independently configured.
167 $timeout = $key->timeout($timeout);
169 Get or set the timeout, in seconds. If the challenge takes longer than this, the challenge will be
170 cancelled and an error is thrown.
172 If the timeout is zero, the challenge is non-blocking; an error is thrown if the challenge would
173 block. If the timeout is negative, timeout is disabled and the challenge will block forever or until
174 a response is received.
180 $callback = $key->pre_challenge($callback);
182 Get or set a callback function that will be called immediately before any challenge is issued. This might be
183 used to prompt the user so they are aware that they are expected to interact with their YubiKey.
185 $key->pre_challenge(sub {
186 my ($key, $challenge) = @_;
188 if ($key->requires_interaction) {
189 say 'Please touch your key device to proceed with decrypting your KDBX file
.';
191 say 'Key
: ', $key->name;
192 if (0 < $key->timeout) {
193 say 'Key access request expires
: ' . localtime(time + $key->timeout);
197 You can throw from this subroutine to abort the challenge. If the challenge is part of loading or dumping
198 a KDBX database, the entire load/dump will be aborted.
202 $callback = $key->post_challenge($callback);
204 Get or set a callback function that will be called immediately after a challenge response has been received.
206 You can throw from this subroutine to abort the challenge. If the challenge is part of loading or dumping
207 a KDBX database, the entire load/dump will be aborted.
211 $program = $key->ykchalresp;
213 Get or set the L<ykchalresp(1)> program name or filepath. Defaults to C<$ENV{YKCHALRESP}> or C<ykchalresp>.
217 $program = $key->ykinfo;
219 Get or set the L<ykinfo(1)> program name or filepath. Defaults to C<$ENV{YKINFO}> or C<ykinfo>.
227 pre_challenge => undef,
228 post_challenge => undef,
229 ykchalresp => sub { $ENV{YKCHALRESP} || 'ykchalresp
' },
230 ykinfo => sub { $ENV{YKINFO} || 'ykinfo
' },
232 while (my ($subname, $default) = each %ATTRS) {
233 no strict 'refs
'; ## no critic (ProhibitNoStrict)
236 $self->{$subname} = shift if @_;
237 $self->{$subname} //= (ref $default eq 'CODE
') ? $default->($self) : $default;
244 touch_level => undef,
248 while (my ($subname, $default) = each %INFO) {
249 no strict 'refs
'; ## no critic (ProhibitNoStrict)
252 $self->{$subname} = shift if @_;
253 defined $self->{$subname} or $self->_set_yubikey_info;
254 $self->{$subname} // $default;
260 Get the device serial number, as a number, or C<undef> if there is no such device.
264 Get the device firmware version (or C<undef>).
268 Get the "touch level" value for the device associated with this key (or C<undef>).
274 Get the vendor ID or product ID for the device associated with this key (or C<undef>).
280 Get a human-readable string identifying the YubiKey (or C<undef>).
286 my $name = _product_name($self->vendor_id, $self->product_id // return);
287 my $serial = $self->serial;
288 my $version = $self->version || '?';
289 my $slot = $self->slot;
290 my $touch = $self->requires_interaction ? ' - Interaction required
' : '';
291 return sprintf('%s v
%s [%d] (slot
#%d)', $name, $version, $serial, $slot);
294 =method requires_interaction
296 Get whether
or not the key requires interaction
(e
.g
. a touch
) to provide a challenge response
(or C
<undef>).
300 sub requires_interaction
{
302 my $touch = $self->touch_level // return;
303 return $touch & $CONFIG_TOUCH[$self->slot];
306 ##############################################################################
308 ### Call ykinfo to get some information about a YubiKey
309 sub _get_yubikey_info
{
313 my @cmd = ($self->ykinfo, "-n$device", qw{-a});
317 my ($pid, $child_in, $child_out, $child_err) = _run_ykpers
(@cmd);
321 local $SIG{PIPE
} = 'IGNORE';
324 my $out = do { local $/; <$child_out> };
325 my $err = do { local $/; <$child_err> };
329 my $exit_status = $? >> 8;
331 if ($exit_status != 0) {
332 my $yk_errno = _yk_errno
($err);
333 return if $yk_errno == YK_ENOKEY
;
334 if ($yk_errno == YK_EWOULDBLOCK
&& ++$try <= 3) {
338 alert
'Failed to get YubiKey device info: ' . ($err ? $err : 'Something happened'),
340 yk_errno
=> $yk_errno || 0;
345 alert
'Failed to get YubiKey device info: no output';
349 my %info = map { $_ => ($out =~ /^\Q$_\E: (.+)$/m)[0] }
350 qw(serial version touch_level vendor_id product_id);
351 $info{vendor_id
} = hex($info{vendor_id
}) if defined $info{vendor_id
};
352 $info{product_id
} = hex($info{product_id
}) if defined $info{product_id
};
357 ### Set the YubiKey information as attributes of a Key object
358 sub _set_yubikey_info
{
360 my %info = $self->_get_yubikey_info($self->device);
361 @$self{keys %info} = values %info;
365 my ($child_err, $child_in, $child_out) = (gensym
);
366 my $pid = eval { open3
($child_in, $child_out, $child_err, @_) };
368 throw
"Failed to run $_[0] - Make sure you have the YubiKey Personalization Tool (CLI) package installed.\n",
371 return ($pid, $child_in, $child_out, $child_err);
375 local $_ = shift or return 0;
376 return YK_EUSBERR
if $_ =~ YK_EUSBERR
;
377 return YK_EWRONGSIZ
if $_ =~ YK_EWRONGSIZ
;
378 return YK_EWRITEERR
if $_ =~ YK_EWRITEERR
;
379 return YK_ETIMEOUT
if $_ =~ YK_ETIMEOUT
;
380 return YK_ENOKEY
if $_ =~ YK_ENOKEY
;
381 return YK_EFIRMWARE
if $_ =~ YK_EFIRMWARE
;
382 return YK_ENOMEM
if $_ =~ YK_ENOMEM
;
383 return YK_ENOSTATUS
if $_ =~ YK_ENOSTATUS
;
384 return YK_ENOTYETIMPL
if $_ =~ YK_ENOTYETIMPL
;
385 return YK_ECHECKSUM
if $_ =~ YK_ECHECKSUM
;
386 return YK_EWOULDBLOCK
if $_ =~ YK_EWOULDBLOCK
;
387 return YK_EINVALIDCMD
if $_ =~ YK_EINVALIDCMD
;
388 return YK_EMORETHANONE
if $_ =~ YK_EMORETHANONE
;
389 return YK_ENODATA
if $_ =~ YK_ENODATA
;
395 YUBIKEY_PID
, NEO_OTP_PID
, NEO_OTP_CCID_PID
, NEO_CCID_PID
, NEO_U2F_PID
, NEO_OTP_U2F_PID
, NEO_U2F_CCID_PID
,
396 NEO_OTP_U2F_CCID_PID
, YK4_OTP_PID
, YK4_U2F_PID
, YK4_OTP_U2F_PID
, YK4_CCID_PID
, YK4_OTP_CCID_PID
,
397 YK4_U2F_CCID_PID
, YK4_OTP_U2F_CCID_PID
, PLUS_U2F_OTP_PID
, ONLYKEY_PID
,
399 $PIDS{$pid} = $PIDS{0+$pid} = $pid;
401 sub _product_name
{ $PIDS{$_[1]} // 'Unknown' }
408 use File::KDBX::Key::YubiKey;
411 my $yubikey = File::KDBX::Key::YubiKey->new(%attributes);
413 my $kdbx = File::KDBX->load_file('database.kdbx', $yubikey);
415 my $kdbx = File::KDBX->load_file('database.kdbx', ['password', $yubikey]);
417 # Scan for USB YubiKeys:
418 my ($first_key, @other_keys) = File::KDBX::Key::YubiKey->scan;
420 my $response = $first_key->challenge('hello');
424 A L<File::KDBX::Key::YubiKey> is a type of challenge-response key. This module follows the KeePassXC-style
425 challenge-response implementation, so this might not work at all with incompatible challenge-response
426 implementations (e.g. KeeChallenge).
428 To use this type of key to secure a L<File::KDBX> database, you also need to install the
429 L<YubiKey Personalization Tool (CLI)|https://developers.yubico.com/yubikey-personalization/> and configure at
430 least one of the slots on your YubiKey for HMAC-SHA1 challenge response mode. You can use the YubiKey
431 Personalization Tool GUI to do this.
433 See L<https://keepassxc.org/docs/#faq-yubikey-howto> for more information.
438 * C<YKCHALRESP> - Path to the L<ykchalresp(1)> program
439 * C<YKINFO> - Path to the L<ykinfo(1)> program
441 C<YubiKey> searches for these programs in the same way perl typically searches for executables (using the
442 C<PATH> environment variable on many platforms). If the programs aren't installed normally, or if you want to
443 override the default programs, these environment variables can be used.