From: Charles McGarvey Date: Sun, 24 Apr 2022 01:03:30 +0000 (-0600) Subject: Add function for creating class attributes X-Git-Tag: v0.800~18 X-Git-Url: https://git.brokenzipper.com/gitweb?a=commitdiff_plain;h=37b09e0f2832514b33de4499a83f22d5ffe7c0a3;p=chaz%2Fp5-File-KDBX Add function for creating class attributes --- diff --git a/lib/File/KDBX.pm b/lib/File/KDBX.pm index 2326b9b..a0f815e 100644 --- a/lib/File/KDBX.pm +++ b/lib/File/KDBX.pm @@ -9,7 +9,7 @@ use Devel::GlobalDestruction; use File::KDBX::Constants qw(:all); use File::KDBX::Error; use File::KDBX::Safe; -use File::KDBX::Util qw(:empty :uuid :search erase simple_expression_query snakify); +use File::KDBX::Util qw(:class :coercion :empty :uuid :search erase simple_expression_query snakify); use Hash::Util::FieldHash qw(fieldhashes); use List::Util qw(any); use Ref::Util qw(is_ref is_arrayref is_plain_hashref); @@ -224,105 +224,85 @@ sub user_agent_string { } my %ATTRS = ( - sig1 => KDBX_SIG1, - sig2 => KDBX_SIG2_2, - version => KDBX_VERSION_3_1, - headers => sub { +{} }, - inner_headers => sub { +{} }, - meta => sub { +{} }, - binaries => sub { +{} }, - deleted_objects => sub { +{} }, - raw => undef, + sig1 => [KDBX_SIG1, coerce => \&to_number], + sig2 => [KDBX_SIG2_2, coerce => \&to_number], + version => [KDBX_VERSION_3_1, coerce => \&to_number], + headers => [{}], + inner_headers => [{}], + meta => [{}], + binaries => [{}], + deleted_objects => [{}], + raw => [undef, coerce => \&to_string], ); my %ATTRS_HEADERS = ( - HEADER_COMMENT() => '', - HEADER_CIPHER_ID() => CIPHER_UUID_CHACHA20, - HEADER_COMPRESSION_FLAGS() => COMPRESSION_GZIP, - HEADER_MASTER_SEED() => sub { random_bytes(32) }, + HEADER_COMMENT() => ['', coerce => \&to_string], + HEADER_CIPHER_ID() => [CIPHER_UUID_CHACHA20, coerce => \&to_uuid], + HEADER_COMPRESSION_FLAGS() => [COMPRESSION_GZIP, coerce => sub { compression($_[0]) }], + HEADER_MASTER_SEED() => [sub { random_bytes(32) }, coerce => \&to_string], # HEADER_TRANSFORM_SEED() => sub { random_bytes(32) }, # HEADER_TRANSFORM_ROUNDS() => 100_000, - HEADER_ENCRYPTION_IV() => sub { random_bytes(16) }, + HEADER_ENCRYPTION_IV() => [sub { random_bytes(16) }, coerce => \&to_string], # HEADER_INNER_RANDOM_STREAM_KEY() => sub { random_bytes(32) }, # 64? - HEADER_STREAM_START_BYTES() => sub { random_bytes(32) }, + HEADER_STREAM_START_BYTES() => [sub { random_bytes(32) }, coerce => \&to_string], # HEADER_INNER_RANDOM_STREAM_ID() => STREAM_ID_CHACHA20, - HEADER_KDF_PARAMETERS() => sub { + HEADER_KDF_PARAMETERS() => [sub { +{ KDF_PARAM_UUID() => KDF_UUID_AES, KDF_PARAM_AES_ROUNDS() => $_[0]->headers->{+HEADER_TRANSFORM_ROUNDS} // KDF_DEFAULT_AES_ROUNDS, KDF_PARAM_AES_SEED() => $_[0]->headers->{+HEADER_TRANSFORM_SEED} // random_bytes(32), }; - }, + }], # HEADER_PUBLIC_CUSTOM_DATA() => sub { +{} }, ); my %ATTRS_META = ( - generator => '', - header_hash => '', - database_name => '', - database_name_changed => sub { scalar gmtime }, - database_description => '', - database_description_changed => sub { scalar gmtime }, - default_username => '', - default_username_changed => sub { scalar gmtime }, - maintenance_history_days => 0, - color => '', - master_key_changed => sub { scalar gmtime }, - master_key_change_rec => -1, - master_key_change_force => -1, - # memory_protection => sub { +{} }, - custom_icons => sub { +{} }, - recycle_bin_enabled => true, - recycle_bin_uuid => "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0", - recycle_bin_changed => sub { scalar gmtime }, - entry_templates_group => "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0", - entry_templates_group_changed => sub { scalar gmtime }, - last_selected_group => "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0", - last_top_visible_group => "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0", - history_max_items => HISTORY_DEFAULT_MAX_ITEMS, - history_max_size => HISTORY_DEFAULT_MAX_SIZE, - settings_changed => sub { scalar gmtime }, - # binaries => sub { +{} }, - # custom_data => sub { +{} }, + generator => ['', coerce => \&to_string], + header_hash => ['', coerce => \&to_string], + database_name => ['', coerce => \&to_string], + database_name_changed => [sub { gmtime }, coerce => \&to_time], + database_description => ['', coerce => \&to_string], + database_description_changed => [sub { gmtime }, coerce => \&to_time], + default_username => ['', coerce => \&to_string], + default_username_changed => [sub { gmtime }, coerce => \&to_time], + maintenance_history_days => [0, coerce => \&to_number], + color => ['', coerce => \&to_string], + master_key_changed => [sub { gmtime }, coerce => \&to_time], + master_key_change_rec => [-1, coerce => \&to_number], + master_key_change_force => [-1, coerce => \&to_number], + # memory_protection => {}, + custom_icons => [{}], + recycle_bin_enabled => [true, coerce => \&to_bool], + recycle_bin_uuid => ["\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0", coerce => \&to_uuid], + recycle_bin_changed => [sub { gmtime }, coerce => \&to_time], + entry_templates_group => ["\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0", coerce => \&to_uuid], + entry_templates_group_changed => [sub { gmtime }, coerce => \&to_time], + last_selected_group => ["\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0", coerce => \&to_uuid], + last_top_visible_group => ["\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0", coerce => \&to_uuid], + history_max_items => [HISTORY_DEFAULT_MAX_ITEMS, coerce => \&to_number], + history_max_size => [HISTORY_DEFAULT_MAX_SIZE, coerce => \&to_number], + settings_changed => [sub { gmtime }, coerce => \&to_time], + # binaries => {}, + # custom_data => {}, ); my %ATTRS_MEMORY_PROTECTION = ( - protect_title => false, - protect_username => false, - protect_password => true, - protect_url => false, - protect_notes => false, + protect_title => [false, coerce => \&to_bool], + protect_username => [false, coerce => \&to_bool], + protect_password => [true, coerce => \&to_bool], + protect_url => [false, coerce => \&to_bool], + protect_notes => [false, coerce => \&to_bool], # auto_enable_visual_hiding => false, ); while (my ($attr, $default) = each %ATTRS) { - no strict 'refs'; ## no critic (ProhibitNoStrict) - *{$attr} = sub { - my $self = shift; - $self->{$attr} = shift if @_; - $self->{$attr} //= (ref $default eq 'CODE') ? $default->($self) : $default; - }; + has $attr => @$default; } while (my ($attr, $default) = each %ATTRS_HEADERS) { - no strict 'refs'; ## no critic (ProhibitNoStrict) - *{$attr} = sub { - my $self = shift; - $self->headers->{$attr} = shift if @_; - $self->headers->{$attr} //= (ref $default eq 'CODE') ? $default->($self) : $default; - }; + has $attr => @$default, store => 'headers'; } while (my ($attr, $default) = each %ATTRS_META) { - no strict 'refs'; ## no critic (ProhibitNoStrict) - *{$attr} = sub { - my $self = shift; - $self->meta->{$attr} = shift if @_; - $self->meta->{$attr} //= (ref $default eq 'CODE') ? $default->($self) : $default; - }; + has $attr => @$default, store => 'meta'; } while (my ($attr, $default) = each %ATTRS_MEMORY_PROTECTION) { - no strict 'refs'; ## no critic (ProhibitNoStrict) - *{$attr} = sub { - my $self = shift; - $self->meta->{$attr} = shift if @_; - $self->meta->{$attr} //= (ref $default eq 'CODE') ? $default->($self) : $default; - }; + has $attr => @$default, store => 'memory_protection'; } my @ATTRS_OTHER = ( @@ -330,6 +310,7 @@ my @ATTRS_OTHER = ( HEADER_TRANSFORM_ROUNDS, HEADER_INNER_RANDOM_STREAM_KEY, HEADER_INNER_RANDOM_STREAM_ID, + HEADER_PUBLIC_CUSTOM_DATA, ); sub _set_default_attributes { my $self = shift; @@ -907,7 +888,7 @@ ways. Public custom data: =for :list * can store strings, booleans and up to 64-bit integer values (custom data can only store text values) * is NOT encrypted within a KDBX file (hence the "public" part of the name) -* is a flat hash/dict of key-value pairs (no other associated fields like modification times) +* is a plain hash/dict of key-value pairs with no other associated fields (like modification times) =cut diff --git a/lib/File/KDBX/Cipher.pm b/lib/File/KDBX/Cipher.pm index 5dbde84..655f8fb 100644 --- a/lib/File/KDBX/Cipher.pm +++ b/lib/File/KDBX/Cipher.pm @@ -7,7 +7,7 @@ use strict; use Devel::GlobalDestruction; use File::KDBX::Constants qw(:cipher :random_stream); use File::KDBX::Error; -use File::KDBX::Util qw(erase format_uuid); +use File::KDBX::Util qw(:class erase format_uuid); use Module::Load; use Scalar::Util qw(looks_like_number); use namespace::clean; @@ -16,6 +16,63 @@ our $VERSION = '999.999'; # VERSION my %CIPHERS; +=attr uuid + + $uuid = $cipher->uuid; + +Get the UUID if the cipher was constructed with one. + +=attr stream_id + + $stream_id = $cipher->stream_id; + +Get the stream ID if the cipher was constructed with one. + +=attr key + + $key = $cipher->key; + +Get the raw encryption key. + +=attr iv + + $iv = $cipher->iv; + +Get the initialization vector. + +=attr iv_size + + $size = $cipher->iv_size; + +Get the expected size of the initialization vector, in bytes. + +=attr key_size + + $size = $cipher->key_size; + +Get the size the mode or stream expects the key to be, in bytes. + +=attr block_size + + $size = $cipher->block_size; + +Get the block size, in bytes. + +=attr algorithm + +Get the symmetric cipher algorithm. + +=cut + +has 'uuid', is => 'ro'; +has 'stream_id', is => 'ro'; +has 'key', is => 'ro'; +has 'iv', is => 'ro'; +sub iv_size { 0 } +sub key_size { -1 } +sub block_size { 0 } +sub algorithm { $_[0]->{algorithm} or throw 'Block cipher algorithm is not set' } + =method new =method new_from_uuid @@ -93,76 +150,6 @@ sub init { $_[0] } sub DESTROY { !in_global_destruction and erase \$_[0]->{key} } -=attr uuid - - $uuid = $cipher->uuid; - -Get the UUID if the cipher was constructed with one. - -=cut - -sub uuid { $_[0]->{uuid} } - -=attr stream_id - - $stream_id = $cipher->stream_id; - -Get the stream ID if the cipher was constructed with one. - -=cut - -sub stream_id { $_[0]->{stream_id} } - -=attr key - - $key = $cipher->key; - -Get the raw encryption key. - -=cut - -sub key { $_[0]->{key} } - -=attr iv - - $iv = $cipher->iv; - -Get the initialization vector. - -=cut - -sub iv { $_[0]->{iv} } - -=attr iv_size - - $size = $cipher->iv_size; - -Get the expected size of the initialization vector, in bytes. - -=cut - -sub iv_size { 0 } - -=attr key_size - - $size = $cipher->key_size; - -Get the size the mode or stream expects the key to be, in bytes. - -=cut - -sub key_size { -1 } - -=attr block_size - - $size = $cipher->block_size; - -Get the block size, in bytes. - -=cut - -sub block_size { 0 } - =method encrypt $ciphertext = $cipher->encrypt($plaintext, ...); @@ -171,7 +158,7 @@ Encrypt some data. =cut -sub encrypt { die "Not implemented" } +sub encrypt { die 'Not implemented' } =method decrypt @@ -181,7 +168,7 @@ Decrypt some data. =cut -sub decrypt { die "Not implemented" } +sub decrypt { die 'Not implemented' } =method finish @@ -295,12 +282,12 @@ __END__ my $cipher = File::KDBX::Cipher->new(uuid => $uuid, key => $key, iv => $iv); - my $ciphertext = $cipher->encrypt('data'); - $ciphertext .= $cipher->encrypt('more data'); + my $ciphertext = $cipher->encrypt('plaintext'); + $ciphertext .= $cipher->encrypt('more plaintext'); $ciphertext .= $cipher->finish; - my $plaintext = $cipher->decrypt('data'); - $plaintext .= $cipher->decrypt('more data'); + my $plaintext = $cipher->decrypt('ciphertext'); + $plaintext .= $cipher->decrypt('more ciphertext'); $plaintext .= $cipher->finish; =head1 DESCRIPTION diff --git a/lib/File/KDBX/Cipher/CBC.pm b/lib/File/KDBX/Cipher/CBC.pm index 8336af4..467b935 100644 --- a/lib/File/KDBX/Cipher/CBC.pm +++ b/lib/File/KDBX/Cipher/CBC.pm @@ -6,12 +6,17 @@ use strict; use Crypt::Mode::CBC; use File::KDBX::Error; +use File::KDBX::Util qw(:class); use namespace::clean; -use parent 'File::KDBX::Cipher'; +extends 'File::KDBX::Cipher'; our $VERSION = '999.999'; # VERSION +has key_size => 32; +sub iv_size { 16 } +sub block_size { 16 } + sub encrypt { my $self = shift; @@ -44,17 +49,6 @@ sub finish { return $out; } -=attr algorithm - -Get the symmetric cipher algorithm. - -=cut - -sub algorithm { $_[0]->{algorithm} or throw 'Block cipher algorithm is not set' } -sub key_size { $_[0]->{key_size} // 32 } -sub iv_size { 16 } -sub block_size { 16 } - 1; __END__ diff --git a/lib/File/KDBX/Cipher/Stream.pm b/lib/File/KDBX/Cipher/Stream.pm index e904c0f..367619a 100644 --- a/lib/File/KDBX/Cipher/Stream.pm +++ b/lib/File/KDBX/Cipher/Stream.pm @@ -7,14 +7,35 @@ use strict; use Crypt::Digest qw(digest_data); use File::KDBX::Constants qw(:cipher :random_stream); use File::KDBX::Error; +use File::KDBX::Util qw(:class); use Scalar::Util qw(blessed); use Module::Load; use namespace::clean; -use parent 'File::KDBX::Cipher'; +extends 'File::KDBX::Cipher'; our $VERSION = '999.999'; # VERSION +=attr counter + + $counter = $cipher->counter; + +Get the initial counter / block count into the keystream. + +=attr offset + + $offset = $cipher->offset; + +Get the initial byte offset into the keystream. This has precedence over L if both are set. + +=cut + +has 'counter', is => 'ro', default => 0; +has 'offset', is => 'ro'; +sub key_size { { Salsa20 => 32, ChaCha => 32 }->{$_[0]->{algorithm} || ''} // 0 } +sub iv_size { { Salsa20 => 8, ChaCha => 12 }->{$_[0]->{algorithm} || ''} // -1 } +sub block_size { 1 } + sub init { my $self = shift; my %args = @_; @@ -109,7 +130,7 @@ sub _stream { if (my $err = $@) { throw 'Failed to initialize stream cipher library', error => $err, - algorithm => $self->algorithm, + algorithm => $self->{algorithm}, key_length => length($self->key), iv_length => length($self->iv), iv => unpack('H*', $self->iv), @@ -124,33 +145,6 @@ sub decrypt { goto &crypt } sub finish { delete $_[0]->{stream}; '' } -=attr algorithm - - $algorithm = $cipher->algorithm; - -Get the stream cipher algorithm. Can be one of C and C. - -=attr counter - - $counter = $cipher->counter; - -Get the initial counter / block count into the keystream. - -=attr offset - - $offset = $cipher->offset; - -Get the initial byte offset into the keystream. This has precedence over L if both are set. - -=cut - -sub algorithm { $_[0]->{algorithm} or throw 'Stream cipher algorithm is not set' } -sub counter { $_[0]->{counter} // 0 } -sub offset { $_[0]->{offset} } -sub key_size { { Salsa20 => 32, ChaCha => 32 }->{$_[0]->{algorithm} || ''} // 0 } -sub iv_size { { Salsa20 => 8, ChaCha => 12 }->{$_[0]->{algorithm} || ''} // -1 } -sub block_size { 1 } - 1; __END__ diff --git a/lib/File/KDBX/Constants.pm b/lib/File/KDBX/Constants.pm index ea4e026..fe80624 100644 --- a/lib/File/KDBX/Constants.pm +++ b/lib/File/KDBX/Constants.pm @@ -274,8 +274,9 @@ BEGIN { } our %EXPORT_TAGS; -push @{$EXPORT_TAGS{header}}, 'KDBX_HEADER'; -push @{$EXPORT_TAGS{inner_header}}, 'KDBX_INNER_HEADER'; +push @{$EXPORT_TAGS{header}}, 'kdbx_header'; +push @{$EXPORT_TAGS{compression}}, 'compression'; +push @{$EXPORT_TAGS{inner_header}}, 'kdbx_inner_header'; push @{$EXPORT_TAGS{icon}}, 'icon'; $EXPORT_TAGS{all} = [map { @$_ } values %EXPORT_TAGS]; @@ -290,8 +291,13 @@ for my $header ( ) { $HEADER{$header} = $HEADER{0+$header} = $header; } -sub KDBX_HEADER { $HEADER{$_[0]} } +sub kdbx_header { $HEADER{$_[0]} } +my %COMPRESSION; +for my $compression (COMPRESSION_NONE, COMPRESSION_GZIP) { + $COMPRESSION{$compression} = $COMPRESSION{0+$compression} = $compression; +} +sub compression { $COMPRESSION{$_[0]} } my %INNER_HEADER; for my $inner_header ( @@ -300,7 +306,7 @@ for my $inner_header ( ) { $INNER_HEADER{$inner_header} = $INNER_HEADER{0+$inner_header} = $inner_header; } -sub KDBX_INNER_HEADER { $INNER_HEADER{$_[0]} } +sub kdbx_inner_header { $INNER_HEADER{$_[0]} } my %ICON; for my $icon ( @@ -399,7 +405,13 @@ Constants related to parsing and generating KDBX file headers: = C = C = C -= C + +=func kdbx_header + + $constant = kdbx_header($number); + $constant = kdbx_header($string); + +Get a header constant from an integer or string value. =head2 :compression @@ -409,6 +421,13 @@ Constants related to identifying the compression state of a file: = C = C +=func compression + + $constant = compression($number); + $constant = compression($string); + +Get a compression constant from an integer or string value. + =head2 :cipher Constants related ciphers: @@ -484,7 +503,13 @@ Constants related to parsing and generating KDBX4 inner headers: = C = C = C -= C + +=func kdbx_inner_header + + $constant = kdbx_inner_header($number); + $constant = kdbx_inner_header($string); + +Get an inner header constant from an integer or string value. =head2 :key_file @@ -579,6 +604,13 @@ Constants for default icons used by KeePass password safe implementations: = C = C +=func icon + + $constant = icon($number); + $constant = icon($string); + +Get an icon constant from an integer or string value. + =head2 :bool Boolean values: diff --git a/lib/File/KDBX/Dumper.pm b/lib/File/KDBX/Dumper.pm index 8be64be..7e2741c 100644 --- a/lib/File/KDBX/Dumper.pm +++ b/lib/File/KDBX/Dumper.pm @@ -7,6 +7,7 @@ use strict; use Crypt::Digest qw(digest_data); use File::KDBX::Constants qw(:magic :header :version :random_stream); use File::KDBX::Error; +use File::KDBX::Util qw(:class); use File::KDBX; use IO::Handle; use Module::Load; @@ -254,10 +255,6 @@ The most common reason to explicitly specify the file format is to save a databa $kdbx->dump_file('database.xml', format => 'XML'); -=cut - -sub format { $_[0]->{format} } - =attr inner_format Get the format of the data inside the KDBX envelope. This only applies to C and C formats. Possible @@ -267,23 +264,6 @@ formats: * C - Write the database groups and entries as XML (default) * C - Write L instead of the actual database contents -=cut - -sub inner_format { $_[0]->{inner_format} // 'XML' } - -=attr min_version - - $min_version = File::KDBX::Dumper->min_version; - -Get the minimum KDBX file version supported, which is 3.0 or C<0x00030000> as -it is encoded. - -To generate older KDBX files unsupported by this module, try L. - -=cut - -sub min_version { KDBX_VERSION_OLDEST } - =attr allow_upgrade $bool = $dumper->allow_upgrade; @@ -294,10 +274,6 @@ too low to support new features being used. The default is to allow upgrading. -=cut - -sub allow_upgrade { $_[0]->{allow_upgrade} // 1 } - =attr randomize_seeds $bool = $dumper->randomize_seeds; @@ -308,7 +284,23 @@ they are. =cut -sub randomize_seeds { $_[0]->{randomize_seeds} // 1 } +has 'format', is => 'ro'; +has 'inner_format', is => 'ro', default => 'XML'; +has 'allow_upgrade', is => 'ro', default => 1; +has 'randomize_seeds', is => 'ro', default => 1; + +=method min_version + + $min_version = File::KDBX::Dumper->min_version; + +Get the minimum KDBX file version supported, which is 3.0 or C<0x00030000> as +it is encoded. + +To generate older KDBX files unsupported by this module, try L. + +=cut + +sub min_version { KDBX_VERSION_OLDEST } sub _fh { $_[0]->{fh} or throw 'IO handle not set' } diff --git a/lib/File/KDBX/Dumper/KDB.pm b/lib/File/KDBX/Dumper/KDB.pm index b1d5ba7..3e4bcd7 100644 --- a/lib/File/KDBX/Dumper/KDB.pm +++ b/lib/File/KDBX/Dumper/KDB.pm @@ -9,10 +9,10 @@ use Encode qw(encode); use File::KDBX::Constants qw(:magic); use File::KDBX::Error; use File::KDBX::Loader::KDB; -use File::KDBX::Util qw(:uuid load_optional); +use File::KDBX::Util qw(:class :uuid load_optional); use namespace::clean; -use parent 'File::KDBX::Dumper'; +extends 'File::KDBX::Dumper'; our $VERSION = '999.999'; # VERSION diff --git a/lib/File/KDBX/Dumper/Raw.pm b/lib/File/KDBX/Dumper/Raw.pm index 00205c8..124a267 100644 --- a/lib/File/KDBX/Dumper/Raw.pm +++ b/lib/File/KDBX/Dumper/Raw.pm @@ -4,7 +4,9 @@ package File::KDBX::Dumper::Raw; use warnings; use strict; -use parent 'File::KDBX::Dumper'; +use File::KDBX::Util qw(:class); + +extends 'File::KDBX::Dumper'; our $VERSION = '999.999'; # VERSION diff --git a/lib/File/KDBX/Dumper/V3.pm b/lib/File/KDBX/Dumper/V3.pm index ceb9f29..b8cf01c 100644 --- a/lib/File/KDBX/Dumper/V3.pm +++ b/lib/File/KDBX/Dumper/V3.pm @@ -10,11 +10,11 @@ use File::KDBX::Constants qw(:header :compression); use File::KDBX::Error; use File::KDBX::IO::Crypt; use File::KDBX::IO::HashBlock; -use File::KDBX::Util qw(:empty :load assert_64bit erase_scoped); +use File::KDBX::Util qw(:class :empty :load assert_64bit erase_scoped); use IO::Handle; use namespace::clean; -use parent 'File::KDBX::Dumper'; +extends 'File::KDBX::Dumper'; our $VERSION = '999.999'; # VERSION @@ -59,7 +59,7 @@ sub _write_header { my $type = shift; my $val = shift // ''; - $type = KDBX_HEADER($type); + $type = kdbx_header($type); if ($type == HEADER_END) { $val = "\r\n\r\n"; } diff --git a/lib/File/KDBX/Dumper/V4.pm b/lib/File/KDBX/Dumper/V4.pm index 642f689..f2a8574 100644 --- a/lib/File/KDBX/Dumper/V4.pm +++ b/lib/File/KDBX/Dumper/V4.pm @@ -11,17 +11,17 @@ use File::KDBX::Constants qw(:header :inner_header :compression :kdf :variant_ma use File::KDBX::Error; use File::KDBX::IO::Crypt; use File::KDBX::IO::HmacBlock; -use File::KDBX::Util qw(:empty :load assert_64bit erase_scoped); +use File::KDBX::Util qw(:class :empty :load assert_64bit erase_scoped); use IO::Handle; use Scalar::Util qw(looks_like_number); use boolean qw(:all); use namespace::clean; -use parent 'File::KDBX::Dumper'; +extends 'File::KDBX::Dumper'; our $VERSION = '999.999'; # VERSION -sub _binaries_written { $_[0]->{_binaries_written} //= {} } +has _binaries_written => {}, is => 'ro'; sub _write_headers { my $self = shift; @@ -61,7 +61,7 @@ sub _write_header { my $type = shift; my $val = shift // ''; - $type = KDBX_HEADER($type); + $type = kdbx_header($type); if ($type == HEADER_END) { # nothing } @@ -289,7 +289,7 @@ sub _write_inner_header { my $buf = pack('C', $type); $fh->print($buf) or throw 'Failed to write inner header type'; - $type = KDBX_INNER_HEADER($type); + $type = kdbx_inner_header($type); if ($type == INNER_HEADER_END) { # nothing diff --git a/lib/File/KDBX/Dumper/XML.pm b/lib/File/KDBX/Dumper/XML.pm index a079aed..3a9e70b 100644 --- a/lib/File/KDBX/Dumper/XML.pm +++ b/lib/File/KDBX/Dumper/XML.pm @@ -9,15 +9,15 @@ use Crypt::Misc 0.029 qw(encode_b64); use Encode qw(encode); use File::KDBX::Constants qw(:version :time); use File::KDBX::Error; -use File::KDBX::Util qw(assert_64bit erase_scoped gzip snakify); +use File::KDBX::Util qw(:class assert_64bit erase_scoped gzip snakify); use IO::Handle; -use Scalar::Util qw(isdual looks_like_number); +use Scalar::Util qw(blessed isdual looks_like_number); use Time::Piece; use XML::LibXML; use boolean; use namespace::clean; -use parent 'File::KDBX::Dumper'; +extends 'File::KDBX::Dumper'; our $VERSION = '999.999'; # VERSION @@ -27,28 +27,12 @@ our $VERSION = '999.999'; # VERSION Get whether or not protected strings and binaries should be written in an encrypted stream. Default: C -=cut - -sub allow_protection { - my $self = shift; - $self->{allow_protection} = shift if @_; - $self->{allow_protection} //= 1; -} - =attr binaries $bool = $dumper->binaries; Get whether or not binaries within the database should be written. Default: C -=cut - -sub binaries { - my $self = shift; - $self->{binaries} = shift if @_; - $self->{binaries} //= $self->kdbx->version < KDBX_VERSION_4_0; -} - =attr compress_binaries $tristate = $dumper->compress_binaries; @@ -60,14 +44,6 @@ Get whether or not to compress binaries. Possible values: * C - Never compress binaries * C - Compress binaries if it results in smaller database sizes (default) -=cut - -sub compress_binaries { - my $self = shift; - $self->{compress_binaries} = shift if @_; - $self->{compress_binaries}; -} - =attr compress_datetimes $bool = $dumper->compress_datetimes; @@ -77,14 +53,6 @@ string format of C<1970-01-01T00:00:00Z>, but they can also be written in a comp bytes. The default is to write compressed datetimes if the KDBX file version is 4+, otherwise use the human-readable format. -=cut - -sub compress_datetimes { - my $self = shift; - $self->{compress_datetimes} = shift if @_; - $self->{compress_datetimes}; -} - =attr header_hash $octets = $dumper->header_hash; @@ -99,6 +67,11 @@ is probably never any reason to set this manually. =cut +has allow_protection => 1; +has binaries => sub { $_[0]->kdbx->version < KDBX_VERSION_4_0 }; +has 'compress_binaries'; +has 'compress_datetimes'; + sub header_hash { $_[0]->{header_hash} } sub _binaries_written { $_[0]->{_binaries_written} //= {} } @@ -592,7 +565,6 @@ sub _encode_bool { } sub _encode_datetime { - goto &_encode_datetime_binary if defined $_[2] && KDBX_VERSION_4_0 <= $_[2]; local $_ = shift; return $_->strftime('%Y-%m-%dT%H:%M:%SZ'); } diff --git a/lib/File/KDBX/Entry.pm b/lib/File/KDBX/Entry.pm index bc81d5a..fc744fd 100644 --- a/lib/File/KDBX/Entry.pm +++ b/lib/File/KDBX/Entry.pm @@ -4,12 +4,12 @@ package File::KDBX::Entry; use warnings; use strict; -use Crypt::Misc 0.029 qw(encode_b32r decode_b64); +use Crypt::Misc 0.029 qw(decode_b64 encode_b32r); use Devel::GlobalDestruction; use Encode qw(encode); use File::KDBX::Constants qw(:history :icon); use File::KDBX::Error; -use File::KDBX::Util qw(:function :uri generate_uuid load_optional); +use File::KDBX::Util qw(:class :coercion :function :uri generate_uuid load_optional); use Hash::Util::FieldHash; use List::Util qw(first sum0); use Ref::Util qw(is_coderef is_plain_hashref); @@ -19,7 +19,7 @@ use Time::Piece; use boolean; use namespace::clean; -use parent 'File::KDBX::Object'; +extends 'File::KDBX::Object'; our $VERSION = '999.999'; # VERSION @@ -175,31 +175,32 @@ sub uuid { $self->{uuid}; } -my @ATTRS = qw(uuid custom_data history); +my @ATTRS = qw(uuid custom_data history icon_id); my %ATTRS = ( # uuid => sub { generate_uuid(printable => 1) }, - icon_id => sub { defined $_[1] ? icon($_[1]) : ICON_PASSWORD }, - custom_icon_uuid => undef, - foreground_color => '', - background_color => '', - override_url => '', - tags => '', - auto_type => sub { +{} }, - previous_parent_group => undef, - quality_check => true, - strings => sub { +{} }, - binaries => sub { +{} }, - # custom_data => sub { +{} }, - # history => sub { +[] }, + # icon_id => sub { defined $_[1] ? icon($_[1]) : ICON_PASSWORD }, + custom_icon_uuid => [undef, coerce => \&to_uuid], + foreground_color => ['', coerce => \&to_string], + background_color => ['', coerce => \&to_string], + override_url => ['', coerce => \&to_string], + tags => ['', coerce => \&to_string], + auto_type => [{}], + previous_parent_group => [undef, coerce => \&to_uuid], + quality_check => [true, coerce => \&to_bool], + strings => [{}], + binaries => [{}], + times => [{}], + # custom_data => {}, + # history => [], ); my %ATTRS_TIMES = ( - last_modification_time => sub { scalar gmtime }, - creation_time => sub { scalar gmtime }, - last_access_time => sub { scalar gmtime }, - expiry_time => sub { scalar gmtime }, - expires => false, - usage_count => 0, - location_changed => sub { scalar gmtime }, + last_modification_time => [sub { gmtime }, coerce => \&to_time], + creation_time => [sub { gmtime }, coerce => \&to_time], + last_access_time => [sub { gmtime }, coerce => \&to_time], + expiry_time => [sub { gmtime }, coerce => \&to_time], + expires => [false, coerce => \&to_bool], + usage_count => [0, coerce => \&to_number], + location_changed => [sub { gmtime }, coerce => \&to_time], ); my %ATTRS_STRINGS = ( title => 'Title', @@ -209,26 +210,13 @@ my %ATTRS_STRINGS = ( notes => 'Notes', ); -while (my ($attr, $setter) = each %ATTRS) { - no strict 'refs'; ## no critic (ProhibitNoStrict) - *{$attr} = is_coderef $setter ? sub { - my $self = shift; - $self->{$attr} = $setter->($self, shift) if @_; - $self->{$attr} //= $setter->($self); - } : sub { - my $self = shift; - $self->{$attr} = shift if @_; - $self->{$attr} //= $setter; - }; +has icon_id => ICON_PASSWORD, coerce => sub { icon($_[0]) }; + +while (my ($attr, $default) = each %ATTRS) { + has $attr => @$default; } while (my ($attr, $default) = each %ATTRS_TIMES) { - no strict 'refs'; ## no critic (ProhibitNoStrict) - *{$attr} = sub { - my $self = shift; - $self->{times} //= {}; - $self->{times}{$attr} = shift if @_; - $self->{times}{$attr} //= (ref $default eq 'CODE') ? $default->($self) : $default; - }; + has $attr => @$default, store => 'times'; } while (my ($attr, $string_key) = each %ATTRS_STRINGS) { no strict 'refs'; ## no critic (ProhibitNoStrict) diff --git a/lib/File/KDBX/Error.pm b/lib/File/KDBX/Error.pm index d23837a..d12d080 100644 --- a/lib/File/KDBX/Error.pm +++ b/lib/File/KDBX/Error.pm @@ -112,34 +112,26 @@ sub details { Get the value of C when the exception was created. -=cut - -sub errno { $_[0]->{errno} } - =attr previous Get the value of C<$@> (i.e. latest exception) at the time the exception was created. - -=cut - -sub previous { $_[0]->{previous} } - =attr trace Get a stack trace indicating where in the code the exception was created. =cut -sub trace { $_[0]->{trace} // [] } - =attr type Get the exception type, if any. =cut -sub type { $_[0]->details->{type} // '' } +sub errno { $_[0]->{errno} } +sub previous { $_[0]->{previous} } +sub trace { $_[0]->{trace} // [] } +sub type { $_[0]->details->{type} // '' } =method to_string diff --git a/lib/File/KDBX/Group.pm b/lib/File/KDBX/Group.pm index d68189f..0870dd1 100644 --- a/lib/File/KDBX/Group.pm +++ b/lib/File/KDBX/Group.pm @@ -7,7 +7,7 @@ use strict; use Devel::GlobalDestruction; use File::KDBX::Constants qw(:icon); use File::KDBX::Error; -use File::KDBX::Util qw(generate_uuid); +use File::KDBX::Util qw(:class :coercion generate_uuid); use Hash::Util::FieldHash; use List::Util qw(sum0); use Ref::Util qw(is_coderef is_ref); @@ -16,59 +16,49 @@ use Time::Piece; use boolean; use namespace::clean; -use parent 'File::KDBX::Object'; +extends 'File::KDBX::Object'; our $VERSION = '999.999'; # VERSION sub _parent_container { 'groups' } -my @ATTRS = qw(uuid custom_data entries groups); +my @ATTRS = qw(uuid custom_data entries groups icon_id); my %ATTRS = ( # uuid => sub { generate_uuid(printable => 1) }, - name => '', - notes => '', - tags => '', - icon_id => sub { defined $_[1] ? icon($_[1]) : ICON_FOLDER }, - custom_icon_uuid => undef, - is_expanded => false, - default_auto_type_sequence => '', - enable_auto_type => undef, - enable_searching => undef, - last_top_visible_entry => undef, - # custom_data => sub { +{} }, - previous_parent_group => undef, - # entries => sub { +[] }, - # groups => sub { +[] }, + name => ['', coerce => \&to_string], + notes => ['', coerce => \&to_string], + tags => ['', coerce => \&to_string], + # icon_id => sub { defined $_[1] ? icon($_[1]) : ICON_FOLDER }, + custom_icon_uuid => [undef, coerce => \&to_uuid], + is_expanded => [false, coerce => \&to_bool], + default_auto_type_sequence => ['', coerce => \&to_string], + enable_auto_type => [undef, coerce => \&to_tristate], + enable_searching => [undef, coerce => \&to_tristate], + last_top_visible_entry => [undef, coerce => \&to_uuid], + # custom_data => {}, + previous_parent_group => [undef, coerce => \&to_uuid], + # entries => [], + # groups => [], + times => [{}], ); + my %ATTRS_TIMES = ( - last_modification_time => sub { scalar gmtime }, - creation_time => sub { scalar gmtime }, - last_access_time => sub { scalar gmtime }, - expiry_time => sub { scalar gmtime }, - expires => false, - usage_count => 0, - location_changed => sub { scalar gmtime }, + last_modification_time => [sub { gmtime }, coerce => \&to_time], + creation_time => [sub { gmtime }, coerce => \&to_time], + last_access_time => [sub { gmtime }, coerce => \&to_time], + expiry_time => [sub { gmtime }, coerce => \&to_time], + expires => [false, coerce => \&to_bool], + usage_count => [0, coerce => \&to_number], + location_changed => [sub { gmtime }, coerce => \&to_time], ); -while (my ($attr, $setter) = each %ATTRS) { - no strict 'refs'; ## no critic (ProhibitNoStrict) - *{$attr} = is_coderef $setter ? sub { - my $self = shift; - $self->{$attr} = $setter->($self, shift) if @_; - $self->{$attr} //= $setter->($self); - } : sub { - my $self = shift; - $self->{$attr} = shift if @_; - $self->{$attr} //= $setter; - }; +has icon_id => ICON_FOLDER, coerce => sub { icon($_[0]) }; + +while (my ($attr, $default) = each %ATTRS) { + has $attr => @$default; } while (my ($attr, $default) = each %ATTRS_TIMES) { - no strict 'refs'; ## no critic (ProhibitNoStrict) - *{$attr} = sub { - my $self = shift; - $self->{times}{$attr} = shift if @_; - $self->{times}{$attr} //= (ref $default eq 'CODE') ? $default->($self) : $default; - }; + has $attr => @$default, store => 'times'; } sub _set_default_attributes { diff --git a/lib/File/KDBX/IO.pm b/lib/File/KDBX/IO.pm index 22de9a3..4d6009d 100644 --- a/lib/File/KDBX/IO.pm +++ b/lib/File/KDBX/IO.pm @@ -6,13 +6,13 @@ use strict; use Devel::GlobalDestruction; use File::KDBX::Constants qw(:bool); -use File::KDBX::Util qw(:empty); +use File::KDBX::Util qw(:class :empty); use List::Util qw(sum0); use Ref::Util qw(is_blessed_ref is_ref is_scalarref); use Symbol qw(gensym); use namespace::clean; -use parent 'IO::Handle'; +extends 'IO::Handle'; our $VERSION = '999.999'; # VERSION diff --git a/lib/File/KDBX/IO/Crypt.pm b/lib/File/KDBX/IO/Crypt.pm index 22fe45e..4218af2 100644 --- a/lib/File/KDBX/IO/Crypt.pm +++ b/lib/File/KDBX/IO/Crypt.pm @@ -6,33 +6,15 @@ use strict; use Errno; use File::KDBX::Error; -use File::KDBX::Util qw(:empty); +use File::KDBX::Util qw(:class :empty); use namespace::clean; -use parent 'File::KDBX::IO'; +extends 'File::KDBX::IO'; our $VERSION = '999.999'; # VERSION our $BUFFER_SIZE = 16384; our $ERROR; -=method new - - $fh = File::KDBX::IO::Crypt->new(%attributes); - $fh = File::KDBX::IO::Crypt->new($fh, %attributes); - -Construct a new crypto IO handle. - -=cut - -sub new { - my $class = shift; - my %args = @_ % 2 == 1 ? (fh => shift, @_) : @_; - my $self = $class->SUPER::new; - $self->_fh($args{fh}) or throw 'IO handle required'; - $self->cipher($args{cipher}) or throw 'Cipher required'; - return $self; -} - =attr cipher A L instance to do the actual encryption or decryption. @@ -51,6 +33,24 @@ while (my ($attr, $default) = each %ATTRS) { }; } +=method new + + $fh = File::KDBX::IO::Crypt->new(%attributes); + $fh = File::KDBX::IO::Crypt->new($fh, %attributes); + +Construct a new crypto IO handle. + +=cut + +sub new { + my $class = shift; + my %args = @_ % 2 == 1 ? (fh => shift, @_) : @_; + my $self = $class->SUPER::new; + $self->_fh($args{fh}) or throw 'IO handle required'; + $self->cipher($args{cipher}) or throw 'Cipher required'; + return $self; +} + sub _FILL { my ($self, $fh) = @_; diff --git a/lib/File/KDBX/IO/HashBlock.pm b/lib/File/KDBX/IO/HashBlock.pm index adb1cc6..f4ab8b6 100644 --- a/lib/File/KDBX/IO/HashBlock.pm +++ b/lib/File/KDBX/IO/HashBlock.pm @@ -7,37 +7,17 @@ use strict; use Crypt::Digest qw(digest_data); use Errno; use File::KDBX::Error; -use File::KDBX::Util qw(:io); +use File::KDBX::Util qw(:class :io); use IO::Handle; use namespace::clean; -use parent 'File::KDBX::IO'; +extends 'File::KDBX::IO'; our $VERSION = '999.999'; # VERSION our $ALGORITHM = 'SHA256'; our $BLOCK_SIZE = 1048576; # 1MiB our $ERROR; -=method new - - $fh = File::KDBX::IO::HashBlock->new(%attributes); - $fh = File::KDBX::IO::HashBlock->new($fh, %attributes); - -Construct a new hash-block stream IO handle. - -=cut - -sub new { - my $class = shift; - my %args = @_ % 2 == 1 ? (fh => shift, @_) : @_; - my $self = $class->SUPER::new; - $self->_fh($args{fh}) or throw 'IO handle required'; - $self->algorithm($args{algorithm}); - $self->block_size($args{block_size}); - $self->_buffer; - return $self; -} - =attr algorithm Digest algorithm in hash-blocking the stream (default: C) @@ -50,7 +30,7 @@ Desired block size when writing (default: C<$File::KDBX::IO::HashBlock::BLOCK_SI my %ATTRS = ( _block_index => 0, - _buffer => \(my $buf = ''), + _buffer => sub { \(my $buf = '') }, _finished => 0, algorithm => sub { $ALGORITHM }, block_size => sub { $BLOCK_SIZE }, @@ -64,6 +44,26 @@ while (my ($attr, $default) = each %ATTRS) { }; } +=method new + + $fh = File::KDBX::IO::HashBlock->new(%attributes); + $fh = File::KDBX::IO::HashBlock->new($fh, %attributes); + +Construct a new hash-block stream IO handle. + +=cut + +sub new { + my $class = shift; + my %args = @_ % 2 == 1 ? (fh => shift, @_) : @_; + my $self = $class->SUPER::new; + $self->_fh($args{fh}) or throw 'IO handle required'; + $self->algorithm($args{algorithm}); + $self->block_size($args{block_size}); + $self->_buffer; + return $self; +} + sub _FILL { my ($self, $fh) = @_; diff --git a/lib/File/KDBX/IO/HmacBlock.pm b/lib/File/KDBX/IO/HmacBlock.pm index ac07e7e..50f054b 100644 --- a/lib/File/KDBX/IO/HmacBlock.pm +++ b/lib/File/KDBX/IO/HmacBlock.pm @@ -8,37 +8,15 @@ 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 File::KDBX::Util qw(:class :io assert_64bit); use namespace::clean; -use parent 'File::KDBX::IO'; +extends 'File::KDBX::IO'; our $VERSION = '999.999'; # VERSION our $BLOCK_SIZE = 1048576; # 1MiB our $ERROR; -=method new - - $fh = File::KDBX::IO::HmacBlock->new(%attributes); - $fh = File::KDBX::IO::HmacBlock->new($fh, %attributes); - -Construct a new HMAC-block stream IO handle. - -=cut - -sub new { - assert_64bit; - - my $class = shift; - my %args = @_ % 2 == 1 ? (fh => shift, @_) : @_; - my $self = $class->SUPER::new; - $self->_fh($args{fh}) or throw 'IO handle required'; - $self->key($args{key}) or throw 'Key required'; - $self->block_size($args{block_size}); - $self->_buffer; - return $self; -} - =attr block_size Desired block size when writing (default: C<$File::KDBX::IO::HmacBlock::BLOCK_SIZE> or 1,048,576 bytes) @@ -51,7 +29,7 @@ HMAC-SHA256 key for authenticating the data stream (required) my %ATTRS = ( _block_index => 0, - _buffer => \(my $buf = ''), + _buffer => sub { \(my $buf = '') }, _finished => 0, block_size => sub { $BLOCK_SIZE }, key => undef, @@ -65,6 +43,28 @@ while (my ($attr, $default) = each %ATTRS) { }; } +=method new + + $fh = File::KDBX::IO::HmacBlock->new(%attributes); + $fh = File::KDBX::IO::HmacBlock->new($fh, %attributes); + +Construct a new HMAC-block stream IO handle. + +=cut + +sub new { + assert_64bit; + + my $class = shift; + my %args = @_ % 2 == 1 ? (fh => shift, @_) : @_; + my $self = $class->SUPER::new; + $self->_fh($args{fh}) or throw 'IO handle required'; + $self->key($args{key}) or throw 'Key required'; + $self->block_size($args{block_size}); + $self->_buffer; + return $self; +} + sub _FILL { my ($self, $fh) = @_; diff --git a/lib/File/KDBX/KDF.pm b/lib/File/KDBX/KDF.pm index 7d29ec3..ce32945 100644 --- a/lib/File/KDBX/KDF.pm +++ b/lib/File/KDBX/KDF.pm @@ -74,7 +74,7 @@ Get the seed (or salt, depending on the function). =cut -sub seed { die "Not implemented" } +sub seed { die 'Not implemented' } =method transform @@ -103,7 +103,7 @@ sub transform { return $self->_transform($key); } -sub _transform { die "Not implemented" } +sub _transform { die 'Not implemented' } =method randomize_seed diff --git a/lib/File/KDBX/KDF/AES.pm b/lib/File/KDBX/KDF/AES.pm index 548f862..5d6177b 100644 --- a/lib/File/KDBX/KDF/AES.pm +++ b/lib/File/KDBX/KDF/AES.pm @@ -8,10 +8,10 @@ use Crypt::Cipher; use Crypt::Digest qw(digest_data); use File::KDBX::Constants qw(:bool :kdf); use File::KDBX::Error; -use File::KDBX::Util qw(:load can_fork); +use File::KDBX::Util qw(:class :load can_fork); use namespace::clean; -use parent 'File::KDBX::KDF'; +extends 'File::KDBX::KDF'; our $VERSION = '999.999'; # VERSION @@ -23,15 +23,6 @@ BEGIN { *_USE_FORK = $use_fork ? \&TRUE : \&FALSE; } -sub init { - my $self = shift; - my %args = @_; - return $self->SUPER::init( - KDF_PARAM_AES_ROUNDS() => $args{+KDF_PARAM_AES_ROUNDS} // $args{rounds}, - KDF_PARAM_AES_SEED() => $args{+KDF_PARAM_AES_SEED} // $args{seed}, - ); -} - =attr rounds $rounds = $kdf->rounds; @@ -43,6 +34,15 @@ Get the number of times to run the function during transformation. sub rounds { $_[0]->{+KDF_PARAM_AES_ROUNDS} || KDF_DEFAULT_AES_ROUNDS } sub seed { $_[0]->{+KDF_PARAM_AES_SEED} } +sub init { + my $self = shift; + my %args = @_; + return $self->SUPER::init( + KDF_PARAM_AES_ROUNDS() => $args{+KDF_PARAM_AES_ROUNDS} // $args{rounds}, + KDF_PARAM_AES_SEED() => $args{+KDF_PARAM_AES_SEED} // $args{seed}, + ); +} + sub _transform { my $self = shift; my $key = shift; diff --git a/lib/File/KDBX/KDF/Argon2.pm b/lib/File/KDBX/KDF/Argon2.pm index 6019380..dde0f2c 100644 --- a/lib/File/KDBX/KDF/Argon2.pm +++ b/lib/File/KDBX/KDF/Argon2.pm @@ -7,26 +7,13 @@ use strict; use Crypt::Argon2 qw(argon2d_raw argon2id_raw); use File::KDBX::Constants qw(:kdf); use File::KDBX::Error; +use File::KDBX::Util qw(:class); use namespace::clean; -use parent 'File::KDBX::KDF'; +extends 'File::KDBX::KDF'; our $VERSION = '999.999'; # VERSION -sub init { - my $self = shift; - my %args = @_; - return $self->SUPER::init( - KDF_PARAM_ARGON2_SALT() => $args{+KDF_PARAM_ARGON2_SALT} // $args{salt}, - KDF_PARAM_ARGON2_PARALLELISM() => $args{+KDF_PARAM_ARGON2_PARALLELISM} // $args{parallelism}, - KDF_PARAM_ARGON2_MEMORY() => $args{+KDF_PARAM_ARGON2_MEMORY} // $args{memory}, - KDF_PARAM_ARGON2_ITERATIONS() => $args{+KDF_PARAM_ARGON2_ITERATIONS} // $args{iterations}, - KDF_PARAM_ARGON2_VERSION() => $args{+KDF_PARAM_ARGON2_VERSION} // $args{version}, - KDF_PARAM_ARGON2_SECRET() => $args{+KDF_PARAM_ARGON2_SECRET} // $args{secret}, - KDF_PARAM_ARGON2_ASSOCDATA() => $args{+KDF_PARAM_ARGON2_ASSOCDATA} // $args{assocdata}, - ); -} - =attr salt =attr parallelism @@ -48,6 +35,7 @@ C, C and C are currently unused. =cut sub salt { $_[0]->{+KDF_PARAM_ARGON2_SALT} or throw 'Salt is not set' } +sub seed { $_[0]->salt } sub parallelism { $_[0]->{+KDF_PARAM_ARGON2_PARALLELISM} //= KDF_DEFAULT_ARGON2_PARALLELISM } sub memory { $_[0]->{+KDF_PARAM_ARGON2_MEMORY} //= KDF_DEFAULT_ARGON2_MEMORY } sub iterations { $_[0]->{+KDF_PARAM_ARGON2_ITERATIONS} //= KDF_DEFAULT_ARGON2_ITERATIONS } @@ -55,7 +43,19 @@ sub version { $_[0]->{+KDF_PARAM_ARGON2_VERSION} //= KDF_DEFAULT_ARGO sub secret { $_[0]->{+KDF_PARAM_ARGON2_SECRET} } sub assocdata { $_[0]->{+KDF_PARAM_ARGON2_ASSOCDATA} } -sub seed { $_[0]->salt } +sub init { + my $self = shift; + my %args = @_; + return $self->SUPER::init( + KDF_PARAM_ARGON2_SALT() => $args{+KDF_PARAM_ARGON2_SALT} // $args{salt}, + KDF_PARAM_ARGON2_PARALLELISM() => $args{+KDF_PARAM_ARGON2_PARALLELISM} // $args{parallelism}, + KDF_PARAM_ARGON2_MEMORY() => $args{+KDF_PARAM_ARGON2_MEMORY} // $args{memory}, + KDF_PARAM_ARGON2_ITERATIONS() => $args{+KDF_PARAM_ARGON2_ITERATIONS} // $args{iterations}, + KDF_PARAM_ARGON2_VERSION() => $args{+KDF_PARAM_ARGON2_VERSION} // $args{version}, + KDF_PARAM_ARGON2_SECRET() => $args{+KDF_PARAM_ARGON2_SECRET} // $args{secret}, + KDF_PARAM_ARGON2_ASSOCDATA() => $args{+KDF_PARAM_ARGON2_ASSOCDATA} // $args{assocdata}, + ); +} sub _transform { my $self = shift; diff --git a/lib/File/KDBX/Key/ChallengeResponse.pm b/lib/File/KDBX/Key/ChallengeResponse.pm index f9b2d48..2bbf368 100644 --- a/lib/File/KDBX/Key/ChallengeResponse.pm +++ b/lib/File/KDBX/Key/ChallengeResponse.pm @@ -5,9 +5,10 @@ use warnings; use strict; use File::KDBX::Error; +use File::KDBX::Util qw(:class); use namespace::clean; -use parent 'File::KDBX::Key'; +extends 'File::KDBX::Key'; our $VERSION = '999.999'; # VERSION diff --git a/lib/File/KDBX/Key/Composite.pm b/lib/File/KDBX/Key/Composite.pm index 86b803a..8878bcd 100644 --- a/lib/File/KDBX/Key/Composite.pm +++ b/lib/File/KDBX/Key/Composite.pm @@ -6,12 +6,12 @@ use strict; use Crypt::Digest qw(digest_data); use File::KDBX::Error; -use File::KDBX::Util qw(:erase); +use File::KDBX::Util qw(:class :erase); use Ref::Util qw(is_arrayref); use Scalar::Util qw(blessed); use namespace::clean; -use parent 'File::KDBX::Key'; +extends 'File::KDBX::Key'; our $VERSION = '999.999'; # VERSION diff --git a/lib/File/KDBX/Key/File.pm b/lib/File/KDBX/Key/File.pm index 5949d4c..fdf131a 100644 --- a/lib/File/KDBX/Key/File.pm +++ b/lib/File/KDBX/Key/File.pm @@ -9,16 +9,46 @@ use Crypt::Misc 0.029 qw(decode_b64 encode_b64); use Crypt::PRNG qw(random_bytes); use File::KDBX::Constants qw(:key_file); use File::KDBX::Error; -use File::KDBX::Util qw(:erase trim); +use File::KDBX::Util qw(:class :erase trim); use Ref::Util qw(is_ref is_scalarref); use Scalar::Util qw(openhandle); use XML::LibXML::Reader; use namespace::clean; -use parent 'File::KDBX::Key'; +extends 'File::KDBX::Key'; our $VERSION = '999.999'; # VERSION +=attr type + + $type = $key->type; + +Get the type of key file. Can be one of: + +=for :list +* C +* C +* C +* C + +=attr version + + $version = $key->version; + +Get the file version. Only applies to XML key files. + +=attr filepath + + $filepath = $key->filepath; + +Get the filepath to the key file, if known. + +=cut + +has 'type', is => 'ro'; +has 'version', is => 'ro'; +has 'filepath', is => 'ro'; + =method load $key = $key->load($filepath); @@ -97,42 +127,6 @@ sub reload { return $self; } -=attr type - - $type = $key->type; - -Get the type of key file. Can be one of: - -=for :list -* C -* C -* C -* C - -=cut - -sub type { $_[0]->{type} } - -=attr version - - $version = $key->version; - -Get the file version. Only applies to XML key files. - -=cut - -sub version { $_[0]->{version} } - -=attr filepath - - $filepath = $key->filepath; - -Get the filepath to the key file, if known. - -=cut - -sub filepath { $_[0]->{filepath} } - =method save $key->save; diff --git a/lib/File/KDBX/Key/Password.pm b/lib/File/KDBX/Key/Password.pm index ba46f99..032de09 100644 --- a/lib/File/KDBX/Key/Password.pm +++ b/lib/File/KDBX/Key/Password.pm @@ -7,10 +7,10 @@ use strict; use Crypt::Digest qw(digest_data); use Encode qw(encode); use File::KDBX::Error; -use File::KDBX::Util qw(erase); +use File::KDBX::Util qw(:class erase); use namespace::clean; -use parent 'File::KDBX::Key'; +extends 'File::KDBX::Key'; our $VERSION = '999.999'; # VERSION diff --git a/lib/File/KDBX/Key/YubiKey.pm b/lib/File/KDBX/Key/YubiKey.pm index 51a05aa..0e42eb0 100644 --- a/lib/File/KDBX/Key/YubiKey.pm +++ b/lib/File/KDBX/Key/YubiKey.pm @@ -6,13 +6,13 @@ use strict; use File::KDBX::Constants qw(:yubikey); use File::KDBX::Error; -use File::KDBX::Util qw(:io pad_pkcs7); +use File::KDBX::Util qw(:class :io pad_pkcs7); use IPC::Cmd 0.52 qw(run_forked); use Ref::Util qw(is_arrayref); use Symbol qw(gensym); use namespace::clean; -use parent 'File::KDBX::Key::ChallengeResponse'; +extends 'File::KDBX::Key::ChallengeResponse'; our $VERSION = '999.999'; # VERSION @@ -222,40 +222,13 @@ Get or set the L program name or filepath. Defaults to C<$ENV{YKINFO} =cut -my %ATTRS = ( - device => 0, - slot => 1, - timeout => 10, - pre_challenge => undef, - post_challenge => undef, - ykchalresp => sub { $ENV{YKCHALRESP} || 'ykchalresp' }, - ykinfo => sub { $ENV{YKINFO} || 'ykinfo' }, -); -while (my ($subname, $default) = each %ATTRS) { - no strict 'refs'; ## no critic (ProhibitNoStrict) - *{$subname} = sub { - my $self = shift; - $self->{$subname} = shift if @_; - $self->{$subname} //= (ref $default eq 'CODE') ? $default->($self) : $default; - }; -} - -my %INFO = ( - serial => undef, - version => undef, - touch_level => undef, - vendor_id => undef, - product_id => undef, -); -while (my ($subname, $default) = each %INFO) { - no strict 'refs'; ## no critic (ProhibitNoStrict) - *{$subname} = sub { - my $self = shift; - $self->{$subname} = shift if @_; - defined $self->{$subname} or $self->_set_yubikey_info; - $self->{$subname} // $default; - }; -} +has device => 0; +has slot => 1; +has timeout => 10; +has pre_challenge => undef; +has post_challenge => undef; +has ykchalresp => sub { $ENV{YKCHALRESP} || 'ykchalresp' }; +has ykinfo => sub { $ENV{YKINFO} || 'ykinfo' }; =method serial @@ -275,6 +248,14 @@ Get the "touch level" value for the device associated with this key (or C Get the vendor ID or product ID for the device associated with this key (or C). +=cut + +has serial => sub { $_[0]->_set_yubikey_info; $_[0]->{serial} }; +has version => sub { $_[0]->_set_yubikey_info; $_[0]->{version} }; +has touch_level => sub { $_[0]->_set_yubikey_info; $_[0]->{touch_level} }; +has vendor_id => sub { $_[0]->_set_yubikey_info; $_[0]->{vendor_id} }; +has product_id => sub { $_[0]->_set_yubikey_info; $_[0]->{product_id} }; + =method name $name = $key->name; diff --git a/lib/File/KDBX/Loader.pm b/lib/File/KDBX/Loader.pm index ff44832..6d289be 100644 --- a/lib/File/KDBX/Loader.pm +++ b/lib/File/KDBX/Loader.pm @@ -6,7 +6,7 @@ use strict; use File::KDBX::Constants qw(:magic :header :version); use File::KDBX::Error; -use File::KDBX::Util qw(:io); +use File::KDBX::Util qw(:class :io); use File::KDBX; use IO::Handle; use Module::Load (); @@ -223,10 +223,6 @@ Possible formats: * C * C -=cut - -sub format { $_[0]->{format} } - =attr inner_format Get the format of the data inside the KDBX envelope. This only applies to C and C formats. Possible @@ -238,9 +234,10 @@ formats: =cut -sub inner_format { $_[0]->{inner_format} // 'XML' } +has format => undef, is => 'ro'; +has inner_format => 'XML', is => 'ro'; -=attr min_version +=method min_version $min_version = File::KDBX::Loader->min_version; diff --git a/lib/File/KDBX/Loader/KDB.pm b/lib/File/KDBX/Loader/KDB.pm index 1f0cb3d..e204365 100644 --- a/lib/File/KDBX/Loader/KDB.pm +++ b/lib/File/KDBX/Loader/KDB.pm @@ -7,7 +7,7 @@ use strict; use Encode qw(encode); use File::KDBX::Constants qw(:header :cipher :random_stream :icon); use File::KDBX::Error; -use File::KDBX::Util qw(:empty :io :uuid load_optional); +use File::KDBX::Util qw(:class :empty :io :uuid load_optional); use File::KDBX; use Ref::Util qw(is_arrayref is_hashref); use Scalar::Util qw(looks_like_number); @@ -15,7 +15,7 @@ use Time::Piece; use boolean; use namespace::clean; -use parent 'File::KDBX::Loader'; +extends 'File::KDBX::Loader'; our $VERSION = '999.999'; # VERSION diff --git a/lib/File/KDBX/Loader/Raw.pm b/lib/File/KDBX/Loader/Raw.pm index 58e920d..7eeaaee 100644 --- a/lib/File/KDBX/Loader/Raw.pm +++ b/lib/File/KDBX/Loader/Raw.pm @@ -4,7 +4,9 @@ package File::KDBX::Loader::Raw; use warnings; use strict; -use parent 'File::KDBX::Loader'; +use File::KDBX::Util qw(:class); + +extends 'File::KDBX::Loader'; our $VERSION = '999.999'; # VERSION diff --git a/lib/File/KDBX/Loader/V3.pm b/lib/File/KDBX/Loader/V3.pm index 687215a..4b89fe9 100644 --- a/lib/File/KDBX/Loader/V3.pm +++ b/lib/File/KDBX/Loader/V3.pm @@ -22,10 +22,10 @@ use File::KDBX::Constants qw(:header :compression :kdf); use File::KDBX::Error; use File::KDBX::IO::Crypt; use File::KDBX::IO::HashBlock; -use File::KDBX::Util qw(:io :load assert_64bit erase_scoped); +use File::KDBX::Util qw(:class :io :load assert_64bit erase_scoped); use namespace::clean; -use parent 'File::KDBX::Loader'; +extends 'File::KDBX::Loader'; our $VERSION = '999.999'; # VERSION @@ -42,7 +42,7 @@ sub _read_header { $buf .= $val; } - $type = KDBX_HEADER($type); + $type = kdbx_header($type); if ($type == HEADER_END) { # done } diff --git a/lib/File/KDBX/Loader/V4.pm b/lib/File/KDBX/Loader/V4.pm index 2180d28..87e8826 100644 --- a/lib/File/KDBX/Loader/V4.pm +++ b/lib/File/KDBX/Loader/V4.pm @@ -22,13 +22,13 @@ use Crypt::Mac::HMAC qw(hmac); use Encode qw(decode); use File::KDBX::Constants qw(:header :inner_header :variant_map :compression); use File::KDBX::Error; -use File::KDBX::Util qw(:io :load assert_64bit erase_scoped); +use File::KDBX::Util qw(:class :io :load assert_64bit erase_scoped); use File::KDBX::IO::Crypt; use File::KDBX::IO::HmacBlock; use boolean; use namespace::clean; -use parent 'File::KDBX::Loader'; +extends 'File::KDBX::Loader'; our $VERSION = '999.999'; # VERSION @@ -45,7 +45,7 @@ sub _read_header { $buf .= $val; } - $type = KDBX_HEADER($type); + $type = kdbx_header($type); if ($type == HEADER_END) { # done } @@ -236,7 +236,7 @@ sub _read_inner_header { read_all $fh, $val, $size or throw 'Expected inner header value', type => $type, size => $size; } - my $dualtype = KDBX_INNER_HEADER($type); + my $dualtype = kdbx_inner_header($type); if (!defined $dualtype) { alert "Ignoring unknown inner header type ($type)", type => $type, size => $size, value => $val; diff --git a/lib/File/KDBX/Loader/XML.pm b/lib/File/KDBX/Loader/XML.pm index 806b261..a607405 100644 --- a/lib/File/KDBX/Loader/XML.pm +++ b/lib/File/KDBX/Loader/XML.pm @@ -9,22 +9,19 @@ use Encode qw(decode); use File::KDBX::Constants qw(:version :time); use File::KDBX::Error; use File::KDBX::Safe; -use File::KDBX::Util qw(:text assert_64bit gunzip erase_scoped); +use File::KDBX::Util qw(:class :text assert_64bit gunzip erase_scoped); use Scalar::Util qw(looks_like_number); use Time::Piece; use XML::LibXML::Reader; use boolean; use namespace::clean; -use parent 'File::KDBX::Loader'; +extends 'File::KDBX::Loader'; our $VERSION = '999.999'; # VERSION -sub _reader { $_[0]->{_reader} } - -sub _binaries { $_[0]->{binaries} //= {} } - -sub _safe { $_[0]->{safe} //= File::KDBX::Safe->new(cipher => $_[0]->kdbx->random_stream) } +has '_reader', is => 'ro'; +has '_safe', is => 'ro', default => sub { File::KDBX::Safe->new(cipher => $_[0]->kdbx->random_stream) }; sub _read { my $self = shift; @@ -39,7 +36,7 @@ sub _read_inner_body { my $reader = $self->{_reader} = XML::LibXML::Reader->new(IO => $fh); - delete $self->{safe}; + delete $self->{_safe}; my $root_done; my $pattern = XML::LibXML::Pattern->new('/KeePassFile/Meta|/KeePassFile/Root'); @@ -63,7 +60,7 @@ sub _read_inner_body { throw 'Failed to parse KeePass XML'; } - $self->kdbx->_safe($self->_safe) if $self->{safe}; + $self->kdbx->_safe($self->_safe) if $self->{_safe}; $self->_resolve_binary_refs; } diff --git a/lib/File/KDBX/Object.pm b/lib/File/KDBX/Object.pm index afede78..0d53dd9 100644 --- a/lib/File/KDBX/Object.pm +++ b/lib/File/KDBX/Object.pm @@ -721,7 +721,7 @@ object or an object not part of the object tree of a database can be added to a * L * L -It is possible to copy or move objects between databases, but you B include the same object in more +It is possible to copy or move objects between databases, but B include the same object in more than one database at once or there could some strange aliasing effects (i.e. changes in one database might effect another in unexpected ways). This could lead to difficult-to-debug problems. It is similarly not safe or valid to add the same object multiple times to the same database. For example: diff --git a/lib/File/KDBX/Transaction.pm b/lib/File/KDBX/Transaction.pm index 0ed48b2..218494d 100644 --- a/lib/File/KDBX/Transaction.pm +++ b/lib/File/KDBX/Transaction.pm @@ -5,6 +5,7 @@ use warnings; use strict; use Devel::GlobalDestruction; +use File::KDBX::Util qw(:class); use namespace::clean; our $VERSION = '999.999'; # VERSION @@ -32,7 +33,7 @@ Get the object being transacted on. =cut -sub object { $_[0]->{object} } +has 'object', is => 'ro'; =method commit diff --git a/lib/File/KDBX/Util.pm b/lib/File/KDBX/Util.pm index 3355d41..9fe9a9e 100644 --- a/lib/File/KDBX/Util.pm +++ b/lib/File/KDBX/Util.pm @@ -12,14 +12,18 @@ use File::KDBX::Error; use List::Util 1.33 qw(any all); use Module::Load; use Ref::Util qw(is_arrayref is_coderef is_hashref is_ref is_refref is_scalarref); -use Scalar::Util qw(blessed readonly); +use Scalar::Util qw(blessed looks_like_number readonly); +use Time::Piece; +use boolean; use namespace::clean -except => 'import'; our $VERSION = '999.999'; # VERSION our %EXPORT_TAGS = ( assert => [qw(assert_64bit)], + class => [qw(extends has)], clone => [qw(clone clone_nomagic)], + coercion => [qw(to_bool to_number to_string to_time to_tristate to_uuid)], crypt => [qw(pad_pkcs7)], debug => [qw(dumper)], fork => [qw(can_fork)], @@ -359,6 +363,89 @@ sub erase_scoped { return Scope::Guard->new(sub { erase(@args) }); } +=func extends + + extends $class; + +Set up the current module to inheret from another module. + +=cut + +sub extends { + my $parent = shift; + my $caller = caller; + load $parent; + no strict 'refs'; ## no critic (ProhibitNoStrict) + @{"${caller}::ISA"} = $parent; +} + +=func has + + has $name => %options; + +Create an attribute getter/setter. Possible options: + +=for :list +* C - Either "rw" (default) or "ro" +* C - Default value +* C - Coercive function + +=cut + +sub has { + my $name = shift; + my %args = @_ % 2 == 1 ? (default => shift, @_) : @_; + + my $d = $args{default}; + my $default = is_arrayref($d) ? sub { [%$d] } : is_hashref($d) ? sub { +{%$d} } : $d; + my $coerce = $args{coerce}; + my $is = $args{is} || 'rw'; + + my $has_default = is_coderef $default; + my $has_coerce = is_coderef $coerce; + + my $caller = caller; + no strict 'refs'; ## no critic (ProhibitNoStrict) + if (my $store = $args{store}) { + *{"${caller}::${name}"} = $is eq 'ro' && $has_default ? sub { + $_[0]->$store->{$name} //= scalar $default->($_[0]); + } : $is eq 'ro' ? sub { + $_[0]->$store->{$name} //= $default; + } : $has_default && $has_coerce ? sub { + $#_ ? $_[0]->$store->{$name} = scalar $coerce->($_[1]) + : $_[0]->$store->{$name} //= scalar $default->($_[0]); + } : $has_default ? sub { + $#_ ? $_[0]->$store->{$name} = $_[1] + : $_[0]->$store->{$name} //= scalar $default->($_[0]); + } : $has_coerce ? sub { + $#_ ? $_[0]->$store->{$name} = scalar $coerce->($_[1]) + : $_[0]->$store->{$name} //= $default; + } : sub { + $#_ ? $_[0]->$store->{$name} = $_[1] + : $_[0]->$store->{$name} //= $default; + }; + } + else { + *{"${caller}::${name}"} = $is eq 'ro' && $has_default ? sub { + $_[0]->{$name} //= scalar $default->($_[0]); + } : $is eq 'ro' ? sub { + $_[0]->{$name} //= $default; + } : $has_default && $has_coerce ? sub { + $#_ ? $_[0]->{$name} = scalar $coerce->($_[1]) + : $_[0]->{$name} //= scalar $default->($_[0]); + } : $has_default ? sub { + $#_ ? $_[0]->{$name} = $_[1] + : $_[0]->{$name} //= scalar $default->($_[0]); + } : $has_coerce ? sub { + $#_ ? $_[0]->{$name} = scalar $coerce->($_[1]) + : $_[0]->{$name} //= $default; + } : sub { + $#_ ? $_[0]->{$name} = $_[1] + : ($_[0]->{$name} //= $default); + }; + } +} + =func format_uuid $string_uuid = format_uuid($raw_uuid); @@ -637,6 +724,10 @@ sub search { return \@match; } +=for Pod::Coverage search_limited + +=cut + sub search_limited { my $list = shift; my $query = shift; @@ -764,6 +855,39 @@ sub split_url { return ($scheme, $auth, $host, $port, $path, $query, $hash, $username, $password); } +=func to_bool + +=func to_number + +=func to_string + +=func to_time + +=func to_tristate + +=func to_uuid + +Various typecasting / coercive functions. + +=cut + +sub to_bool { $_[0] // return; boolean($_[0]) } +sub to_number { $_[0] // return; 0+$_[0] } +sub to_string { $_[0] // return; "$_[0]" } +sub to_time { + $_[0] // return; + return gmtime($_[0]) if looks_like_number($_[0]); + return Time::Piece->strptime($_[0], '%Y-%m-%d %H:%M:%S') if !blessed $_[0]; + return $_[0]; +} +sub to_tristate { $_[0] // return; boolean($_[0]) } +sub to_uuid { + my $str = to_string(@_) // return; + return sprintf('%016s', $str) if length($str) < 16; + return substr($str, 0, 16) if 16 < length($str); + return $str; +} + =func trim $string = trim($string);