1 ;;; encrypt.el --- file encryption routines
2 ;; Copyright (C) 2002, 2003, 2004 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 2, 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., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
27 ;;; This module addresses data encryption. Page breaks are used for
28 ;;; grouping declarations and documentation relating to each
29 ;;; particular aspect.
35 (autoload 'password-read "password")
36 ;; Those two autoloads are needed since T-gnus won't load password.el
37 ;; by way of pgg.el at the compile time.
38 (autoload 'password-read-and-add "password")
39 (autoload 'password-cache-remove "password"))
42 "File encryption configuration.")
44 (defcustom encrypt-password-cache-expiry 200
45 "Encryption password timeout.
46 When set, directly sets password-cache-expiry"
49 :set (lambda (symbol value)
51 (setq password-cache-expiry value)))
53 (defcustom encrypt-file-alist nil
54 "List of file names or regexes matched with encryptions.
59 (encrypt-xor \"Semi-Secret\")))"
62 (list :tag "Encryption entry"
63 (radio :tag "What to encrypt"
64 (file :tag "Filename")
65 (regexp :tag "Regular expression match"))
66 (radio :tag "How to encrypt it"
69 (const :tag "GPG Program" gpg)
70 (radio :tag "Choose a cipher"
71 (const :tag "3DES Encryption" "3DES")
72 (const :tag "CAST5 Encryption" "CAST5")
73 (const :tag "Blowfish Encryption" "BLOWFISH")
74 (const :tag "AES Encryption" "AES")
75 (const :tag "AES192 Encryption" "AES192")
76 (const :tag "AES256 Encryption" "AES256")
77 (const :tag "Twofish Encryption" "TWOFISH")
78 (string :tag "Cipher Name")))
80 :tag "Built-in simple XOR"
81 (const :tag "XOR Encryption" encrypt-xor)
82 (string :tag "XOR Cipher Value (seed value)")))))
85 ;; TODO: now, load gencrypt.el and if successful, modify the
86 ;; custom-type of encrypt-file-alist to add the gencrypt.el options
88 ;; (plist-get (symbol-plist 'encrypt-file-alist) 'custom-type)
91 (defcustom encrypt-gpg-path (executable-find "gpg")
92 "Path to the GPG program."
94 (file :tag "Location of the GPG executable")
95 (const :tag "GPG is not installed" nil))
98 (defvar encrypt-temp-prefix "encrypt"
99 "Prefix for temporary filenames")
101 (defun encrypt-find-model (filename)
102 "Given a filename, find a encrypt-file-alist entry"
103 (dolist (entry encrypt-file-alist)
104 (let ((match (nth 0 entry))
105 (model (nth 1 entry)))
106 (when (or (eq match filename)
107 (string-match match filename))
110 (defun encrypt-insert-file-contents (file &optional model)
111 "Decrypt FILE into the current buffer."
112 (interactive "fFile to insert: ")
113 (let* ((model (or model (encrypt-find-model file)))
114 (method (nth 0 model))
115 (cipher (nth 1 model))
116 (password-key (format "encrypt-password-%s-%s %s"
117 (symbol-name method) cipher file))
119 (password-read-and-add
120 (format "%s password for cipher %s? "
121 (symbol-name method) cipher)
123 (buffer-file-coding-system 'binary)
124 (coding-system-for-read 'binary)
127 ;; note we only insert-file-contents if the method is known to be valid
130 (insert-file-contents file)
131 (setq outdata (encrypt-gpg-decode-buffer passphrase cipher)))
132 ((eq method 'encrypt-xor)
133 (insert-file-contents file)
134 (setq outdata (encrypt-xor-decode-buffer passphrase cipher))))
138 (gnus-message 9 "%s was decrypted with %s (cipher %s)"
139 file (symbol-name method) cipher)
140 (delete-region (point-min) (point-max))
141 (goto-char (point-min))
143 ;; the decryption failed, alas
144 (password-cache-remove password-key)
145 (gnus-error 5 "%s was NOT decrypted with %s (cipher %s)"
146 file (symbol-name method) cipher))))
148 (defun encrypt-get-file-contents (file &optional model)
149 "Decrypt FILE and return the contents."
150 (interactive "fFile to decrypt: ")
152 (encrypt-insert-file-contents file model)
155 (defun encrypt-put-file-contents (file data &optional model)
156 "Encrypt the DATA to FILE, then continue normally."
159 (encrypt-write-file-contents file model)))
161 (defun encrypt-write-file-contents (file &optional model)
162 "Encrypt the current buffer to FILE, then continue normally."
163 (interactive "fFile to write: ")
164 (let* ((model (or model (encrypt-find-model file)))
165 (method (nth 0 model))
166 (cipher (nth 1 model))
167 (password-key (format "encrypt-password-%s-%s %s"
168 (symbol-name method) cipher file))
171 (format "%s password for cipher %s? "
172 (symbol-name method) cipher)
178 (setq outdata (encrypt-gpg-encode-buffer passphrase cipher)))
179 ((eq method 'encrypt-xor)
180 (setq outdata (encrypt-xor-encode-buffer passphrase cipher))))
184 (gnus-message 9 "%s was encrypted with %s (cipher %s)"
185 file (symbol-name method) cipher)
186 (delete-region (point-min) (point-max))
187 (goto-char (point-min))
189 ;; do not confirm overwrites
190 (write-file file nil))
191 ;; the decryption failed, alas
192 (password-cache-remove password-key)
193 (gnus-error 5 "%s was NOT encrypted with %s (cipher %s)"
194 file (symbol-name method) cipher))))
196 (defun encrypt-xor-encode-buffer (passphrase cipher)
197 (encrypt-xor-process-buffer passphrase cipher t))
199 (defun encrypt-xor-decode-buffer (passphrase cipher)
200 (encrypt-xor-process-buffer passphrase cipher nil))
202 (defun encrypt-xor-process-buffer (passphrase
205 "Given PASSPHRASE, xor-encode or decode the contents of the current buffer."
206 (let* ((bs (buffer-substring-no-properties (point-min) (point-max)))
207 ;; passphrase-sum is a simple additive checksum of the
208 ;; passphrase and the cipher
210 (when (stringp passphrase)
211 (apply '+ (append cipher passphrase nil))))
217 (dolist (x (append bs nil))
218 (setq new-list (cons (logxor x passphrase-sum) new-list)))
221 (insert (format "%d " x))))
223 (setq new-list (reverse (split-string bs)))
225 (setq x (string-to-int x))
226 (insert (format "%c" (logxor x passphrase-sum))))))
227 (buffer-substring-no-properties (point-min) (point-max)))))
229 (defun encrypt-gpg-encode-buffer (passphrase cipher)
230 (encrypt-gpg-process-buffer passphrase cipher t))
232 (defun encrypt-gpg-decode-buffer (passphrase cipher)
233 (encrypt-gpg-process-buffer passphrase cipher nil))
235 (defun encrypt-gpg-process-buffer (passphrase
238 "With PASSPHRASE, use GPG to encode or decode the current buffer."
239 (let* ((program encrypt-gpg-path)
240 (input (buffer-substring-no-properties (point-min) (point-max)))
241 (temp-maker (if (fboundp 'make-temp-file)
244 (temp-file (funcall temp-maker encrypt-temp-prefix))
245 (default-enable-multibyte-characters nil)
246 (args `("--cipher-algo" ,cipher
249 "--passphrase-fd" "0"
251 exit-status exit-data)
262 (insert passphrase "\n"))
265 (apply #'call-process-region (point-min) (point-max) program
266 t `(t ,temp-file) nil args))
267 (if (equal exit-status 0)
269 (buffer-substring-no-properties (point-min) (point-max)))
271 (when (file-exists-p temp-file)
272 (insert-file-contents temp-file))
273 (gnus-error 5 (format "%s exited abnormally: '%s' [%s]"
274 program exit-status (buffer-string)))))
275 (delete-file temp-file))
276 (gnus-error 5 "GPG is not installed."))
280 ;;; encrypt.el ends here