Skip to content

Commit

Permalink
Merge c8381c7 into 6fbcc49
Browse files Browse the repository at this point in the history
  • Loading branch information
pryrt committed Nov 21, 2021
2 parents 6fbcc49 + c8381c7 commit b8e2f76
Show file tree
Hide file tree
Showing 8 changed files with 271 additions and 25 deletions.
2 changes: 2 additions & 0 deletions MANIFEST
@@ -1,6 +1,7 @@
CHANGES
examples/workflow.pl
lib/WWW/KeePassHttp.pm
lib/WWW/KeePassHttp/Entry.pm
LICENSE
Makefile.PL
MANIFEST This list of files
Expand All @@ -9,6 +10,7 @@ RELEASE.md
t/00-load.t
t/10-obj.t
t/coverage.t
t/entry.t
t/err-mocked.t
t/err.t
t/helper.t
Expand Down
18 changes: 10 additions & 8 deletions Makefile.PL
Expand Up @@ -39,6 +39,11 @@ use ExtUtils::MakeMaker;
},
},
keywords => [ 'KeePass', 'KeePassHttp'],
provides => {
# versions will be added below, when I parse VERSION_FROM
'WWW::KeePassHttp' => { file => 'lib/WWW/KeePassHttp.pm' },
'WWW::KeePassHttp::Entry' => { file => 'lib/WWW/KeePassHttp/Entry.pm' },
},
},
'LICENSE' => 'perl_5', # EUMM 6.31
'MIN_PERL_VERSION' => '5.12.0', # EUMM 6.48
Expand Down Expand Up @@ -69,14 +74,11 @@ use ExtUtils::MakeMaker;
delete $mm_args{META_MERGE};
} else {
# automatically determine the versions for 'provides'; MM->parse_version exists as of MM v6.31, so not a problem with >= 6.46
# => this comes out right when printed... but MYMETA.* shows values that look wrong
my $v = MM->parse_version( $mm_args{VERSION_FROM} );
$mm_args{META_MERGE}{provides} = {
'WWW::KeePassHttp' => {
file => 'lib/WWW/KeePassHttp.pm',
version => $v,
},
};
for my $k ( keys %{ $mm_args{META_MERGE}{provides} } )
{
$mm_args{META_MERGE}{provides}{$k}{version} = $v;
}
}

if( $ExtUtils::MakeMaker::VERSION < '6.31' ) {
Expand Down Expand Up @@ -132,7 +134,7 @@ distauthtest :: disttest
# auto-populate the VERSION in the submodules from $(VERSION), which comes from main module
populateversion :: lib/WWW/KeePassHttp.pm
$(NOECHO) $(ECHO) want to auto-populate VERSION in all sub-modules: $(VERSION)
# $(PERL) -pi -e "s/^(\s*our\s+.VERSION\s*=).*?;.*?$$/\1 '$(VERSION)'; # auto-populated from W:KPH/" lib/WWW/KeePassHttp/Notepad.pm lib/WWW/KeePassHttp/Editor.pm
$(PERL) -pi -e "s/^(\s*our\s+.VERSION\s*=).*?;.*?$$/\1 '$(VERSION)'; # auto-populated from W:KPH/" lib/WWW/KeePassHttp/Entry.pm
#config :: populateversion
# $(NOECHO) $(NOOP)
Expand Down
6 changes: 4 additions & 2 deletions README.md
Expand Up @@ -8,8 +8,10 @@ WWW::KeePassHttp - Interface with KeePass PasswordSafe through the KeePassHttp p

my $kph = WWW::KeePassHttp->new(Key => $key);
$kph->associate() unless $kph->test_associate();
my $entries = $kph->get_logins($search_string);
print "$_ => $entries->[0]{$_}\n" for qw/Name Login Password/;
my @entries = @${ $kph->get_logins($search_string) };
print $entry[0]->url;
print $entry[0]->login;
print $entry[0]->password;

# DESCRIPTION

Expand Down
32 changes: 22 additions & 10 deletions lib/WWW/KeePassHttp.pm
Expand Up @@ -9,8 +9,9 @@ use JSON; # will use JSON::XS when available
use Time::HiRes qw/gettimeofday sleep/;
use MIME::Base64;
use Carp;
use WWW::KeePassHttp::Entry;

our $VERSION = '0.010'; # rrr.mmmsss : rrr is major revision; mmm is minor revision; sss is sub-revision (new feature path or bugfix); optionally use _sss instead, for alpha sub-releases
our $VERSION = '0.020'; # rrr.mmmsss : rrr is major revision; mmm is minor revision; sss is sub-revision (new feature path or bugfix); optionally use _sss instead, for alpha sub-releases

my $dumpfn;
BEGIN {
Expand All @@ -29,8 +30,10 @@ WWW::KeePassHttp - Interface with KeePass PasswordSafe through the KeePassHttp p
my $kph = WWW::KeePassHttp->new(Key => $key);
$kph->associate() unless $kph->test_associate();
my $entries = $kph->get_logins($search_string);
print "$_ => $entries->[0]{$_}\n" for qw/Name Login Password/;
my @entries = @${ $kph->get_logins($search_string) };
print $entry[0]->url;
print $entry[0]->login;
print $entry[0]->password;
=head1 DESCRIPTION
Expand Down Expand Up @@ -238,15 +241,18 @@ sub associate

=item get_logins
my $entries = $kph->get_logins($search_string);
print "$_ => $entries->[0]{$_}\n" for qw/Name Login Password/;
my @entries = @${ $kph->get_logins($search_string) };
print $entry[0]->url;
print $entry[0]->login;
print $entry[0]->password;
Sends the C<get-logins> request, which returns the Name,
Login, and Password for each of the matching entries.
C<$entries> is an AoH structure: it is an array reference,
and each element of that array is a hash reference; each
referenced hash includes Name, Login, and Password entries.
C<$entries> is an array reference containing
L<WWW::KeePassHttp::Entry> objects, from which you can
extract the url/name, login, and password for each matched
entry.
The rules for the matching of the search string are defined in the
L<KeePassHttp plugin documentation|https://github.com/pfn/keepasshttp/>.
Expand All @@ -268,6 +274,8 @@ sub get_logins
for my $k ( sort keys %$entry ) {
$entry->{$k} = $self->{cbc}->decrypt( decode_base64($entry->{$k}), $self->{key}, decode_base64($content->{Nonce}));
}
$entry->{Url} = $entry->{Name};
$entry = WWW::KeePassHttp::Entry->new( %$entry );
}
#$dumpfn->( { Entries => $entries } );
return $entries;
Expand Down Expand Up @@ -308,6 +316,8 @@ sub get_logins_count
=item set_login
$kph->set_login( Login => $username, Url => $url_and_title, Password => $password );
# or
$kph->set_login( $entry );
Sends the C<set-login> request, which adds a new entry to your
KeePass database, in the "KeePassHttp Passwords" group (folder).
Expand All @@ -322,7 +332,8 @@ or just its documentation, or my interpretation of that documentation.
The arguments to the method define the C<Login> (username), C<Url> (for
entry title and URL field), and C<Password> (secret value) for the new
entry. All three of those parameters are required by the protocol, and
thus by this method.
thus by this method. Alernately, you can just pass it a L<WWW::KeePassHttp::Entry>
object as the single argument.
If you would prefer not to give one or more of those parameters a value,
just pass an empty string. You could afterword then manually access
Expand All @@ -332,7 +343,8 @@ your KeePass database and edit the entry yourself.

sub set_login
{
my ($self, %args) = @_;
my ($self, @rest) = @_;
my %args = UNIVERSAL::isa($rest[0], 'WWW::KeePassHttp::Entry') ? (%{$rest[0]}) : (@rest);
croak "set_login(): missing Login parameter" unless defined $args{Login};
croak "set_login(): missing Url parameter" unless defined $args{Url};
croak "set_login(): missing Password parameter" unless defined $args{Password};
Expand Down
175 changes: 175 additions & 0 deletions lib/WWW/KeePassHttp/Entry.pm
@@ -0,0 +1,175 @@
package WWW::KeePassHttp::Entry;
use 5.012; # //, strict, s//r
use warnings;

use MIME::Base64;
use Crypt::Mode::CBC;
use HTTP::Tiny;
use JSON; # will use JSON::XS when available
use Time::HiRes qw/gettimeofday sleep/;
use MIME::Base64;
use Carp;

our $VERSION = '0.020'; # auto-populated from W:KPH

=pod
=head1 NAME
WWW::KeePassHttp::Entry - Object-oriented access to an Entry retrived using WWW::KeePassHttp
=head1 SYNOPSIS
use WWW::KeePassHttp;
my $kph = WWW::KeePassHttp->new(Key => $key);
$kph->associate() unless $kph->test_associate();
my @entries = @${ $kph->get_logins($search_string) };
print $entry[0]->url;
print $entry[0]->login;
print $entry[0]->password;
print $entry[0]->uuid;
=head1 DESCRIPTION
Object-oriented access to an Entry retrived using L<WWW::KeePassHttp>.
=head1 DETAILS
=over
=item new
my $entry = WWW::KeePassHttp::Entry->new( Url => 'https://github.com', Login => 'username', Password => 'password');
Creates a new Entry object.
L<WWW::KeePassHttp> will do this for you when you grab entries.
Or you can create a new Entry object when you want to L<set_login|WWW::KeePassHttp/set_login>
Url, Login, and Password are all required to be defined. If you want those fields "empty",
just use an emtpy string C<''> as the value. The Uuid will also be returned from an existing
Entry from the database (but will be ignored )
=cut

sub new
{
my ($class, %opts) = @_;
my $self = bless {}, $class;

$self->{Url} = $opts{Url}; die "missing Url" unless defined $self->{Url};
$self->{Login} = $opts{Login}; die "missing Login" unless defined $self->{Login};
$self->{Password} = $opts{Password}; die "missing Password" unless defined $self->{Password};
$self->{Uuid} = $opts{Uuid} // ''; # Uuid is not required

return $self;
}

=item url
=item name
print $entry->url();
print $entry->name(); # gives same result as ->url()
$entry->url('https://new.url/'); # set new value
The getter/setter for the Url of the Entry. Due to the nomenclature of the KeePassHttp plugin's
C<get-logins> structure, the Url can also be accessed as the Name of the entry (since KeePassHttp
uses the URL for both the URL field and the Title/Name field).
=cut

sub url
{
my ($self, $val) = @_;
$self->{Url} = $val if defined $val;
return $self->{Url};
}

*WWW::KeePassHttp::Entry::name = \&WWW::KeePassHttp::Entry::url;

=item login
print $entry->login();
$entry->login('https://new.url/'); # set new value
The getter/setter for the Login of the Entry.
=cut

sub login
{
my ($self, $val) = @_;
$self->{Login} = $val if defined $val;
return $self->{Login};
}

=item password
print $entry->password();
$entry->password('https://new.url/'); # set new value
The getter/setter for the Password of the Entry.
=cut

sub password
{
my ($self, $val) = @_;
$self->{Password} = $val if defined $val;
return $self->{Password};
}

=item uuid
print $entry->uuid(); # the UUID from the database entry
The getter for the UUID of the Entry.
=cut

sub uuid
{
my ($self, $val) = @_;
$self->{Uuid} = $val if defined $val;
return $self->{Uuid};
}

=back
=for comment END OF DETAILS
=head1 AUTHOR
Peter C. Jones C<E<lt>petercj AT cpan DOT orgE<gt>>
Please report any bugs or feature requests
thru the repository's interface at L<https://github.com/pryrt/WWW-KeePassHttp/issues>.
=begin html
<a href="https://metacpan.org/pod/WWW::KeePassHttp"><img src="https://img.shields.io/cpan/v/WWW-KeePassHttp.svg?colorB=00CC00" alt="" title="metacpan"></a>
<a href="https://matrix.cpantesters.org/?dist=WWW-KeePassHttp"><img src="https://cpants.cpanauthors.org/dist/WWW-KeePassHttp.png" alt="" title="cpan testers"></a>
<a href="https://github.com/pryrt/WWW-KeePassHttp/releases"><img src="https://img.shields.io/github/release/pryrt/WWW-KeePassHttp.svg" alt="" title="github release"></a>
<a href="https://github.com/pryrt/WWW-KeePassHttp/issues"><img src="https://img.shields.io/github/issues/pryrt/WWW-KeePassHttp.svg" alt="" title="issues"></a>
<a href="https://coveralls.io/github/pryrt/WWW-KeePassHttp?branch=main"><img src="https://coveralls.io/repos/github/pryrt/WWW-KeePassHttp/badge.svg?branch=main" alt="Coverage Status" /></a>
<a href="https://github.com/pryrt/WWW-KeePassHttp/actions/"><img src="https://github.com/pryrt/WWW-KeePassHttp/actions/workflows/perl-ci.yml/badge.svg" alt="github perl-ci"></a>
=end html
=head1 COPYRIGHT
Copyright (C) 2021 Peter C. Jones
=head1 LICENSE
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See L<http://dev.perl.org/licenses/> for more information.
=cut

1;
13 changes: 13 additions & 0 deletions t/coverage.t
Expand Up @@ -29,6 +29,10 @@ my @series = (
content => "{\"RequestType\":\"get-logins\",\"Success\":true,\"Id\":\"WWW::KeePassHttp\",\"Count\":0,\"Version\":\"1.8.4.2\",\"Hash\":\"91dfdf648925fa42f69f1dbe3b012afcc43aca42\",\"Nonce\":\"AqvxYWMArZTbRoZcU+a21Q==\",\"Verifier\":\"rl6RCAhGIvGdNB5J/6Yo5p5+8c3K/6Yg9sK3G2CXysw=\",\"Entries\":[{\"Login\":\"URDpgbTnHWZfMd9mddik3Q==\",\"Password\":\"k0krqs1+W2mc3QBJP01Z5w==\",\"Uuid\":\"BmcYDdjoivBoG3dYozsaqOkJuBeZMQYKeQjnND+Xjfzzr/d/UPD0/QsuDcvj2ZnF\",\"Name\":\"AfeSGKHYGqtslglqqzKo7Q==\"}]}",
success => 1,
},
{
content => "{\"RequestType\":\"set-login\",\"Success\":true,\"Id\":\"WWW::KeePassHttp\",\"Count\":0,\"Version\":\"1.8.4.2\",\"Hash\":\"91dfdf648925fa42f69f1dbe3b012afcc43aca42\",\"Nonce\":\"gSJXXhByYIhc6zpnbG8FpA==\",\"Verifier\":\"S5PbXFEtbVwsXcBjYMM1EurG+7XsfcN2NI2R/Clunho=\"}",
success => 1,
},
);
$mock->set_series( get => @series );

Expand Down Expand Up @@ -92,6 +96,15 @@ my $ret = $kph->get_logins('WWW-KeePassHttp', SubmitUrl => 'alternative');
is_deeply $ret, [], 'get-logins: retval with no count';
$mock->clear();

# set_login with Entry object
use WWW::KeePassHttp::Entry;
my $entry = WWW::KeePassHttp::Entry->new(
Login => 'coverage.t.username',
Url => 'coverage.t.url',
Password => 'coverage.t.password',
);
ok $kph->set_login($entry), 'set-login: use entry object';

done_testing();


Expand Down
39 changes: 39 additions & 0 deletions t/entry.t
@@ -0,0 +1,39 @@
# This will test "easy" errors -- ones that don't require mocked HTTP responses
#
use 5.012; # strict, //
use warnings;
use Test::More;
use Test::Exception;

BEGIN {
use_ok 'WWW::KeePassHttp::Entry';
}

my $e;

# verify constructor working
lives_ok { $e = WWW::KeePassHttp::Entry->new( Url => 'entry.url', Login => 'entry.login', Password => 'entry.pw') } 'entry success: normal entry';
isa_ok $e, 'WWW::KeePassHttp::Entry', 'Normal Entry';

# verify constructor working with UUID
lives_ok { $e = WWW::KeePassHttp::Entry->new( Url => 'entry.url', Login => 'entry.login', Password => 'entry.pw', Uuid => 'entry.uuid') } 'entry success: entry with UUID';
isa_ok $e, 'WWW::KeePassHttp::Entry', 'Entry with UUID';

# verify setters
is $e->url('https://new.url'), 'https://new.url', 'entry->url(): setter returns new value';
is $e->login('entry.username'), 'entry.username', 'entry->login(): setter returns new value';
is $e->password('entry.password'), 'entry.password', 'entry->password(): setter returns new value';
is $e->uuid('entry.uuid'), 'entry.uuid', 'entry->uuid(): setter returns new value';

# verify getters: by doing these in bulk after the bulk setters, it verifies they don't overwrite each other
is $e->url(), 'https://new.url', 'entry->url(): getter returns same value';
is $e->login(), 'entry.username', 'entry->login(): getter returns same value';
is $e->password(), 'entry.password', 'entry->password(): getter returns same value';
is $e->uuid(), 'entry.uuid', 'entry->uuid(): getter returns same value';

# verify errors
throws_ok { $e = WWW::KeePassHttp::Entry->new( Login => 'entry.login', Password => 'entry.pw') } qr/^\Qmissing Url/, 'entry error: missing URL';
throws_ok { $e = WWW::KeePassHttp::Entry->new( Url => 'entry.url', Password => 'entry.pw') } qr/^\Qmissing Login/, 'entry error: missing Login';
throws_ok { $e = WWW::KeePassHttp::Entry->new( Url => 'entry.url', Login => 'entry.login') } qr/^\Qmissing Password/, 'entry error: missing Password';

done_testing(16);

0 comments on commit b8e2f76

Please sign in to comment.