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 (this will show the contents in the minibuffer)
50 ;;; M-: (encrypt-get-file-contents "~/.authinfo.enc")
57 (if (locate-library "password-cache")
58 (require 'password-cache)
61 (defgroup encrypt '((password-cache custom-variable)
62 (password-cache-expiry custom-variable))
63 "File encryption configuration."
66 (defcustom encrypt-file-alist nil
67 "List of file names or regexes matched with encryptions.
72 (encrypt-xor \"Semi-Secret\")))"
75 (list :tag "Encryption entry"
76 (radio :tag "What to encrypt"
77 (file :tag "Filename")
78 (regexp :tag "Regular expression match"))
79 (radio :tag "How to encrypt it"
82 (const :tag "GPG Program" gpg)
83 (radio :tag "Choose a cipher"
84 (const :tag "3DES Encryption" "3DES")
85 (const :tag "CAST5 Encryption" "CAST5")
86 (const :tag "Blowfish Encryption" "BLOWFISH")
87 (const :tag "AES Encryption" "AES")
88 (const :tag "AES192 Encryption" "AES192")
89 (const :tag "AES256 Encryption" "AES256")
90 (const :tag "Twofish Encryption" "TWOFISH")
91 (string :tag "Cipher Name")))
93 :tag "Built-in simple XOR"
94 (const :tag "XOR Encryption" encrypt-xor)
95 (string :tag "XOR Cipher Value (seed value)")))))
98 ;; TODO: now, load gencrypt.el and if successful, modify the
99 ;; custom-type of encrypt-file-alist to add the gencrypt.el options
101 ;; (plist-get (symbol-plist 'encrypt-file-alist) 'custom-type)
102 ;; then use plist-put
104 (defcustom encrypt-gpg-path (executable-find "gpg")
105 "Path to the GPG program."
107 (file :tag "Location of the GPG executable")
108 (const :tag "GPG is not installed" nil))
111 (defvar encrypt-temp-prefix "encrypt"
112 "Prefix for temporary filenames")
115 (defun encrypt-find-model (filename)
116 "Given a filename, find a encrypt-file-alist entry"
117 (dolist (entry encrypt-file-alist)
118 (let ((match (nth 0 entry))
119 (model (nth 1 entry)))
120 (when (or (eq match filename)
121 (string-match match filename))
125 (defun encrypt-insert-file-contents (file &optional model)
126 "Decrypt FILE into the current buffer."
127 (interactive "fFile to insert: ")
128 (let* ((model (or model (encrypt-find-model file)))
129 (method (nth 0 model))
130 (cipher (nth 1 model))
131 (password-key (format "encrypt-password-%s-%s %s"
132 (symbol-name method) cipher file))
134 (password-read-and-add
135 (format "%s password for cipher %s (file %s)? "
136 file (symbol-name method) cipher)
138 (buffer-file-coding-system 'binary)
139 (coding-system-for-read 'binary)
142 ;; note we only insert-file-contents if the method is known to be valid
145 (insert-file-contents file)
146 (setq outdata (encrypt-gpg-decode-buffer passphrase cipher)))
147 ((eq method 'encrypt-xor)
148 (insert-file-contents file)
149 (setq outdata (encrypt-xor-decode-buffer passphrase cipher))))
153 (message "%s was decrypted with %s (cipher %s)"
154 file (symbol-name method) cipher)
155 (delete-region (point-min) (point-max))
156 (goto-char (point-min))
158 ;; the decryption failed, alas
159 (password-cache-remove password-key)
160 (gnus-error 5 "%s was NOT decrypted with %s (cipher %s)"
161 file (symbol-name method) cipher))))
163 (defun encrypt-get-file-contents (file &optional model)
164 "Decrypt FILE and return the contents."
165 (interactive "fFile to decrypt: ")
167 (encrypt-insert-file-contents file model)
170 (defun encrypt-put-file-contents (file data &optional model)
171 "Encrypt the DATA to FILE, then continue normally."
174 (encrypt-write-file-contents file model)))
176 (defun encrypt-write-file-contents (file &optional model)
177 "Encrypt the current buffer to FILE, then continue normally."
178 (interactive "sFile to write: ")
179 (setq model (or model (encrypt-find-model file)))
181 (let* ((method (nth 0 model))
182 (cipher (nth 1 model))
183 (password-key (format "encrypt-password-%s-%s %s"
184 (symbol-name method) cipher file))
187 (format "%s password for cipher %s? "
188 (symbol-name method) cipher)
194 (setq outdata (encrypt-gpg-encode-buffer passphrase cipher)))
195 ((eq method 'encrypt-xor)
196 (setq outdata (encrypt-xor-encode-buffer passphrase cipher))))
200 (message "%s was encrypted with %s (cipher %s)"
201 file (symbol-name method) cipher)
202 (delete-region (point-min) (point-max))
203 (goto-char (point-min))
205 ;; do not confirm overwrites
206 (write-file file nil))
207 ;; the decryption failed, alas
208 (password-cache-remove password-key)
209 (gnus-error 5 "%s was NOT encrypted with %s (cipher %s)"
210 file (symbol-name method) cipher)))
211 (gnus-error 1 "%s has no associated encryption model! See encrypt-file-alist." file)))
213 (defun encrypt-xor-encode-buffer (passphrase cipher)
214 (encrypt-xor-process-buffer passphrase cipher t))
216 (defun encrypt-xor-decode-buffer (passphrase cipher)
217 (encrypt-xor-process-buffer passphrase cipher nil))
219 (defun encrypt-xor-process-buffer (passphrase
222 "Given PASSPHRASE, xor-encode or decode the contents of the current buffer."
223 (let* ((bs (buffer-substring-no-properties (point-min) (point-max)))
224 ;; passphrase-sum is a simple additive checksum of the
225 ;; passphrase and the cipher
227 (when (stringp passphrase)
228 (apply '+ (append cipher passphrase nil))))
234 (dolist (x (append bs nil))
235 (setq new-list (cons (logxor x passphrase-sum) new-list)))
238 (insert (format "%d " x))))
240 (setq new-list (reverse (split-string bs)))
242 (setq x (string-to-number x))
243 (insert (format "%c" (logxor x passphrase-sum))))))
244 (buffer-substring-no-properties (point-min) (point-max)))))
246 (defun encrypt-gpg-encode-buffer (passphrase cipher)
247 (encrypt-gpg-process-buffer passphrase cipher t))
249 (defun encrypt-gpg-decode-buffer (passphrase cipher)
250 (encrypt-gpg-process-buffer passphrase cipher nil))
252 (defun encrypt-gpg-process-buffer (passphrase
255 "With PASSPHRASE, use GPG to encode or decode the current buffer."
256 (let* ((program encrypt-gpg-path)
257 (input (buffer-substring-no-properties (point-min) (point-max)))
258 (temp-maker (if (fboundp 'make-temp-file)
261 (temp-file (funcall temp-maker encrypt-temp-prefix))
262 (default-enable-multibyte-characters nil)
263 (args `("--cipher-algo" ,cipher
266 "--passphrase-fd" "0"
268 exit-status exit-data)
279 (insert passphrase "\n"))
282 (apply #'call-process-region (point-min) (point-max) program
283 t `(t ,temp-file) nil args))
284 (if (equal exit-status 0)
286 (buffer-substring-no-properties (point-min) (point-max)))
288 (when (file-exists-p temp-file)
289 (insert-file-contents temp-file))
290 (gnus-error 5 (format "%s exited abnormally: '%s' [%s]"
291 program exit-status (buffer-string)))))
292 (delete-file temp-file))
293 (gnus-error 5 "GPG is not installed."))
297 ;;; encrypt.el ends here
299 ;; arch-tag: d907e4f1-71b5-42b1-a180-fc7b84ff0648