*** empty log message ***
authorBrian A. LaMacchia <edu/mit/csail/zurich/bal>
Mon, 30 Mar 1992 20:54:43 +0000 (20:54 +0000)
committerBrian A. LaMacchia <edu/mit/csail/zurich/bal>
Mon, 30 Mar 1992 20:54:43 +0000 (20:54 +0000)
v7/src/runtime/krypt.scm

index ef62eabefd91f671343b8a7e37e2559d116016ec..b3579c64e250539f8a039ebfbdf0a63a62f99826 100644 (file)
 
 (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)))))
     (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))
       (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)
      (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)))
          (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)."
+)))))
+           
+             
+             
+             
+