home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / modes / ange-crypt.el < prev    next >
Encoding:
Text File  |  1990-03-21  |  7.3 KB  |  207 lines
  1. ;From: ange@hplb.hpl.hp.com (Andy Norman)
  2. ;Newsgroups: comp.emacs,gnu.emacs
  3. ;Subject: ange-crypt: simple encrypt / decrypt support for GNU Emacs
  4. ;Message-ID: <ANGE.89Aug14184858@anorman.hpl.hp.com>
  5. ;Date: 14 Aug 89 22:48:58 GMT
  6. ;Organization: Hewlett-Packard Laboratories, Bristol, UK.
  7. ;Lines: 196
  8. ;Keywords: encrypt,decrypt,GNU Emacs,ange-crypt,minor mode
  9. ;Summary: Simple encrypt / decrypt support for GNU Emacs
  10. ;
  11. ;I enclose 'ange-crypt.el' which enables GNU Emacs to encrypt and decrypt files
  12. ;upon reading and writing.
  13. ;
  14. ;Enjoy...
  15. ;
  16. ;P.S. I don't wish to open the worm-can surrounding exportation of crypt from
  17. ;the USA. If you haven't got crypt, use something different.
  18. ;
  19. ;--------------------------------------------------------------------------------
  20. ; -*-Emacs-Lisp-*-
  21. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  22. ;
  23. ; File:         ange-crypt.el
  24. ; RCS:          $Header: ange-crypt.el,v 1.6 89/08/14 18:35:50 ange Exp $
  25. ; Description:  semi-transparent encrypt / decrypt for files
  26. ; Author:       Andy Norman, Kraken
  27. ; Created:      Fri Aug 11 16:59:26 1989
  28. ; Modified:     Mon Aug 14 18:35:05 1989 (Ange) ange@hplb.hpl.hp.com
  29. ;
  30. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  31.  
  32. ;; ange-crypt-mode is a minor mode that can be used with most buffers, and when
  33. ;; switched on makes sure that all future writes of the buffer are piped through
  34. ;; your favorite encryption command. Visiting a file created by saving a buffer
  35. ;; with this mode on will cause the buffer to be initially piped through your
  36. ;; favorite decryption command.
  37. ;; 
  38. ;; Note that by default auto-saving is disabled upon entering ange-crypt-mode so
  39. ;; that the plain-text version of the buffer never gets written to file. This
  40. ;; action can be disabled by setting the variable ange-crypt-disable-auto-saving
  41. ;; to nil.
  42. ;;
  43. ;; This file is not part of GNU Emacs, but FSF are welcome to it if they want it.
  44. ;;
  45. ;; Copying is permitted under those conditions described by the GNU General
  46. ;; Public License.
  47. ;;
  48. ;; Copyright (C) 1989 Andy Norman.
  49. ;;
  50. ;; Author: Andy Norman (ange@hplb.hpl.hp.com)
  51. ;;
  52. ;; Please mail bugs and suggestions to the author at the above address.
  53.  
  54. (defvar ange-crypt-encryption-cmd "crypt %s"
  55.   "*The command (with key) to pipe the buffer through to get encryption")
  56.  
  57. (defvar ange-crypt-decryption-cmd "crypt %s"
  58.   "*The command (with key) to pipe the buffer through to get decryption")
  59.  
  60. (defvar ange-crypt-disable-auto-saving t
  61.   "*Disable auto-saving when in ange-crypt mode.")
  62.  
  63. (defvar ange-crypt-key nil
  64.   "The key to encrypt / decrypt a buffer.")
  65.  
  66. ;; Put the next three lines in your .emacs if you wish to have different keys
  67. ;; for different buffers.
  68. ;;
  69. ;; (make-variable-buffer-local 'ange-crypt-key)
  70. ;; (setq-default ange-crypt-mode nil)
  71.  
  72. (defvar ange-crypt-mode nil
  73.   "This buffer is to be read/written encrypted.")
  74.  
  75. (make-variable-buffer-local 'ange-crypt-mode)
  76. (setq-default ange-crypt-mode nil)
  77.  
  78. (or (assq 'ange-crypt-mode minor-mode-alist)
  79.     (setq minor-mode-alist (cons '(ange-crypt-mode " Crypt") minor-mode-alist)))
  80.  
  81. (defun ange-crypt-mode (arg)
  82.   "Toggle ange-crypt mode.
  83. With arg, turn ange-crypt mode on iff arg is positive.
  84. In ange-crypt mode, when the buffer is saved, it is encrypted first,
  85. and when restored, it is decrypted first."
  86.   (interactive "P")
  87.   (setq ange-crypt-mode
  88.     (if (null arg) (not ange-crypt-mode)
  89.       (> (prefix-numeric-value arg) 0)))
  90.   (if ange-crypt-disable-auto-saving
  91.       (progn
  92.     (delete-auto-save-file-if-necessary)
  93.     (auto-save-mode (not ange-crypt-mode)))) ;enable/disable auto-saves
  94.   (set-buffer-modified-p t))
  95.  
  96. (defun ange-crypt-get-key ()
  97.   "Prompt the user for the key to encrypt / decrypt the current buffer.
  98. Echos a . for each character typed.
  99. End with <cr>, <lf>, or <esc>.  DEL or backspace rubs out."
  100.   (let ((pass "")
  101.     (c 0)
  102.     (echo-keystrokes 0))
  103.     (while (and (/= c ?\r) (/= c ?\n) (/= c ?\e))
  104.       (message "Enter key to encrypt/decrypt %s: %s"
  105.            (buffer-name)
  106.            (make-string (length pass) ?.))
  107.       (setq c (read-char))
  108.       (if (and (/= c ?\b) (/= c ?\177))
  109.       (setq pass (concat pass (char-to-string c)))
  110.     (if (> (length pass) 0)
  111.         (setq pass (substring pass 0 -1)))))
  112.     (setq pass (substring pass 0 -1))))
  113.  
  114. (defun ange-decrypt-buffer ()
  115.   "Decrypts the current buffer if in ange-crypt-mode."
  116.   (if ange-crypt-mode
  117.       (progn
  118.     (let ((mod-p (buffer-modified-p)))
  119.       (or ange-crypt-key (setq ange-crypt-key (ange-crypt-get-key)))
  120.       (save-excursion
  121.         (goto-char (point-max))
  122.         (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move)
  123.         (delete-region (point) (point-max))
  124.         (message "decrypting...")
  125.         (shell-command-on-region (point-min)
  126.                      (point-max)
  127.                      (format ange-crypt-decryption-cmd ange-crypt-key)
  128.                      t)
  129.         (message "decrypting... done"))
  130.       (if ange-crypt-disable-auto-saving
  131.           (progn
  132.         (delete-auto-save-file-if-necessary)
  133.         (auto-save-mode 0)))        ;disable auto-saving
  134.       (set-buffer-modified-p mod-p)))))
  135.  
  136. (defun ange-encrypt-and-write-buffer ()
  137.   "If the buffer is in ange-crypt-mode then encrypt and write to file, otherwise
  138. return nil. This function is mean to be used as a write-file-hook entry."
  139.   (if (not ange-crypt-mode)
  140.       nil                ;let basic-save-buffer do the write
  141.     (let ((contents (buffer-substring (point-min) (point-max))))
  142.       (or ange-crypt-key (setq ange-crypt-key (ange-crypt-get-key)))
  143.       (save-excursion
  144.     (message "encrypting...")
  145.     (shell-command-on-region (point-min)
  146.                  (point-max)
  147.                  (format ange-crypt-encryption-cmd ange-crypt-key)
  148.                  t)
  149.     (message "encrypting... done")
  150.     (goto-char (point-max))
  151.     (insert "\n\f\nLocal variables:\nange-crypt-mode:1\nend:\n")
  152.     (if file-precious-flag
  153.         ;; If file is precious, rename it away before
  154.         ;; overwriting it.
  155.         (let ((rename t)
  156.           (file (concat buffer-file-name "#")))
  157.           (condition-case ()
  158.           (progn (rename-file buffer-file-name file t)
  159.              (setq setmodes (file-modes file)))
  160.         (file-error (setq rename nil)))
  161.           (unwind-protect
  162.           (progn (clear-visited-file-modtime)
  163.              (write-region (point-min) (point-max)
  164.                        buffer-file-name nil t)
  165.              (setq rename nil))
  166.         ;; If rename is still t, writing failed.
  167.         ;; So rename the old file back to original name,
  168.         (if rename
  169.             (progn
  170.               (rename-file file buffer-file-name t)
  171.               (clear-visited-file-modtime))
  172.           ;; Otherwise we don't need the original file,
  173.           ;; so flush it.
  174.           (condition-case ()
  175.               (delete-file file)
  176.             (error nil)))))
  177.       ;; If file not writable, see if we can make it writable
  178.       ;; temporarily while we write it.
  179.       ;; But no need to do so if we have just backed it up
  180.       ;; (setmodes is set) because that says we're superseding.
  181.       (cond ((and tempsetmodes (not setmodes))
  182.          ;; Change the mode back, after writing.
  183.          (setq setmodes (file-modes buffer-file-name))
  184.          (set-file-modes buffer-file-name 511)))
  185.       (write-region (point-min) (point-max) 
  186.             buffer-file-name nil t)
  187.       (erase-buffer)
  188.       (insert contents)
  189.       (set-buffer-modified-p nil))
  190.     t                    ;have done the write already
  191.       ))))
  192.  
  193. (or (memq 'ange-encrypt-and-write-buffer  write-file-hooks)
  194.     (setq write-file-hooks
  195.       (append write-file-hooks
  196.           (list 'ange-encrypt-and-write-buffer)))) ;stick it on the end
  197.  
  198. (or (memq 'ange-decrypt-buffer find-file-hooks)
  199.     (setq find-file-hooks
  200.       (append find-file-hooks
  201.           (list 'ange-decrypt-buffer))))
  202.  
  203. --
  204.                     -- ange --
  205.  
  206.                     ange@hplb.hpl.hp.com
  207.