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

   1 package File::KDBX::Safe;
   2 # ABSTRACT: Keep strings encrypted while in memory
   3
   4 use warnings;
   5 use strict;
   6
   7 use Crypt::PRNG qw(random_bytes);
   8 use Devel::GlobalDestruction;
   9 use Encode qw(encode decode);
  10 use File::KDBX::Constants qw(:random_stream);
  11 use File::KDBX::Error;
  12 use File::KDBX::Util qw(erase erase_scoped);
  13 use Ref::Util qw(is_arrayref is_coderef is_hashref is_scalarref);
  14 use Scalar::Util qw(refaddr);
  15 use namespace::clean;
  16
  17 our $VERSION = '999.999'; # VERSION
  18
  19 =method new
  20
  21     $safe = File::KDBX::Safe->new(%attributes);
  22     $safe = File::KDBX::Safe->new(\@strings, %attributes);
  23
  24 Create a new safe for storing secret strings encrypted in memory.
  25
  26 If a cipher is passed, its stream will be reset.
  27
  28 =cut
  29
  30 sub new {
  31     my $class = shift;
  32     my %args = @_ % 2 == 0 ? @_ : (strings => shift, @_);
  33
  34     if (!$args{cipher} && $args{key}) {
  35         require File::KDBX::Cipher;
  36         $args{cipher} = File::KDBX::Cipher->new(stream_id => STREAM_ID_CHACHA20, key => $args{key});
  37     }
  38
  39     my $self = bless \%args, $class;
  40     $self->cipher->finish;
  41     $self->{counter} = 0;
  42
  43     my $strings = delete $args{strings};
  44     $self->{items} = [];
  45     $self->{index} = {};
  46     $self->add($strings) if $strings;
  47
  48     return $self;
  49 }
  50
  51 sub DESTROY { !in_global_destruction and $_[0]->unlock }
  52
  53 =method clear
  54
  55     $safe->clear;
  56
  57 Clear a safe, removing all store contents permanently.
  58
  59 =cut
  60
  61 sub clear {
  62     my $self = shift;
  63     $self->{items} = [];
  64     $self->{index} = {};
  65     $self->{counter} = 0;
  66     return $self;
  67 }
  68
  69 =method add
  70
  71     $safe = $safe->lock(@strings);
  72     $safe = $safe->lock(\@strings);
  73
  74 Add strings to be encrypted.
  75
  76 Alias: C<lock>
  77
  78 =cut
  79
  80 sub lock { shift->add(@_) }
  81
  82 sub add {
  83     my $self    = shift;
  84     my @strings = map { is_arrayref($_) ? @$_ : $_ } @_;
  85
  86     @strings or throw 'Must provide strings to lock';
  87
  88     my $cipher = $self->cipher;
  89
  90     for my $string (@strings) {
  91         my $item = {str => $string, off => $self->{counter}};
  92         if (is_scalarref($string)) {
  93             next if !defined $$string;
  94             $item->{enc} = 'UTF-8' if utf8::is_utf8($$string);
  95             if (my $encoding = $item->{enc}) {
  96                 my $encoded = encode($encoding, $$string);
  97                 $item->{val} = $cipher->crypt(\$encoded);
  98                 erase $encoded;
  99             }
 100             else {
 101                 $item->{val} = $cipher->crypt($string);
 102             }
 103             erase $string;
 104         }
 105         elsif (is_hashref($string)) {
 106             next if !defined $string->{value};
 107             $item->{enc} = 'UTF-8' if utf8::is_utf8($string->{value});
 108             if (my $encoding = $item->{enc}) {
 109                 my $encoded = encode($encoding, $string->{value});
 110                 $item->{val} = $cipher->crypt(\$encoded);
 111                 erase $encoded;
 112             }
 113             else {
 114                 $item->{val} = $cipher->crypt(\$string->{value});
 115             }
 116             erase \$string->{value};
 117         }
 118         else {
 119             throw 'Safe strings must be a hashref or stringref', type => ref $string;
 120         }
 121         push @{$self->{items}}, $item;
 122         $self->{index}{refaddr($string)} = $item;
 123         $self->{counter} += length($item->{val});
 124     }
 125
 126     return $self;
 127 }
 128
 129 =method add_protected
 130
 131     $safe = $safe->add_protected(@strings);
 132     $safe = $safe->add_protected(\@strings);
 133
 134 Add strings that are already encrypted.
 135
 136 B<WARNING:> You must add already-encrypted strings in the order in which they were original encrypted or they
 137 will not decrypt correctly. You almost certainly do not want to add both unprotected and protected strings to
 138 a safe.
 139
 140 =cut
 141
 142 sub add_protected {
 143     my $self = shift;
 144     my $filter = is_coderef($_[0]) ? shift : undef;
 145     my @strings = map { is_arrayref($_) ? @$_ : $_ } @_;
 146
 147     @strings or throw 'Must provide strings to lock';
 148
 149     for my $string (@strings) {
 150         my $item = {str => $string};
 151         $item->{filter} = $filter if defined $filter;
 152         if (is_scalarref($string)) {
 153             next if !defined $$string;
 154             $item->{val} = $$string;
 155             erase $string;
 156         }
 157         elsif (is_hashref($string)) {
 158             next if !defined $string->{value};
 159             $item->{val} = $string->{value};
 160             erase \$string->{value};
 161         }
 162         else {
 163             throw 'Safe strings must be a hashref or stringref', type => ref $string;
 164         }
 165         push @{$self->{items}}, $item;
 166         $self->{index}{refaddr($string)} = $item;
 167         $self->{counter} += length($item->{val});
 168     }
 169
 170     return $self;
 171 }
 172
 173 =method unlock
 174
 175     $safe = $safe->unlock;
 176
 177 Decrypt all the strings. Each stored string is set to its original value.
 178
 179 This happens automatically when the safe is garbage-collected.
 180
 181 =cut
 182
 183 sub unlock {
 184     my $self = shift;
 185
 186     my $cipher = $self->cipher;
 187     $cipher->finish;
 188     $self->{counter} = 0;
 189
 190     for my $item (@{$self->{items}}) {
 191         my $string  = $item->{str};
 192         my $cleanup = erase_scoped \$item->{val};
 193         my $str_ref;
 194         if (is_scalarref($string)) {
 195             $$string = $cipher->crypt(\$item->{val});
 196             if (my $encoding = $item->{enc}) {
 197                 my $decoded = decode($encoding, $string->{value});
 198                 erase $string;
 199                 $$string = $decoded;
 200             }
 201             $str_ref = $string;
 202         }
 203         elsif (is_hashref($string)) {
 204             $string->{value} = $cipher->crypt(\$item->{val});
 205             if (my $encoding = $item->{enc}) {
 206                 my $decoded = decode($encoding, $string->{value});
 207                 erase \$string->{value};
 208                 $string->{value} = $decoded;
 209             }
 210             $str_ref = \$string->{value};
 211         }
 212         else {
 213             die 'Unexpected';
 214         }
 215         if (my $filter = $item->{filter}) {
 216             my $filtered = $filter->($$str_ref);
 217             erase $str_ref;
 218             $$str_ref = $filtered;
 219         }
 220     }
 221
 222     return $self->clear;
 223 }
 224
 225 =method peek
 226
 227     $string_value = $safe->peek($string);
 228     ...
 229     erase $string_value;
 230
 231 Peek into the safe at a particular string without decrypting the whole safe. A copy of the string is returned,
 232 and in order to ensure integrity of the memory protection you should erase the copy when you're done.
 233
 234 =cut
 235
 236 sub peek {
 237     my $self = shift;
 238     my $string = shift;
 239
 240     my $item = $self->{index}{refaddr($string)} // return;
 241
 242     my $cipher = $self->cipher->dup(offset => $item->{off});
 243
 244     my $value = $cipher->crypt(\$item->{val});
 245     if (my $encoding = $item->{enc}) {
 246         my $decoded = decode($encoding, $value);
 247         erase $value;
 248         return $decoded;
 249     }
 250     return $value;
 251 }
 252
 253 =attr cipher
 254
 255     $cipher = $safe->cipher;
 256
 257 Get the L<File::KDBX::Cipher::Stream> protecting a safe.
 258
 259 =cut
 260
 261 sub cipher {
 262     my $self = shift;
 263     $self->{cipher} //= do {
 264         require File::KDBX::Cipher;
 265         File::KDBX::Cipher->new(stream_id => STREAM_ID_CHACHA20, key => random_bytes(64));
 266     };
 267 }
 268
 269 1;
 270 __END__
 271
 272 =head1 SYNOPSIS
 273
 274     use File::KDBX::Safe;
 275
 276     $safe = File::KDBX::Safe->new;
 277
 278     my $msg = 'Secret text';
 279     $safe->add(\$msg);
 280     # $msg is now undef, the original message no longer in RAM
 281
 282     my $obj = { value => 'Also secret' };
 283     $safe->add($obj);
 284     # $obj is now { value => undef }
 285
 286     say $safe->peek($msg);  # Secret text
 287
 288     $safe->unlock;
 289     say $msg;               # Secret text
 290     say $obj->{value};      # Also secret
 291
 292 =head1 DESCRIPTION
 293
 294 This module provides memory protection functionality. It keeps strings encrypted in memory and decrypts them
 295 as-needed. Encryption and decryption is done using a L<File::KDBX::Cipher::Stream>.
 296
 297 A safe can protect one or more (possibly many) strings. When a string is added to a safe, it gets added to an
 298 internal list so it will be decrypted when the entire safe is unlocked.
 299
 300 =cut