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 = '0.906'; # VERSION
  18
  19
  20 sub new {
  21     my $class = shift;
  22     my %args = @_ % 2 == 0 ? @_ : (strings => shift, @_);
  23
  24     if (!$args{cipher} && $args{key}) {
  25         require File::KDBX::Cipher;
  26         $args{cipher} = File::KDBX::Cipher->new(stream_id => STREAM_ID_CHACHA20, key => $args{key});
  27     }
  28
  29     my $self = bless \%args, $class;
  30     $self->cipher->finish;
  31     $self->{counter} = 0;
  32
  33     my $strings = delete $args{strings};
  34     $self->{items} = [];
  35     $self->{index} = {};
  36     $self->add($strings) if $strings;
  37
  38     return $self;
  39 }
  40
  41 sub DESTROY { local ($., $@, $!, $^E, $?); !in_global_destruction and $_[0]->unlock }
  42
  43
  44 sub clear {
  45     my $self = shift;
  46     $self->{items} = [];
  47     $self->{index} = {};
  48     $self->{counter} = 0;
  49     return $self;
  50 }
  51
  52
  53 sub lock { shift->add(@_) }
  54
  55 sub add {
  56     my $self    = shift;
  57     my @strings = map { is_arrayref($_) ? @$_ : $_ } @_;
  58
  59     @strings or throw 'Must provide strings to lock';
  60
  61     my $cipher = $self->cipher;
  62
  63     for my $string (@strings) {
  64         my $item = {str => $string, off => $self->{counter}};
  65         if (is_scalarref($string)) {
  66             next if !defined $$string;
  67             $item->{enc} = 'UTF-8' if utf8::is_utf8($$string);
  68             if (my $encoding = $item->{enc}) {
  69                 my $encoded = encode($encoding, $$string);
  70                 $item->{val} = $cipher->crypt(\$encoded);
  71                 erase $encoded;
  72             }
  73             else {
  74                 $item->{val} = $cipher->crypt($string);
  75             }
  76             erase $string;
  77         }
  78         elsif (is_hashref($string)) {
  79             next if !defined $string->{value};
  80             $item->{enc} = 'UTF-8' if utf8::is_utf8($string->{value});
  81             if (my $encoding = $item->{enc}) {
  82                 my $encoded = encode($encoding, $string->{value});
  83                 $item->{val} = $cipher->crypt(\$encoded);
  84                 erase $encoded;
  85             }
  86             else {
  87                 $item->{val} = $cipher->crypt(\$string->{value});
  88             }
  89             erase \$string->{value};
  90         }
  91         else {
  92             throw 'Safe strings must be a hashref or stringref', type => ref $string;
  93         }
  94         push @{$self->{items}}, $item;
  95         $self->{index}{refaddr($string)} = $item;
  96         $self->{counter} += length($item->{val});
  97     }
  98
  99     return $self;
 100 }
 101
 102
 103 sub lock_protected { shift->add_protected(@_) }
 104
 105 sub add_protected {
 106     my $self = shift;
 107     my $filter = is_coderef($_[0]) ? shift : undef;
 108     my @strings = map { is_arrayref($_) ? @$_ : $_ } @_;
 109
 110     @strings or throw 'Must provide strings to lock';
 111
 112     for my $string (@strings) {
 113         my $item = {str => $string, off => $self->{counter}};
 114         $item->{filter} = $filter if defined $filter;
 115         if (is_scalarref($string)) {
 116             next if !defined $$string;
 117             $item->{val} = $$string;
 118             erase $string;
 119         }
 120         elsif (is_hashref($string)) {
 121             next if !defined $string->{value};
 122             $item->{val} = $string->{value};
 123             erase \$string->{value};
 124         }
 125         else {
 126             throw 'Safe strings must be a hashref or stringref', type => ref $string;
 127         }
 128         push @{$self->{items}}, $item;
 129         $self->{index}{refaddr($string)} = $item;
 130         $self->{counter} += length($item->{val});
 131     }
 132
 133     return $self;
 134 }
 135
 136
 137 sub unlock {
 138     my $self = shift;
 139
 140     my $cipher = $self->cipher;
 141     $cipher->finish;
 142     $self->{counter} = 0;
 143
 144     for my $item (@{$self->{items}}) {
 145         my $string  = $item->{str};
 146         my $cleanup = erase_scoped \$item->{val};
 147         my $str_ref;
 148         if (is_scalarref($string)) {
 149             $$string = $cipher->crypt(\$item->{val});
 150             if (my $encoding = $item->{enc}) {
 151                 my $decoded = decode($encoding, $string->{value});
 152                 erase $string;
 153                 $$string = $decoded;
 154             }
 155             $str_ref = $string;
 156         }
 157         elsif (is_hashref($string)) {
 158             $string->{value} = $cipher->crypt(\$item->{val});
 159             if (my $encoding = $item->{enc}) {
 160                 my $decoded = decode($encoding, $string->{value});
 161                 erase \$string->{value};
 162                 $string->{value} = $decoded;
 163             }
 164             $str_ref = \$string->{value};
 165         }
 166         else {
 167             die 'Unexpected';
 168         }
 169         if (my $filter = $item->{filter}) {
 170             my $filtered = $filter->($$str_ref);
 171             erase $str_ref;
 172             $$str_ref = $filtered;
 173         }
 174     }
 175
 176     return $self->clear;
 177 }
 178
 179
 180 sub peek {
 181     my $self = shift;
 182     my $string = shift;
 183
 184     my $item = $self->{index}{refaddr($string)} // return;
 185
 186     my $cipher = $self->cipher->dup(offset => $item->{off});
 187
 188     my $value = $cipher->crypt(\$item->{val});
 189     if (my $encoding = $item->{enc}) {
 190         my $decoded = decode($encoding, $value);
 191         erase $value;
 192         return $decoded;
 193     }
 194     return $value;
 195 }
 196
 197
 198 sub cipher {
 199     my $self = shift;
 200     $self->{cipher} //= do {
 201         require File::KDBX::Cipher;
 202         File::KDBX::Cipher->new(stream_id => STREAM_ID_CHACHA20, key => random_bytes(64));
 203     };
 204 }
 205
 206 1;
 207
 208 __END__
 209
 210 =pod
 211
 212 =encoding UTF-8
 213
 214 =head1 NAME
 215
 216 File::KDBX::Safe - Keep strings encrypted while in memory
 217
 218 =head1 VERSION
 219
 220 version 0.906
 221
 222 =head1 SYNOPSIS
 223
 224     use File::KDBX::Safe;
 225
 226     $safe = File::KDBX::Safe->new;
 227
 228     my $msg = 'Secret text';
 229     $safe->add(\$msg);
 230     # $msg is now undef, the original message no longer in RAM
 231
 232     my $obj = { value => 'Also secret' };
 233     $safe->add($obj);
 234     # $obj is now { value => undef }
 235
 236     say $safe->peek($msg);  # Secret text
 237
 238     $safe->unlock;
 239     say $msg;               # Secret text
 240     say $obj->{value};      # Also secret
 241
 242 =head1 DESCRIPTION
 243
 244 This module provides memory protection functionality. It keeps strings encrypted in memory and decrypts them
 245 as-needed. Encryption and decryption is done using a L<File::KDBX::Cipher::Stream>.
 246
 247 A safe can protect one or more (possibly many) strings. When a string is added to a safe, it gets added to an
 248 internal list so it will be decrypted when the entire safe is unlocked.
 249
 250 =head1 ATTRIBUTES
 251
 252 =head2 cipher
 253
 254     $cipher = $safe->cipher;
 255
 256 Get the L<File::KDBX::Cipher::Stream> protecting a safe.
 257
 258 =head1 METHODS
 259
 260 =head2 new
 261
 262     $safe = File::KDBX::Safe->new(%attributes);
 263     $safe = File::KDBX::Safe->new(\@strings, %attributes);
 264
 265 Create a new safe for storing secret strings encrypted in memory.
 266
 267 If a cipher is passed, its stream will be reset.
 268
 269 =head2 clear
 270
 271     $safe = $safe->clear;
 272
 273 Clear a safe, removing all store contents permanently. Returns itself to allow method chaining.
 274
 275 =head2 lock
 276
 277 =head2 add
 278
 279     $safe = $safe->lock(@strings);
 280     $safe = $safe->lock(\@strings);
 281
 282 Add one or more strings to the memory protection stream. Returns itself to allow method chaining.
 283
 284 =head2 lock_protected
 285
 286 =head2 add_protected
 287
 288     $safe = $safe->lock_protected(@strings);
 289     $safe = $safe->lock_protected(\@strings);
 290
 291 Add strings that are already encrypted. Returns itself to allow method chaining.
 292
 293 B<WARNING:> The cipher must be the same as was used to originally encrypt the strings. You must add
 294 already-encrypted strings in the order in which they were original encrypted or they will not decrypt
 295 correctly. You almost certainly do not want to add both unprotected and protected strings to a safe.
 296
 297 =head2 unlock
 298
 299     $safe = $safe->unlock;
 300
 301 Decrypt all the strings. Each stored string is set to its original value, potentially overwriting any value
 302 that might have been set after locking the string (so you probably should avoid modification to strings while
 303 locked). The safe is implicitly cleared. Returns itself to allow method chaining.
 304
 305 This happens automatically when the safe is garbage-collected.
 306
 307 =head2 peek
 308
 309     $string_value = $safe->peek($string);
 310     ...
 311     erase $string_value;
 312
 313 Peek into the safe at a particular string without decrypting the whole safe. A copy of the string is returned,
 314 and in order to ensure integrity of the memory protection you should erase the copy when you're done.
 315
 316 Returns C<undef> if the given C<$string> is not in memory protection.
 317
 318 =head1 BUGS
 319
 320 Please report any bugs or feature requests on the bugtracker website
 321 L<https://github.com/chazmcgarvey/File-KDBX/issues>
 322
 323 When submitting a bug or request, please include a test-file or a
 324 patch to an existing test-file that illustrates the bug or desired
 325 feature.
 326
 327 =head1 AUTHOR
 328
 329 Charles McGarvey <ccm@cpan.org>
 330
 331 =head1 COPYRIGHT AND LICENSE
 332
 333 This software is copyright (c) 2022 by Charles McGarvey.
 334
 335 This is free software; you can redistribute it and/or modify it under
 336 the same terms as the Perl 5 programming language system itself.
 337
 338 =cut