From 4dcf81116ff9ecb43884e82acacbaf01b86bad3b Mon Sep 17 00:00:00 2001
From: "Brian A. LaMacchia" <edu/mit/csail/zurich/bal>
Date: Mon, 30 Mar 1992 20:54:43 +0000
Subject: [PATCH] *** empty log message ***

---
 v7/src/runtime/krypt.scm | 82 ++++++++++++++++++++++++++++++++--------
 1 file changed, 67 insertions(+), 15 deletions(-)

diff --git a/v7/src/runtime/krypt.scm b/v7/src/runtime/krypt.scm
index ef62eabef..b3579c64e 100644
--- a/v7/src/runtime/krypt.scm
+++ b/v7/src/runtime/krypt.scm
@@ -16,10 +16,10 @@
 
 (define (rcm-keyinit key)
   (let loop ((i 0))
-    (if (< i ts)
+    (if (fix:< i ts)
 	(begin
 	  (vector-set! (key/state-table key) i i)
-	  (loop (1+ i)))
+	  (loop (fix:1+ i)))
 	(begin
 	  (set-key/index-i! key 0)
 	  (set-key/index-j! key 0)))))
@@ -29,16 +29,16 @@
     (let loop ((i 0)
 	       (j 0)
 	       (k 0))
-      (if (< i ts)
+      (if (fix:< i ts)
 	  (begin
 	    (let ((s (key/state-table key)))
-	      (let* ((j (modulo (+ j 1 
-				   (vector-ref s i)
-				   (char->ascii (string-ref kbuf k))) ts))
+	      (let* ((j (fix:remainder (fix:+ j 1 
+					  (vector-ref s i)
+					  (char->ascii (string-ref kbuf k))) ts))
 		     (t (vector-ref s i)))
 		(vector-set! s i (vector-ref s j))
 		(vector-set! s j t)
-		(loop (1+ i) j (modulo (1+ k) m)))))))))
+		(loop (fix:1+ i) j (fix:remainder (fix:1+ k) m)))))))))
 
 (define (rcm key n buf)
   (let ((i (key/index-i key))
@@ -47,13 +47,20 @@
       (let loop ((k 0)
 		 (i i)
 		 (j j))
-	(if (< k n)
+	(if (fix:< k n)
 	    (begin
-	      (let* ((i (modulo (1+ i) ts))
-		     (j (modulo (+ j (vector-ref s i)) ts))
+	      (let* ((i (fix:remainder (fix:1+ i) ts))
+		     (j (fix:remainder (fix:+ j (vector-ref s i)) ts))
 		     (t (vector-ref s i)))
 		(vector-set! s i (vector-ref s j))
 		(vector-set! s j t)
+		(string-set! buf k 
+			     (ascii->char 
+			      (fix:xor (char->ascii (string-ref buf k))
+				       (vector-ref s (fix:remainder 
+						      (fix:+ 1 (vector-ref s i) 
+							     (vector-ref s j)) ts)))))
+#|
 		(let ((buf-k-bitstr
 		       (unsigned-integer->bit-string 
 			8 (char->ascii (string-ref buf k))))
@@ -64,6 +71,7 @@
 		  (string-set! buf k (ascii->char 
 				      (bit-string->unsigned-integer
 				       (bit-string-xor buf-k-bitstr xor-string)))))
+|#
 		(loop (1+ k) i j)))
 	    (begin
 	      (set-key/index-i! key i)
@@ -92,21 +100,21 @@
      (write-to-string (decoded-time/year the-time)))))
 #|
 (define (get-krypt-time-string)
-  "Thu Mar 19 19:13:45 1992")
+  "Mon Mar 30 15:11:50 1992")
 |#
 (define (encrypt input-string password)
   (let ((checksum 0)
 	(output-string "")
 	(header (string-append kryptid (get-krypt-time-string) "\n")))
-    (set! output-string (string-append output-string header))
     (let ((key1 (make-key)))
       (rcm-keyinit key1)
       (rcm-key key1 header)
       (rcm-key key1 password)
-      (let ((passwordmac (list->string (map ascii->char '(0 0 0 0 0)))))
+      (let ((passwordmac (make-string 5 #\NUL)))
 	(rcm key1 5 passwordmac)
-	(set! output-string (string-append output-string passwordmac)))
-      (let loop ((rest input-string))
+	(set! output-string (string-append header passwordmac)))
+      (let loop ((rest input-string)
+		 (output-string-list '()))
 	(if (>= (string-length rest) 256)
 	    (let ((current-block (string-head rest 256))
 		  (new-rest (string-tail rest 256)))
@@ -126,3 +134,47 @@
 	  (set! output-string (string-append output-string cc-string))))
       output-string)))
 
+(define (decrypt input-string password)
+  (let* ((header-length (+ (string-length kryptid) 25))
+	 (header (string-head input-string header-length))
+	 (text1 (string-tail input-string header-length))
+	 (pwordmac (string-head text1 5))
+	 (encrypted-text (string-tail text1 5)))
+    (let ((key1 (make-key))
+	  (checksum 0)
+	  (output-string ""))
+      (rcm-keyinit key1)
+      (rcm-key key1 header)
+      (rcm-key key1 password)
+      (let ((passwordmac (make-string 5 #\NUL)))
+	(rcm key1 5 passwordmac)
+	(if (string=? passwordmac pwordmac)
+	    (begin
+	      (let loop ((rest encrypted-text)
+			 (output-string-list '()))
+		(if (>= (string-length rest) 256)
+		    (let ((current-block (string-head rest 256))
+			  (new-rest (string-tail rest 256)))
+		      (rcm key1 (string-length current-block) current-block)
+		      (set! checksum (+ checksum 
+					(apply + (map char->ascii (string->list current-block)))))
+		      (loop new-rest (cons current-block output-string-list)))
+		    (begin
+		      (rcm key1 (string-length rest) rest)
+		      (set! checksum (+ checksum 
+					(apply + (map char->ascii (string->list rest)))))
+		      (let ((foo (apply string-append (reverse (cons rest output-string-list)))))
+			(set! output-string (string-head foo (-1+ (string-length foo))))))))
+	      (if (not (= (fix:remainder checksum 256) 0))
+		  (set! output-string
+			(string-append output-string
+				       "krypt: Checksum error.  File may have been modified.\n")))
+	      output-string)
+	    (list header password passwordmac pwordmac)
+;	    "unmodified (a ciphertext file krypted with different password)."
+)))))
+	    
+	      
+	      
+	      
+	      
-- 
2.25.1