File Coverage

blib/lib/File/KDBX/Key/YubiKey.pm

Criterion	Covered	Total	%
statement	173	200	86.5
branch	72	132	54.5
condition	47	86	54.6
subroutine	29	31	93.5
pod	16	16	100.0
total	337	465	72.4

package File::KDBX::Key::YubiKey;
# ABSTRACT: A Yubico challenge-response key

use warnings;
use strict;

use File::KDBX::Constants qw(:yubikey);
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.904'; # 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;
            }
        }
    }

    return @keys;
}


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' };


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} };


sub name {
    my $self = shift;
    my $name = _product_name($self->vendor_id, $self->product_id // return);
    my $serial = $self->serial;
    my $version = $self->version || '?';
    my $slot = $self->slot;
    my $touch = $self->requires_interaction ? ' - Interaction required' : '';
    return sprintf('%s v%s [%d] (slot #%d)', $name, $version, $serial, $slot);
}


sub requires_interaction {
    my $self = shift;
    my $touch = $self->touch_level // return;
    return $touch & $CONFIG_TOUCH[$self->slot];
}

##############################################################################

### Call ykinfo to get some information about a YubiKey
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:
    {
        $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;
        }
    }

    my $out = $r->{stdout};
    chomp $out;
    if (!$out) {
        alert 'Failed to get YubiKey device info: no output';
        return;
    }

    my %info = map { $_ => ($out =~ /^\Q$_\E: (.+)$/m)[0] }
        qw(serial version touch_level vendor_id product_id);
    $info{vendor_id}    = hex($info{vendor_id})  if defined $info{vendor_id};
    $info{product_id}   = hex($info{product_id}) if defined $info{product_id};

    return %info;
}

### Set the YubiKey information as attributes of a Key object
sub _set_yubikey_info {
    my $self = shift;
    my %info = $self->_get_yubikey_info($self->device);
    @$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 $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 $r;
}

sub _yk_errno {
    local $_ = shift or return 0;
    return YK_EUSBERR       if $_ =~ YK_EUSBERR;
    return YK_EWRONGSIZ     if $_ =~ YK_EWRONGSIZ;
    return YK_EWRITEERR     if $_ =~ YK_EWRITEERR;
    return YK_ETIMEOUT      if $_ =~ YK_ETIMEOUT;
    return YK_ENOKEY        if $_ =~ YK_ENOKEY;
    return YK_EFIRMWARE     if $_ =~ YK_EFIRMWARE;
    return YK_ENOMEM        if $_ =~ YK_ENOMEM;
    return YK_ENOSTATUS     if $_ =~ YK_ENOSTATUS;
    return YK_ENOTYETIMPL   if $_ =~ YK_ENOTYETIMPL;
    return YK_ECHECKSUM     if $_ =~ YK_ECHECKSUM;
    return YK_EWOULDBLOCK   if $_ =~ YK_EWOULDBLOCK;
    return YK_EINVALIDCMD   if $_ =~ YK_EINVALIDCMD;
    return YK_EMORETHANONE  if $_ =~ YK_EMORETHANONE;
    return YK_ENODATA       if $_ =~ YK_ENODATA;
    return -1;
}

my %PIDS;
for my $pid (
    YUBIKEY_PID, NEO_OTP_PID, NEO_OTP_CCID_PID, NEO_CCID_PID, NEO_U2F_PID, NEO_OTP_U2F_PID, NEO_U2F_CCID_PID,
    NEO_OTP_U2F_CCID_PID, YK4_OTP_PID, YK4_U2F_PID, YK4_OTP_U2F_PID, YK4_CCID_PID, YK4_OTP_CCID_PID,
    YK4_U2F_CCID_PID, YK4_OTP_U2F_CCID_PID, PLUS_U2F_OTP_PID, ONLYKEY_PID,
) {
    $PIDS{$pid} = $PIDS{0+$pid} = $pid;
}
sub _product_name { $PIDS{$_[1]} // 'Unknown' }

1;

__END__