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 PerlIO::via::File::KDBX::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     PerlIO::via::File::KDBX::HashBlock->push($write, block_size => 3);
  20     print $write $expected_plaintext;
  21     binmode($write, ':pop');    # finish stream
  22     close($write) or die "close failed: $!";
  23
  24     PerlIO::via::File::KDBX::HashBlock->push($read);
  25     my $plaintext = do { local $/; <$read> };
  26     close($read);
  27
  28     is $plaintext, $expected_plaintext, 'Hash-block just a little bit';
  29 }
  30
  31 SKIP: {
  32     skip 'Tests require fork' if !can_fork;
  33
  34     my $expected_plaintext = "\x64" x (1024*1024*12 - 57);
  35
  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         PerlIO::via::File::KDBX::HashBlock->push($write);
  41         print $write $expected_plaintext;
  42         binmode($write, ':pop');    # finish stream
  43         close($write) or die "close failed: $!";
  44         exit;
  45     }
  46
  47     PerlIO::via::File::KDBX::HashBlock->push($read);
  48     my $plaintext = do { local $/; <$read> };
  49     close($read);
  50
  51     is $plaintext, $expected_plaintext, 'Hash-block a lot';
  52
  53     waitpid($pid, 0) or die "wait failed: $!\n";
  54 }
  55
  56 subtest 'Error handling' => sub {
  57     pipe(my $read, my $write) or die "pipe failed: $!\n";
  58
  59     PerlIO::via::File::KDBX::HashBlock->push($read);
  60
  61     print $write 'blah blah blah';
  62     close($write) or die "close failed: $!";
  63
  64     is $read->error, 0, 'Read handle starts out fine';
  65     my $data = do { local $/; <$read> };
  66     is $read->error, 1, 'Read handle can enter and error state';
  67
  68     like $PerlIO::via::File::KDBX::HashBlock::ERROR, qr/invalid block index/i,
  69         'Error object is available';
  70 };
  71
  72 done_testing;