Update file encryption to work with binary or textual ports.
authorChris Hanson <org/chris-hanson/cph>
Fri, 28 Apr 2017 05:43:53 +0000 (22:43 -0700)
committerChris Hanson <org/chris-hanson/cph>
Fri, 28 Apr 2017 05:43:53 +0000 (22:43 -0700)
src/edwin/filcom.scm
src/edwin/fileio.scm

index 2ee4ee37cf2b46154d46d0c0d75320bb28d973f7..33b275565d0cbbb70887a034b046bb99afb036d0 100644 (file)
@@ -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)))
+\f
+(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))))
 \f
 ;;;; Prompting
 
index 1f8a51da1889ac143d27d8a22ebdf9e092a1b4ef..eb3d69dc03c78e20a192557c8b1addd3f958a2c0 100644 (file)
@@ -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)