Add support for encrypted files.
authorChris Hanson <org/chris-hanson/cph>
Fri, 6 Dec 1996 22:34:08 +0000 (22:34 +0000)
committerChris Hanson <org/chris-hanson/cph>
Fri, 6 Dec 1996 22:34:08 +0000 (22:34 +0000)
v7/src/edwin/edwin.ldr
v7/src/edwin/os2.scm

index a3de07da14cc932555c7cc9790c75d97f2ae87a5..4245bb1ce17880b8370a070e725555c563962407 100644 (file)
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: edwin.ldr,v 1.56 1995/10/25 02:19:36 cph Exp $
+$Id: edwin.ldr,v 1.57 1996/12/06 22:34:08 cph Exp $
 
-Copyright (c) 1989-95 Massachusetts Institute of Technology
+Copyright (c) 1989-96 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -78,11 +78,11 @@ MIT in each case. |#
       (define string-member? (member-procedure string=?))
       (define (boolean-and a b) (and a b))
 
-      (if (eq? (lookup 'OS-TYPE) 'UNIX)
-         ;; #T means no error if not present.
-         (load-option 'KRYPT #t))
       (if (memq (lookup 'OS-TYPE) '(UNIX OS/2))
-         (load-option 'SUBPROCESS))
+         (begin
+           ;; #T means no error if not present.
+           (load-option 'KRYPT #t)
+           (load-option 'SUBPROCESS)))
       (load-option 'RB-TREE)
       (load-option 'HASH-TABLE)
 
index cddc8c0a7163f562251962714dc63cf64f53e805..f84b0ef4f2880f29c66b86c60e8d61d5839d95f0 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: os2.scm,v 1.35 1996/10/10 10:29:08 cph Exp $
+;;;    $Id: os2.scm,v 1.36 1996/12/06 22:34:02 cph Exp $
 ;;;
 ;;;    Copyright (c) 1994-96 Massachusetts Institute of Technology
 ;;;
 (define dired-pathname-wild?
   pathname-wild?)
 \f
-;;;; Compressed Files
+;;;; File-Encoding Methods
 
 (define (os/read-file-methods)
   `((,read/write-compressed-file?
      . ,(lambda (pathname mark visit?)
          visit?
-         (read-compressed-file "gzip -d" pathname mark)))))
+         (read-compressed-file "gzip -d" pathname mark)))
+    (,read/write-encrypted-file?
+     . ,(lambda (pathname mark visit?)
+         visit?
+         (read-encrypted-file pathname mark)))))
 
 (define (os/write-file-methods)
   `((,read/write-compressed-file?
      . ,(lambda (region pathname visit?)
          visit?
-         (write-compressed-file "gzip" region pathname)))))
+         (write-compressed-file "gzip" region pathname)))
+    (,read/write-encrypted-file?
+     . ,(lambda (region pathname visit?)
+         visit?
+         (write-encrypted-file region pathname)))))
 
 (define (os/alternate-pathnames group pathname)
-  (if (and (ref-variable enable-compressed-files group)
-          (dos/fs-long-filenames? pathname)
-          (not (equal? "gz" (pathname-type pathname))))
-      (list (string-append (->namestring pathname) ".gz"))
+  (if (dos/fs-long-filenames? pathname)
+      (append (if (and (ref-variable enable-compressed-files group)
+                      (not (equal? "gz" (pathname-type pathname))))
+                 (list (string-append (->namestring pathname) ".gz"))
+                 '())
+             (if (and (ref-variable enable-encrypted-files group)
+                      (not (equal? "ky" (pathname-type pathname))))
+                 (list (string-append (->namestring pathname) ".ky"))
+                 '()))
       '()))
+\f
+;;;; Compressed Files
 
 (define-variable enable-compressed-files
   "If true, compressed files are automatically uncompressed when read,
@@ -320,6 +335,54 @@ filename suffix \".gz\"."
                            (list region pathname)))
   (append-message "done"))
 \f
+;;;; Encrypted files
+
+(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\"."
+  true
+  boolean?)
+
+(define (read/write-encrypted-file? group pathname)
+  (and (ref-variable enable-encrypted-files group)
+       (equal? "ky" (pathname-type pathname))))
+
+(define (read-encrypted-file pathname mark)
+  (let ((password (prompt-for-password "Password: ")))
+    (temporary-message "Decrypting file " (->namestring pathname) "...")
+    (insert-string (let ((the-encrypted-file
+                         (call-with-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.
+    (define-variable-local-value! (mark-buffer mark)
+       (ref-variable-object auto-save-default)
+      #f)
+    (append-message "done")))
+
+(define (write-encrypted-file region pathname)
+  (let ((password (prompt-for-confirmed-password)))
+    (temporary-message "Encrypting file " (->namestring pathname) "...")
+    (let ((the-encrypted-file
+          (encrypt (extract-string (region-start region) (region-end region))
+                   password)))
+      (call-with-output-file pathname
+       (lambda (port)
+         (write-string the-encrypted-file port))))
+    (append-message "done")))
+\f
 ;;;; Mail Customization
 
 (define (os/sendmail-program)