1package Crypt::CAST5_PP; 2 3require 5.004; 4use strict; 5use AutoLoader qw( AUTOLOAD ); 6use Carp; 7use integer; 8use vars qw( @s1 @s2 @s3 @s4 @s5 @s6 @s7 @s8 $VERSION ); 9 10$VERSION = "1.04"; 11 12sub new { 13 my ($class, $key) = @_; 14 my $cast5 = { }; 15 bless $cast5 => $class; 16 $cast5->init($key) if defined $key; 17 return $cast5; 18} # new 19 20sub blocksize { return 8 } 21sub keysize { return 16 } 22 231 # end module 24__END__ 25 26=head1 NAME 27 28Crypt::CAST5_PP - CAST5 block cipher in pure Perl 29 30=head1 SYNOPSIS 31 32 use Crypt::CBC; 33 34 my $crypt = Crypt::CBC->new({ 35 key => "secret key", 36 cipher => "CAST5_PP", 37 }); 38 39 my $message = "All mimsy were the borogoves"; 40 my $ciphertext = $crypt->encrypt($message); 41 print unpack("H*", $ciphertext), "\n"; 42 43 my $plaintext = $crypt->decrypt($ciphertext); 44 print $plaintext, "\n"; 45 46=head1 DESCRIPTION 47 48This module provides a pure Perl implementation of the CAST5 block cipher. 49CAST5 is also known as CAST-128. It is a product of the CAST design 50procedure developed by C. Adams and S. Tavares. 51 52The CAST5 cipher is available royalty-free. 53 54=head1 FUNCTIONS 55 56=head2 blocksize 57 58Returns the CAST5 block size, which is 8 bytes. This function exists 59so that Crypt::CAST5_PP can work with Crypt::CBC. 60 61=head2 keysize 62 63Returns the maximum CAST5 key size, 16 bytes. 64 65=head2 new 66 67 $cast5 = Crypt::CAST5_PP->new($key); 68 69Create a new encryption object. If the optional key parameter is given, 70it will be passed to the init() function. 71 72=head2 init 73 74 $cast5->init($key); 75 76Set or change the encryption key to be used. The key must be from 40 bits 77(5 bytes) to 128 bits (16 bytes) in length. Note that if the key used is 7880 bits or less, encryption and decryption will be somewhat faster. 79 80It is best for the key to be random binary data, not something printable 81like a password. A message digest function may be useful for converting 82a password to an encryption key; see L<Digest::SHA1> or L<Digest::MD5>. 83Note that Crypt::CBC runs the given "key" through MD5 to get the actual 84encryption key. 85 86=head2 encrypt 87 88 $ciphertext = $cast5->encrypt($plaintext); 89 90Encrypt a block of plaintext using the current encryption key, and return 91the corresponding ciphertext. The input must be 8 bytes long, and the output 92has the same length. Note that the encryption is in ECB mode, which means 93that it encrypts each block independently. That can leave you vulnerable 94to dictionary attacks, so it is generally best to use some form of chaining 95between blocks; see L<Crypt::CBC>. 96 97=head2 decrypt 98 99 $plaintext = $cast5->decrypt($ciphertext); 100 101Decrypt the ciphertext and return the corresponding plaintext. 102 103=head1 LIMITATIONS 104 105Always produces untainted output, even if the input is tainted, because 106that's what perl's pack() function does. 107 108=head1 SEE ALSO 109 110RFC 2144, "The CAST-128 Encryption Algorithm", C. Adams, May 1997 111 112L<Crypt::CBC> 113 114=head1 AUTHOR 115 116Bob Mathews, <bobmathews@alumni.calpoly.edu> 117 118=head1 COPYRIGHT 119 120Copyright (c) 2006 Bob Mathews. All rights reserved. 121This program is free software; you can redistribute it and/or 122modify it under the same terms as Perl itself. 123 124=cut 125 126sub init { 127 use strict; 128 use integer; 129 my ($cast5, $key) = @_; 130 croak "Key length must be 40 to 128 bits" 131 if length($key) < 5 || length($key) > 16; 132 require Crypt::CAST5_PP::Tables; 133 134 # untaint the key. this keeps the evals from blowing up later. 135 # arguably, a tainted key should result in tainted output. oh well. 136 $key =~ /^(.*)$/s and $key = $1; 137 138 # null-pad the key to 16 bytes, and then split it into 32-bit chunks 139 my ($s, $t, $u, $v) = unpack "N4", pack "a16", $key; 140 141 # compute the key schedule 142 # don't try to read this -- it's generated by mkschedule 143 my ($w, $x, $y, $z, @k); 144 for (1..2) { 145 $w=$s^$s5[$v>>16&255]^$s6[$v&255]^$s7[$v>>24&255]^$s8[$v>>8&255]^$s7[$u>>24&255]; 146 $x=$u^$s5[$w>>24&255]^$s6[$w>>8&255]^$s7[$w>>16&255]^$s8[$w&255]^$s8[$u>>8&255]; 147 $y=$v^$s5[$x&255]^$s6[$x>>8&255]^$s7[$x>>16&255]^$s8[$x>>24&255]^$s5[$u>>16&255]; 148 $z=$t^$s5[$y>>8&255]^$s6[$y>>16&255]^$s7[$y&255]^$s8[$y>>24&255]^$s6[$u&255]; 149 push@k,$s5[$y>>24&255]^$s6[$y>>16&255]^$s7[$x&255]^$s8[$x>>8&255]^$s5[$w>>8&255]; 150 push@k,$s5[$y>>8&255]^$s6[$y&255]^$s7[$x>>16&255]^$s8[$x>>24&255]^$s6[$x>>8&255]; 151 push@k,$s5[$z>>24&255]^$s6[$z>>16&255]^$s7[$w&255]^$s8[$w>>8&255]^$s7[$y>>16&255]; 152 push@k,$s5[$z>>8&255]^$s6[$z&255]^$s7[$w>>16&255]^$s8[$w>>24&255]^$s8[$z>>24&255]; 153 $s=$y^$s5[$x>>16&255]^$s6[$x&255]^$s7[$x>>24&255]^$s8[$x>>8&255]^$s7[$w>>24&255]; 154 $t=$w^$s5[$s>>24&255]^$s6[$s>>8&255]^$s7[$s>>16&255]^$s8[$s&255]^$s8[$w>>8&255]; 155 $u=$x^$s5[$t&255]^$s6[$t>>8&255]^$s7[$t>>16&255]^$s8[$t>>24&255]^$s5[$w>>16&255]; 156 $v=$z^$s5[$u>>8&255]^$s6[$u>>16&255]^$s7[$u&255]^$s8[$u>>24&255]^$s6[$w&255]; 157 push@k,$s5[$s&255]^$s6[$s>>8&255]^$s7[$v>>24&255]^$s8[$v>>16&255]^$s5[$u>>24&255]; 158 push@k,$s5[$s>>16&255]^$s6[$s>>24&255]^$s7[$v>>8&255]^$s8[$v&255]^$s6[$v>>16&255]; 159 push@k,$s5[$t&255]^$s6[$t>>8&255]^$s7[$u>>24&255]^$s8[$u>>16&255]^$s7[$s&255]; 160 push@k,$s5[$t>>16&255]^$s6[$t>>24&255]^$s7[$u>>8&255]^$s8[$u&255]^$s8[$t&255]; 161 $w=$s^$s5[$v>>16&255]^$s6[$v&255]^$s7[$v>>24&255]^$s8[$v>>8&255]^$s7[$u>>24&255]; 162 $x=$u^$s5[$w>>24&255]^$s6[$w>>8&255]^$s7[$w>>16&255]^$s8[$w&255]^$s8[$u>>8&255]; 163 $y=$v^$s5[$x&255]^$s6[$x>>8&255]^$s7[$x>>16&255]^$s8[$x>>24&255]^$s5[$u>>16&255]; 164 $z=$t^$s5[$y>>8&255]^$s6[$y>>16&255]^$s7[$y&255]^$s8[$y>>24&255]^$s6[$u&255]; 165 push@k,$s5[$w&255]^$s6[$w>>8&255]^$s7[$z>>24&255]^$s8[$z>>16&255]^$s5[$y>>16&255]; 166 push@k,$s5[$w>>16&255]^$s6[$w>>24&255]^$s7[$z>>8&255]^$s8[$z&255]^$s6[$z>>24&255]; 167 push@k,$s5[$x&255]^$s6[$x>>8&255]^$s7[$y>>24&255]^$s8[$y>>16&255]^$s7[$w>>8&255]; 168 push@k,$s5[$x>>16&255]^$s6[$x>>24&255]^$s7[$y>>8&255]^$s8[$y&255]^$s8[$x>>8&255]; 169 $s=$y^$s5[$x>>16&255]^$s6[$x&255]^$s7[$x>>24&255]^$s8[$x>>8&255]^$s7[$w>>24&255]; 170 $t=$w^$s5[$s>>24&255]^$s6[$s>>8&255]^$s7[$s>>16&255]^$s8[$s&255]^$s8[$w>>8&255]; 171 $u=$x^$s5[$t&255]^$s6[$t>>8&255]^$s7[$t>>16&255]^$s8[$t>>24&255]^$s5[$w>>16&255]; 172 $v=$z^$s5[$u>>8&255]^$s6[$u>>16&255]^$s7[$u&255]^$s8[$u>>24&255]^$s6[$w&255]; 173 push@k,$s5[$u>>24&255]^$s6[$u>>16&255]^$s7[$t&255]^$s8[$t>>8&255]^$s5[$s&255]; 174 push@k,$s5[$u>>8&255]^$s6[$u&255]^$s7[$t>>16&255]^$s8[$t>>24&255]^$s6[$t&255]; 175 push@k,$s5[$v>>24&255]^$s6[$v>>16&255]^$s7[$s&255]^$s8[$s>>8&255]^$s7[$u>>24&255]; 176 push@k,$s5[$v>>8&255]^$s6[$v&255]^$s7[$s>>16&255]^$s8[$s>>24&255]^$s8[$v>>16&255]; 177 } 178 179 for (16..31) { $k[$_] &= 31 } 180 delete $cast5->{encrypt}; 181 delete $cast5->{decrypt}; 182 $cast5->{rounds} = length($key) <= 10 ? 12 : 16; 183 $cast5->{key} = \@k; 184 return $cast5; 185} # init 186 187sub encrypt { 188 use strict; 189 use integer; 190 my ($cast5, $block) = @_; 191 croak "Block size must be 8" if length($block) != 8; 192 193 my $encrypt = $cast5->{encrypt}; 194 unless ($encrypt) { 195 my $key = $cast5->{key} or croak "Call init() first"; 196 my $f = 'sub{my($l,$r,$i)=unpack"N2",$_[0];'; 197 198 my ($l, $r) = qw( $l $r ); 199 my ($op1, $op2, $op3) = qw( + ^ - ); 200 foreach my $round (0 .. $cast5->{rounds}-1) { 201 my $km = $key->[$round]; 202 my $kr = $key->[$round+16]; 203 204 my $rot = ""; 205 if ($kr) { 206 my $mask = ~(~0<<$kr) & 0xffffffff; 207 my $kr2 = 32-$kr; 208 $rot = "\$i=\$i<<$kr|\$i>>$kr2&$mask;" 209 } 210 211 $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];"; 212 ($l, $r) = ($r, $l); 213 ($op1, $op2, $op3) = ($op2, $op3, $op1); 214 } 215 216 $f .= 'pack"N2",$r&0xffffffff,$l&0xffffffff}'; 217 $cast5->{encrypt} = $encrypt = eval $f; 218 } 219 220 return $encrypt->($block); 221} # encrypt 222 223sub decrypt { 224 use strict; 225 use integer; 226 my ($cast5, $block) = @_; 227 croak "Block size must be 8" if length($block) != 8; 228 229 my $decrypt = $cast5->{decrypt}; 230 unless ($decrypt) { 231 my $key = $cast5->{key} or croak "Call init() first"; 232 my $rounds = $cast5->{rounds}; 233 my $f = 'sub{my($r,$l,$i)=unpack"N2",$_[0];'; 234 235 my ($l, $r) = qw( $r $l ); 236 my ($op1, $op2, $op3) = qw( - + ^ ); 237 foreach (1 .. $rounds%3) { ($op1, $op2, $op3) = ($op2, $op3, $op1) } 238 foreach my $round (1 .. $rounds) { 239 my $km = $key->[$rounds-$round]; 240 my $kr = $key->[$rounds-$round+16]; 241 242 my $rot = ""; 243 if ($kr) { 244 my $mask = ~(~0<<$kr) & 0xffffffff; 245 my $kr2 = 32-$kr; 246 $rot = "\$i=\$i<<$kr|\$i>>$kr2&$mask;" 247 } 248 249 $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];"; 250 ($l, $r) = ($r, $l); 251 ($op1, $op2, $op3) = ($op3, $op1, $op2); 252 } 253 254 $f .= 'pack"N2",$l&0xffffffff,$r&0xffffffff}'; 255 $cast5->{decrypt} = $decrypt = eval $f; 256 } 257 258 return $decrypt->($block); 259} # decrypt 260 261# end CAST5_PP.pm 262