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 namespace::clean;
   9
  10 use parent 'File::KDBX::Key';
  11
  12 our $VERSION = '999.999'; # VERSION
  13
  14 sub init {
  15     my $self = shift;
  16     my $primitive = shift or throw 'Missing key primitive';
  17
  18     $self->{responder} = $primitive;
  19
  20     return $self->hide;
  21 }
  22
  23 sub raw_key {
  24     my $self = shift;
  25     if (@_) {
  26         my $challenge = shift // '';
  27         # Don't challenge if we already have the response.
  28         return $self->SUPER::raw_key if $challenge eq ($self->{challenge} // '');
  29         $self->_set_raw_key($self->challenge($challenge, @_));
  30         $self->{challenge} = $challenge;
  31     }
  32     $self->SUPER::raw_key;
  33 }
  34
  35 =method challenge
  36
  37     $response = $key->challenge($challenge, @options);
  38
  39 Issue a challenge and get a response, or throw if the responder failed.
  40
  41 =cut
  42
  43 sub challenge {
  44     my $self = shift;
  45
  46     my $responder = $self->{responder} or throw 'Cannot issue challenge without a responder';
  47     return $responder->(@_);
  48 }
  49
  50 1;
  51 __END__
  52
  53 =head1 SYNOPSIS
  54
  55     my $key = File::KDBX::Key::ChallengeResponse->(
  56         responder => sub { my $challenge = shift; ...; return $response },
  57     );
  58
  59 =head1 DESCRIPTION
  60
  61 =cut