Dogcows Code - chaz/p5-File-KDBX/blob - t/kdbx2.t

   1 #!/usr/bin/env perl
   2
   3 use warnings;
   4 use strict;
   5
   6 use lib 't/lib';
   7 use TestCommon;
   8
   9 use File::KDBX;
  10 use File::KDBX::Constants qw(:version :kdf);
  11 use Test::Deep;
  12 use Test::More;
  13
  14 my $kdbx = File::KDBX->load(testfile('Format200.kdbx'), 'a');
  15
  16 verify_kdbx2($kdbx, KDBX_VERSION_2_0);
  17 is $kdbx->kdf->uuid, KDF_UUID_AES, 'KDBX2 file has a usable KDF configured';
  18
  19 my $dump;
  20 like warning { $dump = $kdbx->dump_string('a', randomize_seeds => 0) }, qr/upgrading database/i,
  21     'There is a warning about a change in file version when writing';
  22
  23 my $kdbx_from_dump = File::KDBX->load_string($dump, 'a');
  24 verify_kdbx2($kdbx_from_dump, KDBX_VERSION_3_1);
  25 is $kdbx->kdf->uuid, KDF_UUID_AES, 'New KDBX3 file has the same KDF';
  26
  27 sub verify_kdbx2 {
  28     my $kdbx = shift;
  29     my $vers = shift;
  30
  31     ok_magic $kdbx, $vers, 'Get the correct KDBX2 file magic';
  32
  33     cmp_deeply $kdbx->headers, superhashof({
  34         cipher_id => "1\301\362\346\277qCP\276X\5!j\374Z\377",
  35         compression_flags => 1,
  36         encryption_iv => "D+VZ\277\274>\226K\225\3237\255\231\35\4",
  37         inner_random_stream_id => 2,
  38         inner_random_stream_key => "\214\aW\253\362\177<\346n`\263l\245\353T\25\261BnFp\177\357\335\36(b\372z\231b\355",
  39         kdf_parameters => {
  40             "\$UUID" => "\311\331\363\232b\212D`\277t\r\b\301\212O\352",
  41             R => 6000,
  42             S => "S\202\207A\3475\265\177\220\331\263[\334\326\365\324B\\\2222zb-f\263m\220\333S\361L\332",
  43         },
  44         master_seed => "\253!\2\241\r*|{\227\0276Lx\215\32\\\17\372d\254\255*\21r\376\251\313+gMI\343",
  45         stream_start_bytes => "\24W\24\3262oU\t>\242B\2666:\231\377\36\3\353 \217M\330U\35\367|'\230\367\221^",
  46     }), 'Get expected headers from KDBX2 file' or diag explain $kdbx->headers;
  47
  48     cmp_deeply $kdbx->meta, superhashof({
  49         custom_data => {},
  50         database_description => "",
  51         database_description_changed => obj_isa('Time::Piece'),
  52         database_name => "",
  53         database_name_changed => obj_isa('Time::Piece'),
  54         default_username => "",
  55         default_username_changed => obj_isa('Time::Piece'),
  56         entry_templates_group => "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0",
  57         entry_templates_group_changed => obj_isa('Time::Piece'),
  58         generator => ignore(),
  59         last_selected_group => "\226Y\251\22\356zB\@\214\222ns\273a\263\221",
  60         last_top_visible_group => "\226Y\251\22\356zB\@\214\222ns\273a\263\221",
  61         maintenance_history_days => 365,
  62         memory_protection => superhashof({
  63             protect_notes => bool(0),
  64             protect_password => bool(0),
  65             protect_title => bool(0),
  66             protect_url => bool(1),
  67             protect_username => bool(1),
  68         }),
  69         recycle_bin_changed => obj_isa('Time::Piece'),
  70         recycle_bin_enabled => bool(1),
  71         recycle_bin_uuid => "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0",
  72     }), 'Get expected metadata from KDBX2 file' or diag explain $kdbx->meta;
  73
  74     $kdbx->unlock;
  75
  76     is scalar @{$kdbx->root->entries}, 1, 'Get one entry in root';
  77
  78     my $entry = $kdbx->root->entries->[0];
  79     is $entry->title, 'Sample Entry', 'Get the correct title';
  80     is $entry->username, 'User Name', 'Get the correct username';
  81
  82     cmp_deeply $entry->binaries, {
  83         "myattach.txt" => {
  84             value => "abcdefghijk",
  85         },
  86         "test.txt" => {
  87             value => "this is a test",
  88         },
  89     }, 'Get two attachments from the entry' or diag explain $entry->binaries;
  90
  91     my @history = @{$entry->history};
  92     is scalar @history, 2, 'Get two historical entries';
  93     is scalar keys %{$history[0]->binaries}, 0, 'First historical entry has no attachments';
  94     is scalar keys %{$history[1]->binaries}, 1, 'Second historical entry has one attachment';
  95     cmp_deeply $history[1]->binary('myattach.txt'), {
  96         value => 'abcdefghijk',
  97     }, 'The attachment has the correct content';
  98 }
  99
 100 done_testing;