Dogcows Code - chaz/p5-File-KDBX/blob - lib/File/KDBX/Cipher/Stream.pm

   1 package File::KDBX::Cipher::Stream;
   2 # ABSTRACT: A cipher stream encrypter/decrypter
   3
   4 use warnings;
   5 use strict;
   6
   7 use Crypt::Digest qw(digest_data);
   8 use File::KDBX::Constants qw(:cipher :random_stream);
   9 use File::KDBX::Error;
  10 use Module::Load;
  11 use namespace::clean;
  12
  13 use parent 'File::KDBX::Cipher';
  14
  15 our $VERSION = '999.999'; # VERSION
  16
  17 sub init {
  18     my $self = shift;
  19     my %args = @_;
  20
  21     if (my $uuid = $args{uuid}) {
  22         if ($uuid eq CIPHER_UUID_CHACHA20 && length($args{iv}) == 16) {
  23             # extract the counter
  24             my $buf = substr($self->{iv}, 0, 4, '');
  25             $self->{counter} = unpack('L<', $buf);
  26         }
  27         elsif ($uuid eq CIPHER_UUID_SALSA20) {
  28             # only need eight bytes...
  29             $self->{iv} = substr($args{iv}, 8);
  30         }
  31     }
  32     elsif (my $id = $args{stream_id}) {
  33         my $key_ref = ref $args{key} ? $args{key} : \$args{key};
  34         if ($id == STREAM_ID_CHACHA20) {
  35             ($self->{key}, $self->{iv}) = unpack('a32 a12', digest_data('SHA512', $$key_ref));
  36         }
  37         elsif ($id == STREAM_ID_SALSA20) {
  38             ($self->{key}, $self->{iv}) = (digest_data('SHA256', $$key_ref), STREAM_SALSA20_IV);
  39         }
  40     }
  41
  42     return $self;
  43 }
  44
  45 sub crypt {
  46     my $self = shift;
  47     my $stream = $self->_stream;
  48     return join('', map { $stream->crypt(ref $_ ? $$_ : $_) } grep { defined } @_);
  49 }
  50
  51 sub keystream {
  52     my $self = shift;
  53     return $self->_stream->keystream(@_);
  54 }
  55
  56 sub dup {
  57     my $self = shift;
  58     my $dup = File::KDBX::Cipher->new(
  59         stream_id   => $self->stream_id,
  60         key         => $self->key,
  61         @_,
  62     );
  63     $dup->{key} = $self->key;
  64     $dup->{iv} = $self->iv;
  65     # FIXME - probably turn this into a proper clone method
  66     return $dup;
  67 }
  68
  69 sub _stream {
  70     my $self = shift;
  71
  72     $self->{stream} //= do {
  73         my $s = eval {
  74             my $pkg = 'Crypt::Stream::'.$self->algorithm;
  75             my $counter = $self->counter;
  76             my $pos = 0;
  77             if (defined (my $offset = $self->offset)) {
  78                 $counter = int($offset / 64);
  79                 $pos = $offset % 64;
  80             }
  81             my $s = $pkg->new($self->key, $self->iv, $counter);
  82             # seek to correct position within block
  83             $s->keystream($pos) if $pos;
  84             $s;
  85         };
  86         if (my $err = $@) {
  87             throw 'Failed to initialize stream cipher library',
  88                 error       => $err,
  89                 algorithm   => $self->algorithm,
  90                 key_length  => length($self->key),
  91                 iv_length   => length($self->iv),
  92                 iv          => unpack('H*', $self->iv),
  93                 key         => unpack('H*', $self->key);
  94         }
  95         $s;
  96     };
  97 }
  98
  99 sub encrypt { goto &crypt }
 100 sub decrypt { goto &crypt }
 101
 102 sub finish { delete $_[0]->{stream}; '' }
 103
 104 sub counter { $_[0]->{counter} // 0 }
 105 sub offset  { $_[0]->{offset} }
 106
 107 =attr algorithm
 108
 109 Get the stream cipher algorithm. Can be one of C<Salsa20> and C<ChaCha>.
 110
 111 =cut
 112
 113 sub algorithm   { $_[0]->{algorithm} or throw 'Stream cipher algorithm is not set' }
 114 sub key_size    { { Salsa20 => 32, ChaCha => 32 }->{$_[0]->{algorithm} || ''} //  0 }
 115 sub iv_size     { { Salsa20 =>  8, ChaCha => 12 }->{$_[0]->{algorithm} || ''} // -1 }
 116 sub block_size  { 1 }
 117
 118 1;
 119 __END__
 120
 121 =head1 SYNOPSIS
 122
 123     use File::KDBX::Cipher::Stream;
 124
 125     my $cipher = File::KDBX::Cipher::Stream->new(algorithm => $algorithm, key => $key, iv => $iv);
 126
 127 =head1 DESCRIPTION
 128
 129 A subclass of L<File::KDBX::Cipher> for encrypting and decrypting data using a stream cipher.
 130
 131 =cut