diff --git a/File-KeePass-2.03/lib/File/KeePass.pm b/File-KeePass/lib/File/KeePass.pm
index 3c414e5..9bcb2d0 100644
--- a/File-KeePass-2.03/lib/File/KeePass.pm
+++ b/File-KeePass/lib/File/KeePass.pm
@@ -122,7 +122,7 @@ sub parse_db {
sub parse_header {
my ($self, $buffer) = @_;
- my ($sig1, $sig2) = unpack 'LL', $buffer;
+ my ($sig1, $sig2) = unpack 'VV', $buffer;
die "File signature (sig1) did not match ($sig1 != ".DB_SIG_1().")\n" if $sig1 != DB_SIG_1;
return $self->_parse_v1_header($buffer) if $sig2 eq DB_SIG_2_v1;
return $self->_parse_v2_header($buffer) if $sig2 eq DB_SIG_2_v2;
@@ -135,7 +135,7 @@ sub _parse_v1_header {
die "File was smaller than db header ($size < ".DB_HEADSIZE_V1().")\n" if $size < DB_HEADSIZE_V1;
my %h = (version => 1, header_size => DB_HEADSIZE_V1);
my @f = qw(sig1 sig2 flags ver seed_rand enc_iv n_groups n_entries checksum seed_key rounds);
- my $t = 'L L L L a16 a16 L L a32 a32 L';
+ my $t = '( L L L L a16 a16 L L a32 a32 L )<';
@h{@f} = unpack $t, $buffer;
die "Unsupported file version ($h{'ver'}).\n" if $h{'ver'} & 0xFFFFFF00 != DB_VER_DW_V1 & 0xFFFFFF00;
$h{'enc_type'} = ($h{'flags'} & DB_FLAG_RIJNDAEL) ? 'rijndael'
@@ -147,12 +147,12 @@ sub _parse_v1_header {
sub _parse_v2_header {
my ($self, $buffer) = @_;
my %h = (version => 2, enc_type => 'rijndael');
- @h{qw(sig1 sig2 ver)} = unpack 'L3', $buffer;
+ @h{qw(sig1 sig2 ver)} = unpack 'V3', $buffer;
die "Unsupported file version2 ($h{'ver'}).\n" if $h{'ver'} & 0xFFFF0000 > 0x00020000 & 0xFFFF0000;
my $pos = 12;
while (1) {
- my ($type, $size) = unpack "\@$pos CS", $buffer;
+ my ($type, $size) = unpack "\@$pos Cv", $buffer;
$pos += 3;
my $val = substr $buffer, $pos, $size; # #my ($val) = unpack "\@$pos a$size", $buffer;
if (!$type) {
@@ -177,7 +177,7 @@ sub _parse_v2_header {
warn "Length of seed key was not 32\n" if length($val) != 32;
$h{'seed_key'} = $val;
} elsif ($type == 6) {
- $h{'rounds'} = unpack 'L', $val;
+ $h{'rounds'} = unpack 'V', $val;
} elsif ($type == 7) {
warn "Length of encryption IV was not 16\n" if length($val) != 16;
$h{'enc_iv'} = $val;
@@ -761,7 +761,7 @@ sub _gen_v1_header {
die "Length of $_ was not 32 (".length($head->{$_}).")\n" for grep {length($head->{$_}) != 32} qw(seed_key checksum);
die "Length of $_ was not 16 (".length($head->{$_}).")\n" for grep {length($head->{$_}) != 16} qw(enc_iv seed_rand);
my @f = qw(sig1 sig2 flags ver seed_rand enc_iv n_groups n_entries checksum seed_key rounds);
- my $t = 'L L L L a16 a16 L L a32 a32 L';
+ my $t = '( L L L L a16 a16 L L a32 a32 L )<';
my $header = pack $t, @$head{@f};
die "Invalid generated header\n" if length($header) != DB_HEADSIZE_V1;
return $header;
@@ -1009,15 +1009,15 @@ sub _gen_v2_header {
die "Length of $_ was not 32 (".length($head->{$_}).")\n" for grep {length($head->{$_}) != 32} qw(seed_rand seed_key protected_stream_key start_bytes);
die "Length of enc_iv was not 16\n" if length($head->{'enc_iv'}) != 16;
- my $buffer = pack 'L3', @$head{qw(sig1 sig2 ver)};
+ my $buffer = pack 'V3', @$head{qw(sig1 sig2 ver)};
- my $pack = sub { my ($type, $str) = @_; $buffer .= pack('C S', $type, length($str)) . $str };
+ my $pack = sub { my ($type, $str) = @_; $buffer .= pack('C v', $type, length($str)) . $str };
$pack->(1, $head->{'comment'}) if defined($head->{'comment'}) && length($head->{'comment'});
$pack->(2, "\x31\xc1\xf2\xe6\xbf\x71\x43\x50\xbe\x58\x05\x21\x6a\xfc\x5a\xff"); # aes cipher
$pack->(3, pack 'V', $head->{'compression'} ? 1 : 0);
$pack->(4, $head->{'seed_rand'});
$pack->(5, $head->{'seed_key'});
- $pack->(6, pack 'LL', $head->{'rounds'}, 0); # a little odd to be double the length but not used
+ $pack->(6, pack 'VV', $head->{'rounds'}, 0); # a little odd to be double the length but not used
$pack->(7, $head->{'enc_iv'});
$pack->(8, $head->{'protected_stream_key'});
$pack->(9, $head->{'start_bytes'});
@@ -1064,7 +1064,7 @@ sub unchunksum {
my ($self, $buffer) = @_;
my ($new, $pos) = ('', 0);
while ($pos < length($buffer)) {
- my ($index, $hash, $size) = unpack "\@$pos L a32 i", $buffer;
+ my ($index, $hash, $size) = unpack "( \@$pos L a32 i )<", $buffer;
$pos += 40;
if ($size == 0) {
warn "Found mismatch for 0 chunksize\n" if $hash ne "\0"x32;
@@ -1087,11 +1087,11 @@ sub chunksum {
my $pos = 0;
while ($pos < length($buffer)) {
my $chunk = substr($buffer, $pos, $chunk_size);
- $new .= pack "L a32 i", $index++, sha256($chunk), length($chunk);
+ $new .= pack "( L a32 i )<", $index++, sha256($chunk), length($chunk);
$new .= $chunk;
$pos += length($chunk);
}
- $new .= pack "L a32 i", $index++, "\0"x32, 0;
+ $new .= pack "( L a32 i )<", $index++, "\0"x32, 0;
return $new;
}
diff --git a/File-KeePass/t/06_sample.t b/File-KeePass/t/06_sample.t
new file mode 100644
index 0000000..9ecf92a
--- /dev/null
+++ b/File-KeePass/t/06_sample.t
@@ -0,0 +1,129 @@
+#!/usr/bin/perl
+
+=head1 NAME
+
+06_sample.t - Check interoperability with a sample database created by KeePass.
+
+=cut
+
+use strict;
+use warnings;
+use Test::More tests => 44;
+use File::Basename;
+
+if (!eval {
+ require MIME::Base64;
+ require XML::Parser;
+ require Compress::Raw::Zlib;
+ require utf8;
+}) {
+ diag "Failed to load library: $@";
+ SKIP: { skip "Missing necessary libraries.\n", 44 };
+ exit;
+}
+
+use_ok('File::KeePass');
+
+my $pass = "qwe123";
+my $filename = dirname(__FILE__). "/NewDatabase.kdbx";
+
+my $obj = File::KeePass->new;
+ok($obj->load_db($filename, $pass), "Database load");
+
+compare(
+ 'group', [
+ {
+ 'title' => 'NewDatabase',
+ 'icon' => 49,
+ 'level' => 0,
+ },
+ {
+ 'title' => 'General',
+ 'icon' => 48,
+ 'level' => 1,
+ },
+ {
+ 'title' => 'Windows',
+ 'icon' => 38,
+ 'level' => 1,
+ },
+ {
+ 'title' => 'Network',
+ 'icon' => 3,
+ 'level' => 1,
+ },
+ {
+ 'title' => 'Internet',
+ 'icon' => 1,
+ 'level' => 1,
+ },
+ {
+ 'title' => 'eMail',
+ 'icon' => 19,
+ 'level' => 1,
+ },
+ {
+ 'title' => 'Homebanking',
+ 'icon' => 37,
+ 'level' => 1,
+ },
+ ]
+);
+compare(
+ 'entry', [
+ {
+ 'title' => 'Sample Entry',
+ 'icon' => '0',
+ 'username' => 'User Name',
+ 'url' => '
http://keepass.info/',
+ 'password' => 'Password',
+ },
+ {
+ 'title' => 'Sample Entry #2',
+ 'icon' => '0',
+ 'username' => 'Michael321',
+ 'url' => '
http://keepass.info/help/kb/testform.html',
+ 'password' => '12345',
+ },
+ ]
+);
+
+sub compare {
+ my $type = shift;
+ my @expected_items = @{shift()};
+ my $find_all_method = {
+ 'group' => 'find_groups',
+ 'entry' => 'find_entries',
+ }->{$type};
+ my $find_one_method = {
+ 'group' => 'find_group',
+ 'entry' => 'find_entry',
+ }->{$type};
+
+ my @items = $obj->$find_all_method({});
+ is($#items, $#expected_items, "\u$type count");
+
+ foreach my $expected_item ( @expected_items ) {
+ my $item = $obj->$find_one_method({
+ 'title' => $expected_item->{'title'}
+ });
+ ok($item, "Found $type ". $expected_item->{'title'});
+ foreach my $property ( keys %$expected_item ) {
+ if ( $property eq 'password' ) {
+ is(
+ $obj->locked_entry_password($item),
+ $expected_item->{$property},
+ 'Retrieved password'
+ );
+ }
+ else {
+ is(
+ $item->{$property},
+ $expected_item->{$property},
+ "\u$type ". $expected_item->{'title'}.
+ " has expected $property"
+ );
+ }
+ }
+ }
+}
diff --git a/File-KeePass/t/NewDatabase.kdbx b/File-KeePass/t/NewDatabase.kdbx
new file mode 100644
index 0000000000000000000000000000000000000000..3ca08a42f246b14bfcd94802f1578d5ccee0d77e
GIT binary patch
literal 2078
zcmV+(2;uhw*`k_f`%AR}00RI55CAd3^5(yBLr}h01tDtuTK@wC0096100bZat@~xS
zL=eHid-@xp%`gG#@-J1_8<!mR2(_?7I;0UF1t0)M4*wa{E?rBQEtHG6;f(<@2G2wG
z>rD9%9VdZ&RbEpD2mo*w00000000LN09)_x@EFSKcB4qWh1TS``3N8Y!<1`9l<`JA
z(`&~xaP?Oq#zCmyp>Cr&nr;dgUCE-z2_OKO5N1fL_G`!G<w)W5hh14iT?2Vh+dyWk
z7w^~B<0`=l1ONg60000401XNa3eDGaRi3h7)iMQEwTEcc2{RTn@z&U^+M8H^U^>U&
zjmr1P+?~@{bU~_lYOp^v1oqjJ!!BxnF%W}s;4g)BH4%y`N?x{DoFW#L!K3IhKbR&A
zz$W$H7sI+y?#}i`^=J{A!Rma7Z^2YwM5=~x1Le)Rg6Jro1POJLsCvCb6KB_WWY?!!
z98wmKI9<l?p_>C&dfxz-?ag-6$lTRqXDF{YxAyH6CuMGsI?pc;NU559AOliEyzr$4
z1eMKBOl2h4)aP<RvwZu`u$BW%q%vRvUsJk685&(pcK1q>-Dlm;5-d_mJggTJSez^G
z)!>twVSAlOOmfX=&)!{5S54DVa&Kn%HWt;CyI*v{=oci_880YX^qkQD<WNTe{`Mqf
z6)2=s0DG&4k9}O?-Z%~uoL8ltTT2>+&~L0g4~)ph9r{T(putt;X`F#L=ma=S-pvv~
z&1q=3#kTaHdmiQF5pN$PevqG-;pR)x+yBz7Spt*>NZt4+A53NV3x+N9PVNS_as6R1
ziu1^NoWW~#56jJ2%;r5g)_N%M>|tqny7%+mOj>xDZ%^sE`=dQD>ByPDev_l0XvWz;
z2C!My{g@HpfEe0dqG`D;72Bi@qo{-V40WOd(n<CxZgsB}`HSa_M$JD4X0O<~i^`J9
z_EgJ#jfL^Ljp;EHE&5_9C;rF0&|oK~90-N40eIF@`^wHg?GIIO>dgh8(xP6NFf%86
zxNWe;UM3c&$-9%!eaK-1N@8{N#bosBJ;`{0Tgk_Iar3XYz=RrA<F!STz&Vv>#E$lh
zs{eG6GrH&UxMp?zB_AwWAuHDZZ)6vq5PqhOI7A^@*ze8!+^_l^$Znz{<9T5|*=Tg{
z@W8yAO9EnoTk`Y+QUKt^8u;_r%7X(i*3xdq4lPLFEs!EPzn+{4FCdke_Na#&+&}fj
z0Omo^bJ3-83g7z7S(%`{z!!@onX9yxZ5YN#EeqtGtcG)3EZ^cio?OWVioIPcs}D^1
za<nI4Sf1GLhoY@?8Pa(;Npk4f;F#rg&5iLgo{yi60ajvE4bB1#-go>eKu43e+Zs=@
z)Nr!4KSsG|QLqsQD&h^&AWYJFH5NZQoa>e7jSpZ|hCl;uiG#?mE!RhYe1lOih%o!R
znSURP#W7ZDc5pxyd+B}<7OLC^;p<l5gI&&B<lb!pmCv+jW~y#DsW=9+U(6!|Z2R1@
zBW^1CzfkW{JaHVFZPh0+S2cQ*_<(~_51kx@bquB8c)_|6#{Bi3PI6~sh#9ld{LNdX
zw0DFfCR@OT*nZu>{t!GRmbi7yIhnJss5h(6zqq*A6$<_*bS#cp9uQhECnM&V6Is92
zhHOlhw7lpTiJlowR9c|1$zYee>X_<LloDVkYv@zTB*gJ)ZB|ZDui>-N#B5xbBy4TL
zt&wPq5zZmHh!jK0**`a!jHEzhoq-=t#r*Y&)S^o^<pu|bHYRD#gOz&0Gr71tk@Df+
zl|4ZN;`VG<wvEg@aD=FhZIiX}0BGSUM5I1%MCGa^YdXLm<ESJPR{R$T+-0gcVEu{$
zmLhH$;((nXOG{NO_`o(+Iu_H=!^9X(JW>F?-s7&a*(6_h1b)|T;%HD-Y%tI(yn{8J
zF*CCXjYF;&`mC$F4v{qwGztf%-h4eDUSo^#A_iq;SRn71!?2=sY;HYLSyTVxlc`K7
zyH#g=$<t9Eoz^^VRyw}zKElqOEKY%+pCt?od9lJkImb4rfgnaHry3n)iO_dUV`6ER
z&_7w~H@px|lDL9_>lnYv$66iy5cdj%-hS3#hN&Z0ZKwMWUhRbWJ)6i7J)hCdZhdY>
zz}^$$@5%y{$#|-(V7N=U@7YP`!NwA?In5|TN~TA>ebqb~f@9oZS=bC*LxN_|M|v&;
zlt(yGLfi@27Y1rem>uPo$*|1D=T}lootSuVX;`TiC^m8O4Uzb|B7qdj^`>q4KK~(K
z$0Yz{l;|fIOXUASfJ5IJoX;G4E7neka5Sjg3X|I^)<CI0_=9%jmHD0g&H4<#tj=-&
zPC$Qi5T^RRh5s5!^t3?Kk!TH|lH7Gw*ZaE!3$l%5JGxF(`xEa&SS;hU+qo%XIt)2=
zldxO)vxp2tEsKJFYJ&;$LSumb=7UovZXix%$+~G=^~i-qXm1H22t!wpT<0(q&JF(I
z6}n-lEoT;?@-)Q3q9{ul2VRh3*aN28W}(wOxi{5g^$-EqPJX1h!;>hFzQ-eeqx06>
zbRzxTH4Mc+ayS{RDSLlDBu-NVY6#W1!9+;~kp(e6=(9;X;Os(CxaxhgTli;21bqhq
zaZ^%#FT7TWcD9-J0<PgD%I0+p8YEeI67P9OUExLbzne<Qhjl`cZHO?op&McG0QEJ6
z!nf*LrT)yzgw3`b1w@~zP6*F{-IAxl=K{iHRTrNMvFMjykYEVUkZx9}gk^&w25g2A
IPxc>m`Ak&z1poj5
literal 0
HcmV?d00001
