X-Git-Url: https://git.dogcows.com/gitweb?a=blobdiff_plain;f=lib%2FFile%2FKDBX%2FKey%2FYubiKey.pm;h=5c2a2eeb3bad014b508943336147486bafe98c0a;hb=13a89f4e259b51789eba6c3b29ef31d4ac759db2;hp=7b7132cc1065201b99f6238f525ec2de428314a0;hpb=b30990a507ef30b6f5b6fcb799a2759632c77ff0;p=chaz%2Fp5-File-KDBX diff --git a/lib/File/KDBX/Key/YubiKey.pm b/lib/File/KDBX/Key/YubiKey.pm index 7b7132c..5c2a2ee 100644 --- a/lib/File/KDBX/Key/YubiKey.pm +++ b/lib/File/KDBX/Key/YubiKey.pm @@ -6,16 +6,20 @@ use strict; use File::KDBX::Constants qw(:yubikey); use File::KDBX::Error; -use File::KDBX::Util qw(:io pad_pkcs7); -use IPC::Cmd 0.52 qw(run_forked); +use File::KDBX::Util qw(:class :io pad_pkcs7); +use IPC::Cmd 0.84 qw(run_forked); use Ref::Util qw(is_arrayref); use Symbol qw(gensym); use namespace::clean; -use parent 'File::KDBX::Key::ChallengeResponse'; +extends 'File::KDBX::Key::ChallengeResponse'; our $VERSION = '999.999'; # VERSION +# It can take some time for the USB device to be ready again, so we can retry a few times. +our $RETRY_COUNT = 5; +our $RETRY_INTERVAL = 0.1; + my @CONFIG_VALID = (0, CONFIG1_VALID, CONFIG2_VALID); my @CONFIG_TOUCH = (0, CONFIG1_TOUCH, CONFIG2_TOUCH); @@ -37,28 +41,38 @@ sub challenge { } my @cmd = ($self->_program('ykchalresp'), "-n$device", "-$slot", qw{-H -i-}, $timeout == 0 ? '-N' : ()); - my $r = $self->_run_ykpers(\@cmd, { - (0 < $timeout ? (timeout => $timeout) : ()), - child_stdin => pad_pkcs7($challenge, 64), - terminate_on_parent_sudden_death => 1, - }); - if (my $t = $r->{timeout}) { - throw 'Timed out while waiting for challenge response', - command => \@cmd, - challenge => $challenge, - timeout => $t, - result => $r; - } + my $r; + my $try = 0; + TRY: + { + $r = $self->_run_ykpers(\@cmd, { + (0 < $timeout ? (timeout => $timeout) : ()), + child_stdin => pad_pkcs7($challenge, 64), + terminate_on_parent_sudden_death => 1, + }); + + if (my $t = $r->{timeout}) { + throw 'Timed out while waiting for challenge response', + command => \@cmd, + challenge => $challenge, + timeout => $t, + result => $r; + } - my $exit_code = $r->{exit_code}; - if ($exit_code != 0) { - my $err = $r->{stderr}; - chomp $err; - my $yk_errno = _yk_errno($err); - throw 'Failed to receive challenge response: ' . ($err ? $err : ''), - error => $err, - yk_errno => $yk_errno || 0; + my $exit_code = $r->{exit_code}; + if ($exit_code != 0) { + my $err = $r->{stderr}; + chomp $err; + my $yk_errno = _yk_errno($err); + if ($yk_errno == YK_EUSBERR && $err =~ /resource busy/i && ++$try <= $RETRY_COUNT) { + sleep $RETRY_INTERVAL; + goto TRY; + } + throw 'Failed to receive challenge response: ' . ($err ? $err : 'Something happened'), + error => $err, + yk_errno => $yk_errno || 0; + } } my $resp = $r->{stdout}; @@ -208,40 +222,13 @@ Get or set the L program name or filepath. Defaults to C<$ENV{YKINFO} =cut -my %ATTRS = ( - device => 0, - slot => 1, - timeout => 10, - pre_challenge => undef, - post_challenge => undef, - ykchalresp => sub { $ENV{YKCHALRESP} || 'ykchalresp' }, - ykinfo => sub { $ENV{YKINFO} || 'ykinfo' }, -); -while (my ($subname, $default) = each %ATTRS) { - no strict 'refs'; ## no critic (ProhibitNoStrict) - *{$subname} = sub { - my $self = shift; - $self->{$subname} = shift if @_; - $self->{$subname} //= (ref $default eq 'CODE') ? $default->($self) : $default; - }; -} - -my %INFO = ( - serial => undef, - version => undef, - touch_level => undef, - vendor_id => undef, - product_id => undef, -); -while (my ($subname, $default) = each %INFO) { - no strict 'refs'; ## no critic (ProhibitNoStrict) - *{$subname} = sub { - my $self = shift; - $self->{$subname} = shift if @_; - defined $self->{$subname} or $self->_set_yubikey_info; - $self->{$subname} // $default; - }; -} +has device => 0; +has slot => 1; +has timeout => 10; +has pre_challenge => undef; +has post_challenge => undef; +has ykchalresp => sub { $ENV{YKCHALRESP} || 'ykchalresp' }; +has ykinfo => sub { $ENV{YKINFO} || 'ykinfo' }; =method serial @@ -261,6 +248,14 @@ Get the "touch level" value for the device associated with this key (or C Get the vendor ID or product ID for the device associated with this key (or C). +=cut + +has serial => sub { $_[0]->_set_yubikey_info; $_[0]->{serial} }; +has version => sub { $_[0]->_set_yubikey_info; $_[0]->{version} }; +has touch_level => sub { $_[0]->_set_yubikey_info; $_[0]->{touch_level} }; +has vendor_id => sub { $_[0]->_set_yubikey_info; $_[0]->{vendor_id} }; +has product_id => sub { $_[0]->_set_yubikey_info; $_[0]->{product_id} }; + =method name $name = $key->name; @@ -301,27 +296,30 @@ sub _get_yubikey_info { my $timeout = $self->timeout; my @cmd = ($self->_program('ykinfo'), "-n$device", qw{-a}); + my $r; my $try = 0; TRY: - my $r = $self->_run_ykpers(\@cmd, { - (0 < $timeout ? (timeout => $timeout) : ()), - terminate_on_parent_sudden_death => 1, - }); - - my $exit_code = $r->{exit_code}; - if ($exit_code != 0) { - my $err = $r->{stderr}; - chomp $err; - my $yk_errno = _yk_errno($err); - return if $yk_errno == YK_ENOKEY; - if ($yk_errno == YK_EWOULDBLOCK && ++$try <= 3) { - sleep 0.1; - goto TRY; + { + $r = $self->_run_ykpers(\@cmd, { + (0 < $timeout ? (timeout => $timeout) : ()), + terminate_on_parent_sudden_death => 1, + }); + + my $exit_code = $r->{exit_code}; + if ($exit_code != 0) { + my $err = $r->{stderr}; + chomp $err; + my $yk_errno = _yk_errno($err); + return if $yk_errno == YK_ENOKEY; + if ($yk_errno == YK_EWOULDBLOCK && ++$try <= $RETRY_COUNT) { + sleep $RETRY_INTERVAL; + goto TRY; + } + alert 'Failed to get YubiKey device info: ' . ($err ? $err : 'Something happened'), + error => $err, + yk_errno => $yk_errno || 0; + return; } - alert 'Failed to get YubiKey device info: ' . ($err ? $err : 'Something happened'), - error => $err, - yk_errno => $yk_errno || 0; - return; } my $out = $r->{stdout}; @@ -430,6 +428,8 @@ A L is a type of challenge-response key. This module f challenge-response implementation, so this might not work at all with incompatible challenge-response implementations (e.g. KeeChallenge). +Inherets methods and attributes from L. + To use this type of key to secure a L database, you also need to install the L and configure at least one of the slots on your YubiKey for HMAC-SHA1 challenge response mode. You can use the YubiKey @@ -441,9 +441,9 @@ See L for more information. =for :list * C - Path to the L program -* C - Extra arguments to the B program * C - Path to the L program -* C - Extra arguments to the B program +* C - Extra arguments to the B program +* C - Extra arguments to the B program B searches for these programs in the same way perl typically searches for executables (using the C environment variable on many platforms). If the programs aren't installed normally, or if you want to @@ -456,4 +456,7 @@ C from L worked in Windows, but it probably doesn't. I spe various quirks to L and L implementations but never quite got it to worked reliably without deadlocks. Maybe I'll revisit this later. Hit me up so I know if there's demand. +It would also be possible to implement this as an XS module that incorporated ykcore, using libusb-1 which +would probably make it more portable with Windows. Perhaps if I get around to it. + =cut