From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 28 Apr 2017 05:43:53 +0000 (-0700)
Subject: Update file encryption to work with binary or textual ports.
X-Git-Tag: mit-scheme-pucked-9.2.12~14^2~118
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=6f4947d242f922a1895587c3ae690a6ffba83f21;p=mit-scheme.git

Update file encryption to work with binary or textual ports.
---

diff --git a/src/edwin/filcom.scm b/src/edwin/filcom.scm
index 2ee4ee37c..33b275565 100644
--- a/src/edwin/filcom.scm
+++ b/src/edwin/filcom.scm
@@ -666,12 +666,13 @@ Prefix arg means treat the plaintext file as binary data."
 			   (->namestring to)
 			   " already exists; overwrite")))
        (begin
-	 ((if binary-plaintext?
-	      call-with-legacy-binary-input-file
-	      call-with-input-file)
-	  from
-	  (lambda (input)
-	    (%blowfish-encrypt-file to input)))
+	 (if binary-plaintext?
+	     (call-with-binary-input-file from
+	       (lambda (input)
+		 (%blowfish-encrypt-from-binary-port to input)))
+	     (call-with-input-file from
+	       (lambda (input)
+		 (%blowfish-encrypt-from-textual-port to input))))
 	 (let ((t (file-modification-time-indirect from)))
 	   (set-file-times! to t t))
 	 (set-file-modes! to (file-modes from))
@@ -686,46 +687,55 @@ Prefix arg means treat the plaintext file as binary data."
 			   (->namestring to)
 			   " already exists; overwrite")))
        (begin
-	 ((if binary-plaintext?
-	      call-with-legacy-binary-output-file
-	      call-with-output-file)
-	  to
-	  (lambda (output)
-	    (%blowfish-decrypt-file from output)))
+	 (if binary-plaintext?
+	     (call-with-binary-output-file to
+	       (lambda (output)
+		 (%blowfish-decrypt-to-binary-port from output)))
+	     (call-with-output-file to
+	       (lambda (output)
+		 (%blowfish-decrypt-to-textual-port from output))))
 	 (let ((t (file-modification-time-indirect from)))
 	   (set-file-times! to t t))
 	 (set-file-modes! to (file-modes from))
 	 (if delete-ciphertext? (delete-file from))
 	 #t)))
+
+(define (%blowfish-encrypt-from-textual-port pathname input)
+  (%blowfish-encrypt-from-binary-port
+   pathname
+   (textual->binary-port input 'iso-8859-1)))
 
-(define (%blowfish-encrypt-file pathname input)
-  (call-with-legacy-binary-output-file pathname
+(define (%blowfish-encrypt-from-binary-port pathname input)
+  (call-with-binary-output-file pathname
     (lambda (output)
-      (call-with-sensitive-string (call-with-confirmed-pass-phrase md5-string)
-	(lambda (key-string)
-	  (blowfish-encrypt-port input output key-string
+      (call-with-sensitive-bytes (call-with-confirmed-pass-phrase md5-string)
+	(lambda (key)
+	  (blowfish-encrypt-port input output key
 				 (write-blowfish-file-header output)
 				 #t))))))
 
-(define (%blowfish-decrypt-file pathname output)
-  (call-with-legacy-binary-input-file pathname
+(define (%blowfish-decrypt-to-textual-port pathname output)
+  (%blowfish-decrypt-to-binary-port
+   pathname
+   (textual->binary-port output 'iso-8859-1)))
+
+(define (%blowfish-decrypt-to-binary-port pathname output)
+  (call-with-binary-input-file pathname
     (lambda (input)
-      (call-with-sensitive-string
+      (call-with-sensitive-bytes
        (call-with-pass-phrase "Pass phrase" md5-string)
-       (lambda (key-string)
-	 (blowfish-encrypt-port input output key-string
+       (lambda (key)
+	 (blowfish-encrypt-port input output key
 				(read-blowfish-file-header input)
 				#f))))))
 
-(define (call-with-sensitive-string string receiver)
+(define (call-with-sensitive-bytes bytes receiver)
   (dynamic-wind (lambda ()
 		  unspecific)
 		(lambda ()
-		  (receiver string))
+		  (receiver bytes))
 		(lambda ()
-		  (string-fill! string #\NUL)
-		  (set! string)
-		  unspecific)))
+		  (bytevector-fill! bytes 0))))
 
 ;;;; Prompting
 
diff --git a/src/edwin/fileio.scm b/src/edwin/fileio.scm
index 1f8a51da1..eb3d69dc0 100644
--- a/src/edwin/fileio.scm
+++ b/src/edwin/fileio.scm
@@ -50,7 +50,7 @@ filename suffix \".bf\"."
     (message m)
     (call-with-output-mark mark
       (lambda (output)
-	(%blowfish-decrypt-file pathname output)))
+	(%blowfish-decrypt-to-textual-port pathname output)))
     ;; Disable auto-save here since we don't want to auto-save the
     ;; unencrypted contents of the encrypted file.
     (local-set-variable! auto-save-default #f (mark-buffer mark))
@@ -59,9 +59,10 @@ filename suffix \".bf\"."
 (define (write-encrypted-file region pathname)
   (let ((m (string-append "Encrypting file " (->namestring pathname) "...")))
     (message m)
-    (%blowfish-encrypt-file pathname
-			    (make-buffer-input-port (region-start region)
-						    (region-end region)))
+    (%blowfish-encrypt-from-textual-port
+     pathname
+     (make-buffer-input-port (region-start region)
+			     (region-end region)))
     (message m "done")))
 
 (define (os-independent/read-file-methods)