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);
}
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 = (
HEADER_TRANSFORM_ROUNDS,
HEADER_INNER_RANDOM_STREAM_KEY,
HEADER_INNER_RANDOM_STREAM_ID,
+ HEADER_PUBLIC_CUSTOM_DATA,
);
sub _set_default_attributes {
my $self = shift;
=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
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;
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
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, ...);
=cut
-sub encrypt { die "Not implemented" }
+sub encrypt { die 'Not implemented' }
=method decrypt
=cut
-sub decrypt { die "Not implemented" }
+sub decrypt { die 'Not implemented' }
=method finish
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
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;
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__
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</counter> 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 = @_;
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),
sub finish { delete $_[0]->{stream}; '' }
-=attr algorithm
-
- $algorithm = $cipher->algorithm;
-
-Get the stream cipher algorithm. Can be one of C<Salsa20> and C<ChaCha>.
-
-=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</counter> 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__
}
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];
) {
$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 (
) {
$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 (
= C<HEADER_INNER_RANDOM_STREAM_ID>
= C<HEADER_KDF_PARAMETERS>
= C<HEADER_PUBLIC_CUSTOM_DATA>
-= C<KDBX_HEADER>
+
+=func kdbx_header
+
+ $constant = kdbx_header($number);
+ $constant = kdbx_header($string);
+
+Get a header constant from an integer or string value.
=head2 :compression
= C<COMPRESSION_NONE>
= C<COMPRESSION_GZIP>
+=func compression
+
+ $constant = compression($number);
+ $constant = compression($string);
+
+Get a compression constant from an integer or string value.
+
=head2 :cipher
Constants related ciphers:
= C<INNER_HEADER_INNER_RANDOM_STREAM_KEY>
= C<INNER_HEADER_BINARY>
= C<INNER_HEADER_BINARY_FLAG_PROTECT>
-= C<KDBX_INNER_HEADER>
+
+=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
= C<ICON_CERTIFICATE>
= C<ICON_SMARTPHONE>
+=func icon
+
+ $constant = icon($number);
+ $constant = icon($string);
+
+Get an icon constant from an integer or string value.
+
=head2 :bool
Boolean values:
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;
$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<V3> and C<V4> formats. Possible
* C<XML> - Write the database groups and entries as XML (default)
* C<Raw> - Write L<File::KDBX/raw> 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<File::KeePass>.
-
-=cut
-
-sub min_version { KDBX_VERSION_OLDEST }
-
=attr allow_upgrade
$bool = $dumper->allow_upgrade;
The default is to allow upgrading.
-=cut
-
-sub allow_upgrade { $_[0]->{allow_upgrade} // 1 }
-
=attr randomize_seeds
$bool = $dumper->randomize_seeds;
=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<File::KeePass>.
+
+=cut
+
+sub min_version { KDBX_VERSION_OLDEST }
sub _fh { $_[0]->{fh} or throw 'IO handle not set' }
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
use warnings;
use strict;
-use parent 'File::KDBX::Dumper';
+use File::KDBX::Util qw(:class);
+
+extends 'File::KDBX::Dumper';
our $VERSION = '999.999'; # VERSION
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
my $type = shift;
my $val = shift // '';
- $type = KDBX_HEADER($type);
+ $type = kdbx_header($type);
if ($type == HEADER_END) {
$val = "\r\n\r\n";
}
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;
my $type = shift;
my $val = shift // '';
- $type = KDBX_HEADER($type);
+ $type = kdbx_header($type);
if ($type == HEADER_END) {
# nothing
}
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
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
Get whether or not protected strings and binaries should be written in an encrypted stream. Default: C<TRUE>
-=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<TRUE>
-=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;
* C<FALSE> - Never compress binaries
* C<undef> - 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;
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;
=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} //= {} }
}
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');
}
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);
use boolean;
use namespace::clean;
-use parent 'File::KDBX::Object';
+extends 'File::KDBX::Object';
our $VERSION = '999.999'; # VERSION
$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',
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)
Get the value of C<errno> 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
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);
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 {
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
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<File::KDBX::Cipher> instance to do the actual encryption or decryption.
};
}
+=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) = @_;
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<SHA-256>)
my %ATTRS = (
_block_index => 0,
- _buffer => \(my $buf = ''),
+ _buffer => sub { \(my $buf = '') },
_finished => 0,
algorithm => sub { $ALGORITHM },
block_size => sub { $BLOCK_SIZE },
};
}
+=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) = @_;
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)
my %ATTRS = (
_block_index => 0,
- _buffer => \(my $buf = ''),
+ _buffer => sub { \(my $buf = '') },
_finished => 0,
block_size => sub { $BLOCK_SIZE },
key => undef,
};
}
+=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) = @_;
=cut
-sub seed { die "Not implemented" }
+sub seed { die 'Not implemented' }
=method transform
return $self->_transform($key);
}
-sub _transform { die "Not implemented" }
+sub _transform { die 'Not implemented' }
=method randomize_seed
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
*_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;
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;
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
=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 }
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;
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
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
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<KEY_FILE_TYPE_BINARY>
+* C<KEY_FILE_TYPE_HEX>
+* C<KEY_FILE_TYPE_XML>
+* C<KEY_FILE_TYPE_HASHED>
+
+=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);
return $self;
}
-=attr type
-
- $type = $key->type;
-
-Get the type of key file. Can be one of:
-
-=for :list
-* C<KEY_FILE_TYPE_BINARY>
-* C<KEY_FILE_TYPE_HEX>
-* C<KEY_FILE_TYPE_XML>
-* C<KEY_FILE_TYPE_HASHED>
-
-=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;
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
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
=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
Get the vendor ID or product ID for the device associated with this key (or C<undef>).
+=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;
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 ();
* C<XML>
* C<Raw>
-=cut
-
-sub format { $_[0]->{format} }
-
=attr inner_format
Get the format of the data inside the KDBX envelope. This only applies to C<V3> and C<V4> formats. Possible
=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;
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);
use boolean;
use namespace::clean;
-use parent 'File::KDBX::Loader';
+extends 'File::KDBX::Loader';
our $VERSION = '999.999'; # VERSION
use warnings;
use strict;
-use parent 'File::KDBX::Loader';
+use File::KDBX::Util qw(:class);
+
+extends 'File::KDBX::Loader';
our $VERSION = '999.999'; # VERSION
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
$buf .= $val;
}
- $type = KDBX_HEADER($type);
+ $type = kdbx_header($type);
if ($type == HEADER_END) {
# done
}
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
$buf .= $val;
}
- $type = KDBX_HEADER($type);
+ $type = kdbx_header($type);
if ($type == HEADER_END) {
# done
}
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;
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;
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');
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;
}
* L<File::KDBX::Group/add_group>
* L<File::KDBX::Entry/add_historical_entry>
-It is possible to copy or move objects between databases, but you B<DO NOT> include the same object in more
+It is possible to copy or move objects between databases, but B<DO NOT> 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:
use strict;
use Devel::GlobalDestruction;
+use File::KDBX::Util qw(:class);
use namespace::clean;
our $VERSION = '999.999'; # VERSION
=cut
-sub object { $_[0]->{object} }
+has 'object', is => 'ro';
=method commit
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)],
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<is> - Either "rw" (default) or "ro"
+* C<default> - Default value
+* C<coerce> - 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);
return \@match;
}
+=for Pod::Coverage search_limited
+
+=cut
+
sub search_limited {
my $list = shift;
my $query = shift;
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);
projects / chaz / p5-File-KDBX / commitdiff
