262 lines
8.6 KiB
Perl
262 lines
8.6 KiB
Perl
package Crypt::CAST5_PP;
|
|
|
|
require 5.004;
|
|
use strict;
|
|
use AutoLoader qw( AUTOLOAD );
|
|
use Carp;
|
|
use integer;
|
|
use vars qw( @s1 @s2 @s3 @s4 @s5 @s6 @s7 @s8 $VERSION );
|
|
|
|
$VERSION = "1.04";
|
|
|
|
sub new {
|
|
my ($class, $key) = @_;
|
|
my $cast5 = { };
|
|
bless $cast5 => $class;
|
|
$cast5->init($key) if defined $key;
|
|
return $cast5;
|
|
} # new
|
|
|
|
sub blocksize { return 8 }
|
|
sub keysize { return 16 }
|
|
|
|
1 # end module
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
Crypt::CAST5_PP - CAST5 block cipher in pure Perl
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use Crypt::CBC;
|
|
|
|
my $crypt = Crypt::CBC->new({
|
|
key => "secret key",
|
|
cipher => "CAST5_PP",
|
|
});
|
|
|
|
my $message = "All mimsy were the borogoves";
|
|
my $ciphertext = $crypt->encrypt($message);
|
|
print unpack("H*", $ciphertext), "\n";
|
|
|
|
my $plaintext = $crypt->decrypt($ciphertext);
|
|
print $plaintext, "\n";
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This module provides a pure Perl implementation of the CAST5 block cipher.
|
|
CAST5 is also known as CAST-128. It is a product of the CAST design
|
|
procedure developed by C. Adams and S. Tavares.
|
|
|
|
The CAST5 cipher is available royalty-free.
|
|
|
|
=head1 FUNCTIONS
|
|
|
|
=head2 blocksize
|
|
|
|
Returns the CAST5 block size, which is 8 bytes. This function exists
|
|
so that Crypt::CAST5_PP can work with Crypt::CBC.
|
|
|
|
=head2 keysize
|
|
|
|
Returns the maximum CAST5 key size, 16 bytes.
|
|
|
|
=head2 new
|
|
|
|
$cast5 = Crypt::CAST5_PP->new($key);
|
|
|
|
Create a new encryption object. If the optional key parameter is given,
|
|
it will be passed to the init() function.
|
|
|
|
=head2 init
|
|
|
|
$cast5->init($key);
|
|
|
|
Set or change the encryption key to be used. The key must be from 40 bits
|
|
(5 bytes) to 128 bits (16 bytes) in length. Note that if the key used is
|
|
80 bits or less, encryption and decryption will be somewhat faster.
|
|
|
|
It is best for the key to be random binary data, not something printable
|
|
like a password. A message digest function may be useful for converting
|
|
a password to an encryption key; see L<Digest::SHA1> or L<Digest::MD5>.
|
|
Note that Crypt::CBC runs the given "key" through MD5 to get the actual
|
|
encryption key.
|
|
|
|
=head2 encrypt
|
|
|
|
$ciphertext = $cast5->encrypt($plaintext);
|
|
|
|
Encrypt a block of plaintext using the current encryption key, and return
|
|
the corresponding ciphertext. The input must be 8 bytes long, and the output
|
|
has the same length. Note that the encryption is in ECB mode, which means
|
|
that it encrypts each block independently. That can leave you vulnerable
|
|
to dictionary attacks, so it is generally best to use some form of chaining
|
|
between blocks; see L<Crypt::CBC>.
|
|
|
|
=head2 decrypt
|
|
|
|
$plaintext = $cast5->decrypt($ciphertext);
|
|
|
|
Decrypt the ciphertext and return the corresponding plaintext.
|
|
|
|
=head1 LIMITATIONS
|
|
|
|
Always produces untainted output, even if the input is tainted, because
|
|
that's what perl's pack() function does.
|
|
|
|
=head1 SEE ALSO
|
|
|
|
RFC 2144, "The CAST-128 Encryption Algorithm", C. Adams, May 1997
|
|
|
|
L<Crypt::CBC>
|
|
|
|
=head1 AUTHOR
|
|
|
|
Bob Mathews, <bobmathews@alumni.calpoly.edu>
|
|
|
|
=head1 COPYRIGHT
|
|
|
|
Copyright (c) 2006 Bob Mathews. All rights reserved.
|
|
This program is free software; you can redistribute it and/or
|
|
modify it under the same terms as Perl itself.
|
|
|
|
=cut
|
|
|
|
sub init {
|
|
use strict;
|
|
use integer;
|
|
my ($cast5, $key) = @_;
|
|
croak "Key length must be 40 to 128 bits"
|
|
if length($key) < 5 || length($key) > 16;
|
|
require Crypt::CAST5_PP::Tables;
|
|
|
|
# untaint the key. this keeps the evals from blowing up later.
|
|
# arguably, a tainted key should result in tainted output. oh well.
|
|
$key =~ /^(.*)$/s and $key = $1;
|
|
|
|
# null-pad the key to 16 bytes, and then split it into 32-bit chunks
|
|
my ($s, $t, $u, $v) = unpack "N4", pack "a16", $key;
|
|
|
|
# compute the key schedule
|
|
# don't try to read this -- it's generated by mkschedule
|
|
my ($w, $x, $y, $z, @k);
|
|
for (1..2) {
|
|
$w=$s^$s5[$v>>16&255]^$s6[$v&255]^$s7[$v>>24&255]^$s8[$v>>8&255]^$s7[$u>>24&255];
|
|
$x=$u^$s5[$w>>24&255]^$s6[$w>>8&255]^$s7[$w>>16&255]^$s8[$w&255]^$s8[$u>>8&255];
|
|
$y=$v^$s5[$x&255]^$s6[$x>>8&255]^$s7[$x>>16&255]^$s8[$x>>24&255]^$s5[$u>>16&255];
|
|
$z=$t^$s5[$y>>8&255]^$s6[$y>>16&255]^$s7[$y&255]^$s8[$y>>24&255]^$s6[$u&255];
|
|
push@k,$s5[$y>>24&255]^$s6[$y>>16&255]^$s7[$x&255]^$s8[$x>>8&255]^$s5[$w>>8&255];
|
|
push@k,$s5[$y>>8&255]^$s6[$y&255]^$s7[$x>>16&255]^$s8[$x>>24&255]^$s6[$x>>8&255];
|
|
push@k,$s5[$z>>24&255]^$s6[$z>>16&255]^$s7[$w&255]^$s8[$w>>8&255]^$s7[$y>>16&255];
|
|
push@k,$s5[$z>>8&255]^$s6[$z&255]^$s7[$w>>16&255]^$s8[$w>>24&255]^$s8[$z>>24&255];
|
|
$s=$y^$s5[$x>>16&255]^$s6[$x&255]^$s7[$x>>24&255]^$s8[$x>>8&255]^$s7[$w>>24&255];
|
|
$t=$w^$s5[$s>>24&255]^$s6[$s>>8&255]^$s7[$s>>16&255]^$s8[$s&255]^$s8[$w>>8&255];
|
|
$u=$x^$s5[$t&255]^$s6[$t>>8&255]^$s7[$t>>16&255]^$s8[$t>>24&255]^$s5[$w>>16&255];
|
|
$v=$z^$s5[$u>>8&255]^$s6[$u>>16&255]^$s7[$u&255]^$s8[$u>>24&255]^$s6[$w&255];
|
|
push@k,$s5[$s&255]^$s6[$s>>8&255]^$s7[$v>>24&255]^$s8[$v>>16&255]^$s5[$u>>24&255];
|
|
push@k,$s5[$s>>16&255]^$s6[$s>>24&255]^$s7[$v>>8&255]^$s8[$v&255]^$s6[$v>>16&255];
|
|
push@k,$s5[$t&255]^$s6[$t>>8&255]^$s7[$u>>24&255]^$s8[$u>>16&255]^$s7[$s&255];
|
|
push@k,$s5[$t>>16&255]^$s6[$t>>24&255]^$s7[$u>>8&255]^$s8[$u&255]^$s8[$t&255];
|
|
$w=$s^$s5[$v>>16&255]^$s6[$v&255]^$s7[$v>>24&255]^$s8[$v>>8&255]^$s7[$u>>24&255];
|
|
$x=$u^$s5[$w>>24&255]^$s6[$w>>8&255]^$s7[$w>>16&255]^$s8[$w&255]^$s8[$u>>8&255];
|
|
$y=$v^$s5[$x&255]^$s6[$x>>8&255]^$s7[$x>>16&255]^$s8[$x>>24&255]^$s5[$u>>16&255];
|
|
$z=$t^$s5[$y>>8&255]^$s6[$y>>16&255]^$s7[$y&255]^$s8[$y>>24&255]^$s6[$u&255];
|
|
push@k,$s5[$w&255]^$s6[$w>>8&255]^$s7[$z>>24&255]^$s8[$z>>16&255]^$s5[$y>>16&255];
|
|
push@k,$s5[$w>>16&255]^$s6[$w>>24&255]^$s7[$z>>8&255]^$s8[$z&255]^$s6[$z>>24&255];
|
|
push@k,$s5[$x&255]^$s6[$x>>8&255]^$s7[$y>>24&255]^$s8[$y>>16&255]^$s7[$w>>8&255];
|
|
push@k,$s5[$x>>16&255]^$s6[$x>>24&255]^$s7[$y>>8&255]^$s8[$y&255]^$s8[$x>>8&255];
|
|
$s=$y^$s5[$x>>16&255]^$s6[$x&255]^$s7[$x>>24&255]^$s8[$x>>8&255]^$s7[$w>>24&255];
|
|
$t=$w^$s5[$s>>24&255]^$s6[$s>>8&255]^$s7[$s>>16&255]^$s8[$s&255]^$s8[$w>>8&255];
|
|
$u=$x^$s5[$t&255]^$s6[$t>>8&255]^$s7[$t>>16&255]^$s8[$t>>24&255]^$s5[$w>>16&255];
|
|
$v=$z^$s5[$u>>8&255]^$s6[$u>>16&255]^$s7[$u&255]^$s8[$u>>24&255]^$s6[$w&255];
|
|
push@k,$s5[$u>>24&255]^$s6[$u>>16&255]^$s7[$t&255]^$s8[$t>>8&255]^$s5[$s&255];
|
|
push@k,$s5[$u>>8&255]^$s6[$u&255]^$s7[$t>>16&255]^$s8[$t>>24&255]^$s6[$t&255];
|
|
push@k,$s5[$v>>24&255]^$s6[$v>>16&255]^$s7[$s&255]^$s8[$s>>8&255]^$s7[$u>>24&255];
|
|
push@k,$s5[$v>>8&255]^$s6[$v&255]^$s7[$s>>16&255]^$s8[$s>>24&255]^$s8[$v>>16&255];
|
|
}
|
|
|
|
for (16..31) { $k[$_] &= 31 }
|
|
delete $cast5->{encrypt};
|
|
delete $cast5->{decrypt};
|
|
$cast5->{rounds} = length($key) <= 10 ? 12 : 16;
|
|
$cast5->{key} = \@k;
|
|
return $cast5;
|
|
} # init
|
|
|
|
sub encrypt {
|
|
use strict;
|
|
use integer;
|
|
my ($cast5, $block) = @_;
|
|
croak "Block size must be 8" if length($block) != 8;
|
|
|
|
my $encrypt = $cast5->{encrypt};
|
|
unless ($encrypt) {
|
|
my $key = $cast5->{key} or croak "Call init() first";
|
|
my $f = 'sub{my($l,$r,$i)=unpack"N2",$_[0];';
|
|
|
|
my ($l, $r) = qw( $l $r );
|
|
my ($op1, $op2, $op3) = qw( + ^ - );
|
|
foreach my $round (0 .. $cast5->{rounds}-1) {
|
|
my $km = $key->[$round];
|
|
my $kr = $key->[$round+16];
|
|
|
|
my $rot = "";
|
|
if ($kr) {
|
|
my $mask = ~(~0<<$kr) & 0xffffffff;
|
|
my $kr2 = 32-$kr;
|
|
$rot = "\$i=\$i<<$kr|\$i>>$kr2&$mask;"
|
|
}
|
|
|
|
$f .= "\$i=$km$op1$r;$rot$l^=((\$s1[\$i>>24&255]$op2\$s2[\$i>>16&255])$op3\$s3[\$i>>8&255])$op1\$s4[\$i&255];";
|
|
($l, $r) = ($r, $l);
|
|
($op1, $op2, $op3) = ($op2, $op3, $op1);
|
|
}
|
|
|
|
$f .= 'pack"N2",$r&0xffffffff,$l&0xffffffff}';
|
|
$cast5->{encrypt} = $encrypt = eval $f;
|
|
}
|
|
|
|
return $encrypt->($block);
|
|
} # encrypt
|
|
|
|
sub decrypt {
|
|
use strict;
|
|
use integer;
|
|
my ($cast5, $block) = @_;
|
|
croak "Block size must be 8" if length($block) != 8;
|
|
|
|
my $decrypt = $cast5->{decrypt};
|
|
unless ($decrypt) {
|
|
my $key = $cast5->{key} or croak "Call init() first";
|
|
my $rounds = $cast5->{rounds};
|
|
my $f = 'sub{my($r,$l,$i)=unpack"N2",$_[0];';
|
|
|
|
my ($l, $r) = qw( $r $l );
|
|
my ($op1, $op2, $op3) = qw( - + ^ );
|
|
foreach (1 .. $rounds%3) { ($op1, $op2, $op3) = ($op2, $op3, $op1) }
|
|
foreach my $round (1 .. $rounds) {
|
|
my $km = $key->[$rounds-$round];
|
|
my $kr = $key->[$rounds-$round+16];
|
|
|
|
my $rot = "";
|
|
if ($kr) {
|
|
my $mask = ~(~0<<$kr) & 0xffffffff;
|
|
my $kr2 = 32-$kr;
|
|
$rot = "\$i=\$i<<$kr|\$i>>$kr2&$mask;"
|
|
}
|
|
|
|
$f .= "\$i=$km$op1$r;$rot$l^=((\$s1[\$i>>24&255]$op2\$s2[\$i>>16&255])$op3\$s3[\$i>>8&255])$op1\$s4[\$i&255];";
|
|
($l, $r) = ($r, $l);
|
|
($op1, $op2, $op3) = ($op3, $op1, $op2);
|
|
}
|
|
|
|
$f .= 'pack"N2",$l&0xffffffff,$r&0xffffffff}';
|
|
$cast5->{decrypt} = $decrypt = eval $f;
|
|
}
|
|
|
|
return $decrypt->($block);
|
|
} # decrypt
|
|
|
|
# end CAST5_PP.pm
|