From b0afc7004220cc502ea07ab8d2555b8fcd2a11d5 Mon Sep 17 00:00:00 2001 From: Charles McGarvey Date: Mon, 18 Apr 2022 18:24:20 -0600 Subject: [PATCH] Add better IO support for possible fopen modes --- lib/File/KDBX/Util.pm | 16 +++++++++++++++- lib/PerlIO/via/File/KDBX/Compression.pm | 23 ++++++++++++----------- lib/PerlIO/via/File/KDBX/Crypt.pm | 19 ++++++++----------- lib/PerlIO/via/File/KDBX/HashBlock.pm | 10 +++++----- lib/PerlIO/via/File/KDBX/HmacBlock.pm | 10 +++++----- 5 files changed, 45 insertions(+), 33 deletions(-) diff --git a/lib/File/KDBX/Util.pm b/lib/File/KDBX/Util.pm index 4b4c2c7..7d51a21 100644 --- a/lib/File/KDBX/Util.pm +++ b/lib/File/KDBX/Util.pm @@ -26,7 +26,7 @@ our %EXPORT_TAGS = ( empty => [qw(empty nonempty)], erase => [qw(erase erase_scoped)], gzip => [qw(gzip gunzip)], - io => [qw(read_all)], + io => [qw(is_readable is_writable read_all)], load => [qw(load_optional load_xs try_load_optional)], search => [qw(query search simple_expression_query)], text => [qw(snakify trim)], @@ -424,6 +424,20 @@ sub gzip { return $out; } +=func is_readable + +=func is_writable + + $bool = is_readable($mode); + $bool = is_writable($mode); + +Determine of an C-style mode is readable, writable or both. + +=cut + +sub is_readable { $_[0] !~ /^[aw]b?$/ } +sub is_writable { $_[0] !~ /^rb?$/ } + =func is_uuid $bool = is_uuid($thing); diff --git a/lib/PerlIO/via/File/KDBX/Compression.pm b/lib/PerlIO/via/File/KDBX/Compression.pm index a1fd120..6e6bff5 100644 --- a/lib/PerlIO/via/File/KDBX/Compression.pm +++ b/lib/PerlIO/via/File/KDBX/Compression.pm @@ -6,7 +6,7 @@ use strict; use Errno; use File::KDBX::Error; -use File::KDBX::Util qw(load_optional); +use File::KDBX::Util qw(:io load_optional); use IO::Handle; use namespace::clean; @@ -49,14 +49,13 @@ sub push { sub PUSHED { my ($class, $mode) = @_; - $ENV{DEBUG_STREAM} and print STDERR "PUSHED\t$class\n"; - my $buf = ''; + $ENV{DEBUG_STREAM} and print STDERR "PUSHED\t$class (mode: $mode)\n"; my $self = bless { - buffer => \$buf, + buffer => \(my $buf = ''), mode => $mode, - $mode =~ /^r/ ? (inflator => _inflator(@PUSHED_ARGS)) : (), - $mode =~ /^w/ ? (deflator => _deflator(@PUSHED_ARGS)) : (), + is_readable($mode) ? (inflator => _inflator(@PUSHED_ARGS)) : (), + is_writable($mode) ? (deflator => _deflator(@PUSHED_ARGS)) : (), }, $class; @PUSHED_ARGS = (); return $self; @@ -79,6 +78,7 @@ sub FILL { } delete $self->{inflator}; + delete $self->{deflator}; return undef; } @@ -86,7 +86,7 @@ sub WRITE { my ($self, $buf, $fh) = @_; $ENV{DEBUG_STREAM} and print STDERR "WRITE\t$self\n"; - return 0 if $self->EOF($fh); + return 0 if $self->EOF($fh) || !$self->deflator; my $status = $self->deflator->deflate($buf, my $out); $status == Compress::Raw::Zlib::Z_OK() or do { @@ -102,10 +102,11 @@ sub POPPED { my ($self, $fh) = @_; $ENV{DEBUG_STREAM} and print STDERR "POPPED\t$self\n"; - return if $self->EOF($fh) || $self->mode !~ /^w/; + return if $self->EOF($fh) || !is_writable($self->mode); # finish my $status = $self->deflator->flush(my $out, Compress::Raw::Zlib::Z_FINISH()); + delete $self->{inflator}; delete $self->{deflator}; $status == Compress::Raw::Zlib::Z_OK() or do { $self->_set_error("Failed to compress: $status", status => $status); @@ -128,11 +129,11 @@ sub FLUSH { return 0; } -sub EOF { +sub EOF { $ENV{DEBUG_STREAM} and print STDERR "EOF\t$_[0]\n"; - (!$_[0]->inflator && !$_[0]->deflator) || $_[0]->ERROR($_[1]); + !($_[0]->{inflator} || $_[0]->{deflator}) || $_[0]->ERROR($_[1]); } -sub ERROR { +sub ERROR { $ENV{DEBUG_STREAM} and print STDERR "ERROR\t$_[0] : ", $_[0]->{error} // 'ok', "\n"; $ERROR = $_[0]->{error} if $_[0]->{error}; $_[0]->{error} ? 1 : 0; diff --git a/lib/PerlIO/via/File/KDBX/Crypt.pm b/lib/PerlIO/via/File/KDBX/Crypt.pm index 4e1231e..cb354c1 100644 --- a/lib/PerlIO/via/File/KDBX/Crypt.pm +++ b/lib/PerlIO/via/File/KDBX/Crypt.pm @@ -4,7 +4,9 @@ package PerlIO::via::File::KDBX::Crypt; use warnings; use strict; +use Errno; use File::KDBX::Error; +use File::KDBX::Util qw(:io); use IO::Handle; use namespace::clean; @@ -45,12 +47,11 @@ sub push { sub PUSHED { my ($class, $mode) = @_; - $ENV{DEBUG_STREAM} and print STDERR "PUSHED\t$class\n"; + $ENV{DEBUG_STREAM} and print STDERR "PUSHED\t$class (mode: $mode)\n"; %PUSHED_ARGS or throw 'Programmer error: Use PerlIO::via::File::KDBX::Crypt->push instead of binmode'; - my $buf = ''; my $self = bless { - buffer => \$buf, + buffer => \(my $buf = ''), cipher => $PUSHED_ARGS{cipher}, mode => $mode, }, $class; @@ -102,7 +103,7 @@ sub POPPED { my ($self, $fh) = @_; $ENV{DEBUG_STREAM} and print STDERR "POPPED\t$self\n"; - return if $self->EOF($fh) || $self->mode !~ /^w/; + return if $self->EOF($fh) || !is_writable($self->mode); ${$self->buffer} .= eval { $self->cipher->finish } || ''; if (my $err = $@) { @@ -126,15 +127,11 @@ sub FLUSH { return 0; } -# sub EOF { !$_[0]->cipher || $_[0]->ERROR($_[1]) } -# sub ERROR { $_[0]->{error} ? 1 : 0 } -# sub CLEARERR { delete $_[0]->{error}; 0 } - -sub EOF { +sub EOF { $ENV{DEBUG_STREAM} and print STDERR "EOF\t$_[0]\n"; - !$_[0]->cipher || $_[0]->ERROR($_[1]); + !$_[0]->{cipher} || $_[0]->ERROR($_[1]); } -sub ERROR { +sub ERROR { $ENV{DEBUG_STREAM} and print STDERR "ERROR\t$_[0] : ", $_[0]->{error} // 'ok', "\n"; $_[0]->{error} ? 1 : 0; } diff --git a/lib/PerlIO/via/File/KDBX/HashBlock.pm b/lib/PerlIO/via/File/KDBX/HashBlock.pm index ce1b935..e4a772b 100644 --- a/lib/PerlIO/via/File/KDBX/HashBlock.pm +++ b/lib/PerlIO/via/File/KDBX/HashBlock.pm @@ -5,6 +5,7 @@ use warnings; use strict; use Crypt::Digest qw(digest_data); +use Errno; use File::KDBX::Error; use File::KDBX::Util qw(:io); use IO::Handle; @@ -46,13 +47,12 @@ sub push { sub PUSHED { my ($class, $mode) = @_; - $ENV{DEBUG_STREAM} and print STDERR "PUSHED\t$class\n"; - my $buf = ''; + $ENV{DEBUG_STREAM} and print STDERR "PUSHED\t$class (mode: $mode)\n"; my $self = bless { algorithm => $PUSHED_ARGS{algorithm} || $ALGORITHM, block_index => 0, block_size => $PUSHED_ARGS{block_size} || $BLOCK_SIZE, - buffer => \$buf, + buffer => \(my $buf = ''), eof => 0, mode => $mode, }, $class; @@ -120,11 +120,11 @@ sub FLUSH { return 0; } -sub EOF { +sub EOF { $ENV{DEBUG_STREAM} and print STDERR "EOF\t$_[0]\n"; $_[0]->{eof} || $_[0]->ERROR($_[1]); } -sub ERROR { +sub ERROR { $ENV{DEBUG_STREAM} and print STDERR "ERROR\t$_[0] : ", $_[0]->{error} // 'ok', "\n"; $ERROR = $_[0]->{error} if $_[0]->{error}; $_[0]->{error} ? 1 : 0; diff --git a/lib/PerlIO/via/File/KDBX/HmacBlock.pm b/lib/PerlIO/via/File/KDBX/HmacBlock.pm index ba54d60..5655aa1 100644 --- a/lib/PerlIO/via/File/KDBX/HmacBlock.pm +++ b/lib/PerlIO/via/File/KDBX/HmacBlock.pm @@ -6,6 +6,7 @@ use strict; use Crypt::Digest qw(digest_data); use Crypt::Mac::HMAC qw(hmac); +use Errno; use File::KDBX::Error; use File::KDBX::Util qw(:io assert_64bit); use namespace::clean; @@ -54,12 +55,11 @@ sub PUSHED { %PUSHED_ARGS or throw 'Programmer error: Use PerlIO::via::File::KDBX::HmacBlock->push instead of binmode'; - $ENV{DEBUG_STREAM} and print STDERR "PUSHED\t$class\n"; - my $buf = ''; + $ENV{DEBUG_STREAM} and print STDERR "PUSHED\t$class (mode: $mode)\n"; my $self = bless { block_index => 0, block_size => $PUSHED_ARGS{block_size} || $BLOCK_SIZE, - buffer => \$buf, + buffer => \(my $buf = ''), key => $PUSHED_ARGS{key}, mode => $mode, }, $class; @@ -131,11 +131,11 @@ sub FLUSH { return 0; } -sub EOF { +sub EOF { $ENV{DEBUG_STREAM} and print STDERR "EOF\t$_[0]\n"; $_[0]->{eof} || $_[0]->ERROR($_[1]); } -sub ERROR { +sub ERROR { $ENV{DEBUG_STREAM} and print STDERR "ERROR\t$_[0] : ", $_[0]->{error} // 'ok', "\n"; $ERROR = $_[0]->{error} if $_[0]->{error}; $_[0]->{error} ? 1 : 0; -- 2.43.0