X-Git-Url: https://git.dogcows.com/gitweb?a=blobdiff_plain;f=lib%2FFile%2FKDBX%2FKey%2FYubiKey.pm;h=51a05aae4de441051e8b477f0da86036cb5ff7d3;hb=52cf8dbcf4ded14b1582e905cf034749385624b3;hp=e86b6e786a5246b3b2d21189f4e7a112312bb16a;hpb=0d19b6cdca02d43bb5c6bdf7b2617ae5e54f2953;p=chaz%2Fp5-File-KDBX diff --git a/lib/File/KDBX/Key/YubiKey.pm b/lib/File/KDBX/Key/YubiKey.pm index e86b6e7..51a05aa 100644 --- a/lib/File/KDBX/Key/YubiKey.pm +++ b/lib/File/KDBX/Key/YubiKey.pm @@ -6,10 +6,9 @@ use strict; use File::KDBX::Constants qw(:yubikey); use File::KDBX::Error; -use File::KDBX::Util qw(pad_pkcs7); -use IPC::Open3; +use File::KDBX::Util qw(:io pad_pkcs7); +use IPC::Cmd 0.52 qw(run_forked); use Ref::Util qw(is_arrayref); -use Scope::Guard; use Symbol qw(gensym); use namespace::clean; @@ -17,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); @@ -25,8 +28,6 @@ sub challenge { my $challenge = shift; my %args = @_; - my @cleanup; - my $device = $args{device} // $self->device; my $slot = $args{slot} // $self->slot; my $timeout = $args{timeout} // $self->timeout; @@ -40,43 +41,43 @@ sub challenge { } my @cmd = ($self->_program('ykchalresp'), "-n$device", "-$slot", qw{-H -i-}, $timeout == 0 ? '-N' : ()); - my ($pid, $child_in, $child_out, $child_err) = _run_ykpers(@cmd); - push @cleanup, Scope::Guard->new(sub { kill $pid if defined $pid }); - - # Set up an alarm [mostly] safely - my $prev_alarm = 0; - local $SIG{ALRM} = sub { - $prev_alarm -= $timeout; - throw 'Timed out while waiting for challenge response', - command => \@cmd, - challenge => $challenge, - timeout => $timeout, - }; - $prev_alarm = alarm $timeout if 0 < $timeout; - push @cleanup, Scope::Guard->new(sub { alarm($prev_alarm < 1 ? 1 : $prev_alarm) }) if $prev_alarm; - - local $SIG{PIPE} = 'IGNORE'; - binmode($child_in); - print $child_in pad_pkcs7($challenge, 64); - close($child_in); - - binmode($child_out); - binmode($child_err); - my $resp = do { local $/; <$child_out> }; - my $err = do { local $/; <$child_err> }; - chomp($resp, $err); - - waitpid($pid, 0); - undef $pid; - my $exit_status = $? >> 8; - alarm 0; - - my $yk_errno = _yk_errno($err); - $exit_status == 0 or throw 'Failed to receive challenge response: ' . ($err ? $err : ''), - error => $err, - yk_errno => $yk_errno || 0; - - $resp =~ /^[A-Fa-f0-9]+$/ or throw 'Unexpected response from challenge', response => $resp; + + 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); + 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}; + chomp $resp; + $resp =~ /^[A-Fa-f0-9]+$/ or throw 'Unexpected response from challenge', response => $resp, result => $r; $resp = pack('H*', $resp); # HMAC-SHA1 response is only 20 bytes @@ -311,37 +312,37 @@ sub _get_yubikey_info { my $self = shift; my $device = shift; + my $timeout = $self->timeout; my @cmd = ($self->_program('ykinfo'), "-n$device", qw{-a}); + my $r; my $try = 0; TRY: - my ($pid, $child_in, $child_out, $child_err) = _run_ykpers(@cmd); - - close($child_in); - - local $SIG{PIPE} = 'IGNORE'; - binmode($child_out); - binmode($child_err); - my $out = do { local $/; <$child_out> }; - my $err = do { local $/; <$child_err> }; - chomp $err; - - waitpid($pid, 0); - my $exit_status = $? >> 8; - - if ($exit_status != 0) { - 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}; + chomp $out; if (!$out) { alert 'Failed to get YubiKey device info: no output'; return; @@ -373,13 +374,23 @@ sub _program { } sub _run_ykpers { - my ($child_err, $child_in, $child_out) = (gensym); - my $pid = eval { open3($child_in, $child_out, $child_err, @_) }; - if (my $err = $@) { - throw "Failed to run $_[0] - Make sure you have the YubiKey Personalization Tool (CLI) package installed.\n", + my $self = shift; + my $ppid = $$; + my $r = eval { run_forked(@_) }; + my $err = $@; + if ($$ != $ppid) { + # Work around IPC::Cmd bug where child can return from run_forked. + # https://rt.cpan.org/Public/Bug/Display.html?id=127372 + require POSIX; + POSIX::_exit(0); + } + if ($err || ($r->{exit_code} == 0 && $r->{err_msg} eq '' && $r->{stdout} eq '' && $r->{stderr} eq '')) { + $err //= 'No output'; + my $prog = $_[0][0]; + throw "Failed to run $prog - Make sure you have the YubiKey Personalization Tool (CLI) package installed.\n", error => $err; } - return ($pid, $child_in, $child_out, $child_err); + return $r; } sub _yk_errno { @@ -436,6 +447,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 @@ -447,12 +460,22 @@ 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 override the default programs, these environment variables can be used. +=head1 CAVEATS + +This doesn't work yet on Windows, probably. The hangup is pretty silly: IPC. Theoretically it would work if +C from L worked in Windows, but it probably doesn't. I spent a couple hours applying +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 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