#!/usr/bin/perl
# adapted to Perl by mi at alma dot ch - July 2006
# encode email link for use with http://www.jracademy.com/~jtucek/email/encrypt.js
# todo: cleanup var names, output, email/email+subject,

# Hedaer of Jim's javascript version:
#// Speaking of Java, this particular script is (C) Copyright 2004 Jim Tucek
#// This script is NOT for public use.  I'm working on a general RSA encryption
#// script, so be patient!  This is not the script that decrypts an email so that
#// spam bots can't find it.  This is the script that makes that script!
#// (Wow, code that writes code.  Not that big of a deal really)

#// Visit www.jracademy.com/~jtucek/email/ for script information or 
#// www.jracademy.com/~jtucek/email/contact.php for contact information.

#// A brief history of this script can be found (and it's rather entertaining)
#// at www.jracademy.com/~jtucek/email/

use POSIX; # so we have floor()
use strict;
use Win32::Clipboard;

my $debug = 0;

my @primes = qw(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197 199 211 223 227 229 233 239 241 251 257 263 269 271 277 281 283 293 307 311 313 317 331 337 347 349 353 359 367 373 379 383 389 397 401 409);
# Don't offer too big primes. The decoder would take too long, and users may get incomprehensible warnings from their browser
# 419 421 431 433 439 443 449 457 461 463 467 479 487 491 499 503 509 521 523 541 547 557 563 569 571 577 587 593 599 601 607 613 617 619 631 641 643 647 653 659 661 673 677 683 691 701 709 719 727 733 739 743 751 757 761 769 773 787 797 809 811 821 823 827 829 839 853 857 859 863 877 881 883 887 907 911 919 929 937 941 947 953 967 971 977 983 991 997 1009 1013 1019 1021 1031 1033 1039 1049);

sub usage {
	return qq{
Usage: $0  Prime1  Prime2  Email  [Subject]
  Prime1 and Prime2 must be two different prime numbers and
  Prime1*Prime2 must be greater than 255

Choose primes from this list: }
	. join(" ", @primes) . "\n";
}

### get arguments and check them
if (grep /^-?-h(elp)?$/, @ARGV) {
	print usage;
	exit;
}

my ($P, $Q, $email, $subject) = @ARGV;

$SIG{__DIE__} = sub {
	die "*"x60, "\n", "*\n", 
		"* ERROR: $_[0]",
		"*\n", "*"x60, "\n",
		usage();
};

unless ($P && $Q && $email) {
	die "missing argument(s)!\n";
}

for ($P, $Q) {
	unless (is_prime($_)) {
		die "$_ is not a prime!\n";
	}
}

if ($P == $Q) {
	die "the 2 primes must be different!\n";
}
if ($P * $Q <= 255) {
	die "Prime1 * Prime2 must be greater than 255! (you have $P * $Q = " . $P*$Q . ")\n";
}

sub is_prime {
	my $num = shift;

	return 0 if ($num==1); # special case
	return 0 if ($num % 2 == 0 and $num != 2); # even and not 2

	for(my $i=3; $i<int(sqrt($num))+1; $i += 2) {
		return 0 if ($num % $i == 0); # it's a factor
	}
	return 1;
}

### subs where all the real work is:
# - make_keys (calls getKey)
# - getKey
# - encode_message ( calls myMod)
# - myMod
# (getKey and myMod are the ones doing all the crypting magic which I don't understand)

sub make_keys {
	my ($p, $q) = @_;

	my $e = 0;
	my $z = ($p-1)*($q-1);
	my $n = $p*$q;
	my $d;

	do {
		$e++;
		$d = getKey($primes[$e],$z);
	} while ($d==1);
	$e = $primes[$e];

	return $d, $e;
}

sub encode_message {
	# in: keys, message string
	# out: array of crypted char codes
	my ($e, $n, $msg) = @_;
	my @char_codes = map {ord $_} split(//, $msg); 
	my @code;
	foreach my $i ( @char_codes ) {
		push @code, myMod($i,$e,$n);
	}
	return join(" ", @code);
}

sub myMod {
	my ($x,$e,$y) = @_;
	my $answer;
	if ($e % 2 == 0) {
		$answer = 1;
	} else {
		$answer = $x;
	}
	for(my $i = 1; $i <= $e/2; $i++) {
		my $temp = ($x*$x) % $y;
		$answer = ($temp*$answer) % $y;
	}
	return $answer;
}

sub getKey {
	my ($e,$z) = @_;
	my $A = 1;
	my $B = 0;
	my $C = $z;
	my $F = 0;
	my $G = 1;
	my $bar = $e;
	#// Euclid's Algorithm:
	while ($bar != 0) {
		my $foo = floor($C/$bar);
		my $K = $A - $foo * $F;
		my $L = $B - $foo * $G;
		my $M = $C - $foo * $bar;
		$A = $F;$B = $G;$C = $bar;
		$F = $K;$G = $L;$bar = $M;
	}
	if ($B < 0) {
		return $B + $z;
	} else {
		return ($B);
	}
}

### compute and print results
my $N = $P * $Q;
my ($D, $E) = make_keys($P, $Q);

my $email_code = encode_message($E, $N, $email);

my $subject_code;
if ($subject) {
	$subject = "?subject=$subject";
	$subject_code = encode_message($E, $N, $subject);
}

print 	"prime1 = $P, prime2 = $Q, prime1 * prime2 = $N, D = $D\n" if $debug;
print 	"email = $email\n" if $debug;
print 	"email_code = $email_code\n" if $debug;
print 	"subject_code = $subject_code\n" if $debug;
print 	"\n\n" if $debug;

my $full_code = $email_code;
$full_code .= " $subject_code" if $subject_code;

my $html = <<HTML;
<!-- crypted email link -->
<a href="javascript:var N=$N,D=$D;bid('$full_code',N,D)"
   title="Click to send email"
   class="mail">Email</a>
HTML

Win32::Clipboard::Set($html);

print $html;

__END__

## these have not been fully adapted from javascript to Perl and are left out:
#function testAll() {
sub testAll {
#var size = primes.length;
#window.alert("Testing for " + size + " prime numbers...  Please wait.");
	my $size = scalar(@primes); #!? primes.length;
	print "Testing for $size prime numbers...  Please wait\n";

#var allCharacters = "";
#for(var c = 33; c <= 126; c++)
#	allCharacters = allCharacters + String.fromCharCode(c);
	# Doesn't work! why? my $allCharacters = join("", chr(33)..chr(126));
	my $allCharacters = join( "", map {chr($_)} 33..126 );

#document.form.Message.value = allCharacters;
	$email = $allCharacters;

#for(var i = 0; i < size - 1; i++) {
#	for(var j = i + 1; j < size; j++) {
#		var p = primes[i];
#		var q = primes[j];
#		if(p*q < 255)
#			break;
#		makeKey(p,q);
#		var encrypted = document.form.encrypted.value;
#		document.form.P2.value = p;
#		document.form.Q2.value = q;
#		var d = document.form.D.value;
#		var decrypted = goForth(encrypted,p*q,d);
#		document.form.decrypted.value  = decrypted;
#		if(decrypted != allCharacters) {
#			window.alert("Encryption/Decryption error when (p,q) = ("+p+","+q+")");
#			return;
#		}
#	}
#}
	foreach my $p (@primes) {
		foreach my $q (@primes) {
			last if ($p*$q < 255);
			makeKey($p,$q);
			my $encrypted = $encrypted;
			my $d = $D;
			my $decrypted = goForth($encrypted,$p*$q,$d);
			$decrypted  = $decrypted;
			if($decrypted ne $allCharacters) {
				print "Encryption/Decryption error when (\$p,\$q) = ($p,$q)\n";
				return;
			}
		}
	}
#window.alert("Done!");
#}
	print "Done!\n";
}

#function goForth(c,n,d) {
#	c += " ";
#	var length = c.length;
#	var number = 0;
#	var bar = 0;
#	var answer = "";
#
#	for(var i = 0; i < length; i++) {
#		number = 0;
#		bar = 0;
#		while(c.charCodeAt(i) != 32) { 
#			number = number * 10;
#			number = number + c.charCodeAt(i)-48;
#			i++;
#		}
#		answer += String.fromCharCode(decrypt(number,n,d));
#	}
#return answer;
#}
sub goForth {
	#appears to decrypt $c ?
	my ($c,$n,$d) = @_;
	return join( "", map {chr decrypt($_, $n, $d)} split(/\s+/, $c) );
}

#function decrypt(c,n,d) {
#// Split exponents up
#if (d % 2== 0) {
#     bar = 1;
#     for(var i = 1; i <= d/2; i++) {
#	 foo = (c*c) % n;
#	 bar = (foo*bar) % n;
#     }
#} else {
#     bar = c;
#     for(var i = 1; i <= d/2; i++) {
#       foo = (c*c) % n;
#       bar = (foo*bar) % n;
#     }
#}
#return bar;
#}
sub decrypt {
	my ($c,$n,$d) = @_;
	#// Split exponents up
	my ($foo, $bar);
	if ($d % 2== 0) {
		$bar = 1;
	} else {
		$bar = $c;
	}
	for(my $i = 1; $i <= $d/2; $i++) {
		$foo = ($c*$c) % $n;
		$bar = ($foo*$bar) % $n;
	}
	return $bar;
}