File Coverage

blib/lib/File/KDBX/Safe.pm

Criterion	Covered	Total	%
statement	129	148	87.1
branch	36	56	64.2
condition	5	8	62.5
subroutine	19	21	90.4
pod	9	9	100.0
total	198	242	81.8

package File::KDBX::Safe;
# ABSTRACT: Keep strings encrypted while in memory

use warnings;
use strict;

use Crypt::PRNG qw(random_bytes);
use Devel::GlobalDestruction;
use Encode qw(encode decode);
use File::KDBX::Constants qw(:random_stream);
use File::KDBX::Error;
use File::KDBX::Util qw(erase erase_scoped);
use Ref::Util qw(is_arrayref is_coderef is_hashref is_scalarref);
use Scalar::Util qw(refaddr);
use namespace::clean;

our $VERSION = '0.904'; # VERSION


sub new {
    my $class = shift;
    my %args = @_ % 2 == 0 ? @_ : (strings => shift, @_);

    if (!$args{cipher} && $args{key}) {
        require File::KDBX::Cipher;
        $args{cipher} = File::KDBX::Cipher->new(stream_id => STREAM_ID_CHACHA20, key => $args{key});
    }

    my $self = bless \%args, $class;
    $self->cipher->finish;
    $self->{counter} = 0;

    my $strings = delete $args{strings};
    $self->{items} = [];
    $self->{index} = {};
    $self->add($strings) if $strings;

    return $self;
}

sub DESTROY { local ($., $@, $!, $^E, $?); !in_global_destruction and $_[0]->unlock }


sub clear {
    my $self = shift;
    $self->{items} = [];
    $self->{index} = {};
    $self->{counter} = 0;
    return $self;
}


sub lock { shift->add(@_) }

sub add {
    my $self    = shift;
    my @strings = map { is_arrayref($_) ? @$_ : $_ } @_;

    @strings or throw 'Must provide strings to lock';

    my $cipher = $self->cipher;

    for my $string (@strings) {
        my $item = {str => $string, off => $self->{counter}};
        if (is_scalarref($string)) {
            next if !defined $$string;
            $item->{enc} = 'UTF-8' if utf8::is_utf8($$string);
            if (my $encoding = $item->{enc}) {
                my $encoded = encode($encoding, $$string);
                $item->{val} = $cipher->crypt(\$encoded);
                erase $encoded;
            }
            else {
                $item->{val} = $cipher->crypt($string);
            }
            erase $string;
        }
        elsif (is_hashref($string)) {
            next if !defined $string->{value};
            $item->{enc} = 'UTF-8' if utf8::is_utf8($string->{value});
            if (my $encoding = $item->{enc}) {
                my $encoded = encode($encoding, $string->{value});
                $item->{val} = $cipher->crypt(\$encoded);
                erase $encoded;
            }
            else {
                $item->{val} = $cipher->crypt(\$string->{value});
            }
            erase \$string->{value};
        }
        else {
            throw 'Safe strings must be a hashref or stringref', type => ref $string;
        }
        push @{$self->{items}}, $item;
        $self->{index}{refaddr($string)} = $item;
        $self->{counter} += length($item->{val});
    }

    return $self;
}


sub lock_protected { shift->add_protected(@_) }

sub add_protected {
    my $self = shift;
    my $filter = is_coderef($_[0]) ? shift : undef;
    my @strings = map { is_arrayref($_) ? @$_ : $_ } @_;

    @strings or throw 'Must provide strings to lock';

    for my $string (@strings) {
        my $item = {str => $string, off => $self->{counter}};
        $item->{filter} = $filter if defined $filter;
        if (is_scalarref($string)) {
            next if !defined $$string;
            $item->{val} = $$string;
            erase $string;
        }
        elsif (is_hashref($string)) {
            next if !defined $string->{value};
            $item->{val} = $string->{value};
            erase \$string->{value};
        }
        else {
            throw 'Safe strings must be a hashref or stringref', type => ref $string;
        }
        push @{$self->{items}}, $item;
        $self->{index}{refaddr($string)} = $item;
        $self->{counter} += length($item->{val});
    }

    return $self;
}


sub unlock {
    my $self = shift;

    my $cipher = $self->cipher;
    $cipher->finish;
    $self->{counter} = 0;

    for my $item (@{$self->{items}}) {
        my $string  = $item->{str};
        my $cleanup = erase_scoped \$item->{val};
        my $str_ref;
        if (is_scalarref($string)) {
            $$string = $cipher->crypt(\$item->{val});
            if (my $encoding = $item->{enc}) {
                my $decoded = decode($encoding, $string->{value});
                erase $string;
                $$string = $decoded;
            }
            $str_ref = $string;
        }
        elsif (is_hashref($string)) {
            $string->{value} = $cipher->crypt(\$item->{val});
            if (my $encoding = $item->{enc}) {
                my $decoded = decode($encoding, $string->{value});
                erase \$string->{value};
                $string->{value} = $decoded;
            }
            $str_ref = \$string->{value};
        }
        else {
            die 'Unexpected';
        }
        if (my $filter = $item->{filter}) {
            my $filtered = $filter->($$str_ref);
            erase $str_ref;
            $$str_ref = $filtered;
        }
    }

    return $self->clear;
}


sub peek {
    my $self = shift;
    my $string = shift;

    my $item = $self->{index}{refaddr($string)} // return;

    my $cipher = $self->cipher->dup(offset => $item->{off});

    my $value = $cipher->crypt(\$item->{val});
    if (my $encoding = $item->{enc}) {
        my $decoded = decode($encoding, $value);
        erase $value;
        return $decoded;
    }
    return $value;
}


sub cipher {
    my $self = shift;
    $self->{cipher} //= do {
        require File::KDBX::Cipher;
        File::KDBX::Cipher->new(stream_id => STREAM_ID_CHACHA20, key => random_bytes(64));
    };
}

1;

__END__