# Tea.pm ######################################################################### # This Perl module is Copyright (c) 2000, Peter J Billam # # c/o P J B Computing, www.pjb.com.au # # # # This module is free software; you can redistribute it and/or # # modify it under the same terms as Perl itself. # ######################################################################### # # implements TEA, the Tiny Encryption Algorithm, in Perl and Javascript. # http://www.cl.cam.ac.uk/ftp/papers/djw-rmn/djw-rmn-tea.html # # Usage: # use Tea; # $key = 'PUFgob$*LKDF D)(F IDD&P?/'; # $ascii_cyphertext = &encrypt ($plaintext, $key); # ... # $plaintext_again = &decrypt ($ascii_cyphertext, $key); # ... # $signature = &asciidigest ($text); # # The $key is a sufficiently longish string; at least 17 random 8-bit bytes # # Written by Peter J Billam, http://www.pjb.com.au package Crypt::Tea; $VERSION = '2.12'; # Don't like depending on externals; this is strong encrytion ... but ... use Exporter; @ISA = qw(Exporter); @EXPORT=qw(asciidigest encrypt decrypt tea_in_javascript); @EXPORT_OK = qw(str2ascii ascii2str encrypt_and_write); %EXPORT_TAGS = (ALL => [@EXPORT,@EXPORT_OK]); # begin config my %a2b = ( A=>000, B=>001, C=>002, D=>003, E=>004, F=>005, G=>006, H=>007, I=>010, J=>011, K=>012, L=>013, M=>014, N=>015, O=>016, P=>017, Q=>020, R=>021, S=>022, T=>023, U=>024, V=>025, W=>026, X=>027, Y=>030, Z=>031, a=>032, b=>033, c=>034, d=>035, e=>036, f=>037, g=>040, h=>041, i=>042, j=>043, k=>044, l=>045, m=>046, n=>047, o=>050, p=>051, q=>052, r=>053, s=>054, t=>055, u=>056, v=>057, w=>060, x=>061, y=>062, z=>063, '0'=>064, '1'=>065, '2'=>066, '3'=>067, '4'=>070,'5'=>071,'6'=>072,'7'=>073,'8'=>074,'9'=>075,'-'=>076,'_'=>077, ); my %b2a = reverse %a2b; $a2b{'+'}=076; # end config # ------------------ infrastructure ... sub tea_in_javascript { my @js; while () { last if /^EOT$/; push @js, $_; } join '', @js; } sub encrypt_and_write { my ($str, $key) = @_; return unless $str; return unless $key; print "\n"; } sub binary2ascii { return &str2ascii(&binary2str(@_)); } sub ascii2binary { return &str2binary(&ascii2str($_[$[])); } sub str2binary { my @str = split //, $_[$[]; my @intarray = (); my $ii = $[; while (1) { last unless @str; $intarray[$ii] = (0xFF & ord shift @str)<<24; last unless @str; $intarray[$ii] |= (0xFF & ord shift @str)<<16; last unless @str; $intarray[$ii] |= (0xFF & ord shift @str)<<8; last unless @str; $intarray[$ii] |= 0xFF & ord shift @str; $ii++; } return @intarray; } sub binary2str { my @str = (); foreach $i (@_) { push @str, chr (0xFF & ($i>>24)), chr (0xFF & ($i>>16)), chr (0xFF & ($i>>8)), chr (0xFF & $i); } return join '', @str; } sub ascii2str { my $a = $_[$[]; # converts pseudo-base64 to string of bytes # no warnings; 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; } 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; # 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 (Cypher Block Chaining) use integer; return '' unless $str; return '' unless $key; @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; } my $btmp = &binary2str(@cblocks); 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 ... } sub tea_code { my ($v0,$v1, $k0,$k1,$k2,$k3) = @_; # TEA. 64-bit cleartext block in $v0,$v1. 128-bit key in $k0..$k3. # &prn("tea_code: v0=$v0 v1=$v1"); 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); } sub tea_decode { my ($v0,$v1, $k0,$k1,$k2,$k3) = @_; # TEA. 64-bit cyphertext block in $v0,$v1. 128-bit key in $k0..$k3. use integer; my $sum = 0; my $n = 32; $sum = 0x9e3779b9 << 5 ; # TEA magic number delta while ($n-- > 0) { $v1 -= (($v0<<4)+$k2) ^ ($v0+$sum) ^ ((0x07FFFFFF & ($v0>>5))+$k3) ; $v1 &= 0xFFFFFFFF; $v0 -= (($v1<<4)+$k0) ^ ($v1+$sum) ^ ((0x07FFFFFF & ($v1>>5))+$k1) ; $v0 &= 0xFFFFFFFF; $sum -= 0x9e3779b9 ; } return ($v0, $v1); } sub rand_byte { if (! $rand_byte_already_called) { srand(time() ^ ($$+($$<<15))); # could do better, but its only padding $rand_byte_already_called = 1; } int(rand 256); } 1; __DATA__ EOT =pod =head1 NAME Tea.pm - The Tiny Encryption Algorithm in Perl and JavaScript =head1 SYNOPSIS Usage: use Crypt::Tea; $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; 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. Version 2.12, #COMMENT# (c) Peter J Billam 1998 =head1 SUBROUTINES =over 3 =item I( $plaintext, $key ); Encrypts with CBC (Cypher Block Chaining) =item I( $cyphertext, $key ); Decrypts with CBC (Cypher Block Chaining) =item I( $a_string ); Returns an asciified binary signature of the argument. =item I(); Returns a compatible implementation of TEA in JavaScript, for use in CGI scripts to communicate with browsers. =head1 EXPORT_OK SUBROUTINES The following routines are not exported by default, but are exported under the I tag, so if you need them you should: import Crypt::Tea qw(:ALL); =item I( $a_binary_string ); Provides an ascii text encoding of the binary argument. If Tea.pm is not being invoked from a CGI script (as judged by the existence of $ENV{REMOTE_ADDR}), the ascii is split into lines of 72 characters. =item I( $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 ( str, keystr ) =item I ( ascii, keystr ) =item I ( 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: $plaintext = "

Hello World !

\n"; dbmopen %keys, "/home/wherever/passwords"; $key = $keys{$username}; dbmclose %keys; $cyphertext = &encrypt ($plaintext, $key); At the browser end there are various ways of doing it. Easiest is to ask the user for their password every time they view an encrypted page, or submit a form. print &tea_in_javascript(), < EOT To submit an encrypted FORM, the neatest way is to contruct two FORMs; one overt one which the user fills in but which never actually gets submitted, and one covert one which will hold the cyphertext. print <<'EOT'; EOT print <
Contact
Date
Report
EOT See the cgi script examples/tea_demo.cgi in the distribution directory. If you want the browser to remember its Key from page to page, to form a session, then things get harder. If you store the Key in a Cookie, it is vulnerable to any imposter server who imitates your IP address, and also to anyone who sits down at the user's computer. However, this remains the most practical option. The alternative is to store the Key in a JavaScript variable, but unfortunately all JavaScript variables get anihilated when you load a new page into the same target frame. Therefore you have to store the Key in a JavaScript variable in a frameset, open up a subframe covering almost all the screen, and load the subsequent pages into that subframe; they can then use I to encrypt and decrypt. This can become intractable. See CGI::Htauth.pm for attempts to use this kind of technique. =head1 BROWSERS Crypt::Tea works fine with most browsers. You can check out yours by viewing the test page test.html which is generated in the install directory when you run I or I. If you can read the paragraphs at the end, then everything works. There is believed to be a problem with MacOS 10.2 Safari and IE browsers, in which binary operations like xor and shift mess up the leftmost bit of the word. The work-around would probably be to re-implement these machine instructions in JavaScript :-( There is believed to be some problem in the core functions tea_code and tea_decode on the version of Konqueror reporting itself as I although the very similar I works fine. =head1 ROADMAP Versions 2.xx can decrypt files encrypted by 1.xx, and version 1.45 can decrypt files encrypted by versions 2.xx. However, the digest (signature) functions of 1.xx and 2.xx differ in their use of '+' and '-' characters respectively. Version 1.45 will remain the final version in the 1.xx branch; the '+' character it used in the ascii-encoding is a reserved character in the query part of URLs. Crypt::Tea can conflict with a similarly-named Crypt::TEA by Abhijit Menon-Sen. The functionality of Crypt::Tea is different from Abhijit's Crypt::TEA; here the encryption is done in pure Perl, all cyphertext is ascii-encoded, and notably there is a subroutine to return JavaScript code which implements compatible functions. Unfortunately, Microsoft operating systems confuse the two names and are unable to install both. This version (2.11) is mature, and apart perhaps from minor bug fixes it will probably be the final version of Crypt::Tea. Further development will take place probably under the name Crypt::Tea_JS. Crypt::Tea_JS will use some C for extra speed, and will use the new version of the TEA algorithm. The calling interface will be identical. Backward compatibility will be available for files encrypted with Crypt::Tea, but it will not be the default. =head1 AUTHOR Peter J Billam ( http://www.pjb.com.au/comp/contact.html ). =head1 CREDITS Based on TEA, as described in http://www.cl.cam.ac.uk/ftp/papers/djw-rmn/djw-rmn-tea.html , and on some help from I by Bruce Schneier as regards the modes of use. Thanks also to Neil Watkiss for the MakeMaker packaging, and to Scott Harrison for suggesting workarounds for MacOS 10.2 browsers, to Morgan Burke for pointing out the problem with URL query strings, and to Rolf Wagner for testing. =head1 SEE ALSO examples/tea_demo.cgi, http://www.pjb.com.au/comp, CGI::Htauth.pm, tea(1), perl(1). =cut