004gziphdr.t

source of perl for linux application,

BEGIN {
    if ($ENV{PERL_CORE}) {
	chdir 't' if -d 't';
	@INC = ("../lib", "lib/compress");
    }
}

use lib qw(t t/compress);
use strict;
use warnings;
use bytes;

use Test::More ;
use CompTestUtils;

BEGIN {
    # use Test::NoWarnings, if available
    my $extra = 0 ;
    $extra = 1
        if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };


    plan tests => 910 + $extra ;

    use_ok('Compress::Raw::Zlib') ;
    use_ok('IO::Compress::Gzip::Constants') ;

    use_ok('IO::Compress::Gzip', qw($GzipError)) ;
    use_ok('IO::Uncompress::Gunzip', qw($GunzipError)) ;

}



# Check the Gzip Header Parameters
#========================================

my $ThisOS_code = $Compress::Raw::Zlib::gzip_os_code;

my $lex = new LexFile my $name ;

{
    title "Check Defaults";
    # Check Name defaults undef, no name, no comment
    # and Time can be explicitly set.

    my $hdr = readHeaderInfo($name, -Time => 1234);

    is $hdr->{Time}, 1234;
    ok ! defined $hdr->{Name};
    is $hdr->{MethodName}, 'Deflated';
    is $hdr->{ExtraFlags}, 0;
    is $hdr->{MethodID}, Z_DEFLATED;
    is $hdr->{OsID}, $ThisOS_code ;
    ok ! defined $hdr->{Comment} ;
    ok ! defined $hdr->{ExtraFieldRaw} ;
    ok ! defined $hdr->{HeaderCRC} ;
    ok ! $hdr->{isMinimalHeader} ;
}

{

    title "Check name can be different from filename" ;
    # Check Name can be different from filename
    # Comment and Extra can be set
    # Can specify a zero Time 

    my $comment = "This is a Comment" ;
    my $extra = "A little something extra" ;
    my $aname = "a new name" ;
    my $hdr = readHeaderInfo $name, 
				      -Strict     => 0,
				      -Name       => $aname,
    				  -Comment    => $comment,
    				  -ExtraField => $extra,
    				  -Time       => 0 ;

    ok $hdr->{Time} == 0;
    ok $hdr->{Name} eq $aname;
    ok $hdr->{MethodName} eq 'Deflated';
    ok $hdr->{MethodID} == 8;
    is $hdr->{ExtraFlags}, 0;
    ok $hdr->{Comment} eq $comment ;
    is $hdr->{OsID}, $ThisOS_code ;
    ok ! $hdr->{isMinimalHeader} ;
    ok ! defined $hdr->{HeaderCRC} ;
}

{
    title "Check Time defaults to now" ;

    # Check Time defaults to now
    # and that can have empty name, comment and extrafield
    my $before = time ;
    my $hdr = readHeaderInfo $name, 
		          -TextFlag   => 1,
		          -Name       => "",
    		      -Comment    => "",
    		      -ExtraField => "";
    my $after = time ;

    ok $hdr->{Time} >= $before ;
    ok $hdr->{Time} <= $after ;

    ok defined $hdr->{Name} ;
    ok $hdr->{Name} eq "";
    ok defined $hdr->{Comment} ;
    ok $hdr->{Comment} eq "";
    ok defined $hdr->{ExtraFieldRaw} ;
    ok $hdr->{ExtraFieldRaw} eq "";
    is $hdr->{ExtraFlags}, 0;

    ok ! $hdr->{isMinimalHeader} ;
    ok   $hdr->{TextFlag} ;
    ok ! defined $hdr->{HeaderCRC} ;
    is $hdr->{OsID}, $ThisOS_code ;

}

{
    title "can have null extrafield" ;

    my $before = time ;
    my $hdr = readHeaderInfo $name, 
				      -strict     => 0,
		              -Name       => "a",
    			      -Comment    => "b",
    			      -ExtraField => "\x00";
    my $after = time ;

    ok $hdr->{Time} >= $before ;
    ok $hdr->{Time} <= $after ;
    ok $hdr->{Name} eq "a";
    ok $hdr->{Comment} eq "b";
    is $hdr->{ExtraFlags}, 0;
    ok $hdr->{ExtraFieldRaw} eq "\x00";
    ok ! $hdr->{isMinimalHeader} ;
    ok ! $hdr->{TextFlag} ;
    ok ! defined $hdr->{HeaderCRC} ;
    is $hdr->{OsID}, $ThisOS_code ;

}

{
    title "can have undef name, comment, time and extrafield" ;

    my $hdr = readHeaderInfo $name, 
	                  -Name       => undef,
    		          -Comment    => undef,
    		          -ExtraField => undef,
                      -Time       => undef;

    ok $hdr->{Time} == 0;
    ok ! defined $hdr->{Name} ;
    ok ! defined $hdr->{Comment} ;
    ok ! defined $hdr->{ExtraFieldRaw} ;
    ok ! $hdr->{isMinimalHeader} ;
    ok ! $hdr->{TextFlag} ;
    ok ! defined $hdr->{HeaderCRC} ;
    is $hdr->{OsID}, $ThisOS_code ;

}

for my $value ( "0D", "0A", "0A0D", "0D0A", "0A0A", "0D0D")
{
    title "Comment with $value" ;

    my $v = pack "h*", $value;
    my $comment = "my${v}comment$v";
    my $hdr = readHeaderInfo $name, 
                    Time => 0,
                  -TextFlag   => 1, 
                  -Name       => "",
                  -Comment    => $comment,
                  -ExtraField => "";
    my $after = time ;

    is $hdr->{Time}, 0 ;

    ok defined $hdr->{Name} ;
    ok $hdr->{Name} eq "";
    ok defined $hdr->{Comment} ;
    is $hdr->{Comment}, $comment;
    ok defined $hdr->{ExtraFieldRaw} ;
    ok $hdr->{ExtraFieldRaw} eq "";
    is $hdr->{ExtraFlags}, 0;

    ok ! $hdr->{isMinimalHeader} ;
    ok   $hdr->{TextFlag} ;
    ok ! defined $hdr->{HeaderCRC} ;
    is $hdr->{OsID}, $ThisOS_code ;
}

{
    title "Check crchdr" ;

    my $hdr = readHeaderInfo $name, -HeaderCRC  => 1;

    ok ! defined $hdr->{Name};
    is $hdr->{ExtraFlags}, 0;
    ok ! defined $hdr->{ExtraFieldRaw} ;
    ok ! defined $hdr->{Comment} ;
    ok ! $hdr->{isMinimalHeader} ;
    ok ! $hdr->{TextFlag} ;
    ok   defined $hdr->{HeaderCRC} ;
    is $hdr->{OsID}, $ThisOS_code ;
}

{
    title "Check ExtraFlags" ;

    my $hdr = readHeaderInfo $name, -Level  => Z_BEST_SPEED;

    ok ! defined $hdr->{Name};
    is $hdr->{ExtraFlags}, 2;
    ok ! defined $hdr->{ExtraFieldRaw} ;
    ok ! defined $hdr->{Comment} ;
    ok ! $hdr->{isMinimalHeader} ;
    ok ! $hdr->{TextFlag} ;
    ok ! defined $hdr->{HeaderCRC} ;

    $hdr = readHeaderInfo $name, -Level  => Z_BEST_COMPRESSION;

    ok ! defined $hdr->{Name};
    is $hdr->{ExtraFlags}, 4;
    ok ! defined $hdr->{ExtraFieldRaw} ;
    ok ! defined $hdr->{Comment} ;
    ok ! $hdr->{isMinimalHeader} ;
    ok ! $hdr->{TextFlag} ;
    ok ! defined $hdr->{HeaderCRC} ;

    $hdr = readHeaderInfo $name, -Level  => Z_BEST_COMPRESSION,
                                 -ExtraFlags => 42;

    ok ! defined $hdr->{Name};
    is $hdr->{ExtraFlags}, 42;
    ok ! defined $hdr->{ExtraFieldRaw} ;
    ok ! defined $hdr->{Comment} ;
    ok ! $hdr->{isMinimalHeader} ;
    ok ! $hdr->{TextFlag} ;
    ok ! defined $hdr->{HeaderCRC} ;


}

{
    title "OS Code" ;

    for my $code ( -1, undef, '', 'fred' )
    {
        my $code_name = defined $code ? "'$code'" : "'undef'";
        eval { new IO::Compress::Gzip $name, -OS_Code => $code } ;
        like $@, mkErr("^IO::Compress::Gzip: Parameter 'OS_Code' must be an unsigned int, got $code_name"),
            " Trap OS Code $code_name";
    }

    for my $code ( qw( 256 ) )
    {
        eval { ok ! new IO::Compress::Gzip($name, OS_Code => $code) };
        like $@, mkErr("OS_Code must be between 0 and 255, got '$code'"),
            " Trap OS Code $code";
        like $GzipError, "/OS_Code must be between 0 and 255, got '$code'/",
            " Trap OS Code $code";
    }

    for my $code ( qw(0 1 12 254 255) )
    {
        my $hdr = readHeaderInfo $name, OS_Code => $code;

        is $hdr->{OsID}, $code, "  Code is $code" ;
    }



}

{
    title 'Check ExtraField';

    my @tests = (
        [1, ['AB' => '']                   => [['AB'=>'']] ],
        [1, {'AB' => ''}                   => [['AB'=>'']] ],
        [1, ['AB' => 'Fred']               => [['AB'=>'Fred']] ],
        [1, {'AB' => 'Fred'}               => [['AB'=>'Fred']] ],
        [1, ['Xx' => '','AB' => 'Fred']    => [['Xx' => ''],['AB'=>'Fred']] ],
        [1, ['Xx' => '','Xx' => 'Fred']    => [['Xx' => ''],['Xx'=>'Fred']] ],
        [1, ['Xx' => '',
             'Xx' => 'Fred', 
             'Xx' => 'Fred']               => [['Xx' => ''],['Xx'=>'Fred'],
                                               ['Xx'=>'Fred']] ],
        [1, [ ['Xx' => 'a'],
              ['AB' => 'Fred'] ]           => [['Xx' => 'a'],['AB'=>'Fred']] ],
        [0, {'AB' => 'Fred', 
             'Pq' => 'r', 
             "\x01\x02" => "\x03"}         => [['AB'=>'Fred'],
                                               ['Pq'=>'r'], 
                                               ["\x01\x02"=>"\x03"]] ],
        [1, ['AB' => 'z' x GZIP_FEXTRA_SUBFIELD_MAX_SIZE] => 
                            [['AB'=>'z' x GZIP_FEXTRA_SUBFIELD_MAX_SIZE]] ],
                );

    foreach my $test (@tests) {
        my ($order, $input, $result) = @$test ;
        ok my $x = new IO::Compress::Gzip $name,
                                -ExtraField  => $input,
                                -HeaderCRC   => 1
            or diag "GzipError is $GzipError" ;                            ;
        my $string = "abcd" ;
        ok $x->write($string) ;
        ok $x->close ;
        #is GZreadFile($name), $string ;

        ok $x = new IO::Uncompress::Gunzip $name,
                              #-Strict     => 1,
                               -ParseExtra => 1
            or diag "GunzipError is $GunzipError" ;                            ;
        my $hdr = $x->getHeaderInfo();
        ok $hdr;
        ok ! defined $hdr->{Name};
        ok ! defined $hdr->{Comment} ;
        ok ! $hdr->{isMinimalHeader} ;
        ok ! $hdr->{TextFlag} ;
        ok   defined $hdr->{HeaderCRC} ;

        ok   defined $hdr->{ExtraFieldRaw} ;
        ok   defined $hdr->{ExtraField} ;

        my $extra = $hdr->{ExtraField} ;

        if ($order) {
            eq_array $extra, $result;
        } else {
            eq_set $extra, $result;
        } 
    }

}

{
    title 'Write Invalid ExtraField';

    my $prefix = 'Error with ExtraField Parameter: ';
    my @tests = (
            [ sub{ "abc" }        => "Not a scalar, array ref or hash ref"],
            [ [ "a" ]             => "Not even number of elements"],
            [ [ "a" => "fred" ]   => 'SubField ID not two chars long'],
            [ [ "a\x00" => "fred" ]   => 'SubField ID 2nd byte is 0x00'],
            [ [ [ {}, "abc" ]]    => "SubField ID is a reference"],
            [ [ [ "ab", \1 ]]     => "SubField Data is a reference"],
            [ [ {"a" => "fred"} ] => "Not list of lists"],
            [ [ ['ab'=>'x'],{"a" => "fred"} ] => "Not list of lists"],
            [ [ ["aa"] ]          => "SubField must have two parts"],
            [ [ ["aa", "b", "c"] ] => "SubField must have two parts"],
            [ [ ["ab" => 'x' x (GZIP_FEXTRA_SUBFIELD_MAX_SIZE + 1) ] ] 
                                   => "SubField Data too long"],

            [ { 'abc', 1 }        => "SubField ID not two chars long"],
            [ { \1 , "abc" }    => "SubField ID not two chars long"],
            [ { "ab", \1 }     => "SubField Data is a reference"],
        );

    

    foreach my $test (@tests) {
        my ($input, $string) = @$test ;
        my $buffer ;
        my $x ;
        eval { $x = new IO::Compress::Gzip \$buffer, -ExtraField  => $input; };
        like $@, mkErr("$prefix$string");  
        like $GzipError, "/$prefix$string/";  
        ok ! $x ;

    }

}

{
    # Corrupt ExtraField

    my @tests = (
        ["Sub-field truncated",           
            "Error with ExtraField Parameter: Truncated in FEXTRA Body Section",
            "Header Error: Truncated in FEXTRA Body Section",
            ['a', undef, undef]              ],
        ["Length of field incorrect",     
            "Error with ExtraField Parameter: Truncated in FEXTRA Body Section",
            "Header Error: Truncated in FEXTRA Body Section",
            ["ab", 255, "abc"]               ],
        ["Length of 2nd field incorrect", 
            "Error with ExtraField Parameter: Truncated in FEXTRA Body Section",
            "Header Error: Truncated in FEXTRA Body Section",
            ["ab", 3, "abc"], ["de", 7, "x"] ],
        ["Length of 2nd field incorrect", 
            "Error with ExtraField Parameter: SubField ID 2nd byte is 0x00",
            "Header Error: SubField ID 2nd byte is 0x00",
            ["a\x00", 3, "abc"], ["de", 7, "x"] ],
        );

    foreach my $test (@tests)
    {
        my $name = shift @$test;
        my $gzip_error = shift @$test;
        my $gunzip_error = shift @$test;

        title "Read Corrupt ExtraField - $name" ;

        my $input = '';

        for my $field (@$test)
        {
            my ($id, $len, $data) = @$field;

            $input .= $id if defined $id ;
            $input .= pack("v", $len) if defined $len ;
            $input .= $data if defined $data;
        }
        #hexDump(\$input);

        my $buffer ;
        my $x ;
        eval {$x = new IO::Compress::Gzip \$buffer, -ExtraField  => $input, Strict => 1; };
        like $@, mkErr("$gzip_error"), "  $name";  
        like $GzipError, "/$gzip_error/", "  $name";  

        ok ! $x, "  IO::Compress::Gzip fails";
        like $GzipError, "/$gzip_error/", "  $name";  

        foreach my $check (0, 1)    
        {
            ok $x = new IO::Compress::Gzip \$buffer, 
                                           ExtraField => $input, 
                                           Strict     => 0
                or diag "GzipError is $GzipError" ;
            my $string = "abcd" ;
            $x->write($string) ;
            $x->close ;
            is anyUncompress(\$buffer), $string ;

            $x = new IO::Uncompress::Gunzip \$buffer, 
                                       Strict      => 0,
                                       Transparent => 0,
                                       ParseExtra  => $check;
            if ($check) {
                ok ! $x ;
                like $GunzipError, "/^$gunzip_error/";  
            }
            else {
                ok $x ;
            }

        }
    }
}


{
    title 'Check Minimal';

    ok my $x = new IO::Compress::Gzip $name, -Minimal => 1;
    my $string = "abcd" ;
    ok $x->write($string) ;
    ok $x->close ;
    #is GZreadFile($name), $string ;

    ok $x = new IO::Uncompress::Gunzip $name  ;
    my $hdr = $x->getHeaderInfo();
    ok $hdr;
    ok $hdr->{Time} == 0;
    is $hdr->{ExtraFlags}, 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 ;
}

{
    # Check Minimal + no comressed data