From 6f4947d242f922a1895587c3ae690a6ffba83f21 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 27 Apr 2017 22:43:53 -0700 Subject: [PATCH] Update file encryption to work with binary or textual ports. --- src/edwin/filcom.scm | 64 +++++++++++++++++++++++++------------------- src/edwin/fileio.scm | 9 ++++--- 2 files changed, 42 insertions(+), 31 deletions(-) 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) -- 2.25.1