add initial WIP

[chaz/p5-File-KDBX] / t / kdbx2.t

diff --git a/t/kdbx2.t b/t/kdbx2.t
new file mode 100644 (file)
index 0000000..958348a
--- /dev/null
+++ b/t/kdbx2.t
@@ -0,0 +1,100 @@
+#!/usr/bin/env perl
+
+use warnings;
+use strict;
+
+use lib 't/lib';
+use TestCommon;
+
+use File::KDBX;
+use File::KDBX::Constants qw(:version :kdf);
+use Test::Deep;
+use Test::More;
+
+my $kdbx = File::KDBX->load(testfile('Format200.kdbx'), 'a');
+
+verify_kdbx2($kdbx, KDBX_VERSION_2_0);
+is $kdbx->kdf->uuid, KDF_UUID_AES, 'KDBX2 file has a usable KDF configured';
+
+my $dump;
+like warning { $dump = $kdbx->dump_string('a', randomize_seeds => 0) }, qr/upgrading database/i,
+    'There is a warning about a change in file version when writing';
+
+my $kdbx_from_dump = File::KDBX->load_string($dump, 'a');
+verify_kdbx2($kdbx_from_dump, KDBX_VERSION_3_1);
+is $kdbx->kdf->uuid, KDF_UUID_AES, 'New KDBX3 file has the same KDF';
+
+sub verify_kdbx2 {
+    my $kdbx = shift;
+    my $vers = shift;
+
+    ok_magic $kdbx, $vers, 'Get the correct KDBX2 file magic';
+
+    cmp_deeply $kdbx->headers, superhashof({
+        cipher_id => "1\301\362\346\277qCP\276X\5!j\374Z\377",
+        compression_flags => 1,
+        encryption_iv => "D+VZ\277\274>\226K\225\3237\255\231\35\4",
+        inner_random_stream_id => 2,
+        inner_random_stream_key => "\214\aW\253\362\177<\346n`\263l\245\353T\25\261BnFp\177\357\335\36(b\372z\231b\355",
+        kdf_parameters => {
+            "\$UUID" => "\311\331\363\232b\212D`\277t\r\b\301\212O\352",
+            R => 6000,
+            S => "S\202\207A\3475\265\177\220\331\263[\334\326\365\324B\\\2222zb-f\263m\220\333S\361L\332",
+        },
+        master_seed => "\253!\2\241\r*|{\227\0276Lx\215\32\\\17\372d\254\255*\21r\376\251\313+gMI\343",
+        stream_start_bytes => "\24W\24\3262oU\t>\242B\2666:\231\377\36\3\353 \217M\330U\35\367|'\230\367\221^",
+    }), 'Get expected headers from KDBX2 file' or diag explain $kdbx->headers;
+
+    cmp_deeply $kdbx->meta, superhashof({
+        custom_data => {},
+        database_description => "",
+        database_description_changed => obj_isa('Time::Piece'),
+        database_name => "",
+        database_name_changed => obj_isa('Time::Piece'),
+        default_username => "",
+        default_username_changed => obj_isa('Time::Piece'),
+        entry_templates_group => "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0",
+        entry_templates_group_changed => obj_isa('Time::Piece'),
+        generator => ignore(),
+        last_selected_group => "\226Y\251\22\356zB\@\214\222ns\273a\263\221",
+        last_top_visible_group => "\226Y\251\22\356zB\@\214\222ns\273a\263\221",
+        maintenance_history_days => 365,
+        memory_protection => superhashof({
+            protect_notes => bool(0),
+            protect_password => bool(0),
+            protect_title => bool(0),
+            protect_url => bool(1),
+            protect_username => bool(1),
+        }),
+        recycle_bin_changed => obj_isa('Time::Piece'),
+        recycle_bin_enabled => bool(1),
+        recycle_bin_uuid => "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0",
+    }), 'Get expected metadata from KDBX2 file' or diag explain $kdbx->meta;
+
+    $kdbx->unlock;
+
+    is scalar @{$kdbx->root->entries}, 1, 'Get one entry in root';
+
+    my $entry = $kdbx->root->entries->[0];
+    is $entry->title, 'Sample Entry', 'Get the correct title';
+    is $entry->username, 'User Name', 'Get the correct username';
+
+    cmp_deeply $entry->binaries, {
+        "myattach.txt" => {
+            value => "abcdefghijk",
+        },
+        "test.txt" => {
+            value => "this is a test",
+        },
+    }, 'Get two attachments from the entry' or diag explain $entry->binaries;
+
+    my @history = @{$entry->history};
+    is scalar @history, 2, 'Get two historical entries';
+    is scalar keys %{$history[0]->binaries}, 0, 'First historical entry has no attachments';
+    is scalar keys %{$history[1]->binaries}, 1, 'Second historical entry has one attachment';
+    cmp_deeply $history[1]->binary('myattach.txt'), {
+        value => 'abcdefghijk',
+    }, 'The attachment has the correct content';
+}
+
+done_testing;