Crypt-Tea_JS
view release on metacpan or search on metacpan
sub ascii2str { my $a = $_[$[]; # converts pseudo-base64 to string of bytes
local $^W = 0;
$a =~ tr#-A-Za-z0-9+_##cd;
my $ia = $[-1; my $la = length $a; # BUG not length, final!
my $ib = $[; my @b = ();
my $carry;
while (1) { # reads 4 ascii chars and produces 3 bytes
$ia++; last if ($ia>=$la);
$b[$ib] = $a2b{substr $a, $ia+$[, 1}<<2;
$ia++; last if ($ia>=$la);
$carry=$a2b{substr $a, $ia+$[, 1}; $b[$ib] |= ($carry>>4); $ib++;
# if low 4 bits of $carry are 0 and its the last char, then break
$carry = 0xF & $carry; last if ($carry == 0 && $ia == ($la-1));
$b[$ib] = $carry<<4;
$ia++; last if ($ia>=$la);
$carry=$a2b{substr $a, $ia+$[, 1}; $b[$ib] |= ($carry>>2); $ib++;
# if low 2 bits of $carry are 0 and its the last char, then break
$carry = 03 & $carry; last if ($carry == 0 && $ia == ($la-1));
$b[$ib] = $carry<<6;
$ia++; last if ($ia>=$la);
$b[$ib] |= $a2b{substr $a, $ia+$[, 1}; $ib++;
}
return pack 'C*', @b; # 2.16
}
sub str2ascii { my $b = $_[$[]; # converts string of bytes to pseudo-base64
my $ib = $[; my $lb = length $b; my @s = ();
my $b1; my $b2; my $b3;
my $carry;
while (1) { # reads 3 bytes and produces 4 ascii chars
if ($ib >= $lb) { last; };
$b1 = ord substr $b, $ib+$[, 1; $ib++;
push @s, $b2a{$b1>>2}; $carry = 03 & $b1;
if ($ib >= $lb) { push @s, $b2a{$carry<<4}; last; }
$b2 = ord substr $b, $ib+$[, 1; $ib++;
push @s, $b2a{($b2>>4) | ($carry<<4)}; $carry = 0xF & $b2;
if ($ib >= $lb) { push @s, $b2a{$carry<<2}; last; }
$b3 = ord substr $b, $ib+$[, 1; $ib++;
push @s, $b2a{($b3>>6) | ($carry<<2)}, $b2a{077 & $b3};
if (!$ENV{REMOTE_ADDR} && (($ib % 36) == 0)) { push @s, "\n"; }
}
return join('', @s);
}
sub asciidigest { # returns 22-char ascii signature
return binary2ascii(binarydigest($_[$[]));
}
sub binarydigest { my $str = $_[$[]; # returns 4 32-bit-int binary signature
# warning: mode of use invented by Peter Billam 1998, needs checking !
return '' unless $str;
if ($] > 5.007 && Encode::is_utf8($str)) {
Encode::_utf8_off($str);
# $str = Encode::encode_utf8($str);
}
# add 1 char ('0'..'15') at front to specify no of pad chars at end ...
my $npads = 15 - ((length $str) % 16);
$str = chr($npads) . $str;
if ($npads) { $str .= "\0" x $npads; }
my @str = str2binary($str);
my @key = (0x61626364, 0x62636465, 0x63646566, 0x64656667);
my ($cswap, $v0, $v1, $v2, $v3);
my $c0 = 0x61626364; my $c1 = 0x62636465; # CBC Initial Value. Retain !
my $c2 = 0x61626364; my $c3 = 0x62636465; # likewise (abcdbcde).
while (@str) {
# shift 2 blocks off front of str ...
$v0 = shift @str; $v1 = shift @str; $v2 = shift @str; $v3 = shift @str;
# cipher them XOR'd with previous stage ...
($c0,$c1) = tea_code($v0^$c0, $v1^$c1, @key);
($c2,$c3) = tea_code($v2^$c2, $v3^$c3, @key);
# mix up the two cipher blocks with a 4-byte left rotation ...
$cswap = $c0; $c0=$c1; $c1=$c2; $c2=$c3; $c3=$cswap;
}
return ($c0,$c1,$c2,$c3);
}
sub encrypt { my ($str,$key)=@_; # encodes with CBC (Cipher Block Chaining)
return '' unless $str; return '' unless $key;
if ($] > 5.007 && Encode::is_utf8($str)) {
Encode::_utf8_off($str);
# $str = Encode::encode_utf8($str);
}
use integer;
@key = binarydigest($key);
# add 1 char ('0'..'7') at front to specify no of pad chars at end ...
my $npads = 7 - ((length $str) % 8);
$str = chr($npads|(0xF8 & rand_byte())) . $str;
if ($npads) {
my $padding = pack 'CCCCCCC', rand_byte(), rand_byte(),
rand_byte(), rand_byte(), rand_byte(), rand_byte(), rand_byte();
$str = $str . substr($padding,$[,$npads);
}
my @pblocks = str2binary($str);
my $v0; my $v1;
my $c0 = 0x61626364; my $c1 = 0x62636465; # CBC Initial Value. Retain !
my @cblocks;
while (1) {
last unless @pblocks; $v0 = shift @pblocks; $v1 = shift @pblocks;
($c0,$c1) = tea_code($v0^$c0, $v1^$c1, @key);
push @cblocks, $c0, $c1;
}
return str2ascii( binary2str(@cblocks) );
}
sub decrypt { my ($acstr, $key) = @_; # decodes with CBC
use integer;
return '' unless $acstr; return '' unless $key;
@key = binarydigest($key);
my $v0; my $v1; my $c0; my $c1; my @pblocks = (); my $de0; my $de1;
my $lastc0 = 0x61626364; my $lastc1 = 0x62636465; # CBC Init Val. Retain!
my @cblocks = str2binary( ascii2str($acstr) );
while (1) {
last unless @cblocks; $c0 = shift @cblocks; $c1 = shift @cblocks;
($de0, $de1) = tea_decode($c0,$c1, @key);
$v0 = $lastc0 ^ $de0; $v1 = $lastc1 ^ $de1;
push @pblocks, $v0, $v1;
$lastc0 = $c0; $lastc1 = $c1;
}
my $str = binary2str(@pblocks);
# remove no of pad chars at end specified by 1 char ('0'..'7') at front
my $npads = 0x7 & ord $str; substr ($str, $[, 1) = '';
if ($npads) { substr ($str, 0 - $npads) = ''; }
return $str;
}
sub triple_encrypt { my ($plaintext, $long_key) = @_; # not yet ...
}
sub triple_decrypt { my ($cyphertext, $long_key) = @_; # not yet ...
}
# PurePerl versions: introduced in 2.23
sub pp_tea_code { my ($v0,$v1,@k) = @_;
# Note that both "<<" and ">>" in Perl are implemented directly using
# "<<" and ">>" in C. If "use integer" (see "Integer Arithmetic") is in
# force then signed C integers are used, else unsigned C integers are used.
use integer;
my $sum = 0; my $n = 32;
while ($n-- > 0) {
$v0 += ((($v1<<4)^(0x07FFFFFF&($v1>>5)))+$v1) ^ ($sum+$k[$sum&3]);
$v0 &= 0xFFFFFFFF;
$sum += 0x9e3779b9; # TEA magic number delta
# $sum &= 0xFFFFFFFF; # changes nothing
$v1 += ((($v0<<4)^(0x07FFFFFF&($v0>>5)))+$v0)^($sum+$k[($sum>>11)&3]);
$v1 &= 0xFFFFFFFF;
}
return ($v0, $v1);
}
sub pp_tea_decode { my ($v0,$v1, @k) = @_;
use integer;
my $sum = 0; my $n = 32;
$sum = 0x9e3779b9 << 5 ; # TEA magic number delta
while ($n-- > 0) {
$v1 -= ((($v0<<4)^(0x07FFFFFF&($v0>>5)))+$v0)^($sum+$k[($sum>>11)&3]);
$v1 &= 0xFFFFFFFF;
$sum -= 0x9e3779b9 ;
$v0 -= ((($v1<<4)^(0x07FFFFFF&($v1>>5)))+$v1) ^ ($sum+$k[$sum&3]);
$v0 &= 0xFFFFFFFF;
}
return ($v0, $v1);
}
sub pp_oldtea_code { my ($v0,$v1, $k0,$k1,$k2,$k3) = @_;
use integer;
my $sum = 0; my $n = 32;
while ($n-- > 0) {
$sum += 0x9e3779b9; # TEA magic number delta
$v0 += (($v1<<4)+$k0) ^ ($v1+$sum) ^ ((0x07FFFFFF & ($v1>>5))+$k1) ;
$v0 &= 0xFFFFFFFF;
$v1 += (($v0<<4)+$k2) ^ ($v0+$sum) ^ ((0x07FFFFFF & ($v0>>5))+$k3) ;
$v1 &= 0xFFFFFFFF;
}
return ($v0, $v1);
while (1) {
if (ibl >= nbl) break;
bytes[iby] = 0xFF & (blocks[ibl] >>> 24); iby++;
bytes[iby] = 0xFF & (blocks[ibl] >>> 16); iby++;
bytes[iby] = 0xFF & (blocks[ibl] >>> 8); iby++;
bytes[iby] = 0xFF & blocks[ibl]; iby++;
ibl++;
}
return bytes;
}
function digest_pad (bytearray) {
// add 1 char ('0'..'15') at front to specify no of \x00 pad chars at end
var newarray = new Array(); var ina = 0;
var iba = 0; var nba = bytearray.length;
var npads = 15 - (nba % 16); newarray[ina] = npads; ina++;
while (iba < nba) { newarray[ina] = bytearray[iba]; ina++; iba++; }
var ip = npads; while (ip>0) { newarray[ina] = 0; ina++; ip--; }
return newarray;
}
function pad (bytearray) {
// add 1 char ('0'..'7') at front to specify no of rand pad chars at end
// unshift and push fail on Netscape 4.7 :-(
var newarray = new Array(); var ina = 0;
var iba = 0; var nba = bytearray.length;
var npads = 7 - (nba % 8);
newarray[ina] = (0xF8 & rand_byte()) | (7 & npads); ina++;
while (iba < nba) { newarray[ina] = bytearray[iba]; ina++; iba++; }
var ip = npads; while (ip>0) { newarray[ina] = rand_byte(); ina++; ip--; }
return newarray;
}
function rand_byte() { // used by pad
return Math.floor( 256*Math.random() ); // Random needs js1.1 . Seed ?
// for js1.0 compatibility, could try following ...
if (! rand_byte_already_called) {
var now = new Date(); seed = now.milliseconds;
rand_byte_already_called = true;
}
seed = (1029*seed + 221591) % 1048576; // see Fortran77, Wagener, p177
return Math.floor(seed / 4096);
}
function unpad (bytearray) {
// remove no of pad chars at end specified by 1 char ('0'..'7') at front
// unshift and push fail on Netscape 4.7 :-(
var iba = 0;
var newarray = new Array(); var ina = 0;
var npads = 0x7 & bytearray[iba]; iba++; var nba = bytearray.length - npads;
while (iba < nba) { newarray[ina] = bytearray[iba]; ina++; iba++; }
return newarray;
}
// --- TEA stuff, translated from the Perl Tea_JS.pm see www.pjb.com.au/comp ---
// In JavaScript we express an 8-byte block as an array of 2 32-bit ints
function asciidigest (str) {
return binary2ascii( binarydigest(str) );
}
function binarydigest (str, keystr) { // returns 22-char ascii signature
var key = new Array(); // key = binarydigest(keystr);
key[0]=0x61626364; key[1]=0x62636465; key[2]=0x63646566; key[3]=0x64656667;
// Initial Value for CBC mode = "abcdbcde". Retain for interoperability.
var c0 = new Array(); c0[0] = 0x61626364; c0[1] = 0x62636465;
var c1 = new Array(); c1 = c0;
var v0 = new Array(); var v1 = new Array(); var swap;
var blocks = new Array(); blocks = bytes2blocks(digest_pad(str2bytes(str)));
var ibl = 0; var nbl = blocks.length;
while (1) {
if (ibl >= nbl) break;
v0[0] = blocks[ibl]; ibl++; v0[1] = blocks[ibl]; ibl++;
v1[0] = blocks[ibl]; ibl++; v1[1] = blocks[ibl]; ibl++;
// cipher them XOR'd with previous stage ...
c0 = tea_code( xor_blocks(v0,c0), key );
c1 = tea_code( xor_blocks(v1,c1), key );
// mix up the two cipher blocks with a 32-bit left rotation ...
swap=c0[0]; c0[0]=c0[1]; c0[1]=c1[0]; c1[0]=c1[1]; c1[1]=swap;
}
var concat = new Array();
concat[0]=c0[0]; concat[1]=c0[1]; concat[2]=c1[0]; concat[3]=c1[1];
return concat;
}
function encrypt (str,keystr) { // encodes with CBC (Cipher Block Chaining)
if (! keystr) { alert("encrypt: no key"); return false; }
var key = new Array(); key = binarydigest(keystr);
if (! str) return "";
var blocks = new Array(); blocks = bytes2blocks(pad(str2bytes(str)));
var ibl = 0; var nbl = blocks.length;
// Initial Value for CBC mode = "abcdbcde". Retain for interoperability.
var c = new Array(); c[0] = 0x61626364; c[1] = 0x62636465;
var v = new Array(); var cblocks = new Array(); var icb = 0;
while (1) {
if (ibl >= nbl) break;
v[0] = blocks[ibl]; ibl++; v[1] = blocks[ibl]; ibl++;
c = tea_code( xor_blocks(v,c), key );
cblocks[icb] = c[0]; icb++; cblocks[icb] = c[1]; icb++;
}
return binary2ascii(cblocks);
}
function decrypt (ascii, keystr) { // decodes with CBC
if (! keystr) { alert("decrypt: no key"); return false; }
var key = new Array(); key = binarydigest(keystr);
if (! ascii) return "";
var cblocks = new Array(); cblocks = ascii2binary(ascii);
var icbl = 0; var ncbl = cblocks.length;
// Initial Value for CBC mode = "abcdbcde". Retain for interoperability.
var lastc = new Array(); lastc[0] = 0x61626364; lastc[1] = 0x62636465;
var v = new Array(); var c = new Array();
var blocks = new Array(); var ibl = 0;
while (1) {
if (icbl >= ncbl) break;
c[0] = cblocks[icbl]; icbl++; c[1] = cblocks[icbl]; icbl++;
v = xor_blocks( lastc, tea_decode(c,key) );
blocks[ibl] = v[0]; ibl++; blocks[ibl] = v[1]; ibl++;
lastc[0] = c[0]; lastc[1] = c[1];
}
return bytes2str(unpad(blocks2bytes(blocks)));
}
function xor_blocks(blk1, blk2) { // xor of two 8-byte blocks
var blk = new Array();
blk[0] = blk1[0]^blk2[0]; blk[1] = blk1[1]^blk2[1];
return blk;
}
function tea_code (v, k) {
// NewTEA. 2-int (64-bit) cyphertext block in v. 4-int (128-bit) key in k.
var v0 = v[0]; var v1 = v[1];
var sum = 0; var n = 32;
while (n-- > 0) {
v0 += (((v1<<4)^(v1>>>5))+v1) ^ (sum+k[sum&3]) ; v0 = v0|0 ;
sum -= 1640531527; // TEA magic number 0x9e3779b9
sum = sum|0; // force it back to 32-bit int
v1 += (((v0<<4)^(v0>>>5))+v0) ^ (sum+k[(sum>>>11)&3]); v1 = v1|0 ;
}
var w = new Array(); w[0] = v0; w[1] = v1; return w;
}
function tea_decode (v, k) {
// NewTEA. 2-int (64-bit) cyphertext block in v. 4-int (128-bit) key in k.
var v0 = v[0]; var v1 = v[1];
var sum = 0; var n = 32;
sum = -957401312 ; // TEA magic number 0x9e3779b9<<5
while (n-- > 0) {
v1 -= (((v0<<4)^(v0>>>5))+v0) ^ (sum+k[(sum>>>11)&3]); v1 = v1|0 ;
sum += 1640531527; // TEA magic number 0x9e3779b9 ;
sum = sum|0; // force it back to 32-bit int
v0 -= (((v1<<4)^(v1>>>5))+v1) ^ (sum+k[sum&3]); v0 = v0|0 ;
}
var w = new Array(); w[0] = v0; w[1] = v1; return w;
}
// ------------- assocarys used by the conversion routines -----------
c2b = new Object();
c2b["\x00"]=0; c2b["\x01"]=1; c2b["\x02"]=2; c2b["\x03"]=3;
c2b["\x04"]=4; c2b["\x05"]=5; c2b["\x06"]=6; c2b["\x07"]=7;
c2b["\x08"]=8; c2b["\x09"]=9; c2b["\x0A"]=10; c2b["\x0B"]=11;
c2b["\x0C"]=12; c2b["\x0D"]=13; c2b["\x0E"]=14; c2b["\x0F"]=15;
c2b["\x10"]=16; c2b["\x11"]=17; c2b["\x12"]=18; c2b["\x13"]=19;
c2b["\x14"]=20; c2b["\x15"]=21; c2b["\x16"]=22; c2b["\x17"]=23;
c2b["\x18"]=24; c2b["\x19"]=25; c2b["\x1A"]=26; c2b["\x1B"]=27;
c2b["\x1C"]=28; c2b["\x1D"]=29; c2b["\x1E"]=30; c2b["\x1F"]=31;
c2b["\x20"]=32; c2b["\x21"]=33; c2b["\x22"]=34; c2b["\x23"]=35;
c2b["\x24"]=36; c2b["\x25"]=37; c2b["\x26"]=38; c2b["\x27"]=39;
c2b["\x28"]=40; c2b["\x29"]=41; c2b["\x2A"]=42; c2b["\x2B"]=43;
c2b["\x2C"]=44; c2b["\x2D"]=45; c2b["\x2E"]=46; c2b["\x2F"]=47;
c2b["\x30"]=48; c2b["\x31"]=49; c2b["\x32"]=50; c2b["\x33"]=51;
c2b["\x34"]=52; c2b["\x35"]=53; c2b["\x36"]=54; c2b["\x37"]=55;
c2b["\x38"]=56; c2b["\x39"]=57; c2b["\x3A"]=58; c2b["\x3B"]=59;
=pod
=head1 NAME
Tea_JS.pm - The Tiny Encryption Algorithm in Perl and JavaScript
=head1 SYNOPSIS
Usage:
use Crypt::Tea_JS;
$key = 'PUFgob$*LKDF D)(F IDD&P?/';
$ascii_cyphertext = encrypt($plaintext, $key);
...
$plaintext_again = decrypt($ascii_cyphertext, $key);
...
$signature = asciidigest($text);
In CGI scripts:
use Crypt::Tea_JS;
print tea_in_javascript();
# now the browser can encrypt and decrypt ! In JS:
var ascii_ciphertext = encrypt (plaintext, key);
var plaintext_again = decrypt (ascii_ciphertext, key);
var signature = asciidigest (text);
=head1 DESCRIPTION
This module implements TEA, the Tiny Encryption Algorithm,
and some Modes of Use, in Perl and JavaScript.
The $key is a sufficiently longish string; at least 17 random 8-bit
bytes for single encryption.
Crypt::Tea_JS can be used for secret-key encryption in general,
or, in particular, to communicate securely between browser and web-host.
In this case, the simplest arrangement is for the user to
enter the key into a JavaScript variable, and for the host to
retrieve that user's key from a database.
Or, for extra security, the first message (or even each message)
between browser and host could contain a random challenge-string,
which each end would then turn into a signature,
and use that signature as the encryption-key for the session (or the reply).
If a travelling employee can carry a session-startup file
(e.g. I<login_on_the_road.html>) on their laptop,
then they are invulnerable to imposter-web-hosts
trying to feed them trojan JavaScript.
Version 2.23
(c) Peter J Billam 1998
=head1 SUBROUTINES
=over 3
=item I<encrypt>( $plaintext, $key );
Encrypts with CBC (Cipher Block Chaining)
=item I<decrypt>( $cyphertext, $key );
Decrypts with CBC (Cipher Block Chaining)
=item I<asciidigest>( $a_string );
Returns an asciified binary signature of the argument.
=item I<tea_in_javascript>();
Returns a compatible implementation of TEA in JavaScript,
for use in CGI scripts to communicate with browsers.
=back
=head1 EXPORT_OK SUBROUTINES
The following routines are not exported by default,
but are exported under the I<ALL> tag, so if you need them you should:
import Crypt::Tea_JS qw(:ALL);
=over 3
=item I<binary2ascii>( $a_binary_string );
Provides an ascii text encoding of the binary argument.
If Tea_JS.pm is not being invoked from a GCI script,
the ascii is split into lines of 72 characters.
=item I<ascii2binary>( $an_ascii_string );
Provides the binary original of an ascii text encoding.
=back
=head1 JAVASCRIPT
At the browser end, the following functions offer the same
functionality as their perl equivalents above:
=over 3
=item I<encrypt> ( str, keystr )
=item I<decrypt> ( ascii, keystr )
=item I<asciidigest> ( str );
=back
Of course the same Key must be used by the Perl on the server
and by the JavaScript in the browser, and of course you
don't want to transmit the Key in cleartext between them.
Let's assume you've already asked the user to fill in a form
asking for their Username, and that this username can be transmitted
back and forth in cleartext as an ordinary form variable.
On the server, typically you will retrieve the Key from a
database of some sort, for example:
dbmopen %keys, "/home/wherever/passwords", 0666;
$key = $keys{$username}; dbmclose %keys;
( run in 0.667 second using v1.01-cache-2.11-cpan-e1769b4cff6 )