1 package PerlIO
::via
::File
::KDBX
::Crypt
;
2 # ABSTRACT: Encrypter/decrypter PerlIO layer
9 use File
::KDBX
::Util
qw(:io);
13 our $VERSION = '999.999'; # VERSION
14 our $BUFFER_SIZE = 8192;
19 PerlIO
::via
::File
::KDBX
::Crypt-
>push($fh, cipher
=> $cipher);
21 Push an encryption
or decryption layer onto a filehandle
. C
<$cipher> must be compatible with
22 L
<File
::KDBX
::Cipher
>.
24 You mustn
't push this layer using C<binmode> directly because the layer needs to be initialized with the
25 required cipher object.
27 B<WARNING:> When writing, you mustn't
close the filehandle before popping this layer
(using
28 C
<binmode($fh, ':pop')>) or the stream will be truncated
. The layer needs to know
when there
is no more data
29 before the filehandle closes so it can finish the encryption correctly
, and the way to indicate that
is by
36 %PUSHED_ARGS and throw
'Pushing Crypt layer would stomp existing arguments';
39 my %args = @_ % 2 == 0 ? @_ : (cipher
=> @_);
40 $args{cipher
} or throw
'Must pass a cipher';
41 $args{cipher
}->finish if defined $args{finish
} && !$args{finish
};
44 binmode($fh, ':via(' . __PACKAGE__
. ')');
48 my ($class, $mode) = @_;
50 $ENV{DEBUG_STREAM
} and print STDERR
"PUSHED\t$class (mode: $mode)\n";
51 %PUSHED_ARGS or throw
'Programmer error: Use PerlIO::via::File::KDBX::Crypt->push instead of binmode';
54 buffer
=> \
(my $buf = ''),
55 cipher
=> $PUSHED_ARGS{cipher
},
65 $ENV{DEBUG_STREAM
} and print STDERR
"FILL\t$self\n";
66 return if $self->EOF($fh);
68 $fh->read(my $buf, $BUFFER_SIZE);
69 if (0 < length($buf)) {
70 my $plaintext = eval { $self->cipher->decrypt($buf) };
72 $self->_set_error($err);
79 my $plaintext = eval { $self->cipher->finish };
81 $self->_set_error($err);
84 delete $self->{cipher
};
89 my ($self, $buf, $fh) = @_;
91 $ENV{DEBUG_STREAM
} and print STDERR
"WRITE\t$self\n";
92 return 0 if $self->EOF($fh);
94 ${$self->buffer} .= eval { $self->cipher->encrypt($buf) } || '';
96 $self->_set_error($err);
103 my ($self, $fh) = @_;
105 $ENV{DEBUG_STREAM
} and print STDERR
"POPPED\t$self\n";
106 return if $self->EOF($fh) || !is_writable
($self->mode);
108 ${$self->buffer} .= eval { $self->cipher->finish } || '';
110 $self->_set_error($err);
114 delete $self->{cipher
};
119 my ($self, $fh) = @_;
121 $ENV{DEBUG_STREAM
} and print STDERR
"FLUSH\t$self\n";
122 return 0 if !ref $self;
124 my $buf = $self->buffer;
125 print $fh $$buf or return -1 if 0 < length($$buf);
131 $ENV{DEBUG_STREAM
} and print STDERR
"EOF\t$_[0]\n";
132 !$_[0]->{cipher
} || $_[0]->ERROR($_[1]);
135 $ENV{DEBUG_STREAM
} and print STDERR
"ERROR\t$_[0] : ", $_[0]->{error
} // 'ok', "\n";
136 $_[0]->{error
} ? 1 : 0;
139 $ENV{DEBUG_STREAM
} and print STDERR
"CLEARERR\t$_[0]\n";
140 # delete $_[0]->{error};
143 sub cipher
{ $_[0]->{cipher
} }
144 sub mode
{ $_[0]->{mode
} }
145 sub buffer
{ $_[0]->{buffer
} }
149 $ENV{DEBUG_STREAM
} and print STDERR
"err\t$self\n";
150 delete $self->{cipher
};
151 if (exists &Errno
::EPROTO
) {
154 elsif (exists &Errno
::EIO
) {
157 $self->{error
} = $ERROR = File
::KDBX
::Error-
>new(@_);
165 use PerlIO::via::File::KDBX::Crypt;
166 use File::KDBX::Cipher;
168 my $cipher = File::KDBX::Cipher->new(...);
170 open(my $out_fh, '>:raw', 'ciphertext.bin');
171 PerlIO::via::File::KDBX::Crypt->push($out_fh, cipher => $cipher);
173 print $out_fh $plaintext;
175 binmode($out_fh, ':pop'); # <-- This is required.
178 open(my $in_fh, '<:raw', 'ciphertext.bin');
179 PerlIO::via::File::KDBX::Crypt->push($in_fh, cipher => $cipher);
181 my $plaintext = do { local $/; <$in_fh> );