From b4e8407685b3f9ce0193aedf05f6651ed588a448 Mon Sep 17 00:00:00 2001 From: Charles McGarvey Date: Wed, 20 Apr 2022 10:22:28 -0600 Subject: [PATCH] use functions moved to File::KDBX::XS module --- lib/File/KDBX/Constants.pm | 13 +++++++++++++ lib/File/KDBX/Entry.pm | 28 +++++++++++++-------------- lib/File/KDBX/IO.pm | 3 ++- lib/File/KDBX/KDF/AES.pm | 19 +++++++++---------- lib/File/KDBX/Util.pm | 39 ++++++++++++++------------------------ t/erase.t | 2 +- t/kdf-aes-pp.t | 2 +- 7 files changed, 54 insertions(+), 52 deletions(-) diff --git a/lib/File/KDBX/Constants.pm b/lib/File/KDBX/Constants.pm index be17f76..51e7e4c 100644 --- a/lib/File/KDBX/Constants.pm +++ b/lib/File/KDBX/Constants.pm @@ -201,6 +201,10 @@ BEGIN { CERTIFICATE => dualvar( 67, 'Certificate'), SMARTPHONE => dualvar( 68, 'Smartphone'), }, + bool => { + FALSE => !1, + TRUE => 1, + }, time => { __prefix => 'TIME', SECONDS_AD1_TO_UNIX_EPOCH => 62_135_596_800, @@ -324,6 +328,7 @@ This module provides importable constants related to KDBX. Constants can be impo * L * L * L +* L * L * L * C<:all> - All of the above @@ -555,6 +560,14 @@ Constants for default icons used by KeePass password safe implementations: = C = C +=head2 :bool + +Boolean values: + +=for :list += C += C + =head2 :time Constants related to time: diff --git a/lib/File/KDBX/Entry.pm b/lib/File/KDBX/Entry.pm index c124b94..5e666bb 100644 --- a/lib/File/KDBX/Entry.pm +++ b/lib/File/KDBX/Entry.pm @@ -132,7 +132,7 @@ Boolean value indicating whether or not an entry is expired. =attr usage_count -The number of times an entry has been used, which typically means how many times the C string has +The number of times an entry has been used, which typically means how many times the B string has been accessed. =attr location_changed @@ -141,23 +141,23 @@ Date and time when the entry was last moved to a different group. =attr notes -Alias for the C string value. +Alias for the B string value. =attr password -Alias for the C string value. +Alias for the B string value. =attr title -Alias for the C string value. +Alias for the B<Title> string value. =attr url -Alias for the C<URL> string value. +Alias for the B<URL> string value. =attr username -Aliases for the C<UserName> string value. +Aliases for the B<UserName> string value. =cut @@ -831,11 +831,11 @@ called "files" or "attachments"). Every string and binary has a key or name. The that every entry has: =for :list -* C<Title> -* C<UserName> -* C<Password> -* C<URL> -* C<Notes> +* B<Title> +* B<UserName> +* B<Password> +* B<URL> +* B<Notes> Beyond this, you can store any number of other strings and any number of binaries that you can use for whatever purpose you want. @@ -849,7 +849,7 @@ the attributes to see what's available. Entry string and auto-type key sequences can have placeholders or template tags that can be replaced by other values. Placeholders can appear like C<{PLACEHOLDER}>. For example, a B<URL> string might have a value of C<http://example.com?user={USERNAME}>. C<{USERNAME}> is a placeholder for the value of the B<UserName> string -of the same entry. If the C<UserName> string had a value of "batman", the B<URL> string would expand to +of the same entry. If the B<UserName> string had a value of "batman", the B<URL> string would expand to C<http://example.com?user=batman>. Some placeholders take an argument, where the argument follows the tag after a colon but before the closing @@ -962,7 +962,7 @@ C<{NUMPAD4}>, C<{NUMPAD5}>, C<{NUMPAD6}>, C<{NUMPAD7}>, C<{NUMPAD8}>, C<{NUMPAD9 * ☒ C<{CLIPBOARD}> * ☒ C<{CMD:/CommandLine/Options/}> * ☑ C<{C:Comment}> - Comments are simply replaced by nothing -* ☑ C<{ENV:} and C<%ENV%> - Environment variables +* ☑ C<{ENV:}> and C<%ENV%> - Environment variables * ☒ C<{GROUP_SEL_NOTES}> * ☒ C<{GROUP_SEL_PATH}> * ☒ C<{GROUP_SEL}> @@ -996,7 +996,7 @@ strings or auto-complete key sequences. If the name of the placeholder ends in a colon, then it is expected to receive an argument. During expansion, everything after the colon and before the end of the placeholder is passed to your placeholder handler -subroutine. So if the placeholder is C<{MY_PLACEHOLDER:whatever}>, C<$arg> will have the value C<whatever>. +subroutine. So if the placeholder is C<{MY_PLACEHOLDER:whatever}>, C<$arg> will have the value B<whatever>. An argument is required for placeholders than take one. I.e. The placeholder handler won't be called if there is no argument. If you want a placeholder to support an optional argument, you'll need to set the placeholder diff --git a/lib/File/KDBX/IO.pm b/lib/File/KDBX/IO.pm index 48c8e19..22de9a3 100644 --- a/lib/File/KDBX/IO.pm +++ b/lib/File/KDBX/IO.pm @@ -5,7 +5,8 @@ use warnings; use strict; use Devel::GlobalDestruction; -use File::KDBX::Util qw(:empty :bool); +use File::KDBX::Constants qw(:bool); +use File::KDBX::Util qw(:empty); use List::Util qw(sum0); use Ref::Util qw(is_blessed_ref is_ref is_scalarref); use Symbol qw(gensym); diff --git a/lib/File/KDBX/KDF/AES.pm b/lib/File/KDBX/KDF/AES.pm index fd954f8..161c086 100644 --- a/lib/File/KDBX/KDF/AES.pm +++ b/lib/File/KDBX/KDF/AES.pm @@ -6,7 +6,7 @@ use strict; use Crypt::Cipher; use Crypt::Digest qw(digest_data); -use File::KDBX::Constants qw(:kdf); +use File::KDBX::Constants qw(:bool :kdf); use File::KDBX::Error; use File::KDBX::Util qw(:load can_fork); use namespace::clean; @@ -19,11 +19,8 @@ our $VERSION = '999.999'; # VERSION my $FORK_OPTIMIZATION_THRESHOLD = 100_000; BEGIN { - load_xs; - - my $use_fork = 1; - $use_fork = 0 if $ENV{NO_FORK} || !can_fork; - *_USE_FORK = $use_fork ? sub() { 1 } : sub() { 0 }; + my $use_fork = $ENV{NO_FORK} || !can_fork ? FALSE : TRUE; + *_USE_FORK = sub() { $use_fork }; } sub init { @@ -87,10 +84,7 @@ sub _transform { return digest_data('SHA256', $l, $r); } -sub _transform_half { - my $xs = __PACKAGE__->can('_transform_half_xs'); - goto $xs if $xs; - +sub _transform_half_pp { my $seed = shift; my $key = shift; my $rounds = shift; @@ -105,6 +99,11 @@ sub _transform_half { return $result; } +BEGIN { + my $use_xs = load_xs; + *_transform_half = $use_xs ? \&File::KDBX::XS::kdf_aes_transform_half : \&_transform_half_pp; +} + 1; __END__ diff --git a/lib/File/KDBX/Util.pm b/lib/File/KDBX/Util.pm index 87d87d6..630b181 100644 --- a/lib/File/KDBX/Util.pm +++ b/lib/File/KDBX/Util.pm @@ -7,6 +7,7 @@ use strict; use Crypt::PRNG qw(random_bytes random_string); use Encode qw(decode encode); use Exporter qw(import); +use File::KDBX::Constants qw(:bool); use File::KDBX::Error; use List::Util 1.33 qw(any all); use Module::Load; @@ -18,7 +19,6 @@ our $VERSION = '999.999'; # VERSION our %EXPORT_TAGS = ( assert => [qw(assert_64bit)], - bool => [qw(FALSE TRUE)], clone => [qw(clone clone_nomagic)], crypt => [qw(pad_pkcs7)], debug => [qw(dumper)], @@ -82,17 +82,6 @@ my %OP_NEG = ( '!~' => '=~', ); -=func FALSE - -=func TRUE - -Constants appropriate for use as return values in functions claiming to return true or false. - -=cut - -sub FALSE() { !1 } -sub TRUE() { 1 } - =func load_xs $bool = load_xs(); @@ -103,23 +92,23 @@ that at least the given version is loaded. =cut +my $XS_LOADED; sub load_xs { my $version = shift; - goto IS_LOADED if File::KDBX->can('_XS_LOADED'); + goto IS_LOADED if defined $XS_LOADED; - my $try_xs = 1; - $try_xs = 0 if $ENV{PERL_ONLY} || (exists $ENV{PERL_FILE_KDBX_XS} && !$ENV{PERL_FILE_KDBX_XS}); - - my $use_xs = 0; - $use_xs = eval { require File::KDBX::XS; 1 } if $try_xs; + if ($ENV{PERL_ONLY} || (exists $ENV{PERL_FILE_KDBX_XS} && !$ENV{PERL_FILE_KDBX_XS})) { + return $XS_LOADED = FALSE; + } - *File::KDBX::_XS_LOADED = *File::KDBX::_XS_LOADED = $use_xs ? \&TRUE : \&FALSE; + $XS_LOADED = !!eval { require File::KDBX::XS; 1 }; IS_LOADED: { local $@; - return $version ? !!eval { File::KDBX::XS->VERSION($version); 1 } : File::KDBX::_XS_LOADED(); + return $XS_LOADED if !$version; + return !!eval { File::KDBX::XS->VERSION($version); 1 }; } } @@ -286,13 +275,13 @@ Overwrite the memory used by one or more string. BEGIN { if (load_xs) { - # loaded CowREFCNT + *_CowREFCNT = \&File::KDBX::XS::CowREFCNT; } elsif (eval { require B::COW; 1 }) { - *CowREFCNT = \*B::COW::cowrefcnt; + *_CowREFCNT = \&B::COW::cowrefcnt; } else { - *CowREFCNT = sub { undef }; + *_CowREFCNT = sub { undef }; } } @@ -303,7 +292,7 @@ sub erase { for (@_) { if (!is_ref($_)) { next if !defined $_ || readonly $_; - my $cowrefcnt = CowREFCNT($_); + my $cowrefcnt = _CowREFCNT($_); goto FREE_NONREF if defined $cowrefcnt && 1 < $cowrefcnt; # if (__PACKAGE__->can('erase_xs')) { # erase_xs($_); @@ -318,7 +307,7 @@ sub erase { } elsif (is_scalarref($_)) { next if !defined $$_ || readonly $$_; - my $cowrefcnt = CowREFCNT($$_); + my $cowrefcnt = _CowREFCNT($$_); goto FREE_REF if defined $cowrefcnt && 1 < $cowrefcnt; # if (__PACKAGE__->can('erase_xs')) { # erase_xs($$_); diff --git a/t/erase.t b/t/erase.t index 3730fcd..46454ae 100644 --- a/t/erase.t +++ b/t/erase.t @@ -6,7 +6,7 @@ use strict; use lib 't/lib'; use TestCommon; -use File::KDBX::Util qw(erase erase_scoped); +use File::KDBX::Util qw(:erase); use Test::More; my $data1 = 'hello'; diff --git a/t/kdf-aes-pp.t b/t/kdf-aes-pp.t index 9ebdb39..55bfc82 100644 --- a/t/kdf-aes-pp.t +++ b/t/kdf-aes-pp.t @@ -15,7 +15,7 @@ use Test::More; my $kdf = File::KDBX::KDF->new(uuid => KDF_UUID_AES, seed => "\1" x 32, rounds => 10); -ok !File::KDBX::_XS_LOADED(), 'XS can be avoided'; +ok !File::KDBX::XS->can('kdf_aes_transform_half'), 'XS can be avoided'; my $r = $kdf->transform("\2" x 32); is $r, "\342\234cp\375\\p\253]\213\f\246\345\230\266\260\r\222j\332Z\204:\322 p\224mhm\360\222", -- 2.45.2