1 ;;; encrypt.el --- file encryption routines
2 ;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
4 ;; Author: Teodor Zlatanov <tzz@lifelogs.com>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 3, or (at your option)
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02110-1301, USA.
27 ;;; This module addresses data encryption. Page breaks are used for
28 ;;; grouping declarations and documentation relating to each
29 ;;; particular aspect.
31 ;;; Use in Gnus like this:
33 ;;; nnimap-authinfo-file "~/.authinfo.enc"
34 ;;; nntp-authinfo-file "~/.authinfo.enc"
35 ;;; smtpmail-auth-credentials "~/.authinfo.enc"
36 ;;; ;; using the AES256 cipher, feel free to use your own favorite
37 ;;; encrypt-file-alist (quote (("~/.authinfo.enc" (gpg "AES256"))))
38 ;;; password-cache-expiry 600)
40 ;;; Then write ~/.authinfo.enc:
42 ;;; 1) open the old authinfo
43 ;;; C-x C-f ~/.authinfo
45 ;;; 2) write the new authinfo.enc
46 ;;; M-x encrypt-file-contents ~/.authinfo.enc
48 ;;; 3) verify the new authinfo is correct (this will show the contents in the minibuffer)
49 ;;; M-: (encrypt-get-file-contents "~/.authinfo.enc")
56 (autoload 'password-read "password"))
58 (defgroup encrypt '((password-cache custom-variable)
59 (password-cache-expiry custom-variable))
60 "File encryption configuration."
63 (defcustom encrypt-file-alist nil
64 "List of file names or regexes matched with encryptions.
69 (encrypt-xor \"Semi-Secret\")))"
72 (list :tag "Encryption entry"
73 (radio :tag "What to encrypt"
74 (file :tag "Filename")
75 (regexp :tag "Regular expression match"))
76 (radio :tag "How to encrypt it"
79 (const :tag "GPG Program" gpg)
80 (radio :tag "Choose a cipher"
81 (const :tag "3DES Encryption" "3DES")
82 (const :tag "CAST5 Encryption" "CAST5")
83 (const :tag "Blowfish Encryption" "BLOWFISH")
84 (const :tag "AES Encryption" "AES")
85 (const :tag "AES192 Encryption" "AES192")
86 (const :tag "AES256 Encryption" "AES256")
87 (const :tag "Twofish Encryption" "TWOFISH")
88 (string :tag "Cipher Name")))
90 :tag "Built-in simple XOR"
91 (const :tag "XOR Encryption" encrypt-xor)
92 (string :tag "XOR Cipher Value (seed value)")))))
95 ;; TODO: now, load gencrypt.el and if successful, modify the
96 ;; custom-type of encrypt-file-alist to add the gencrypt.el options
98 ;; (plist-get (symbol-plist 'encrypt-file-alist) 'custom-type)
101 (defcustom encrypt-gpg-path (executable-find "gpg")
102 "Path to the GPG program."
104 (file :tag "Location of the GPG executable")
105 (const :tag "GPG is not installed" nil))
108 (defvar encrypt-temp-prefix "encrypt"
109 "Prefix for temporary filenames")
112 (defun encrypt-find-model (filename)
113 "Given a filename, find a encrypt-file-alist entry"
114 (dolist (entry encrypt-file-alist)
115 (let ((match (nth 0 entry))
116 (model (nth 1 entry)))
117 (when (or (eq match filename)
118 (string-match match filename))
122 (defun encrypt-insert-file-contents (file &optional model)
123 "Decrypt FILE into the current buffer."
124 (interactive "fFile to insert: ")
125 (let* ((model (or model (encrypt-find-model file)))
126 (method (nth 0 model))
127 (cipher (nth 1 model))
128 (password-key (format "encrypt-password-%s-%s %s"
129 (symbol-name method) cipher file))
131 (password-read-and-add
132 (format "%s password for cipher %s (file %s)? "
133 file (symbol-name method) cipher)
135 (buffer-file-coding-system 'binary)
136 (coding-system-for-read 'binary)
139 ;; note we only insert-file-contents if the method is known to be valid
142 (insert-file-contents file)
143 (setq outdata (encrypt-gpg-decode-buffer passphrase cipher)))
144 ((eq method 'encrypt-xor)
145 (insert-file-contents file)
146 (setq outdata (encrypt-xor-decode-buffer passphrase cipher))))
150 (message "%s was decrypted with %s (cipher %s)"
151 file (symbol-name method) cipher)
152 (delete-region (point-min) (point-max))
153 (goto-char (point-min))
155 ;; the decryption failed, alas
156 (password-cache-remove password-key)
157 (gnus-error 5 "%s was NOT decrypted with %s (cipher %s)"
158 file (symbol-name method) cipher))))
160 (defun encrypt-get-file-contents (file &optional model)
161 "Decrypt FILE and return the contents."
162 (interactive "fFile to decrypt: ")
164 (encrypt-insert-file-contents file model)
167 (defun encrypt-put-file-contents (file data &optional model)
168 "Encrypt the DATA to FILE, then continue normally."
171 (encrypt-write-file-contents file model)))
173 (defun encrypt-write-file-contents (file &optional model)
174 "Encrypt the current buffer to FILE, then continue normally."
175 (interactive "sFile to write: ")
176 (setq model (or model (encrypt-find-model file)))
178 (let* ((method (nth 0 model))
179 (cipher (nth 1 model))
180 (password-key (format "encrypt-password-%s-%s %s"
181 (symbol-name method) cipher file))
184 (format "%s password for cipher %s? "
185 (symbol-name method) cipher)
191 (setq outdata (encrypt-gpg-encode-buffer passphrase cipher)))
192 ((eq method 'encrypt-xor)
193 (setq outdata (encrypt-xor-encode-buffer passphrase cipher))))
197 (message "%s was encrypted with %s (cipher %s)"
198 file (symbol-name method) cipher)
199 (delete-region (point-min) (point-max))
200 (goto-char (point-min))
202 ;; do not confirm overwrites
203 (write-file file nil))
204 ;; the decryption failed, alas
205 (password-cache-remove password-key)
206 (gnus-error 5 "%s was NOT encrypted with %s (cipher %s)"
207 file (symbol-name method) cipher)))
208 (gnus-error 1 "%s has no associated encryption model! See encrypt-file-alist." file)))
210 (defun encrypt-xor-encode-buffer (passphrase cipher)
211 (encrypt-xor-process-buffer passphrase cipher t))
213 (defun encrypt-xor-decode-buffer (passphrase cipher)
214 (encrypt-xor-process-buffer passphrase cipher nil))
216 (defun encrypt-xor-process-buffer (passphrase
219 "Given PASSPHRASE, xor-encode or decode the contents of the current buffer."
220 (let* ((bs (buffer-substring-no-properties (point-min) (point-max)))
221 ;; passphrase-sum is a simple additive checksum of the
222 ;; passphrase and the cipher
224 (when (stringp passphrase)
225 (apply '+ (append cipher passphrase nil))))
231 (dolist (x (append bs nil))
232 (setq new-list (cons (logxor x passphrase-sum) new-list)))
235 (insert (format "%d " x))))
237 (setq new-list (reverse (split-string bs)))
239 (setq x (string-to-number x))
240 (insert (format "%c" (logxor x passphrase-sum))))))
241 (buffer-substring-no-properties (point-min) (point-max)))))
243 (defun encrypt-gpg-encode-buffer (passphrase cipher)
244 (encrypt-gpg-process-buffer passphrase cipher t))
246 (defun encrypt-gpg-decode-buffer (passphrase cipher)
247 (encrypt-gpg-process-buffer passphrase cipher nil))
249 (defun encrypt-gpg-process-buffer (passphrase
252 "With PASSPHRASE, use GPG to encode or decode the current buffer."
253 (let* ((program encrypt-gpg-path)
254 (input (buffer-substring-no-properties (point-min) (point-max)))
255 (temp-maker (if (fboundp 'make-temp-file)
258 (temp-file (funcall temp-maker encrypt-temp-prefix))
259 (default-enable-multibyte-characters nil)
260 (args `("--cipher-algo" ,cipher
263 "--passphrase-fd" "0"
265 exit-status exit-data)
276 (insert passphrase "\n"))
279 (apply #'call-process-region (point-min) (point-max) program
280 t `(t ,temp-file) nil args))
281 (if (equal exit-status 0)
283 (buffer-substring-no-properties (point-min) (point-max)))
285 (when (file-exists-p temp-file)
286 (insert-file-contents temp-file))
287 (gnus-error 5 (format "%s exited abnormally: '%s' [%s]"
288 program exit-status (buffer-string)))))
289 (delete-file temp-file))
290 (gnus-error 5 "GPG is not installed."))
294 ;;; encrypt.el ends here
296 ;; arch-tag: d907e4f1-71b5-42b1-a180-fc7b84ff0648