004gziphdr.t

source of perl for linux application,

    # This is the smallest possible gzip file (20 bytes)

    ok my $x = new IO::Compress::Gzip $name, -Minimal => 1;
    ok $x->close ;
    #ok GZreadFile($name) eq '' ;

    ok $x = new IO::Uncompress::Gunzip $name, -Append => 1 ;
    my $data ;
    my $status  = 1;

    $status = $x->read($data)
        while $status >  0;
    is $status, 0 ;
    is $data, '';
    ok ! $x->error() ;
    ok $x->eof() ;

    my $hdr = $x->getHeaderInfo();
    ok $hdr;

    ok defined $hdr->{ISIZE} ;
    is $hdr->{ISIZE}, 0;

    ok defined $hdr->{CRC32} ;
    is $hdr->{CRC32}, 0;

    is $hdr->{Time}, 0;
    ok ! defined $hdr->{Name} ;
    ok ! defined $hdr->{ExtraFieldRaw} ;
    ok ! defined $hdr->{Comment} ;
    is $hdr->{OsName}, 'Unknown' ;
    is $hdr->{MethodName}, "Deflated";
    is $hdr->{Flags}, 0;
    ok $hdr->{isMinimalHeader} ;
    ok ! $hdr->{TextFlag} ;
    ok $x->close ;
}

{
    # Header Corruption Tests

    my $string = <<EOM;
some text
EOM

    my $good = '';
    ok my $x = new IO::Compress::Gzip \$good, -HeaderCRC => 1 ;
    ok $x->write($string) ;
    ok $x->close ;

    {
        title "Header Corruption - Fingerprint wrong 1st byte" ;
        my $buffer = $good ;
        substr($buffer, 0, 1) = 'x' ;

        ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0  ;
        ok $GunzipError =~ /Header Error: Bad Magic/;
    }

    {
        title "Header Corruption - Fingerprint wrong 2nd byte" ;
        my $buffer = $good ;
        substr($buffer, 1, 1) = "\xFF" ;

        ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0  ;
        ok $GunzipError =~ /Header Error: Bad Magic/;
        #print "$GunzipError\n";
    }

    {
        title "Header Corruption - CM not 8";
        my $buffer = $good ;
        substr($buffer, 2, 1) = 'x' ;

        ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0  ;
        like $GunzipError, '/Header Error: Not Deflate \(CM is \d+\)/';
    }

    {
        title "Header Corruption - Use of Reserved Flags";
        my $buffer = $good ;
        substr($buffer, 3, 1) = "\xff";

        ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0  ;
        like $GunzipError, '/Header Error: Use of Reserved Bits in FLG field./';
    }

    {
        title "Header Corruption - Fail HeaderCRC";
        my $buffer = $good ;
        substr($buffer, 10, 1) = chr((ord(substr($buffer, 10, 1)) + 1) & 0xFF);

        ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0, Strict => 1
         or print "# $GunzipError\n";
        like $GunzipError, '/Header Error: CRC16 mismatch/'
            #or diag "buffer length " . length($buffer);
            or hexDump(\$good), hexDump(\$buffer);
    }
}

{
    title "ExtraField max raw size";
    my $x ;
    my $store = "x" x GZIP_FEXTRA_MAX_SIZE ;
    my $z = new IO::Compress::Gzip(\$x, ExtraField => $store, Strict => 0) ;
    ok $z,  "Created IO::Compress::Gzip object" ;
    my $gunz = new IO::Uncompress::Gunzip \$x, Strict => 0;
    ok $gunz, "Created IO::Uncompress::Gunzip object" ;
    my $hdr = $gunz->getHeaderInfo();
    ok $hdr;

    is $hdr->{ExtraFieldRaw}, $store ;
}

{
    title "Header Corruption - ExtraField too big";
    my $x;
    eval { new IO::Compress::Gzip(\$x, -ExtraField => "x" x (GZIP_FEXTRA_MAX_SIZE + 1)) ;};
    like $@, mkErr('Error with ExtraField Parameter: Too Large');
    like $GzipError, '/Error with ExtraField Parameter: Too Large/';
}

{
    title "Header Corruption - Create Name with Illegal Chars";

    my $x;
    eval { new IO::Compress::Gzip \$x, -Name => "fred\x02" };
    like $@, mkErr('Non ISO 8859-1 Character found in Name');
    like $GzipError, '/Non ISO 8859-1 Character found in Name/';

    ok  my $gz = new IO::Compress::Gzip \$x,
		                      -Strict => 0,
		                      -Name => "fred\x02" ;
    ok $gz->close();                          

    ok ! new IO::Uncompress::Gunzip \$x,
                        -Transparent => 0,
                        -Strict => 1;

    like $GunzipError, '/Header Error: Non ISO 8859-1 Character found in Name/';                    
    ok my $gunzip = new IO::Uncompress::Gunzip \$x,
                                   -Strict => 0;

    my $hdr = $gunzip->getHeaderInfo() ;                  

    is $hdr->{Name}, "fred\x02";

}

{
    title "Header Corruption - Null Chars in Name";
    my $x;
    eval { new IO::Compress::Gzip \$x, -Name => "\x00" };
    like $@, mkErr('Null Character found in Name');
    like $GzipError, '/Null Character found in Name/';

    eval { new IO::Compress::Gzip \$x, -Name => "abc\x00" };
    like $@, mkErr('Null Character found in Name');
    like $GzipError, '/Null Character found in Name/';

    ok my $gz = new IO::Compress::Gzip \$x,
		                     -Strict  => 0,
		                     -Name => "abc\x00de" ;
    ok $gz->close() ;                             
    ok my $gunzip = new IO::Uncompress::Gunzip \$x,
                                   -Strict => 0;

    my $hdr = $gunzip->getHeaderInfo() ;                  

    is $hdr->{Name}, "abc";
    
}

{
    title "Header Corruption - Create Comment with Illegal Chars";

    my $x;
    eval { new IO::Compress::Gzip \$x, -Comment => "fred\x02" };
    like $@, mkErr('Non ISO 8859-1 Character found in Comment');
    like $GzipError, '/Non ISO 8859-1 Character found in Comment/';

    ok  my $gz = new IO::Compress::Gzip \$x,
		                      -Strict => 0,
		                      -Comment => "fred\x02" ;
    ok $gz->close();                          

    ok ! new IO::Uncompress::Gunzip \$x, Strict => 1,
                        -Transparent => 0;

    like $GunzipError, '/Header Error: Non ISO 8859-1 Character found in Comment/';
    ok my $gunzip = new IO::Uncompress::Gunzip \$x, Strict => 0;

    my $hdr = $gunzip->getHeaderInfo() ;                  

    is $hdr->{Comment}, "fred\x02";

}

{
    title "Header Corruption - Null Char in Comment";
    my $x;
    eval { new IO::Compress::Gzip \$x, -Comment => "\x00" };
    like $@, mkErr('Null Character found in Comment');
    like $GzipError, '/Null Character found in Comment/';

    eval { new IO::Compress::Gzip \$x, -Comment => "abc\x00" } ;
    like $@, mkErr('Null Character found in Comment');
    like $GzipError, '/Null Character found in Comment/';

    ok my $gz = new IO::Compress::Gzip \$x,
		                     -Strict  => 0,
		                     -Comment => "abc\x00de" ;
    ok $gz->close() ;                             
    ok my $gunzip = new IO::Uncompress::Gunzip \$x,
                                   -Strict => 0;

    my $hdr = $gunzip->getHeaderInfo() ;                  

    is $hdr->{Comment}, "abc";
    
}


for my $index ( GZIP_MIN_HEADER_SIZE + 1 ..  GZIP_MIN_HEADER_SIZE + GZIP_FEXTRA_HEADER_SIZE + 1)
{
    title "Header Corruption - Truncated in Extra";
    my $string = <<EOM;
some text
EOM

    my $truncated ;
    ok my $x = new IO::Compress::Gzip \$truncated, -HeaderCRC => 1, Strict => 0,
				-ExtraField => "hello" x 10  ;
    ok $x->write($string) ;
    ok $x->close ;

    substr($truncated, $index) = '' ;
    #my $lex = new LexFile my $name ;
    #writeFile($name, $truncated) ;

    #my $g = new IO::Uncompress::Gunzip $name, -Transparent => 0; 
    my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0; 
    ok ! $g 
	or print "# $g\n" ;

    like($GunzipError, '/^Header Error: Truncated in FEXTRA/');


}

my $Name = "fred" ;
    my $truncated ;
for my $index ( GZIP_MIN_HEADER_SIZE ..  GZIP_MIN_HEADER_SIZE + length($Name) -1)
{
    title "Header Corruption - Truncated in Name";
    my $string = <<EOM;
some text
EOM

    my $truncated ;
    ok my $x = new IO::Compress::Gzip \$truncated, -Name => $Name;
    ok $x->write($string) ;
    ok $x->close ;

    substr($truncated, $index) = '' ;

    my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0; 
    ok ! $g 
	or print "# $g\n" ;

    like $GunzipError, '/^Header Error: Truncated in FNAME Section/';

}

my $Comment = "comment" ;
for my $index ( GZIP_MIN_HEADER_SIZE ..  GZIP_MIN_HEADER_SIZE + length($Comment) -1)
{
    title "Header Corruption - Truncated in Comment";
    my $string = <<EOM;
some text
EOM

    my $truncated ;
    ok my $x = new IO::Compress::Gzip \$truncated, -Comment => $Comment;
    ok $x->write($string) ;
    ok $x->close ;

    substr($truncated, $index) = '' ;
    #my $lex = new LexFile my $name ;
    #writeFile($name, $truncated) ;

    #my $g = new IO::Uncompress::Gunzip $name, -Transparent => 0; 
    my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0; 
    ok ! $g 
	or print "# $g\n" ;

    like $GunzipError, '/^Header Error: Truncated in FCOMMENT Section/';

}

for my $index ( GZIP_MIN_HEADER_SIZE ..  GZIP_MIN_HEADER_SIZE + GZIP_FHCRC_SIZE -1)
{
    title "Header Corruption - Truncated in CRC";
    my $string = <<EOM;
some text
EOM

    my $truncated ;
    ok my $x = new IO::Compress::Gzip \$truncated, -HeaderCRC => 1;
    ok $x->write($string) ;
    ok $x->close ;

    substr($truncated, $index) = '' ;
    my $lex = new LexFile my $name ;
    writeFile($name, $truncated) ;

    my $g = new IO::Uncompress::Gunzip $name, -Transparent => 0; 
    #my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0; 
    ok ! $g 
	or print "# $g\n" ;

    like $GunzipError, '/^Header Error: Truncated in FHCRC Section/';

}


{
    # Trailer Corruption tests

    my $string = <<EOM;
some text
EOM

    my $good ;
    {
        ok my $x = new IO::Compress::Gzip \$good ;
        ok $x->write($string) ;
        ok $x->close ;
    }

    writeFile($name, $good) ;
    ok my $gunz = new IO::Uncompress::Gunzip $name, 
                                       -Append   => 1,
                                       -Strict   => 1;
    my $uncomp ;
    1 while  $gunz->read($uncomp) > 0 ;
    ok $gunz->close() ;
    ok $uncomp eq $string 
	or print "# got [$uncomp] wanted [$string]\n";;

    foreach my $trim (-8 .. -1)
    {
        my $got = $trim + 8 ;
        title "Trailer Corruption - Trailer truncated to $got bytes" ;
        my $buffer = $good ;
        my $expected_trailing = substr($good, -8, 8) ;
        substr($expected_trailing, $trim) = '';

        substr($buffer, $trim) = '';
        writeFile($name, $buffer) ;

        foreach my $strict (0, 1)
        {
            ok my $gunz = new IO::Uncompress::Gunzip $name, -Strict   => $strict ;
            my $uncomp ;
            if ($strict)
            {
                ok $gunz->read($uncomp) < 0 ;
                like $GunzipError, "/Trailer Error: trailer truncated. Expected 8 bytes, got $got/";
            }
            else
            {
                ok   $gunz->read($uncomp) > 0 ;
                ok ! $GunzipError ;
                my $expected = substr($buffer, - $got);
                is  $gunz->trailingData(),  $expected_trailing;
            }
            ok $gunz->eof() ;
            ok $uncomp eq $string;
            ok $gunz->close ;
        }

    }

    {
        title "Trailer Corruption - Length Wrong, CRC Correct" ;
        my $buffer = $good ;
        my $actual_len = unpack("V", substr($buffer, -4, 4));
        substr($buffer, -4, 4) = pack('V', $actual_len + 1);
        writeFile($name, $buffer) ;

        foreach my $strict (0, 1)
        {
            ok my $gunz = new IO::Uncompress::Gunzip $name, 
                                               -Strict   => $strict ;
            my $uncomp ;
            if ($strict)
            {
                ok $gunz->read($uncomp) < 0 ;
                my $got_len = $actual_len + 1;
                like $GunzipError, "/Trailer Error: ISIZE mismatch. Got $got_len, expected $actual_len/";
            }
            else
            {
                ok   $gunz->read($uncomp) > 0 ;
                ok ! $GunzipError ;
                #is   $gunz->trailingData(), substr($buffer, - $got) ;
            }
            ok ! $gunz->trailingData() ;
            ok $gunz->eof() ;
            ok $uncomp eq $string;
            ok $gunz->close ;
        }

    }

    {
        title "Trailer Corruption - Length Correct, CRC Wrong" ;
        my $buffer = $good ;
        my $actual_crc = unpack("V", substr($buffer, -8, 4));
        substr($buffer, -8, 4) = pack('V', $actual_crc+1);
        writeFile($name, $buffer) ;

        foreach my $strict (0, 1)
        {
            ok my $gunz = new IO::Uncompress::Gunzip $name, 
                                               -Strict   => $strict ;
            my $uncomp ;
            if ($strict)
            {
                ok $gunz->read($uncomp) < 0 ;
                like $GunzipError, '/Trailer Error: CRC mismatch/';
            }
            else
            {
                ok   $gunz->read($uncomp) > 0 ;
                ok ! $GunzipError ;
            }
            ok ! $gunz->trailingData() ;
            ok $gunz->eof() ;
            ok $uncomp eq $string;
            ok $gunz->close ;
        }

    }

    {
        title "Trailer Corruption - Length Wrong, CRC Wrong" ;
        my $buffer = $good ;
        my $actual_len = unpack("V", substr($buffer, -4, 4));
        my $actual_crc = unpack("V", substr($buffer, -8, 4));
        substr($buffer, -4, 4) = pack('V', $actual_len+1);
        substr($buffer, -8, 4) = pack('V', $actual_crc+1);
        writeFile($name, $buffer) ;

        foreach my $strict (0, 1)
        {
            ok my $gunz = new IO::Uncompress::Gunzip $name, 
                                               -Strict   => $strict ;
            my $uncomp ;
            if ($strict)
            {
                ok $gunz->read($uncomp) < 0 ;
                like $GunzipError, '/Trailer Error: CRC mismatch/';
            }
            else
            {
                ok   $gunz->read($uncomp) > 0 ;
                ok ! $GunzipError ;
            }
            ok $gunz->eof() ;
            ok $uncomp eq $string;
            ok $gunz->close ;
        }

    }
}