Crypt-Tea_JS
view release on metacpan or search on metacpan
return unless $str; return unless $key;
print
"<SCRIPT LANGUAGE=\"JavaScript\">\n<!--\nparent.decrypt_and_write('";
print encrypt($str,$key);
print "');\n// -->\n</SCRIPT>\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
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; }
}
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;
}
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) = @_;
#!perl
#########################################################################
# This Perl script is Copyright (c) 2000, Peter J Billam #
# c/o P J B Computing, www.pjb.com.au #
# #
# This program is free software; you can redistribute it and/or #
# modify it under the same terms as Perl itself. #
#########################################################################
$^W=0;
while ($ARGV[$[] =~ /^-/) {
if ($ARGV[$[] =~ /^-c/) { $encrypt='yes'; shift;
} elsif ($ARGV[$[] =~ /^-s/) { $sign='yes'; shift;
} elsif ($ARGV[$[] =~ /^-o/) { $old='yes'; shift;
} elsif ($ARGV[$[] =~ /^-j/) {
require 'Crypt/Tea_JS.pm'; import Crypt::Tea_JS;
print &tea_in_javascript; exit 0;
} else { require 'Crypt/Tea_JS.pm'; print <<EOT; exit;
usage:
tea -c filename # enCrypts filename
tea filename # decrypts filename
tea -s filename # calculates ascii digital Signature for filename
tea -j # outputs Javascript code to do compatible encryption
tea -o # set Old mode, for Crypt::Tea-compatibility
tea -h # prints this Helpful message
examples/old_tea_demo.cgi view on Meta::CPAN
document.write("$plaintext");
document.write(decrypt("$new_cyphertext", key));
// -->
</SCRIPT>
EOT
}
&footer(); exit 0;
#-----------------------------------------------------------------------
sub header { my $title = $_[$[] || $ENV{SCRIPT_NAME};
print <<EOT;
Content-type: text/html
<HTML><HEAD><TITLE>$title</TITLE>
</HEAD><BODY BGCOLOR="#FFFFFF">
<P ALIGN="center"><FONT SIZE="+2"><B><I>$title</I></B></FONT></P><HR>
EOT
}
sub sorry { print '<B>Sorry, ', $_[$[], '</B>'; &footer(); exit 0; }
sub footer { print "<HR></BODY></HTML>\n"; }
__END__
=pod
=head1 NAME
tea_demo.cgi - CGI script to submit an encrypted form using Crypt::Tea_JS
}
&generate_test_html();
exit;
# --------------------------- infrastructure ----------------
sub equal { my ($xref, $yref) = @_;
my $eps = .000000001;
my @x = @$xref; my @y = @$yref;
if (scalar @x != scalar @y) { return 0; }
my $i; for ($i=$[; $i<=$#x; $i++) {
if (abs($x[$i]-$y[$i]) > $eps) { return 0; }
}
return 1;
}
sub generate_test_html {
$key1 = &asciidigest ("G $$ ". time);
my $key2 = &asciidigest ("Arghhh... " . time ."Xgloopiegleep $$");
my $p1 = <<EOT;
( run in 0.386 second using v1.01-cache-2.11-cpan-cc502c75498 )