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

   1 package File::KDBX::IO::Crypt;
   2 # ABSTRACT: Encrypter/decrypter IO handle
   3
   4 use warnings;
   5 use strict;
   6
   7 use Errno;
   8 use File::KDBX::Error;
   9 use File::KDBX::Util qw(:empty);
  10 use namespace::clean;
  11
  12 use parent 'File::KDBX::IO';
  13
  14 our $VERSION = '999.999'; # VERSION
  15 our $BUFFER_SIZE = 16384;
  16 our $ERROR;
  17
  18 =method new
  19
  20     $fh = File::KDBX::IO::Crypt->new(%attributes);
  21     $fh = File::KDBX::IO::Crypt->new($fh, %attributes);
  22
  23 Construct a new crypto IO handle.
  24
  25 =cut
  26
  27 sub new {
  28     my $class = shift;
  29     my %args = @_ % 2 == 1 ? (fh => shift, @_) : @_;
  30     my $self = $class->SUPER::new;
  31     $self->_fh($args{fh}) or throw 'IO handle required';
  32     $self->cipher($args{cipher}) or throw 'Cipher required';
  33     return $self;
  34 }
  35
  36 =attr cipher
  37
  38 A L<File::KDBX::Cipher> instance to do the actual encryption or decryption.
  39
  40 =cut
  41
  42 my %ATTRS = (
  43     cipher  => undef,
  44 );
  45 while (my ($attr, $default) = each %ATTRS) {
  46     no strict 'refs'; ## no critic (ProhibitNoStrict)
  47     *$attr = sub {
  48         my $self = shift;
  49         *$self->{$attr} = shift if @_;
  50         *$self->{$attr} //= (ref $default eq 'CODE') ? $default->($self) : $default;
  51     };
  52 }
  53
  54 sub _FILL {
  55     my ($self, $fh) = @_;
  56
  57     $ENV{DEBUG_STREAM} and print STDERR "FILL\t$self\n";
  58     my $cipher = $self->cipher or return;
  59
  60     $fh->read(my $buf = '', $BUFFER_SIZE);
  61     if (0 < length($buf)) {
  62         my $plaintext = eval { $cipher->decrypt($buf) };
  63         if (my $err = $@) {
  64             $self->_set_error($err);
  65             return;
  66         }
  67         return $plaintext if 0 < length($plaintext);
  68     }
  69
  70     # finish
  71     my $plaintext = eval { $cipher->finish };
  72     if (my $err = $@) {
  73         $self->_set_error($err);
  74         return;
  75     }
  76     $self->cipher(undef);
  77     return $plaintext;
  78 }
  79
  80 sub _WRITE {
  81     my ($self, $buf, $fh) = @_;
  82
  83     $ENV{DEBUG_STREAM} and print STDERR "WRITE\t$self\n";
  84     my $cipher = $self->cipher or return 0;
  85
  86     my $new_data = eval { $cipher->encrypt($buf) } || '';
  87     if (my $err = $@) {
  88         $self->_set_error($err);
  89         return 0;
  90     }
  91     $self->_buffer_out_add($new_data) if nonempty $new_data;
  92     return length($buf);
  93 }
  94
  95 sub _POPPED {
  96     my ($self, $fh) = @_;
  97
  98     $ENV{DEBUG_STREAM} and print STDERR "POPPED\t$self\n";
  99     return if $self->_mode ne 'w';
 100     my $cipher = $self->cipher or return;
 101
 102     my $new_data = eval { $cipher->finish } || '';
 103     if (my $err = $@) {
 104         $self->_set_error($err);
 105         return;
 106     }
 107     $self->_buffer_out_add($new_data) if nonempty $new_data;
 108
 109     $self->cipher(undef);
 110     $self->_FLUSH($fh);
 111 }
 112
 113 sub _FLUSH {
 114     my ($self, $fh) = @_;
 115
 116     $ENV{DEBUG_STREAM} and print STDERR "FLUSH\t$self\n";
 117     return if $self->_mode ne 'w';
 118
 119     my $buffer = $self->_buffer_out;
 120     while (@$buffer) {
 121         my $read = shift @$buffer;
 122         next if empty $read;
 123         $fh->print($read) or return -1;
 124     }
 125     return 0;
 126 }
 127
 128 sub _set_error {
 129     my $self = shift;
 130     $ENV{DEBUG_STREAM} and print STDERR "err\t$self\n";
 131     if (exists &Errno::EPROTO) {
 132         $! = &Errno::EPROTO;
 133     }
 134     elsif (exists &Errno::EIO) {
 135         $! = &Errno::EIO;
 136     }
 137     $self->cipher(undef);
 138     $self->_error($ERROR = File::KDBX::Error->new(@_));
 139 }
 140
 141 1;
 142 __END__
 143
 144 =head1 SYNOPSIS
 145
 146     use File::KDBX::IO::Crypt;
 147     use File::KDBX::Cipher;
 148
 149     my $cipher = File::KDBX::Cipher->new(...);
 150
 151     open(my $out_fh, '>:raw', 'ciphertext.bin');
 152     $out_fh = File::KDBX::IO::Crypt->new($out_fh, cipher => $cipher);
 153
 154     print $out_fh $plaintext;
 155
 156     close($out_fh);
 157
 158     open(my $in_fh, '<:raw', 'ciphertext.bin');
 159     $in_fh = File::KDBX::IO::Crypt->new($in_fh, cipher => $cipher);
 160
 161     my $plaintext = do { local $/; <$in_fh> );
 162
 163     close($in_fh);
 164
 165 =cut