view release on metacpan or  search on metacpan

lib/File/KDBX/Key/YubiKey.pm  view on Meta::CPAN

use File::KDBX::Error;
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;

extends 'File::KDBX::Key::ChallengeResponse';

our $VERSION = '0.906'; # 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);

sub challenge {
    my $self = shift;
    my $challenge = shift;
    my %args = @_;

    my $device  = $args{device}  // $self->device;
    my $slot    = $args{slot}    // $self->slot;
    my $timeout = $args{timeout} // $self->timeout;
    local $self->{device}   = $device;
    local $self->{slot}     = $slot;
    local $self->{timeout}  = $timeout;

    my $hooks = $challenge ne 'test';
    if ($hooks and my $hook = $self->{pre_challenge}) {
        $hook->($self, $challenge);
    }

    my @cmd = ($self->_program('ykchalresp'), "-n$device", "-$slot", qw{-H -i-}, $timeout == 0 ? '-N' : ());

    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
    substr($resp, 20) = '';

    if ($hooks and my $hook = $self->{post_challenge}) {
        $hook->($self, $challenge, $resp);
    }

    return $resp;
}


sub scan {
    my $self = shift;
    my %args = @_;

    my $limit = delete $args{limit} // 4;

    my @keys;
    for (my $device = 0; $device < $limit; ++$device) {
        my %info = $self->_get_yubikey_info($device) or last;

        for (my $slot = 1; $slot <= 2; ++$slot) {
            my $config = $CONFIG_VALID[$slot] // next;
            next unless $info{touch_level} & $config;

            my $key = $self->new(%args, device => $device, slot => $slot, %info);
            if ($info{product_id} <= NEO_OTP_U2F_CCID_PID) {
                # NEO and earlier always require touch, so forego testing
                $key->touch_level($info{touch_level} | $CONFIG_TOUCH[$slot]);
                push @keys, $key;
            }
            else {
                eval { $key->challenge('test', timeout => 0) };
                if (my $err = $@) {
                    my $yk_errno = ref $err && $err->details->{yk_errno} || 0;
                    if ($yk_errno == YK_EWOULDBLOCK) {
                        $key->touch_level($info{touch_level} | $CONFIG_TOUCH[$slot]);
                    }
                    elsif ($yk_errno != 0) {
                        # alert $err;
                        next;
                    }
                }
                push @keys, $key;
            }
        }