Add support for Blowfish.
authorChris Hanson <org/chris-hanson/cph>
Mon, 9 Jun 1997 08:12:28 +0000 (08:12 +0000)
committerChris Hanson <org/chris-hanson/cph>
Mon, 9 Jun 1997 08:12:28 +0000 (08:12 +0000)
v7/src/edwin/os2.scm
v7/src/edwin/unix.scm

index 267c32d467df4623aafca236e5e093724bca634e..938c46353f245d71c0e260313526e6f03afacfea 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: os2.scm,v 1.39 1997/06/06 05:06:04 cph Exp $
+;;;    $Id: os2.scm,v 1.40 1997/06/09 08:12:22 cph Exp $
 ;;;
 ;;;    Copyright (c) 1994-97 Massachusetts Institute of Technology
 ;;;
@@ -46,7 +46,7 @@
 (declare (usual-integrations))
 \f
 (define dos/encoding-pathname-types
-  '("gz" "ky"))
+  '("gz" "bf" "ky"))
 
 (define dos/executable-pathname-types
   '("exe" "cmd"))
                       (not (equal? "gz" (pathname-type pathname))))
                  (list (string-append (->namestring pathname) ".gz"))
                  '())
+             (if (and (ref-variable enable-encrypted-files group)
+                      (not (equal? "bf" (pathname-type pathname))))
+                 (list (string-append (->namestring pathname) ".bf"))
+                 '())
              (if (and (ref-variable enable-encrypted-files group)
                       (not (equal? "ky" (pathname-type pathname))))
                  (list (string-append (->namestring pathname) ".ky"))
@@ -340,30 +344,41 @@ filename suffix \".gz\"."
 (define-variable enable-encrypted-files
   "If true, encrypted files are automatically decrypted when read,
 and recrypted when written.  An encrypted file is identified by the
-filename suffix \".ky\"."
+filename suffixes \".bf\" and \".ky\"."
   #t
   boolean?)
 
 (define (read/write-encrypted-file? group pathname)
   (and (ref-variable enable-encrypted-files group)
-       (equal? "ky" (pathname-type pathname))))
+       (or (and (equal? "bf" (pathname-type pathname))
+               (blowfish-available?))
+          (equal? "ky" (pathname-type pathname)))))
 
 (define (read-encrypted-file pathname mark)
-  (let ((password (prompt-for-password "Password: ")))
+  (let ((password (prompt-for-password "Password: "))
+       (type (pathname-type pathname)))
     (message "Decrypting file " (->namestring pathname) "...")
-    (insert-string (let ((the-encrypted-file
-                         (call-with-binary-input-file pathname
-                           (lambda (port)
-                             (read-string (char-set) port)))))
-                    (decrypt the-encrypted-file password
-                             (lambda () 
-                               (kill-buffer (mark-buffer mark))
-                               (editor-error "krypt: Password error!"))
-                             (lambda (x) 
-                               (editor-beep)
-                               (message "krypt: Checksum error!")
-                               x)))
-                  mark)
+    (cond ((equal? "bf" type)
+          (call-with-binary-input-file pathname
+            (lambda (input)
+              (read-blowfish-file-header input)
+              (call-with-output-mark mark
+                (lambda (output)
+                  (blowfish-encrypt-port input output password #f))))))
+         ((or (equal? "ky" type) (equal? "KY" type))
+          (insert-string (let ((the-encrypted-file
+                                (call-with-binary-input-file pathname
+                                  (lambda (port)
+                                    (read-string (char-set) port)))))
+                           (decrypt the-encrypted-file password
+                                    (lambda () 
+                                      (kill-buffer (mark-buffer mark))
+                                      (editor-error "krypt: Password error!"))
+                                    (lambda (x) 
+                                      (editor-beep)
+                                      (message "krypt: Checksum error!")
+                                      x)))
+                         mark)))
     ;; Disable auto-save here since we don't want to
     ;; auto-save the unencrypted contents of the 
     ;; encrypted file.
@@ -373,14 +388,25 @@ filename suffix \".ky\"."
     (append-message "done")))
 
 (define (write-encrypted-file region pathname)
-  (let ((password (prompt-for-confirmed-password)))
+  (let ((password (prompt-for-confirmed-password))
+       (type (pathname-type pathname)))
     (message "Encrypting file " (->namestring pathname) "...")
-    (let ((the-encrypted-file
-          (encrypt (extract-string (region-start region) (region-end region))
-                   password)))
-      (call-with-binary-output-file pathname
-       (lambda (port)
-         (write-string the-encrypted-file port))))
+    (cond ((equal? "bf" type)
+          (let ((input
+                 (make-buffer-input-port (region-start region)
+                                         (region-end region))))
+            (call-with-binary-output-file pathname
+              (lambda (output)
+                (write-blowfish-file-header output)
+                (blowfish-encrypt-port input output password #t)))))
+         ((or (equal? "ky" type) (equal? "KY" type))
+          (let ((the-encrypted-file
+                 (encrypt (extract-string (region-start region)
+                                          (region-end region))
+                          password)))
+            (call-with-binary-output-file pathname
+              (lambda (port)
+                (write-string the-encrypted-file port))))))
     (append-message "done")))
 \f
 ;;;; Mail Customization
index ce07fa2f302d2b58c07c377cc48d9a3aaf3c9ad5..0df46cd6aeb6fe3ab80891a4f7b3961e4cbe5d8e 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: unix.scm,v 1.78 1997/06/06 05:05:59 cph Exp $
+;;;    $Id: unix.scm,v 1.79 1997/06/09 08:12:28 cph Exp $
 ;;;
 ;;;    Copyright (c) 1989-97 Massachusetts Institute of Technology
 ;;;
@@ -276,7 +276,7 @@ Includes the new backup.  Must be > 0."
              result))))))
 \f
 (define unix/encoding-pathname-types
-  '("Z" "gz" "KY" "ky"))
+  '("Z" "gz" "KY" "ky" "bf"))
 
 (define unix/backup-suffixes
   (cons "~"
@@ -487,33 +487,46 @@ of the filename suffixes \".gz\" or \".Z\"."
 (define-variable enable-encrypted-files
   "If true, encrypted files are automatically decrypted when read,
 and recrypted when written.  An encrypted file is identified by the
-filename suffix \".ky\"."
+filename suffixes \".bf\" and \".ky\"."
   #t
   boolean?)
 
 (define (read/write-encrypted-file? group pathname)
   (and (ref-variable enable-encrypted-files group)
-       (member (pathname-type pathname) unix/encrypted-file-suffixes)))
+       (let ((type (pathname-type pathname)))
+        (and (member type unix/encrypted-file-suffixes)
+             (if (equal? "bf" type)
+                 (blowfish-available?)
+                 #t)))))
 
 (define unix/encrypted-file-suffixes
-  '("KY" "ky"))
+  '("bf" "ky" "KY"))
 
 (define (read-encrypted-file pathname mark)
-  (let ((password (prompt-for-password "Password: ")))
+  (let ((password (prompt-for-password "Password: "))
+       (type (pathname-type pathname)))
     (message "Decrypting file " (->namestring pathname) "...")
-    (insert-string (let ((the-encrypted-file
-                         (call-with-binary-input-file pathname
-                           (lambda (port)
-                             (read-string (char-set) port)))))
-                    (decrypt the-encrypted-file password
-                             (lambda () 
-                               (kill-buffer (mark-buffer mark))
-                               (editor-error "krypt: Password error!"))
-                             (lambda (x) 
-                               (editor-beep)
-                               (message "krypt: Checksum error!")
-                               x)))
-                  mark)
+    (cond ((equal? "bf" type)
+          (call-with-binary-input-file pathname
+            (lambda (input)
+              (read-blowfish-file-header input)
+              (call-with-output-mark mark
+                (lambda (output)
+                  (blowfish-encrypt-port input output password #f))))))
+         ((or (equal? "ky" type) (equal? "KY" type))
+          (insert-string (let ((the-encrypted-file
+                                (call-with-binary-input-file pathname
+                                  (lambda (port)
+                                    (read-string (char-set) port)))))
+                           (decrypt the-encrypted-file password
+                                    (lambda () 
+                                      (kill-buffer (mark-buffer mark))
+                                      (editor-error "krypt: Password error!"))
+                                    (lambda (x) 
+                                      (editor-beep)
+                                      (message "krypt: Checksum error!")
+                                      x)))
+                         mark)))
     ;; Disable auto-save here since we don't want to
     ;; auto-save the unencrypted contents of the 
     ;; encrypted file.
@@ -523,14 +536,25 @@ filename suffix \".ky\"."
     (append-message "done")))
 
 (define (write-encrypted-file region pathname)
-  (let ((password (prompt-for-confirmed-password)))
+  (let ((password (prompt-for-confirmed-password))
+       (type (pathname-type pathname)))
     (message "Encrypting file " (->namestring pathname) "...")
-    (let ((the-encrypted-file
-          (encrypt (extract-string (region-start region) (region-end region))
-                   password)))
-      (call-with-binary-output-file pathname
-       (lambda (port)
-         (write-string the-encrypted-file port))))
+    (cond ((equal? "bf" type)
+          (let ((input
+                 (make-buffer-input-port (region-start region)
+                                         (region-end region))))
+            (call-with-binary-output-file pathname
+              (lambda (output)
+                (write-blowfish-file-header output)
+                (blowfish-encrypt-port input output password #t)))))
+         ((or (equal? "ky" type) (equal? "KY" type))
+          (let ((the-encrypted-file
+                 (encrypt (extract-string (region-start region)
+                                          (region-end region))
+                          password)))
+            (call-with-binary-output-file pathname
+              (lambda (port)
+                (write-string the-encrypted-file port))))))
     (append-message "done")))
 \f
 ;;;; Dired customization