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:
32 ;;; (require 'encrypt)
34 ;;; nnimap-authinfo-file "~/.authinfo.enc"
35 ;;; nntp-authinfo-file "~/.authinfo.enc"
36 ;;; smtpmail-auth-credentials "~/.authinfo.enc"
37 ;;; ;; GnuPG using the AES256 cipher, feel free to use your own favorite
38 ;;; encrypt-file-alist (quote (("~/.authinfo.enc" (gpg "AES256"))))
39 ;;; password-cache-expiry 600)
41 ;;; Then write ~/.authinfo.enc:
43 ;;; 1) open the old authinfo
44 ;;; C-x C-f ~/.authinfo
46 ;;; 2) write the new authinfo.enc
47 ;;; M-x encrypt-write-file-contents RET ~/.authinfo.enc
49 ;;; 3) verify the new authinfo is correct
50 ;;; (this will insert the contents in the current buffer)
52 ;;; M-: (encrypt-insert-file-contents "~/.authinfo.enc")
59 (if (locate-library "password-cache")
60 (require 'password-cache)
63 (defgroup encrypt '((password-cache custom-variable)
64 (password-cache-expiry custom-variable))
65 "File encryption configuration."
68 (defcustom encrypt-file-alist nil
69 "List of file names or regexes matched with encryptions.
76 (encrypt-xor \"Semi-Secret\")))"
79 (list :tag "Encryption entry"
80 (radio :tag "What to encrypt"
81 (file :tag "Filename")
82 (regexp :tag "Regular expression match"))
83 (radio :tag "How to encrypt it"
85 :tag "GPG Encryption via PGG (including passphrases)"
86 (const :tag "GPG via PGG" pgg))
89 (const :tag "GPG Program" gpg)
90 (radio :tag "Choose a cipher"
91 (const :tag "3DES Encryption" "3DES")
92 (const :tag "CAST5 Encryption" "CAST5")
93 (const :tag "Blowfish Encryption" "BLOWFISH")
94 (const :tag "AES Encryption" "AES")
95 (const :tag "AES192 Encryption" "AES192")
96 (const :tag "AES256 Encryption" "AES256")
97 (const :tag "Twofish Encryption" "TWOFISH")
98 (string :tag "Cipher Name")))
100 :tag "Built-in simple XOR"
101 (const :tag "XOR Encryption" encrypt-xor)
102 (string :tag "XOR Cipher Value (seed value)")))))
105 ;; TODO: now, load gencrypt.el and if successful, modify the
106 ;; custom-type of encrypt-file-alist to add the gencrypt.el options
108 ;; (plist-get (symbol-plist 'encrypt-file-alist) 'custom-type)
109 ;; then use plist-put
111 (defcustom encrypt-gpg-path (executable-find "gpg")
112 "Path to the GPG program."
114 (file :tag "Location of the GPG executable")
115 (const :tag "GPG is not installed" nil))
118 (defvar encrypt-temp-prefix "encrypt"
119 "Prefix for temporary filenames")
122 (defun encrypt-find-model (filename)
123 "Given a filename, find a encrypt-file-alist entry"
124 (dolist (entry encrypt-file-alist)
125 (let ((match (nth 0 entry))
126 (model (nth 1 entry)))
127 (when (or (eq match filename)
128 (string-match match filename))
132 (defun encrypt-insert-file-contents (file &optional model erase)
133 "Decrypt FILE into the current buffer."
134 (interactive "fFile to insert: ")
135 (let* ((model (or model (encrypt-find-model file)))
136 (method (nth 0 model))
137 (cipher (nth 1 model))
138 (passphrase (encrypt-get-passphrase-if-needed file method cipher t))
139 (buffer-file-coding-system 'binary)
140 (coding-system-for-read 'binary)
143 ;; note we only insert-file-contents if the method is known to be valid
147 (insert-file-contents file)
148 (setq outdata (encrypt-gpg-decode-buffer passphrase cipher)))
150 (insert-file-contents file)
151 (setq outdata (encrypt-pgg-decode-buffer)))
152 ((eq method 'encrypt-xor)
153 (insert-file-contents file)
154 (setq outdata (encrypt-xor-decode-buffer passphrase cipher)))))
158 (message "%s was decrypted with %s"
160 (encrypt-message-method-and-cipher method cipher))
162 (delete-region (point-min) (point-max)))
164 ;; the decryption failed, alas
165 (password-cache-remove (encrypt-password-key file method cipher))
166 (gnus-error 5 "%s was NOT decrypted with %s"
168 (encrypt-message-method-and-cipher method cipher)))))
170 (defun encrypt-get-file-contents (file &optional model)
171 "Decrypt FILE and return the contents."
172 (interactive "fFile to decrypt: ")
174 (encrypt-insert-file-contents file model)
177 (defun encrypt-put-file-contents (file data &optional model)
178 "Encrypt the DATA to FILE, then continue normally."
181 (encrypt-write-file-contents file model)))
183 (defun encrypt-write-file-contents (file &optional model)
184 "Encrypt the current buffer to FILE, then continue normally."
185 (interactive "sFile to write: ")
186 (setq model (or model (encrypt-find-model file)))
188 (let* ((method (nth 0 model))
189 (cipher (nth 1 model))
191 (encrypt-get-passphrase-if-needed file method cipher))
195 (encrypt-gpg-encode-buffer passphrase cipher))
197 (encrypt-pgg-encode-buffer))
198 ((eq method 'encrypt-xor)
199 (encrypt-xor-encode-buffer passphrase cipher)))))
203 (message "%s was encrypted with %s"
205 (encrypt-message-method-and-cipher method cipher))
208 ;; do not confirm overwrites
209 (write-file file nil)))
210 ;; the decryption failed, alas
211 (password-cache-remove (encrypt-password-key file method cipher))
212 (gnus-error 5 "%s was NOT encrypted with %s"
214 (encrypt-message-method-and-cipher method cipher))))
217 "%s has no associated encryption model! See encrypt-file-alist."
220 (defun encrypt-password-key (file method cipher)
221 (format "encrypt-password-%s-%s %s" (symbol-name method) cipher file))
223 (defun encrypt-get-passphrase-if-needed (file method cipher &optional add)
224 "Read the passphrase for FILE, METHOD, CIPHER if necessary."
225 (when (not (eq method 'pgg))
226 (let ((password-key (encrypt-password-key file method cipher))
228 (format "password for %s (file %s)? "
229 (encrypt-message-method-and-cipher method cipher)
232 (password-read-and-add password-question password-key)
233 (password-read password-question password-key)))))
236 (defun encrypt-message-method-and-cipher (method cipher)
237 (format "method %s%s"
239 (if cipher (format " (cipher %s)" cipher) "")))
241 (defun encrypt-xor-encode-buffer (passphrase cipher)
242 (encrypt-xor-process-buffer passphrase cipher t))
244 (defun encrypt-xor-decode-buffer (passphrase cipher)
245 (encrypt-xor-process-buffer passphrase cipher nil))
247 (defun encrypt-xor-process-buffer (passphrase
250 "Given PASSPHRASE, xor-encode or decode the contents of the current buffer."
251 (let* ((bs (buffer-substring-no-properties (point-min) (point-max)))
252 ;; passphrase-sum is a simple additive checksum of the
253 ;; passphrase and the cipher
255 (when (stringp passphrase)
256 (apply '+ (append cipher passphrase nil))))
262 (dolist (x (append bs nil))
263 (setq new-list (cons (logxor x passphrase-sum) new-list)))
266 (insert (format "%d " x))))
268 (setq new-list (reverse (split-string bs)))
270 (setq x (string-to-number x))
271 (insert (format "%c" (logxor x passphrase-sum))))))
272 (buffer-substring-no-properties (point-min) (point-max)))))
274 (defun encrypt-gpg-encode-buffer (passphrase cipher)
275 (encrypt-gpg-process-buffer passphrase cipher t))
277 (defun encrypt-gpg-decode-buffer (passphrase cipher)
278 (encrypt-gpg-process-buffer passphrase cipher nil))
280 (defun encrypt-gpg-process-buffer (passphrase
283 "With PASSPHRASE, use GPG to encode or decode the current buffer."
284 (let* ((program encrypt-gpg-path)
285 (input (buffer-substring-no-properties (point-min) (point-max)))
286 (temp-maker (if (fboundp 'make-temp-file)
289 (temp-file (funcall temp-maker encrypt-temp-prefix))
290 (default-enable-multibyte-characters nil)
291 (args `("--cipher-algo" ,cipher
294 "--passphrase-fd" "0"
296 exit-status exit-data)
307 (insert passphrase "\n"))
310 (apply #'call-process-region (point-min) (point-max) program
311 t `(t ,temp-file) nil args))
312 (if (equal exit-status 0)
314 (buffer-substring-no-properties (point-min) (point-max)))
316 (when (file-exists-p temp-file)
317 (insert-file-contents temp-file))
318 (gnus-error 5 (format "%s exited abnormally: '%s' [%s]"
319 program exit-status (buffer-string)))))
320 (delete-file temp-file))
321 (gnus-error 5 "GPG is not installed."))
324 (defun encrypt-pgg-encode-buffer ()
325 (encrypt-pgg-process-buffer t))
327 (defun encrypt-pgg-decode-buffer ()
328 (encrypt-pgg-process-buffer))
330 (defun encrypt-pgg-process-buffer (&optional encode)
331 "Use PGG to encode or decode the current buffer."
332 (let ((pfft (if encode 'pgg-encrypt-symmetric 'pgg-decrypt))
333 (default-enable-multibyte-characters nil)
334 (input (buffer-substring-no-properties (point-min) (point-max)))
338 ;; note that we call pfft before pgg-display-output-buffer
339 (pgg-display-output-buffer (point-min) (point-max) (funcall pfft))
341 (buffer-substring-no-properties (point-min) (point-max))))
346 ;;; encrypt.el ends here
348 ;; arch-tag: d907e4f1-71b5-42b1-a180-fc7b84ff0648