;*****************************************************************************
;*************************---RSA Encryption---********************************
;
;William McHale
;
;
;This program implements the RSA Encryption scheme in Common Lisp.
;
;Common Lisp has many advantages over more traditional imperative languages
;in implementing RSA.  The most significant is that large integers are built
;into the language; thus the exact same operators and functions that work on 
;1 or 2 digit integers will also work on 100 digit ones with few complaints.
;
;There are two problems with Lisp that must be considered.  The first is speed.
;Even the best Lisp implementations will run more slowly than a good version
;of C or C++.  However as computers get more powerful this no longer the 
;problem that it would have been a few years ago.
;
;The other, potentially more serious problem is that the stack depth in Lisp
;is more limited than it might be in a language that operates at the machine 
;level, this meant that I had to be careful in my use of recursion.  For 
;example, using a purely recursive algorithim for the exponentiation function
;would have limited the size of the largest number handled to be about fifty
;digits, the current implementation can handle numbers up to at least a hundred
;digits.

(defun rsa ()
  (format t "This is a program to perform an rsa encryption on a file.  It~%")
  (format t "may do 1 of five things:~%1. Encrypt~%2. Decrypt~%")
  (format t "3. Encrypt for Authentication~%4. Decrypt for Authentication~%")
  (format t "5. Generate a key~%~%")
  (format t "Please note that to sent a message to someone you need their~%")
  (format t "public key, and to recieve a message you need both a public~%")
  (format t "and a private key.  Please enter your choice (1-5)~%")
  (read-line)
  (setf choice (read-line))
  (if (string-equal choice "1")
      (progn
	(format t "Please enter the name of the file you wish to encrypt~%")
	(setf pfile (read-line))
	(format t "Please enter the file with the reciever's public key~%")
	(setf kfile (read-line))
	(format t "Please enter the name of the file for the cypher text~%")
	(setf ofile (read-line))
	(encrypt_file pfile kfile ofile)))
  (if (string-equal choice "2")
      (progn
	(format t "Please enter file to be decrypted~%")
	(setf efile (read-line))
	(format t "Plese enter the file with your key~%")
	(setf kfile (read-line))
	(decrypt_file efile kfile)))
  (if (string-equal choice "3")
      (progn
	(format t "Please enter the name of the file you wish to encrypt~%")
	(setf pfile (read-line))
	(format t "Please enter the file with your private key~%")
	(setf kfile (read-line))
	(format t "Please enter the name of the file for the cypher text~%")
	(setf ofile (read-line))
	(encrypt_file pfile kfile ofile)))
  (if (string-equal choice "4")
      (progn
	(format t "Please enter file to be decrypted~%")
	(setf efile (read-line))
	(format t "Plese enter the file with the senders public key~%")
	(setf kfile (read-line))
	(decrypt_file efile kfile)))
  (if (string-equal choice "5")
      (progn
	(format t "Please enter where you want your public key stored~%")
	(setf pukey (read-line))
	(format t "Please enter where you want the private key stored~%")
	(setf prkey (read-line))
	(make_key pukey prkey))))


;number <-- get_rand_numb (size)
;This function will generate a random number with size<= n <=(size + 1) digits.
;Since security is important I will not use the default seed, rather
;I will generate a random-state that I will use as a seed.
;finally as the random funtion in GCL seems to be biased towards even numbers 
;for very large numbers I will add one to the result
(defun get_rand_num (size)
  (let ((randSeed (make-random-state t))  ;Establish a seed for the random fun.
	(randSize (expt 10 size)))        ;Sets the ceiling for the random num.
    ;Generate the number
    (+ (random randSize randSeed) (+ 1 (expt 10 (- size 1))))))


;number <--get_pseudo_prime (size)
;This function will generate a pseudo prime with at least size digits and at 
;most size + 1 digits.  It will get a random number and then use the 
;Solovay-Strassen test 10 times to test for primality, if the number passes it
;will be returned else it will get another number and repeat the tests
(defun get_pseudo_prime (size)
  (setf testnum (get_rand_num size))
  ;This loop will continue until a probablilistic prime is found.
  (while (not (= (test_primality testnum) 1)) 
    (setf testnum (get_rand_num size)))
  testnum)

;number <--test_primality (n)
;This function will return a 1 if the testprime passes the test ten times
;if it fails it will return a zero
(defun test_primality (n)
  (setf exponent (truncate (- n 1) 2)
	x 0
	isprime 1)
  ;Do the test 10 times or until it returns a composite value
  (while (and (< x 10)(= isprime 1))
    (setf a (random (- n 1)))
    (setf testvalue (expt_mod a exponent n))
    ;If a number is composite set isprime to 0 and exit loop.
    (if (not (or (= testvalue 1)(= testvalue (- n 1))(= testvalue 0)))
	(setf isprime 0)
      (incf x)))
  isprime)


;**This is the original expt_mod, I replaced it with the one bleow because**
;**The fully recurrsive version was choking on numbers larger than 50 digits**
;number <-- expt_mod (number exponent modulus)
;This function is meant to facilitate calculating large exponents whose modulus;is then taken.  Since the system will choke on very large exponents (where 
;it could concievably take hundreds of digits, the system will rely on the 
;fact that x^n mod m is equivalent to (x^(n/2) mod m)^2 mod m to calculate the
;values without going beyond the ability of the system to handle it.
;(defun expt_mod (number exponent modulus)
;  (if (= exponent 1) ;Base case, if the exponent is 1 return the number
;      number
   ;If it is an odd exponent subtract 1, divide by 2 and square the result and
   ;multiply by the number, taking the modulus in the process
;    (if (= (mod exponent 2) 1) 
;        (mod
;	 (*(expt (expt_mod number (/ (- exponent 1) 2) modulus) 2) number)
;	 modulus)
      ;else divide by two and then square the resulting exponent and take the
      ;modulus.
;      (mod (expt (expt_mod number (/ exponent 2) modulus) 2) modulus))))

;number <-- expt_mod (number exponent modulus)
;This function is meant to facilitate calculating large exponents whose modulus
;is then taken.  Since the system will choke on very large exponents (where 
;it could concievably take hundreds of digits, the system will rely on the 
;fact that x^n mod m is equivalent to (x^(n/2) mod m)^2 mod m to calculate the
;values without going beyond the ability of the system to handle it.
;It should be noted that the recursive segment of this algorithm is much less
;significant than the precious version and is based off of the idea that 
;log A*B = (log A + log B), where A can then be used to determine the number of
;iterations to run at.
(defun expt_mod (number exponent modulus)
  (if (<= exponent 1)
      (mod (expt number exponent) modulus)
    (progn
      (setf x (floor (log exponent 2)))
      (setf y (- exponent (expt 2 x)))
      (setf temp number)
      (do ((i 0 (+ i 1)))
	  ((>= i x))
	(setf number (mod (* number number) modulus)))
      (mod (* number (expt_mod temp y modulus)) modulus))))




;number <-- thi_of_n (prime1 prime2)
;This function simply computes thi(n) for the product of the two primes that
;are placed into it. 
(defun thi_of_n (prime1 prime2)
  (* (- prime1 1) (- prime2 1)))
  

;number <-- choose_b (thi_N)
;This will choose some number b smaller than thi_N and make sure that the 
;gcd(thi_N, B) is 1, if not it will return another B. Note because of the 
;proclivity of Lisp's random function to choose even numbers when they are
;large 1 will be added to the final result to make the occurace of odd numbers 
;more likely (and essential since thi_N will always be even)
(defun choose_b (thi_N)
  (setf b (+ (random thi_N) 1))
  (while (not (= (gcd thi_n b) 1))
    (setf b (+ (random thi_N) 1)))
  b)

;number <-- choose_a (n, b)
;Thus is actually an implementation of the Extended Euclid Algorithm and it
;finds the inverse of b in a mod n system (in this case thi(n)).
(defun choose_a (n b)
  (setf n[0] n)
  (setf b[0] b)
  (setf x[0] 0)
  (setf x 1)
  (setf q (floor n[0] b[0]))
  (setf r (- n[0] (* q b[0])))
  (while (> r 0)
    (setf temp (- x[0] (* q x)))
    (setf temp (mod temp n))
    (setf x[0] x)
    (setf x temp)
    (setf n[0] b[0])
    (setf b[0] r)
    (setf q (floor n[0] b[0]))
    (setf r (- n[0] (* q b[0]))))
  (if (not(= b[0] 1))
      'nil
    (mod x n)))

;make_key (public, private)
;This function will generate the key for a user
;Currently it will work with primes of 50 digits each
(defun make_key (public private)
  (format t "This could take a minute or two")
  (setf my_p (get_pseudo_prime 50))
  (setf my_q (get_pseudo_prime 50))
  (setf my_n (* my_p my_q))
  (setf my_thi_n (thi_of_n my_p my_q))
  (setf my_b (choose_b my_thi_n))
  (setf my_a (choose_a my_thi_n my_b))
  (setf pub_key (make-pathname :name public))
  (setf pub_file (open pub_key :direction :output :if-exists :supersede))
  (setf priv_key (make-pathname :name private))
  (setf priv_file (open priv_key :direction :output :if-exists :supersede)) 
  (format pub_file "~A~%" my_b)
  (format pub_file "~A~%" my_n)
  (close pub_file)
  (format priv_file "~A~%" my_a)
  (format priv_file "~A~%" my_n)
  (format priv_file "~A~%" my_thi_n)
  (format priv_file "~A~%" my_p)
  (format priv_file "~A~%" my_q)
  (close priv_file))

;encrypt_file(file, file file)
;This function will read in a plain text file, convert it into an ascii list
;that represents it and then encrypt it using the RSA encryption algorithm.
(defun encrypt_file (p_txt_file public e_txt_file)
  (setf filestream (make-pathname :name public))
  (setf key_file (open filestream :direction :input))
  (setf a (str_to_int (read-line key_file)))
  (setf n (str_to_int (read-line key_file)))
  (close key_file)
  (setf ptext (read_text_file p_txt_file))
  (setf i (- (length ptext) 1))
  (setf j 9)
  (setf temp 0)
  (setf filestream (make-pathname :name e_txt_file))
  (setf key_file (open filestream :direction :output :if-exists :supersede))
  (while (>= i 0)
    (setf temp (+ temp (* (nth i ptext)(expt 1000 j))))
    (if (= j 0)
	(progn
	  (format key_file "~A~%" (encrypt temp a n))
	  (setf temp 0)))
    (decf i)
    (setf j (mod (- j 1) 10)))
  (format key_file "~A~%" (encrypt temp a n))
  nil)

;decrypt_file(file, file)
;This function will take two files, and encrypted file and a key file and 
;decrypt the encrypted file and print the results to the screen.
(defun decrypt_file (e_txt_file private)
  (setf filestream (make-pathname :name private))
  (setf key_file (open filestream :direction :input))
  (setf b (str_to_int (read-line key_file)))
  (setf n (str_to_int (read-line key_file)))
  (close key_file)
  (setf test (make-pathname :name e_txt_file))
  (setf file (open test :direction :input))  
  (setf sentinal1 0)
  (do ((line (read-line file nil 'eof)
	     (read-line file nil 'eof)))
      ((eql line 'eof))
    (progn
      (setf etext (str_to_int line))
      (setf ptext (encrypt etext b n))
      (while (> ptext 0)
	(setf temp_num (mod ptext 1000))
	(setf ptext (floor ptext 1000))
	(if (= sentinal1 0)
	    (setf temp_lst (cons temp_num nil))
	  (setf temp_lst (cons temp_num temp_lst)))

	(incf sentinal1))
      (setf sentinal1 0)
      (write_plain_text temp_lst))))

;int<--encrypt(int, int, int)
;Thus function will encrypt (or decrypt depending how it is used) the text
;number that it is given.  
(defun encrypt (text exponent modulus)
  (expt_mod text exponent modulus))


;list<--read_text_file (file)
;This function will read a file in and convert the individual characters in
;it into numbers which will then be placed into the list that will allow it
;to be encrypted.
(defun read_text_file (filename)
  (setf test (make-pathname :name filename))
  (setf file (open test :direction :input))
  (setf j 0)
  (with-open-file (str file :direction :input)
  (do ((line (read-line file nil 'eof)
	     (read-line file nil 'eof)))
      ((eql line 'eof))
    (progn
      (setf i 0)
      (while (> (length line) i)
	(if (= j 0)
	    (setf x (cons (char-code (char line i)) nil))
	  (setf x (cons (char-code (char line i)) x)))
	(incf i)
	(incf j)))
    (setf x (cons 10 x))))  ;This fills in the next line character
  x)


;list<-- parse_num (number)
;This function will take a number and parse it into a list of two and three
;digit numbers, which should be ASCII values which then can be parsed into
;real characters.
(defun parse_num (arg)
  (setf s 0)
  (while (> arg 0)
    (setf temp_num (mod arg 1000))
    (setf arg (floor arg 1000))
    (if (= s 0)
	(setf num_lst (cons temp_num nil))
      (setf num_lst (cons temp_num num_lst)))
    (incf s))
  num_lst)


;write_plain_text (list)
;This will take a list and convert the values in that list to characters and
;then write them to the screen.
(defun write_plain_text (list)
  (setf i 0)
  (while (< i (length list))
    (format t "~A" (code-char (nth i list)))
    (incf i)))

;int <-- str_to_int(string)
;This function calls char_con to convert a digit to a str.
(defun str_to_int (numstr)
  (char_con numstr (- (length numstr) 1) 0)
)

;int <-- char_con (string, int, int)
;Thus function will take a string and convert it into a number.
(defun char_con (numstr place position) 
  (if (= place 0)
      (* (- (char-code (char numstr 0)) 48)(expt 10 position))
    (+ (char_con numstr (- place 1) (+ position 1))
       (* (- (char-code (char numstr place)) 48)(expt 10 position)))))
   

;This macro simulates a while loop similar to that found in many procedural 
;languages.
(defmacro while (test &rest body)
  `(do ()
       ((not ,test))
     ,@body))