X-Git-Url: https://git.dogcows.com/gitweb?a=blobdiff_plain;f=lib%2FFile%2FKDBX%2FKey%2FYubiKey.pm;h=fb22bf838483117e0481bdfc43057193923da51b;hb=1b913e5c8826cae2355b0076ec5701aa3ce63c63;hp=7a7e23893313d2b4ff184e3df98509f57e8925e7;hpb=f63182fc62b25269b1c38588dca2b3535ed1a1a2;p=chaz%2Fp5-File-KDBX

diff --git a/lib/File/KDBX/Key/YubiKey.pm b/lib/File/KDBX/Key/YubiKey.pm
index 7a7e238..fb22bf8 100644
--- a/lib/File/KDBX/Key/YubiKey.pm
+++ b/lib/File/KDBX/Key/YubiKey.pm
@@ -6,9 +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 Scope::Guard;
+use File::KDBX::Util qw(:io pad_pkcs7);
+use IPC::Cmd 0.52 qw(run_forked);
+use Ref::Util qw(is_arrayref);
 use Symbol qw(gensym);
 use namespace::clean;
 
@@ -24,8 +24,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;
@@ -38,44 +36,34 @@ sub challenge {
         $hook->($self, $challenge);
     }
 
-    my @cmd = ($self->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 });
+    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,
+    });
 
-    # Set up an alarm [mostly] safely
-    my $prev_alarm = 0;
-    local $SIG{ALRM} = sub {
-        $prev_alarm -= $timeout;
+    if (my $t = $r->{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;
+            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 $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
@@ -310,25 +298,20 @@ sub _get_yubikey_info {
     my $self = shift;
     my $device = shift;
 
-    my @cmd = ($self->ykinfo, "-n$device", qw{-a});
+    my $timeout = $self->timeout;
+    my @cmd = ($self->_program('ykinfo'), "-n$device", qw{-a});
 
     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;
+    my $r = $self->_run_ykpers(\@cmd, {
+        (0 < $timeout ? (timeout => $timeout) : ()),
+        terminate_on_parent_sudden_death    => 1,
+    });
 
-    if ($exit_status != 0) {
+    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) {
@@ -341,6 +324,8 @@ sub _get_yubikey_info {
         return;
     }
 
+    my $out = $r->{stdout};
+    chomp $out;
     if (!$out) {
         alert 'Failed to get YubiKey device info: no output';
         return;
@@ -361,14 +346,34 @@ sub _set_yubikey_info {
     @$self{keys %info} = values %info;
 }
 
+sub _program {
+    my $self = shift;
+    my $name = shift;
+    my @cmd = $self->$name // $name;
+    my $name_uc = uc($name);
+    my $flags = $ENV{"${name_uc}_FLAGS"};
+    push @cmd, split(/\h+/, $flags) if $flags;
+    return @cmd;
+}
+
 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",
-            error   => $err;
+    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);
     }
-    return ($pid, $child_in, $child_out, $child_err);
+    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 $r;
 }
 
 sub _yk_errno {
@@ -425,6 +430,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
@@ -437,9 +444,21 @@ See L<https://keepassxc.org/docs/#faq-yubikey-howto> for more information.
 =for :list
 * C<YKCHALRESP> - Path to the L<ykchalresp(1)> program
 * C<YKINFO> - Path to the L<ykinfo(1)> program
+* C<YKCHALRESP_FLAGS> - Extra arguments to the B<ykchalresp(1)> program
+* C<YKINFO_FLAGS> - Extra arguments to the B<ykinfo(1)> program
 
-C<YubiKey> searches for these programs in the same way perl typically searches for executables (using the
+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
 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<run_forked> from L<IPC::Cmd> worked in Windows, but it probably doesn't. I spent a couple hours applying
+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