X-Git-Url: https://git.dogcows.com/gitweb?a=blobdiff_plain;f=lib%2FFile%2FKDBX%2FKey%2FYubiKey.pm;h=51a05aae4de441051e8b477f0da86036cb5ff7d3;hb=52cf8dbcf4ded14b1582e905cf034749385624b3;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..51a05aa 100644
--- a/lib/File/KDBX/Key/YubiKey.pm
+++ b/lib/File/KDBX/Key/YubiKey.pm
@@ -16,6 +16,10 @@ use parent '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};
@@ -301,27 +315,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 +447,8 @@ A L<File::KDBX::Key::YubiKey> 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<File::KDBX::Key::ChallengeResponse>.
+
 To use this type of key to secure a L<File::KDBX> database, you also need to install the
 L<YubiKey Personalization Tool (CLI)|https://developers.yubico.com/yubikey-personalization/> and configure at
 least one of the slots on your YubiKey for HMAC-SHA1 challenge response mode. You can use the YubiKey
@@ -441,9 +460,9 @@ See L<https://keepassxc.org/docs/#faq-yubikey-howto> for more information.
 
 =for :list
 * C<YKCHALRESP> - Path to the L<ykchalresp(1)> program
-* C<YKCHALRESP_FLAGS> - Extra arguments to the B<ykchalresp> program
 * C<YKINFO> - Path to the L<ykinfo(1)> program
-* C<YKINFO_FLAGS> - Extra arguments to the B<ykinfo> program
+* C<YKCHALRESP_FLAGS> - Extra arguments to the B<ykchalresp(1)> program
+* C<YKINFO_FLAGS> - Extra arguments to the B<ykinfo(1)> program
 
 B<YubiKey> searches for these programs in the same way perl typically searches for executables (using the
 C<PATH> environment variable on many platforms). If the programs aren't installed normally, or if you want to
@@ -456,4 +475,7 @@ C<run_forked> from L<IPC::Cmd> worked in Windows, but it probably doesn't. I spe
 various quirks to L<IPC::Open3> and L<IPC::Cmd> 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 is 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