view release on metacpan or  search on metacpan

lib/File/KeePass/KDBX.pm  view on Meta::CPAN

package File::KeePass::KDBX;
# ABSTRACT: Read and write KDBX files (using the File::KDBX backend)

use utf8;
use warnings;
use strict;

use Crypt::PRNG qw(irand);
use Crypt::Misc 0.029 qw(decode_b64 encode_b64);
use File::KDBX 0.900;
use File::KDBX::Constants qw(:header :magic :version);
use File::KDBX::Loader::KDB;
use File::KDBX::Util qw(clone_nomagic generate_uuid load_optional);
use Hash::Util::FieldHash qw(fieldhashes);
use Module::Load;
use Scalar::Util qw(blessed looks_like_number weaken);
use boolean;
use namespace::clean;

our $VERSION = '0.902'; # VERSION

fieldhashes \my (%KDBX, %TIED);

BEGIN {
    our @ISA;
    @ISA = qw(File::KeePass) if $INC{'File/KeePass.pm'};
}


sub new {
    my $class = shift;

    # copy constructor
    return $_[0]->clone if @_ == 1 && (blessed $_[0] // '') eq __PACKAGE__;

    if (@_ == 1 && blessed $_[0] && $_[0]->isa('File::KeePass')) {
        return $class->from_fkp(@_);
    }

    if (@_ == 1 && blessed $_[0] && $_[0]->isa('File::KDBX')) {
        my $self = bless {}, $class;
        $self->kdbx($_[0]);
        return $self;
    }

    my $args = ref $_[0] ? {%{$_[0]}} : {@_};
    my $self = bless $args, $class;
    exists $args->{kdbx} and $self->kdbx(delete $args->{kdbx});
    return $self;
}

sub DESTROY { $_[0]->clear }


sub clone {
    my $self = shift;
    require Storable;
    return Storable::dclone($self);
}

sub STORABLE_freeze {
    my $self = shift;
    my $copy = {%$self};
    delete @$self{qw(header groups)};
    return '', $copy, $KDBX{$self};
}

sub STORABLE_thaw {
    my $self    = shift;
    my $cloning = shift;
    shift;  # empty
    my $copy    = shift;
    my $kdbx    = shift;

    @$self{keys %$copy} = values %$copy;
    $self->kdbx($kdbx) if $kdbx;

lib/File/KeePass/KDBX.pm  view on Meta::CPAN

    return $uniq->{$id} ||= do {
        if (length($id) != 16) {
            $id = substr($self->encode_base64($id), 0, 16) if $id !~ /^\d+$/ || $id > 2**32-1;
            $id = sprintf '%016s', $id if $id ne '0';
        }
        $id = $self->gen_uuid while $uniq->{$id}++;
        $id;
    };
}

##############################################################################


sub auto_lock {
    my $self = shift;
    $self->{auto_lock} = shift if @_;
    $self->{auto_lock} //= 1;
}


sub is_locked { $_[0]->kdbx->is_locked }


sub lock { $_[0]->kdbx->lock }


sub unlock { $_[0]->kdbx->unlock }


sub locked_entry_password {
    my $self = shift;
    my $entry = shift;

    $self->is_locked or die "Passwords are not locked\n";

    $entry = $self->find_entry({id => $entry}) if !ref $entry;
    return if !$entry;

    my $entry_obj = $entry->{__object} or return;
    return $entry_obj->string_peek('Password');
}

##############################################################################

sub _tie {
    my $self    = shift;
    my $ref     = shift // \my %h;
    my $class   = shift;
    my $obj     = shift;

    my $cache = $TIED{$self} //= {};

    $class = __PACKAGE__."::Tie::$class" if $class !~ s/^\+//;
    my $key = "$class:" . Hash::Util::FieldHash::id($obj);
    my $hit = $cache->{$key};
    return $hit if defined $hit;

    load $class;
    tie((ref $ref eq 'ARRAY' ? @$ref : %$ref), $class, $obj, @_, $self);
    $hit = $cache->{$key} = $ref;
    weaken $cache->{$key};
    return $hit;
}

### convert datetime from KDBX to KeePass format
sub _decode_datetime {
    local $_ = shift or return;
    return $_->strftime('%Y-%m-%d %H:%M:%S');
}

### convert datetime from KeePass to KDBX format
sub _encode_datetime {
    local $_ = shift or return;
    return Time::Piece->strptime($_, '%Y-%m-%d %H:%M:%S');
}

### convert UUID from KeePass to KDBX format
sub _encode_uuid {
    local $_ = shift // return;
    # Group IDs in KDB files are 32-bit integers
    return sprintf('%016x', $_) if length($_) != 16 && looks_like_number($_);
    return $_;
}

### convert tristate from KDBX to KeePass format
sub _decode_tristate {
    local $_ = shift // return;
    return $_ ? 1 : 0;
}

### convert tristate from KeePass to KDBX format
sub _encode_tristate {
    local $_ = shift // return;
    return boolean($_);
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

File::KeePass::KDBX - Read and write KDBX files (using the File::KDBX backend)

=head1 VERSION

version 0.902

=head1 SYNOPSIS

    use File::KeePass::KDBX;

    my $k = File::KeePass::KDBX->new($kdbx);
    # OR
    my $k = File::KeePass::KDBX->load_db($filepath, $password);

    print Dumper $k->header;