Dogcows Code - chaz/p5-File-KDBX/blob - t/hash-block.t

   1 #!/usr/bin/env perl
   2
   3 use warnings;
   4 use strict;
   5
   6 use lib 't/lib';
   7 use TestCommon qw(:no_warnings_test);
   8
   9 use File::KDBX::Util qw(can_fork);
  10 use IO::Handle;
  11 use File::KDBX::IO::HashBlock;
  12 use Test::More;
  13
  14 {
  15     my $expected_plaintext = 'Tiny food from Spain!';
  16
  17     pipe(my $read, my $write) or die "pipe failed: $!\n";
  18
  19     $write = File::KDBX::IO::HashBlock->new($write, block_size => 3);
  20     print $write $expected_plaintext;
  21     close($write) or die "close failed: $!";
  22
  23     $read = File::KDBX::IO::HashBlock->new($read);
  24     my $plaintext = do { local $/; <$read> };
  25     close($read);
  26
  27     is $plaintext, $expected_plaintext, 'Hash-block just a little bit';
  28 }
  29
  30 SKIP: {
  31     skip 'Tests require fork' if !can_fork;
  32
  33     my $expected_plaintext = "\x64" x (1024*1024*12 - 57);
  34
  35     local $SIG{CHLD} = 'IGNORE';
  36     pipe(my $read, my $write) or die "pipe failed: $!\n";
  37
  38     defined(my $pid = fork) or die "fork failed: $!\n";
  39     if ($pid == 0) {
  40         $write = File::KDBX::IO::HashBlock->new($write);
  41         print $write $expected_plaintext;
  42         close($write) or die "close failed: $!";
  43         # exit;
  44         require POSIX;
  45         POSIX::_exit(0);
  46     }
  47
  48     $read = File::KDBX::IO::HashBlock->new($read);
  49     my $plaintext = do { local $/; <$read> };
  50     close($read);
  51
  52     is $plaintext, $expected_plaintext, 'Hash-block a lot';
  53 }
  54
  55 subtest 'Error handling' => sub {
  56     pipe(my $read, my $write) or die "pipe failed: $!\n";
  57
  58     $read = File::KDBX::IO::HashBlock->new($read);
  59
  60     print $write 'blah blah blah';
  61     close($write) or die "close failed: $!";
  62
  63     is $read->error, '', 'Read handle starts out fine';
  64     my $data = do { local $/; <$read> };
  65     is $read->error, 1, 'Read handle can enter an error state';
  66
  67     like $File::KDBX::IO::HashBlock::ERROR, qr/invalid block index/i, 'Error object is available';
  68 };
  69
  70 done_testing;