;;; public.scm
;;;
;;;
;;; Public Key Cryptography

;;; -----------------------------------------------------------------
;;; PUBLIC KEY CREATION
;;;
;;; Some definitions:
;;;
;;; "key system" -- a key system consists of both public information
;;;                 (p, g, and y) and private information (x) that
;;;                 can be used by the private key's owner to encrypt
;;;                 and sign messages
;;;
;;; "public key" -- this is just the public information about a 
;;;                 person's key that is released to the world so that
;;;                 others can encrypt/decrypt and authenticate
;;;                 

;; ElGamal key agreement: produce a key system, consisting of
;; a safe prime p, a generator g for p, an exponent x, and y = g^x (mod p)

;; To produce a key system, first choose values for safe prime p and 
;; generator g, then package it along with an exponent x, and
;; y = g^x (mod p).  
;;
(define (generate-key-system digits)
  (let ((p (choose-safe-prime digits))) ;p will be public
    (let ((g (find-generator p)))       ;g will be public
      (let ((x (choose-random p)))      ;x will be secret
        (let ((y (expmod g x p)))       ;y will be public
          (make-key-system p g x y))))))

;; Create a public key using the public parts of a key system
;;
(define (key-system->public-key key-system)
  (make-public-key (key-system-p key-system)
                   (key-system-g key-system)
                   (key-system-y key-system)))


;;; -----------------------------------------------------------------
;;; ENCRYPTION AND DECRYPTION

;; ElGamal encryption, given a message and a public key
;;
(define (encrypt message-text public-key)
  (let ((p (public-key-p public-key))
        (g (public-key-g public-key))
        (y (public-key-y public-key)))
    (let ((my-x (choose-random p)))
      (make-encrypted-message
       (expmod g my-x p)
       (symmetric-encrypt message-text (expmod y my-x p))))))

;; PROBLEM 1

;; ElGamal decryption, given a message-pair and a key system
;;
;; **** This is for you to implement
;;
(define (decrypt encrypted-message key-system)
  ...)

;;; -----------------------------------------------------------------
;;; DIGITAL SIGNATURES

;; ElGamal Signing
;;
(define (sign message key-system)
  (let ((p (key-system-p key-system))
        (g (key-system-g key-system))
        (x (key-system-x key-system)))
    (let ((h (modulo (message-digest message) p))
          (k (good-k p)))
      (let ((r (expmod g k p))
            (d (invert-modulo k (- p 1))))
        (let ((s (modulo (* d (- h (* x r))) (- p 1))))
          (make-signature r s))))))

;; Finding a "good k" such that 2 <= k <= p-2 with gcd(k,p-1)=1
(define (good-k p)
  (let ((k (choose-random (- p 1))))
    (if (= (gcd k (- p 1)) 1)
        k
        (good-k p))))

;; Computing the inverse of k modulo m
(define (invert-modulo k m)
  (if (= (gcd k m) 1)
      (let ((y (cadr (solve-ax+by=1 m k))))
        (modulo y m))                   ;just in case y was negative
      (error "gcd not 1" k m)))

;; PROBLEM 4

;; solve ax+by=1
;;
;; **** This is for you to implement
;;
(define (solve-ax+by=1 a b)...) 


;; PROBLEM 3

;; ElGamal Verifying
;;
;; **** This is for you to implement
;;
(define (verify message signature public-key) ...)


;;; -----------------------------------------------------------------
;;; CRACKING PUBLIC KEY ENCRYPTION

;; If we can compute discrete logs, we can crack a public key to 
;; recover the entire key system

(define (crack-public-key public-key)
  (let ((p (public-key-p public-key))
        (g (public-key-g public-key))
        (y (public-key-y public-key)))
    (make-key-system p
                     g
                     (find-discrete-log y g p)
                     y)))

;; PROBLEM 5

;; find-discrete-log by brute force search.  Find x, given g^x mod p
;;
;; **** This is for you to implement
;;
(define (find-discrete-log y g p) ...)


;;; -----------------------------------------------------------------
;;; FINDING PRIME NUMBERS
;;;
;;; Essentially as in section 1.2.6 of the book

;; To choose a prime, we start searching at a random odd number of 
;; a specified number of digits

(define (choose-prime digits)
  (let ((range (expt 10 (- digits 1))))
    (let ((start (+ range (choose-random (* 9 range)))))
    (search-for-prime (if (even? start) (+ start 1) start)))))

;; We seach by checking with two rounds of the Fermat test
(define (search-for-prime guess)
  (if (fast-prime? guess 2)
      guess
      (search-for-prime (+ guess 2))))

;; The Fermat test for primality, from the textbook section 1.2.6
;; except that we use a procedure CHOOSE-RANDOM that returns 
;; a random number between 2 and n-2 (inclusive).

(define (fermat-test n)
    (let ((a (choose-random n)))
      (= (expmod a n n) a)))

(define (fast-prime? n times)
    (cond ((= times 0) true)
          ((fermat-test n) (fast-prime? n (- times 1)))
          (else false)))

;; PROBLEM 2

;; choose-safe-prime
;;
;; Find a prime of the form 2q+1
;;
;; **** This is for you to implement
;;
(define (choose-safe-prime digits) ...)

;; find-generator
;;
;; **** This is for you to implement
;;
;;(define (find-generator safe-prime) ...)
    

;; fast modular exponentiation
;;
;; Note that here (unlike the textbook) we use MODULO rather than REMAINDER.
;; The difference is that MODULO returns a positive value, even if
;; the first argument is negative, while REMAINDER does not. In the book,
;; we only worried about reducing positive numbers, but the subtraction 
;; in the SIGN procedure could produce a negative number that we'd need to
;; reduce.

(define (expmod b e m)
  (cond ((zero? e) 1)
        ((even? e)
         (modulo (square (expmod b (/ e 2) m))
                 m))
        (else
         (modulo (* b (expmod b (-1+ e) m))
                 m))))

(define (square x) (* x x))


;;; -----------------------------------------------------------------
;;; ENCRYTION SUPPORT PROCEDURES
;;;

;; symmetric cipher encryption/decryption
;;
;; This uses the same integer key to encrypt and decrypt a string
;; message into/from an intcode. The particular symmetric cipher used
;; here is called blowfish.  The details of it are not shown.
;;
(define (symmetric-encrypt message-text key)
  (message->intcode (blowfish-encrypt-string message-text
                                             (number->string key)
                                             #t)))

(define (symmetric-decrypt cipher-intcode key)
    (blowfish-encrypt-string (intcode->message cipher-intcode)
                             (number->string key)
                             #f))

;; hack to allow both old and new versions of MIT Scheme 7.5a to work.
;; ignore this
(or (environment-bound?
	  system-global-environment 'blowfish-encrypt-string)
    (eval 
     '(define (blowfish-encrypt-string string key encrypt?)
	(if encrypt?
	    (let ((n (string-length string))
		  (init-vector (compute-blowfish-init-vector)))
	      (let ((ciphertext (make-string (+ n 8))))
		(substring-move-left! init-vector 0 8 ciphertext 0)
		(blowfish-cfb64 string 0 n
				ciphertext 8
				(blowfish-set-key (md5 key))
				init-vector 0
				#t)
		ciphertext))
	    (let ((n+8 (string-length string)))
	      (let ((plaintext (make-string (- n+8 8))))
		(blowfish-cfb64 string 8 n+8
				plaintext 0
				(blowfish-set-key (md5 key))
				(substring string 0 8) 0
				#f)
		plaintext))))
     user-initial-environment)
    )




;; message-digest
;;
;; This performs a one-way hash on the message string (without the
;; use of any key).  We happen to use md5 here. 
;;
(define (message-digest string)
  (message->intcode (md5 string)))
;E.g. (message-digest "This is a test")


;; ------------------------------
;; Random numbers

;; Pick a random number between 2 and n-1
(define (choose-random n)
  (+ 2 (protected-random (- n 2))))

;; The following procedure picks a random number in a given range,
;; but makes sure that the specified range is not too big for
;; Scheme's RANDOM primitive, which only works up to about 10^300
;;
(define (protected-random n)
  (let ((max-random-number (expt 10 300))) ;limits of Scheme RANDOM primitive
    (random (floor->exact (min n max-random-number)))))

;; to help in debugging.  Whenever you run reset-random!, the
;; random number generator will be returned to its initial state.
;; This permits you to do repeatable experiments.
;;
(define initial-random-state (make-random-state false))

(define (reset-random!)
  (set! *random-state* (make-random-state initial-random-state))
  "Random number generator has been reset")


;; ------------------------------
;; utility for timing procedure calls.
;; returns the time in seconds
;;
(define (timed f . args)
  (let ((start (runtime)))
    (let ((val (apply f args)))
      (list (- (runtime) start) val))))

;; ------------------------------
;; Simple data structures for the crypto algorithms

;; Constructor and selectors for encrypted messages

(define (make-encrypted-message y cipher-intcode)
  (list y cipher-intcode))

(define (encrypted-message-y message-pair)
  (car message-pair))

(define (encrypted-message-cipher-intcode message-pair)
  (cadr message-pair))

;; Constructor and selectors for key systems

(define (make-key-system p g x y)
  (list p g x y))

(define (key-system-p key-system)
  (list-ref key-system 0))

(define (key-system-g key-system)
  (list-ref key-system 1))

(define (key-system-x key-system)
  (list-ref key-system 2))

(define (key-system-y key-system)
  (list-ref key-system 3))

;; Constructor and selectors for public keys

(define (make-public-key p g y)
  (list p g y))

(define (public-key-p public-key)
  (list-ref public-key 0))

(define (public-key-g public-key)
  (list-ref public-key 1))

(define (public-key-y public-key)
  (list-ref public-key 2))

;; Constructor and selectors for signatures

(define (make-signature r s)
  (list r s))

(define (signature-r signature)
  (list-ref signature 0))

(define (signature-s signature)
  (list-ref signature 1))


;; ------------------------------
;; Low-Level Message Conversions 

;; message->intlist converts a message (a string) into a 'intlist'
;;
;; Details: For ease of understanding (a cryptographic oxymoron!) 
;; this simple 'number for character' substitution starts at 1 for "a"
;; and proceeds sequentially.  We assume there are only 256 possible
;; characters and thus 'wrap around' our numbers so they are in the
;; range 1 to 256.
;;
(define (message->intlist msg)
  (map (lambda (char)
         (+ 1 (modulo (- (char->integer char) 97) 256)))
       (string->list msg)))
;E.g. (message->intlist "cat")

;; and its inverse...
(define (intlist->message intlist)
  (apply string-append
         (map (lambda (code)
                (char->string (integer->char (modulo (+ code 96) 256))))
              intlist)))
;E.g. (intlist->message (list 1 2))

;; combine-intlist merges together a whole sequence of numbers into
;; one big number.  So one can actually "look" at the numbers
;; and see the message, we will do something simple and allocate three
;; digits for each character number.  
;;
(define (combine-intlist nums)
  (define (combine-helper nums sofar)
    (if (null? nums)
        sofar
        (combine-helper (cdr nums)
                        (+ (* 1000 sofar) (car nums)))))
  (combine-helper nums 0))
;E.g. (combine-intlist (list 1 2 3))

;; split-intcode takes a big integer and pulls out the individual numbers
;; in it.
(define (split-intcode num)
  (if (< num 1000)
      (list num)
      (append (split-intcode (quotient num 1000))
              (list (remainder num 1000)))))
;E.g. (split-intcode 1003)
;     (split-intcode (combine-intlist (list 1 222 5)))

;; message->intcode converts a message (a string) into an 'intcode' (a
;; single large integer version of the message).
;;
(define (message->intcode msg)
  (combine-intlist (message->intlist msg)))
;E.g. (message->charcodes  "ab")
;     (message->intcode "ab")

;; and its inverse...
(define (intcode->message num)
  (intlist->message (split-intcode num)))
;E.g. (intcode->message 1002)
;E.g. (intcode->message (message->intcode "this is a test"))


;;; -----------------------------------------------------------------
;;; TEST DATA FOR PROBLEM SET

(define ks-ex-1 (list 12611687927 2256251222 10083648550 10665630784))

(define enc-message-ex-1 (list 9879933445 219194251102137098014031162051181227199063032192224055119129254223131240212158046253221043082015061208078201001088095151039196239034179025247041117060059078217078051040024081106152141114071099075165184123085120112030162056105119158097011039227235038183044163144231064004150059052048200193120045051058111167172053114221213221174009096074025021063095185218177160235095211196111142204240020044078250103232252061036213164248165196038207252083200254255184110014061170243124083180250196118054070214118051241013100021023037059235036129201148216033204060074096156210256137086220050069133092191242235183178032148165158148233157105045197107193154126196140188240159089010120186067096162087241142153214102055126054037053227097109122089))

(define pk-ex-3 (list 4043495999 1180363484 81389772))

(define m1-ex-3 "Nobody in their right mind would take 6.001 on grades!")
(define s1-ex-3 (list 6374270378 1967067800))

(define m2-ex-3 "6.001 is the best course at the institute!")
(define s2-ex-3 (list 353109106 1381914417))

(define pk-ex-5 (list 8699 4469 3222))

(define pk-ex-vest (list 193163 50305 161114))

(define message-ex-vest (list 41204 170146241058085224019033029160020215198243090246204123199024174125183067250132123120206195119048126098008240027021028134242001037050221050140135222225209175098080195152012185127051110185055028188210219100024100176078085009174094207186157251051194202119228122016038058254168106017088032166041108234169006237029203068231130179096143006015065211172082244068153234002022184084051101069167229141122190027027188153076023064228216083021158144245086202227037169148152014014143207161182105008077026234224007158092121027213130009229132194254239076235153096255209041030116112180058033001132225254020110242049243040060108174087155189042044082119068160133022231118152188245005026209090113010182003088057050170060221252061047151061135209113093148139212143158037100185076220023217165022015167079148165081055111189243220106236086151121162182052063141115240088180059247141095071229204121042182025094066238246187163245190160028004098173087137106131114096209140004003178083123139204232014057123102178056068234031175199018077188248167127139002028042060124089024130124032093119039199023213069038221078050254247023120136135023234230026028228240030145221256249188092203192127155013253178126051081040172097176008094249119133031047036076022221117089202016226245060136004242022048153256013232100250251175246215068250050080102172252076086192002069132166111087057209239082009148107029020010092089196115044143093133095012250199243135211060150043117031096028130002119102188141001037037155053170226078116242114076040225185151168056189019011086146091194244118089145048026188130160251049207211089129122192056186085143101197036220166251030155157118122040219253113058015164031128046205080079102050162173073058136237017099248201220124170156074236223201177180129034066087119034170102112070030090202081051196176161055170079134198182081130014148218133091214023246008068204084239234105001123136226131046143184182106160138128076159125087068175226048226131027194062200135121122013242215069084024197115190080202096104055131232036220195005240039212208129082159153243054052079080144067188204044027164005128150006092005102244171160092126144124092158019196114190140065032180011069189019133067079173056035225128049120048106021028190093194))

;; more blowfish compatibility tricks.
;; ignore this also.
(or (environment-bound?
	  system-global-environment 'blowfish-encrypt-string)
    (eval
     '(begin
	(set! enc-message-ex-1 '(9879933445 219194251102137098014031162051181227199063032192224055119129254223131240212158046253221043082015061208078201001088095151039196239034179025247041117060059078217078051040024081106152141114071099075165184123085120112030162056105119158097011039227235038183044163144231064004150059052048200193120045051058111167172053114221213221174009096074025021063095185218177160235095211196111142204240020044078250103232252061036213164248165196038207252083200254255184110014061170243124083180250196118054070214118051241013100021023037059235036129201148216033204060074096156210256137086220050069133092191242235183178032148165158148233157105045197107193154126196140188240159089010120186067096162087241142153214102055126054037053227097109122089))
	(set! message-ex-vest '(41204 170146241058085224019033029160020215198243090246204123199024174125183067250132123120206195119048126098008240027021028134242001037050221050140135222225209175098080195152012185127051110185055028188210219100024100176078085009174094207186157251051194202119228122016038058254168106017088032166041108234169006237029203068231130179096143006015065211172082244068153234002022184084051101069167229141122190027027188153076023064228216083021158144245086202227037169148152014014143207161182105008077026234224007158092121027213130009229132194254239076235153096255209041030116112180058033001132225254020110242049243040060108174087155189042044082119068160133022231118152188245005026209090113010182003088057050170060221252061047151061135209113093148139212143158037100185076220023217165022015167079148165081055111189243220106236086151121162182052063141115240088180059247141095071229204121042182025094066238246187163245190160028004098173087137106131114096209140004003178083123139204232014057123102178056068234031175199018077188248167127139002028042060124089024130124032093119039199023213069038221078050254247023120136135023234230026028228240030145221256249188092203192127155013253178126051081040172097176008094249119133031047036076022221117089202016226245060136004242022048153256013232100250251175246215068250050080102172252076086192002069132166111087057209239082009148107029020010092089196115044143093133095012250199243135211060150043117031096028130002119102188141001037037155053170226078116242114076040225185151168056189019011086146091194244118089145048026188130160251049207211089129122192056186085143101197036220166251030155157118122040219253113058015164031128046205080079102050162173073058136237017099248201220124170156074236223201177180129034066087119034170102112070030090202081051196176161055170079134198182081130014148218133091214023246008068204084239234105001123136226131046143184182106160138128076159125087068175226048226131027194062200135121122013242215069084024197115190080202096104055131232036220195005240039212208129082159153243054052079080144067188204044027164005128150006092005102244171160092126144124092158019196114190140065032180011069189019133067079173056035225128049120048106021028190093194))
	)
     user-initial-environment)
    )