--- /dev/null
+package PerlIO::via::File::KDBX::Crypt;
+# ABSTRACT: Encrypter/decrypter PerlIO layer
+
+use warnings;
+use strict;
+
+use File::KDBX::Error;
+use IO::Handle;
+use namespace::clean;
+
+our $VERSION = '999.999'; # VERSION
+our $BUFFER_SIZE = 8192;
+our $ERROR;
+
+=method push
+
+ PerlIO::via::File::KDBX::Crypt->push($fh, cipher => $cipher);
+
+Push an encryption or decryption layer onto a filehandle. C<$cipher> must be compatible with
+L<File::KDBX::Cipher>.
+
+You mustn't push this layer using C<binmode> directly because the layer needs to be initialized with the
+required cipher object.
+
+B<WARNING:> When writing, you mustn't close the filehandle before popping this layer (using
+C<binmode($fh, ':pop')>) or the stream will be truncated. The layer needs to know when there is no more data
+before the filehandle closes so it can finish the encryption correctly, and the way to indicate that is by
+popping the layer.
+
+=cut
+
+my %PUSHED_ARGS;
+sub push {
+ %PUSHED_ARGS and throw 'Pushing Crypt layer would stomp existing arguments';
+ my $class = shift;
+ my $fh = shift;
+ my %args = @_ % 2 == 0 ? @_ : (cipher => @_);
+ $args{cipher} or throw 'Must pass a cipher';
+ $args{cipher}->finish if defined $args{finish} && !$args{finish};
+
+ %PUSHED_ARGS = %args;
+ binmode($fh, ':via(' . __PACKAGE__ . ')');
+}
+
+sub PUSHED {
+ my ($class, $mode) = @_;
+
+ $ENV{DEBUG_STREAM} and print STDERR "PUSHED\t$class\n";
+ %PUSHED_ARGS or throw 'Programmer error: Use PerlIO::via::File::KDBX::Crypt->push instead of binmode';
+
+ my $buf = '';
+ my $self = bless {
+ buffer => \$buf,
+ cipher => $PUSHED_ARGS{cipher},
+ mode => $mode,
+ }, $class;
+ %PUSHED_ARGS = ();
+ return $self;
+}
+
+sub FILL {
+ my ($self, $fh) = @_;
+
+ $ENV{DEBUG_STREAM} and print STDERR "FILL\t$self\n";
+ return if $self->EOF($fh);
+
+ $fh->read(my $buf, $BUFFER_SIZE);
+ if (0 < length($buf)) {
+ my $plaintext = eval { $self->cipher->decrypt($buf) };
+ if (my $err = $@) {
+ $self->_set_error($err);
+ return;
+ }
+ return $plaintext;
+ }
+
+ # finish
+ my $plaintext = eval { $self->cipher->finish };
+ if (my $err = $@) {
+ $self->_set_error($err);
+ return;
+ }
+ delete $self->{cipher};
+ return $plaintext;
+}
+
+sub WRITE {
+ my ($self, $buf, $fh) = @_;
+
+ $ENV{DEBUG_STREAM} and print STDERR "WRITE\t$self\n";
+ return 0 if $self->EOF($fh);
+
+ ${$self->buffer} .= eval { $self->cipher->encrypt($buf) } || '';
+ if (my $err = $@) {
+ $self->_set_error($err);
+ return 0;
+ }
+ return length($buf);
+}
+
+sub POPPED {
+ my ($self, $fh) = @_;
+
+ $ENV{DEBUG_STREAM} and print STDERR "POPPED\t$self\n";
+ return if $self->EOF($fh) || $self->mode !~ /^w/;
+
+ ${$self->buffer} .= eval { $self->cipher->finish } || '';
+ if (my $err = $@) {
+ $self->_set_error($err);
+ return;
+ }
+
+ delete $self->{cipher};
+ $self->FLUSH($fh);
+}
+
+sub FLUSH {
+ my ($self, $fh) = @_;
+
+ $ENV{DEBUG_STREAM} and print STDERR "FLUSH\t$self\n";
+ return 0 if !ref $self;
+
+ my $buf = $self->buffer;
+ print $fh $$buf or return -1 if 0 < length($$buf);
+ $$buf = '';
+ return 0;
+}
+
+# sub EOF { !$_[0]->cipher || $_[0]->ERROR($_[1]) }
+# sub ERROR { $_[0]->{error} ? 1 : 0 }
+# sub CLEARERR { delete $_[0]->{error}; 0 }
+
+sub EOF {
+ $ENV{DEBUG_STREAM} and print STDERR "EOF\t$_[0]\n";
+ !$_[0]->cipher || $_[0]->ERROR($_[1]);
+}
+sub ERROR {
+ $ENV{DEBUG_STREAM} and print STDERR "ERROR\t$_[0] : ", $_[0]->{error} // 'ok', "\n";
+ $_[0]->{error} ? 1 : 0;
+}
+sub CLEARERR {
+ $ENV{DEBUG_STREAM} and print STDERR "CLEARERR\t$_[0]\n";
+ # delete $_[0]->{error};
+}
+
+sub cipher { $_[0]->{cipher} }
+sub mode { $_[0]->{mode} }
+sub buffer { $_[0]->{buffer} }
+
+sub _set_error {
+ my $self = shift;
+ $ENV{DEBUG_STREAM} and print STDERR "err\t$self\n";
+ delete $self->{cipher};
+ if (exists &Errno::EPROTO) {
+ $! = &Errno::EPROTO;
+ }
+ elsif (exists &Errno::EIO) {
+ $! = &Errno::EIO;
+ }
+ $self->{error} = $ERROR = File::KDBX::Error->new(@_);
+}
+
+1;
+__END__
+
+=head1 SYNOPSIS
+
+ use PerlIO::via::File::KDBX::Crypt;
+ use File::KDBX::Cipher;
+
+ my $cipher = File::KDBX::Cipher->new(...);
+
+ open(my $out_fh, '>:raw', 'ciphertext.bin');
+ PerlIO::via::File::KDBX::Crypt->push($out_fh, cipher => $cipher);
+
+ print $out_fh $plaintext;
+
+ binmode($out_fh, ':pop'); # <-- This is required.
+ close($out_fh);
+
+ open(my $in_fh, '<:raw', 'ciphertext.bin');
+ PerlIO::via::File::KDBX::Crypt->push($in_fh, cipher => $cipher);
+
+ my $plaintext = do { local $/; <$in_fh> );
+
+ close($in_fh);
+
+=cut