ext/Compress/Zlib/t/11truncate.t

   1
   2 use lib 't';
   3 use strict;
   4 use warnings;
   5 use bytes;
   6
   7 use Test::More ;
   8 use ZlibTestUtils;
   9
  10 BEGIN {
  11     # use Test::NoWarnings, if available
  12     my $extra = 0 ;
  13     $extra = 1
  14         if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
  15
  16     plan tests => 2374 + $extra;
  17
  18     use_ok('Compress::Zlib', 2) ;
  19
  20     use_ok('IO::Compress::Gzip', qw($GzipError)) ;
  21     use_ok('IO::Uncompress::Gunzip', qw($GunzipError)) ;
  22
  23     use_ok('IO::Compress::Deflate', qw($DeflateError)) ;
  24     use_ok('IO::Uncompress::Inflate', qw($InflateError)) ;
  25
  26     use_ok('IO::Compress::RawDeflate', qw($RawDeflateError)) ;
  27     use_ok('IO::Uncompress::RawInflate', qw($RawInflateError)) ;
  28
  29 }
  30
  31
  32 my $hello = <<EOM ;
  33 hello world
  34 this is a test
  35 some more stuff on this line
  36 ad finally...
  37 EOM
  38
  39 my $blocksize = 10 ;
  40
  41
  42 foreach my $CompressClass ('IO::Compress::Gzip', 'IO::Compress::Deflate')
  43 {
  44     my $UncompressClass = getInverse($CompressClass);
  45
  46
  47     my $compressed ;
  48     my $cc ;
  49     my $gz ;
  50     if ($CompressClass eq 'IO::Compress::Gzip') {
  51         ok( my $x = new IO::Compress::Gzip \$compressed,
  52                                  -Name       => "My name",
  53                                  -Comment    => "a comment",
  54                                  -ExtraField => ['ab' => "extra"],
  55                                  -HeaderCRC  => 1);
  56         ok $x->write($hello) ;
  57         ok $x->close ;
  58         $cc = $compressed ;
  59
  60         ok($gz = new IO::Uncompress::Gunzip \$cc,
  61                                 -Transparent => 0)
  62                 or diag "$GunzipError";
  63         my $un;
  64         ok $gz->read($un) > 0 ;
  65         ok $gz->close();
  66         ok $un eq $hello ;
  67     }
  68     else {
  69         ok( my $x = new $CompressClass(\$compressed));
  70         ok $x->write($hello) ;
  71         ok $x->close ;
  72         $cc = $compressed ;
  73
  74         ok($gz = new $UncompressClass(\$cc,
  75                                       -Transparent => 0))
  76                 or diag "$GunzipError";
  77         my $un;
  78         ok $gz->read($un) > 0 ;
  79         ok $gz->close();
  80         ok $un eq $hello ;
  81     }
  82
  83
  84     for my $trans ( 0 .. 1)
  85     {
  86         title "Testing $CompressClass, Transparent $trans";
  87
  88         my $info = $gz->getHeaderInfo() ;
  89         my $header_size = $info->{HeaderLength};
  90         my $trailer_size = $info->{TrailerLength};
  91         ok 1, "Compressed size is " . length($compressed) ;
  92         ok 1, "Header size is $header_size" ;
  93         ok 1, "Trailer size is $trailer_size" ;
  94
  95         title "Fingerprint Truncation";
  96         foreach my $i (1)
  97         {
  98             my $name = "test.gz" ;
  99             unlink $name ;
 100             my $lex = new LexFile $name ;
 101
 102             ok 1, "Length $i" ;
 103             my $part = substr($compressed, 0, $i);
 104             writeFile($name, $part);
 105
 106             my $gz = new $UncompressClass $name,
 107                                           -BlockSize   => $blocksize,
 108                                           -Transparent => $trans;
 109             if ($trans) {
 110                 ok $gz;
 111                 ok ! $gz->error() ;
 112                 my $buff ;
 113                 ok $gz->read($buff) == length($part) ;
 114                 ok $buff eq $part ;
 115                 ok $gz->eof() ;
 116                 $gz->close();
 117             }
 118             else {
 119                 ok !$gz;
 120             }
 121
 122         }
 123
 124         title "Header Truncation";
 125         #
 126         # Any header corruption past the fingerprint is considered catastrophic
 127         # so even if Transparent is set, it should still fail
 128         #
 129         foreach my $i (2 .. $header_size -1)
 130         {
 131             my $name = "test.gz" ;
 132             unlink $name ;
 133             my $lex = new LexFile $name ;
 134
 135             ok 1, "Length $i" ;
 136             my $part = substr($compressed, 0, $i);
 137             writeFile($name, $part);
 138             ok ! defined new $UncompressClass $name,
 139                                               -BlockSize   => $blocksize,
 140                                               -Transparent => $trans;
 141             #ok $gz->eof() ;
 142         }
 143
 144         title "Compressed Data Truncation";
 145         foreach my $i ($header_size .. length($compressed) - 1 - $trailer_size)
 146         {
 147
 148             my $name = "test.gz" ;
 149             unlink $name ;
 150             my $lex = new LexFile $name ;
 151
 152             ok 1, "Length $i" ;
 153             my $part = substr($compressed, 0, $i);
 154             writeFile($name, $part);
 155             ok my $gz = new $UncompressClass $name,
 156                                              -BlockSize   => $blocksize,
 157                                              -Transparent => $trans;
 158             my $un ;
 159             my $status = 0 ;
 160             $status = $gz->read($un) while $status >= 0 ;
 161             ok $status < 0 ;
 162             ok $gz->eof() ;
 163             ok $gz->error() ;
 164             $gz->close();
 165         }
 166
 167         # RawDeflate does not have a trailer
 168         next if $CompressClass eq 'IO::Compress::RawDeflate' ;
 169
 170         title "Compressed Trailer Truncation";
 171         foreach my $i (length($compressed) - $trailer_size .. length($compressed) -1 )
 172         {
 173             foreach my $lax (0, 1)
 174             {
 175                 my $name = "test.gz" ;
 176                 unlink $name ;
 177                 my $lex = new LexFile $name ;
 178
 179                 ok 1, "Length $i, Lax $lax" ;
 180                 my $part = substr($compressed, 0, $i);
 181                 writeFile($name, $part);
 182                 ok my $gz = new $UncompressClass $name,
 183                                                  -BlockSize   => $blocksize,
 184                                                  -Strict      => !$lax,
 185                                                  -Append      => 1,
 186                                                  -Transparent => $trans;
 187                 my $un = '';
 188                 my $status = 1 ;
 189                 $status = $gz->read($un) while $status > 0 ;
 190
 191                 if ($lax)
 192                 {
 193                     is $un, $hello;
 194                     is $status, 0
 195                         or diag "Status $status Error is " . $gz->error() ;
 196                     ok $gz->eof()
 197                         or diag "Status $status Error is " . $gz->error() ;
 198                     ok ! $gz->error() ;
 199                 }
 200                 else
 201                 {
 202                     ok $status < 0
 203                         or diag "Status $status Error is " . $gz->error() ;
 204                     ok $gz->eof()
 205                         or diag "Status $status Error is " . $gz->error() ;
 206                     ok $gz->error() ;
 207                 }
 208
 209                 $gz->close();
 210             }
 211         }
 212     }
 213 }
 214
 215
 216 foreach my $CompressClass ( 'IO::Compress::RawDeflate')
 217 {
 218     my $UncompressClass = getInverse($CompressClass);
 219     my $Error = getErrorRef($UncompressClass);
 220
 221     my $compressed ;
 222         ok( my $x = new IO::Compress::RawDeflate \$compressed);
 223         ok $x->write($hello) ;
 224         ok $x->close ;
 225
 226
 227     my $cc = $compressed ;
 228
 229     my $gz ;
 230     ok($gz = new $UncompressClass(\$cc,
 231                                   -Transparent => 0))
 232             or diag "$$Error\n";
 233     my $un;
 234     ok $gz->read($un) > 0 ;
 235     ok $gz->close();
 236     ok $un eq $hello ;
 237
 238     for my $trans (0 .. 1)
 239     {
 240         title "Testing $CompressClass, Transparent = $trans";
 241
 242         my $info = $gz->getHeaderInfo() ;
 243         my $header_size = $info->{HeaderLength};
 244         my $trailer_size = $info->{TrailerLength};
 245         ok 1, "Compressed size is " . length($compressed) ;
 246         ok 1, "Header size is $header_size" ;
 247         ok 1, "Trailer size is $trailer_size" ;
 248
 249
 250         title "Compressed Data Truncation";
 251         foreach my $i (0 .. $blocksize)
 252         {
 253
 254             my $name = "test.gz" ;
 255             unlink $name ;
 256             my $lex = new LexFile $name ;
 257
 258             ok 1, "Length $i" ;
 259             my $part = substr($compressed, 0, $i);
 260             writeFile($name, $part);
 261             my $gz = new $UncompressClass $name,
 262                                        -BlockSize   => $blocksize,
 263                                        -Transparent => $trans;
 264             if ($trans) {
 265                 ok $gz;
 266                 ok ! $gz->error() ;
 267                 my $buff = '';
 268                 ok $gz->read($buff) == length $part ;
 269                 ok $buff eq $part ;
 270                 ok $gz->eof() ;
 271                 $gz->close();
 272             }
 273             else {
 274                 ok !$gz;
 275             }
 276         }
 277
 278         foreach my $i ($blocksize+1 .. length($compressed)-1)
 279         {
 280
 281             my $name = "test.gz" ;
 282             unlink $name ;
 283             my $lex = new LexFile $name ;
 284
 285             ok 1, "Length $i" ;
 286             my $part = substr($compressed, 0, $i);
 287             writeFile($name, $part);
 288             ok my $gz = new $UncompressClass $name,
 289                                              -BlockSize   => $blocksize,
 290                                              -Transparent => $trans;
 291             my $un ;
 292             my $status = 0 ;
 293             $status = $gz->read($un) while $status >= 0 ;
 294             ok $status < 0 ;
 295             ok $gz->eof() ;
 296             ok $gz->error() ;
 297             $gz->close();
 298         }
 299     }
 300
 301 }
 302