Dogcows Code - chaz/p5-File-KDBX/blob - lib/File/KDBX/Key/ChallengeResponse.pm

   1 package File::KDBX::Key::ChallengeResponse;
   2 # ABSTRACT: A challenge-response key
   3
   4 use warnings;
   5 use strict;
   6
   7 use File::KDBX::Error;
   8 use File::KDBX::Util qw(:class);
   9 use namespace::clean;
  10
  11 extends 'File::KDBX::Key';
  12
  13 our $VERSION = '999.999'; # VERSION
  14
  15 sub init {
  16     my $self = shift;
  17     my $primitive = shift or throw 'Missing key primitive';
  18
  19     $self->{responder} = $primitive;
  20
  21     return $self->hide;
  22 }
  23
  24 =method raw_key
  25
  26     $raw_key = $key->raw_key;
  27     $raw_key = $key->raw_key($challenge);
  28
  29 Get the raw key which is the response to a challenge. The response will be saved so that subsequent calls
  30 (with or without the challenge) can provide the response without challenging the responder again. Only once
  31 response is saved at a time; if you call this with a different challenge, the new response is saved over any
  32 previous response.
  33
  34 =cut
  35
  36 sub raw_key {
  37     my $self = shift;
  38     if (@_) {
  39         my $challenge = shift // '';
  40         # Don't challenge if we already have the response.
  41         return $self->SUPER::raw_key if $challenge eq ($self->{challenge} // '');
  42         $self->_set_raw_key($self->challenge($challenge, @_));
  43         $self->{challenge} = $challenge;
  44     }
  45     $self->SUPER::raw_key;
  46 }
  47
  48 =method challenge
  49
  50     $response = $key->challenge($challenge, @options);
  51
  52 Issue a challenge and get a response, or throw if the responder failed to provide one.
  53
  54 =cut
  55
  56 sub challenge {
  57     my $self = shift;
  58
  59     my $responder = $self->{responder} or throw 'Cannot issue challenge without a responder';
  60     return $responder->(@_);
  61 }
  62
  63 1;
  64 __END__
  65
  66 =head1 SYNOPSIS
  67
  68     use File::KDBX::Key::ChallengeResponse;
  69
  70     my $responder = sub {
  71         my $challenge = shift;
  72         ...;    # generate a response based on a secret of some sort
  73         return $response;
  74     };
  75     my $key = File::KDBX::Key::ChallengeResponse->new($responder);
  76
  77 =head1 DESCRIPTION
  78
  79 A challenge-response key is kind of like multifactor authentication, except you don't really I<authenticate>
  80 to a KDBX database because it's not a service. Specifically it would be the "what you have" component. It
  81 assumes there is some device that can store a key that is only known to the unlocker of a database.
  82 A challenge is made to the device and the response generated based on the key is used as the raw key.
  83
  84 Inherets methods and attributes from L<File::KDBX::Key>.
  85
  86 This is a generic implementation where a responder subroutine is provided to provide the response. There is
  87 also L<File::KDBX::Key::YubiKey> which is a subclass that allows YubiKeys to be responder devices.
  88
  89 =cut