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 = $safe->clear;
  56
  57 Clear a safe, removing all store contents permanently. Returns itself to allow method chaining.
  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 lock
  70
  71 =method add
  72
  73     $safe = $safe->lock(@strings);
  74     $safe = $safe->lock(\@strings);
  75
  76 Add one or more strings to the memory protection stream. Returns itself to allow method chaining.
  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 lock_protected
 130
 131 =method add_protected
 132
 133     $safe = $safe->lock_protected(@strings);
 134     $safe = $safe->lock_protected(\@strings);
 135
 136 Add strings that are already encrypted. Returns itself to allow method chaining.
 137
 138 B<WARNING:> The cipher must be the same as was used to originally encrypt the strings. You must add
 139 already-encrypted strings in the order in which they were original encrypted or they will not decrypt
 140 correctly. You almost certainly do not want to add both unprotected and protected strings to a safe.
 141
 142 =cut
 143
 144 sub lock_protected { shift->add_protected(@_) }
 145
 146 sub add_protected {
 147     my $self = shift;
 148     my $filter = is_coderef($_[0]) ? shift : undef;
 149     my @strings = map { is_arrayref($_) ? @$_ : $_ } @_;
 150
 151     @strings or throw 'Must provide strings to lock';
 152
 153     for my $string (@strings) {
 154         my $item = {str => $string};
 155         $item->{filter} = $filter if defined $filter;
 156         if (is_scalarref($string)) {
 157             next if !defined $$string;
 158             $item->{val} = $$string;
 159             erase $string;
 160         }
 161         elsif (is_hashref($string)) {
 162             next if !defined $string->{value};
 163             $item->{val} = $string->{value};
 164             erase \$string->{value};
 165         }
 166         else {
 167             throw 'Safe strings must be a hashref or stringref', type => ref $string;
 168         }
 169         push @{$self->{items}}, $item;
 170         $self->{index}{refaddr($string)} = $item;
 171         $self->{counter} += length($item->{val});
 172     }
 173
 174     return $self;
 175 }
 176
 177 =method unlock
 178
 179     $safe = $safe->unlock;
 180
 181 Decrypt all the strings. Each stored string is set to its original value, potentially overwriting any value
 182 that might have been set after locking the string (so you probably should avoid modification to strings while
 183 locked). The safe is implicitly cleared. Returns itself to allow method chaining.
 184
 185 This happens automatically when the safe is garbage-collected.
 186
 187 =cut
 188
 189 sub unlock {
 190     my $self = shift;
 191
 192     my $cipher = $self->cipher;
 193     $cipher->finish;
 194     $self->{counter} = 0;
 195
 196     for my $item (@{$self->{items}}) {
 197         my $string  = $item->{str};
 198         my $cleanup = erase_scoped \$item->{val};
 199         my $str_ref;
 200         if (is_scalarref($string)) {
 201             $$string = $cipher->crypt(\$item->{val});
 202             if (my $encoding = $item->{enc}) {
 203                 my $decoded = decode($encoding, $string->{value});
 204                 erase $string;
 205                 $$string = $decoded;
 206             }
 207             $str_ref = $string;
 208         }
 209         elsif (is_hashref($string)) {
 210             $string->{value} = $cipher->crypt(\$item->{val});
 211             if (my $encoding = $item->{enc}) {
 212                 my $decoded = decode($encoding, $string->{value});
 213                 erase \$string->{value};
 214                 $string->{value} = $decoded;
 215             }
 216             $str_ref = \$string->{value};
 217         }
 218         else {
 219             die 'Unexpected';
 220         }
 221         if (my $filter = $item->{filter}) {
 222             my $filtered = $filter->($$str_ref);
 223             erase $str_ref;
 224             $$str_ref = $filtered;
 225         }
 226     }
 227
 228     return $self->clear;
 229 }
 230
 231 =method peek
 232
 233     $string_value = $safe->peek($string);
 234     ...
 235     erase $string_value;
 236
 237 Peek into the safe at a particular string without decrypting the whole safe. A copy of the string is returned,
 238 and in order to ensure integrity of the memory protection you should erase the copy when you're done.
 239
 240 Returns C<undef> if the given C<$string> is not in memory protection.
 241
 242 =cut
 243
 244 sub peek {
 245     my $self = shift;
 246     my $string = shift;
 247
 248     my $item = $self->{index}{refaddr($string)} // return;
 249
 250     my $cipher = $self->cipher->dup(offset => $item->{off});
 251
 252     my $value = $cipher->crypt(\$item->{val});
 253     if (my $encoding = $item->{enc}) {
 254         my $decoded = decode($encoding, $value);
 255         erase $value;
 256         return $decoded;
 257     }
 258     return $value;
 259 }
 260
 261 =attr cipher
 262
 263     $cipher = $safe->cipher;
 264
 265 Get the L<File::KDBX::Cipher::Stream> protecting a safe.
 266
 267 =cut
 268
 269 sub cipher {
 270     my $self = shift;
 271     $self->{cipher} //= do {
 272         require File::KDBX::Cipher;
 273         File::KDBX::Cipher->new(stream_id => STREAM_ID_CHACHA20, key => random_bytes(64));
 274     };
 275 }
 276
 277 1;
 278 __END__
 279
 280 =head1 SYNOPSIS
 281
 282     use File::KDBX::Safe;
 283
 284     $safe = File::KDBX::Safe->new;
 285
 286     my $msg = 'Secret text';
 287     $safe->add(\$msg);
 288     # $msg is now undef, the original message no longer in RAM
 289
 290     my $obj = { value => 'Also secret' };
 291     $safe->add($obj);
 292     # $obj is now { value => undef }
 293
 294     say $safe->peek($msg);  # Secret text
 295
 296     $safe->unlock;
 297     say $msg;               # Secret text
 298     say $obj->{value};      # Also secret
 299
 300 =head1 DESCRIPTION
 301
 302 This module provides memory protection functionality. It keeps strings encrypted in memory and decrypts them
 303 as-needed. Encryption and decryption is done using a L<File::KDBX::Cipher::Stream>.
 304
 305 A safe can protect one or more (possibly many) strings. When a string is added to a safe, it gets added to an
 306 internal list so it will be decrypted when the entire safe is unlocked.
 307
 308 =cut