view release on metacpan or  search on metacpan

t/parameters.t  view on Meta::CPAN

test(
     Crypt::CBC->new(-cipher                  => 'Crypt::Crypt16',
		     -header                  => 'salt',
		     -key                     => 'test key',
		     -nodeprecate             => 1,
		     -salt                    => 'goodsalt')->salt eq 'goodsalt',
     "module did not allow setting and retrieval of a good salt");

test(
     !defined eval {Crypt::CBC->new(-cipher                  => 'Crypt::Crypt16',
				    -header                  => 'badheadermethod',
				    -nodeprecate             => 1,
				    -key                     => 'test key')},
     "module allowed setting of an invalid header method, and shouldn't have");

test(
     !defined eval {Crypt::CBC->new(-cipher                  => 'Crypt::Crypt16',
				    -header                  => 'none',
				    -pbkdf                   => 'none',
				    -key                     => 'a'x16)
     },
     "module allowed initialization of pbkdf method 'none' without an iv");

test(
     !defined eval {Crypt::CBC->new(-cipher                  => 'Crypt::Crypt16',
				    -header                  => 'none',
				    -nodeprecate             => 1,
				    -iv                      => 'a'x16)
     },
     "module allowed initialization of header_mode 'none' without a key");

$crypt = eval {Crypt::CBC->new(-cipher         => 'Crypt::Crypt8',
			       -literal_key    => 1,
			       -header         => 'none',
			       -key            => 'a'x56,
			       -iv             => 'b'x8,
			       -nodeprecate             => 1,
			      ) };
test(defined $crypt,"unable to create a Crypt::CBC object with the -literal_key option: $@");
test($plaintext eq $crypt->decrypt($crypt->encrypt($plaintext)),'cannot decrypt encrypted data using -literal_key');
test($crypt->passphrase eq '','passphrase should be empty when -literal_key specified');
test($crypt->key eq 'a'x56,'key should match provided -key argument when -literal_key specified');

# test behavior of pbkdf option
test($crypt->pbkdf eq 'none','PBKDF should default to "none" when -literal_key provided, but got '.$crypt->pbkdf);

$crypt = eval {Crypt::CBC->new(-cipher  => 'Crypt::Crypt8',-pass=>'very secret',-nodeprecate=>1)} or warn $@;
test($crypt->pbkdf eq 'opensslv1','PBKDF should default to "opensslv1", but got '.$crypt->pbkdf);

$crypt = eval {Crypt::CBC->new(-cipher  => 'Crypt::Crypt8',-pass=>'very secret',-pbkdf=>'pbkdf2')} or warn $@;
test($crypt->pbkdf eq 'pbkdf2','PBKDF not setting properly. Expected "pbkdf2" but got '.$crypt->pbkdf);

$crypt = eval {Crypt::CBC->new(-cipher  => 'Crypt::Crypt8',
			       -pass=>'very secret',
			       -pbkdf=>'pbkdf2',
			       -hasher=>'HMACSHA3',
			       -iter=>1000)} or warn $@;
my $pbkdf = $crypt->pbkdf_obj;
test(defined $pbkdf,"PBKDF object not created as expected");
test($pbkdf->{hash_class} eq 'HMACSHA3','pbkdf object hasher not initialized to correct class');
test($pbkdf->{iterations} == 1000,'pbkdf object hasher not initialized to correct number of iterations');

test( !eval {Crypt::CBC->new(-cipher  => 'Crypt::Crypt8',
			    -pass=>'very secret',
			    -pbkdf=>'pbkdf2',
			    -iv   => 'b'x8,
			    -header=>'randomiv')
      },
      'module should not allow a header mode of randomiv and a pbkdf not equal to randomiv'
    );

$crypt = eval {Crypt::CBC->new(-cipher  => 'Crypt::Crypt8',
			       -pass=>'very secret',
			       -pbkdf=>'pbkdf2',
			       -iv   => 'b'x8,
			       -header=>'none'),
} or warn $@;
# not sure this test is correct behaviour
# test(73,$crypt->pbkdf eq 'none','pbkdf should be set to "none" when header mode of "none" used');

# now test that setting the -salt generates the same key and IV
$crypt = eval {Crypt::CBC->new(-cipher => 'Crypt::Crypt8',
			       -pass   => 'baby knows me well',
			       -pbkdf  => 'pbkdf2',
			       -salt   => '01234567')} or warn $@;
test($crypt->salt eq '01234567',"can't set salt properly");
$crypt->set_key_and_iv();  # need to do this before there is a key and iv
my ($key,$iv) = ($crypt->key,$crypt->iv);
$crypt = eval {Crypt::CBC->new(-cipher => 'Crypt::Crypt8',
			       -pass   => 'baby knows me well',
			       -pbkdf  => 'pbkdf2',
			       -salt   => '01234567')} or warn $@;
$crypt->set_key_and_iv();
test($crypt->key eq $key,"key changed even when salt was forced");
test($crypt->iv  eq $iv,"iv changed even when salt was forced");
$crypt = eval {Crypt::CBC->new(-cipher => 'Crypt::Crypt8',
			       -pass   => 'baby knows me well',
			       -pbkdf  => 'pbkdf2',
			       -salt   => '76543210')} or warn $@;
$crypt->set_key_and_iv();
test($crypt->key ne $key,"key didn't change when salt was changed");
$crypt = eval {
    Crypt::CBC->new(-cipher => 'Crypt::Crypt8',
		    -key    => 'xyz',
		    -header => 'salt',
		    -salt   => 1);
};
test($crypt,"-salt=>1 is generating an exception: $@");

exit 0;

my $number = 1;

sub test ($$){
    local($^W) = 0;
    my($true,$msg) = @_;
    $msg =~ s/\n$//;
    ++$number;
    print($true ? "ok $number\n" : "not ok $number # $msg\n");
}