view lisp/gnus/encrypt.el @ 86733:78712c70c05b

Move to etc/nxml

;;; encrypt.el --- file encryption routines
;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.

;; Author: Teodor Zlatanov <[e-mail]>
;; Created: 2003/01/24
;; Keywords: files

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;;; This module addresses data encryption.  Page breaks are used for
;;; grouping declarations and documentation relating to each
;;; particular aspect.

;;; Use in Gnus like this:
;;; (setq
;;;   nnimap-authinfo-file "~/.authinfo.enc"
;;;   nntp-authinfo-file "~/.authinfo.enc"
;;;   smtpmail-auth-credentials "~/.authinfo.enc"
;;;   ;; using the AES256 cipher, feel free to use your own favorite
;;;   encrypt-file-alist (quote (("~/.authinfo.enc" (gpg "AES256"))))
;;;   password-cache-expiry 600)

;;; Then write ~/.authinfo.enc:

;;; 1) open the old authinfo
;;; C-x C-f ~/.authinfo

;;; 2) write the new authinfo.enc
;;; M-x encrypt-write-file-contents RET ~/.authinfo.enc

;;; 3) verify the new authinfo is correct (this will show the contents in the minibuffer)
;;; M-: (encrypt-get-file-contents "~/.authinfo.enc")


;;; Code:

;; autoload password
(eval-and-compile
  (autoload 'password-read "password"))

(defgroup encrypt '((password-cache custom-variable)
		    (password-cache-expiry custom-variable))
  "File encryption configuration."
  :group 'applications)

(defcustom encrypt-file-alist nil
  "List of file names or regexes matched with encryptions.
Format example:
 '((\"beta\"
    (gpg \"AES\"))
   (\"/home/tzz/alpha\"
    (encrypt-xor \"Semi-Secret\")))"

  :type '(repeat
	  (list :tag "Encryption entry"
	   (radio :tag "What to encrypt"
		  (file :tag "Filename")
		  (regexp :tag "Regular expression match"))
	   (radio :tag "How to encrypt it"
		  (list
		   :tag "GPG Encryption"
		   (const :tag "GPG Program" gpg)
		   (radio :tag "Choose a cipher"
			  (const :tag "3DES Encryption" "3DES")
			  (const :tag "CAST5 Encryption" "CAST5")
			  (const :tag "Blowfish Encryption" "BLOWFISH")
			  (const :tag "AES Encryption" "AES")
			  (const :tag "AES192 Encryption" "AES192")
			  (const :tag "AES256 Encryption" "AES256")
			  (const :tag "Twofish Encryption" "TWOFISH")
			  (string :tag "Cipher Name")))
		  (list
		   :tag "Built-in simple XOR"
		   (const :tag "XOR Encryption" encrypt-xor)
		   (string :tag "XOR Cipher Value (seed value)")))))
  :group 'encrypt)

;; TODO: now, load gencrypt.el and if successful, modify the
;; custom-type of encrypt-file-alist to add the gencrypt.el options

;; (plist-get (symbol-plist 'encrypt-file-alist) 'custom-type)
;; then use plist-put

(defcustom encrypt-gpg-path (executable-find "gpg")
  "Path to the GPG program."
  :type '(radio
	  (file :tag "Location of the GPG executable")
	  (const :tag "GPG is not installed" nil))
  :group 'encrypt)

(defvar encrypt-temp-prefix "encrypt"
  "Prefix for temporary filenames")

;;;###autoload
(defun encrypt-find-model (filename)
  "Given a filename, find a encrypt-file-alist entry"
  (dolist (entry encrypt-file-alist)
    (let ((match (nth 0 entry))
	  (model (nth 1 entry)))
      (when (or (eq match filename)
		(string-match match filename))
	(return model)))))

;;;###autoload
(defun encrypt-insert-file-contents (file &optional model)
  "Decrypt FILE into the current buffer."
  (interactive "fFile to insert: ")
  (let* ((model (or model (encrypt-find-model file)))
	 (method (nth 0 model))
	 (cipher (nth 1 model))
	 (password-key (format "encrypt-password-%s-%s %s"
			       (symbol-name method) cipher file))
	 (passphrase
	  (password-read-and-add
	   (format "%s password for cipher %s (file %s)? "
		   file (symbol-name method) cipher)
	   password-key))
	  (buffer-file-coding-system 'binary)
	 (coding-system-for-read 'binary)
	 outdata)

    ;; note we only insert-file-contents if the method is known to be valid
    (cond
     ((eq method 'gpg)
      (insert-file-contents file)
      (setq outdata (encrypt-gpg-decode-buffer passphrase cipher)))
     ((eq method 'encrypt-xor)
      (insert-file-contents file)
      (setq outdata (encrypt-xor-decode-buffer passphrase cipher))))

    (if outdata
	(progn
	  (message "%s was decrypted with %s (cipher %s)"
		   file (symbol-name method) cipher)
	  (delete-region (point-min) (point-max))
	  (goto-char (point-min))
	  (insert outdata))
      ;; the decryption failed, alas
      (password-cache-remove password-key)
      (gnus-error 5 "%s was NOT decrypted with %s (cipher %s)"
		  file (symbol-name method) cipher))))

(defun encrypt-get-file-contents (file &optional model)
  "Decrypt FILE and return the contents."
  (interactive "fFile to decrypt: ")
  (with-temp-buffer
    (encrypt-insert-file-contents file model)
    (buffer-string)))

(defun encrypt-put-file-contents (file data &optional model)
  "Encrypt the DATA to FILE, then continue normally."
  (with-temp-buffer
    (insert data)
    (encrypt-write-file-contents file model)))

(defun encrypt-write-file-contents (file &optional model)
  "Encrypt the current buffer to FILE, then continue normally."
  (interactive "sFile to write: ")
  (setq model (or model (encrypt-find-model file)))
  (if model
      (let* ((method (nth 0 model))
	     (cipher (nth 1 model))
	     (password-key (format "encrypt-password-%s-%s %s"
				   (symbol-name method) cipher file))
	     (passphrase
	      (password-read
	       (format "%s password for cipher %s? "
		       (symbol-name method) cipher)
	       password-key))
	     outdata)

	(cond
	 ((eq method 'gpg)
	  (setq outdata (encrypt-gpg-encode-buffer passphrase cipher)))
	 ((eq method 'encrypt-xor)
	  (setq outdata (encrypt-xor-encode-buffer passphrase cipher))))

	(if outdata
	    (progn
	      (message "%s was encrypted with %s (cipher %s)"
		       file (symbol-name method) cipher)
	      (delete-region (point-min) (point-max))
	      (goto-char (point-min))
	      (insert outdata)
	      ;; do not confirm overwrites
	      (write-file file nil))
	  ;; the decryption failed, alas
	  (password-cache-remove password-key)
	  (gnus-error 5 "%s was NOT encrypted with %s (cipher %s)"
		      file (symbol-name method) cipher)))
    (gnus-error 1 "%s has no associated encryption model!  See encrypt-file-alist." file)))

(defun encrypt-xor-encode-buffer (passphrase cipher)
  (encrypt-xor-process-buffer passphrase cipher t))

(defun encrypt-xor-decode-buffer (passphrase cipher)
  (encrypt-xor-process-buffer passphrase cipher nil))

(defun encrypt-xor-process-buffer (passphrase
					cipher
					&optional encode)
  "Given PASSPHRASE, xor-encode or decode the contents of the current buffer."
  (let* ((bs (buffer-substring-no-properties (point-min) (point-max)))
	 ;; passphrase-sum is a simple additive checksum of the
	 ;; passphrase and the cipher
	(passphrase-sum
	 (when (stringp passphrase)
	   (apply '+ (append cipher passphrase nil))))
	new-list)

    (with-temp-buffer
      (if encode
	  (progn
	    (dolist (x (append bs nil))
	      (setq new-list (cons (logxor x passphrase-sum) new-list)))

	    (dolist (x new-list)
	      (insert (format "%d " x))))
	(progn
	  (setq new-list (reverse (split-string bs)))
	  (dolist (x new-list)
	    (setq x (string-to-number x))
	    (insert (format "%c" (logxor x passphrase-sum))))))
      (buffer-substring-no-properties (point-min) (point-max)))))

(defun encrypt-gpg-encode-buffer (passphrase cipher)
  (encrypt-gpg-process-buffer passphrase cipher t))

(defun encrypt-gpg-decode-buffer (passphrase cipher)
  (encrypt-gpg-process-buffer passphrase cipher nil))

(defun encrypt-gpg-process-buffer (passphrase 
					cipher 
					&optional encode)
  "With PASSPHRASE, use GPG to encode or decode the current buffer."
  (let* ((program encrypt-gpg-path)
	 (input (buffer-substring-no-properties (point-min) (point-max)))
	 (temp-maker (if (fboundp 'make-temp-file) 
			 'make-temp-file 
		       'make-temp-name))
	 (temp-file (funcall temp-maker encrypt-temp-prefix))
	 (default-enable-multibyte-characters nil)
	 (args `("--cipher-algo" ,cipher
		 "--status-fd" "2"
		 "--logger-fd" "2"
		 "--passphrase-fd" "0"
		 "--no-tty"))
	 exit-status exit-data)
    
    (when encode
      (setq args
	    (append args
		    '("--symmetric"
		      "--armor"))))

    (if program
	(with-temp-buffer
	  (when passphrase
	    (insert passphrase "\n"))
	  (insert input)
	  (setq exit-status
		(apply #'call-process-region (point-min) (point-max) program
		       t `(t ,temp-file) nil args))
	  (if (equal exit-status 0)
	      (setq exit-data
		    (buffer-substring-no-properties (point-min) (point-max)))
	    (with-temp-buffer
	      (when (file-exists-p temp-file)
		(insert-file-contents temp-file))
	      (gnus-error 5 (format "%s exited abnormally: '%s' [%s]"
				    program exit-status (buffer-string)))))
	  (delete-file temp-file))
      (gnus-error 5 "GPG is not installed."))
    exit-data))

(provide 'encrypt)
;;; encrypt.el ends here

;; arch-tag: d907e4f1-71b5-42b1-a180-fc7b84ff0648