1 ;;; gnus-encrypt.el --- file encryption routines for Gnus, OBSOLETE (use encrypt.el instead)
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 under Gnus. Page breaks are
28 ;;; used for 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 (defvar password-cache-expiry))
44 (defgroup gnus-encrypt nil
45 "Gnus encryption configuration.")
47 (defcustom gnus-encrypt-password-cache-expiry 200
48 "Gnus encryption password timeout.
49 When set, directly sets password-cache-expiry"
52 :set (lambda (symbol value)
54 (setq password-cache-expiry value)))
56 (defcustom gnus-encrypt-file-alist nil
57 "List of file names or regexes matched with encryptions.
62 (gnus-encrypt-xor \"Semi-Secret\")))"
65 (list :tag "Encryption entry"
66 (radio :tag "What to encrypt"
67 (file :tag "Filename")
68 (regexp :tag "Regular expression match"))
69 (radio :tag "How to encrypt it"
72 (const :tag "GPG Program" gpg)
73 (radio :tag "Choose a cipher"
74 (const :tag "3DES Encryption" "3DES")
75 (const :tag "CAST5 Encryption" "CAST5")
76 (const :tag "Blowfish Encryption" "BLOWFISH")
77 (const :tag "AES Encryption" "AES")
78 (const :tag "AES192 Encryption" "AES192")
79 (const :tag "AES256 Encryption" "AES256")
80 (const :tag "Twofish Encryption" "TWOFISH")
81 (string :tag "Cipher Name")))
83 :tag "Built-in simple XOR"
84 (const :tag "XOR Encryption" gnus-encrypt-xor)
85 (string :tag "XOR Cipher Value (seed value)")))))
88 ;; TODO: now, load gencrypt.el and if successful, modify the
89 ;; custom-type of gnus-encrypt-file-alist to add the gencrypt.el options
91 ;; (plist-get (symbol-plist 'gnus-encrypt-file-alist) 'custom-type)
94 (defcustom gnus-encrypt-gpg-path (executable-find "gpg")
95 "Path to the GPG program."
97 (file :tag "Location of the GPG executable")
98 (const :tag "GPG is not installed" nil))
101 (defvar gnus-encrypt-temp-prefix "gnus-encrypt"
102 "Prefix for temporary filenames")
104 (defun gnus-encrypt-find-model (filename)
105 "Given a filename, find a gnus-encrypt-file-alist entry"
106 (dolist (entry gnus-encrypt-file-alist)
107 (let ((match (nth 0 entry))
108 (model (nth 1 entry)))
109 (when (or (eq match filename)
110 (string-match match filename))
113 (defun gnus-encrypt-insert-file-contents (file &optional model)
114 "Decrypt FILE into the current buffer."
115 (interactive "fFile to insert: ")
116 (let* ((model (or model (gnus-encrypt-find-model file)))
117 (method (nth 0 model))
118 (cipher (nth 1 model))
119 (password-key (format "gnus-encrypt-password-%s-%s %s"
120 (symbol-name method) cipher file))
122 (password-read-and-add
123 (format "%s password for cipher %s? "
124 (symbol-name method) cipher)
126 (buffer-file-coding-system 'binary)
127 (coding-system-for-read 'binary)
130 ;; note we only insert-file-contents if the method is known to be valid
133 (insert-file-contents file)
134 (setq outdata (gnus-encrypt-gpg-decode-buffer passphrase cipher)))
135 ((eq method 'gnus-encrypt-xor)
136 (insert-file-contents file)
137 (setq outdata (gnus-encrypt-xor-decode-buffer passphrase cipher))))
141 (gnus-message 9 "%s was decrypted with %s (cipher %s)"
142 file (symbol-name method) cipher)
143 (delete-region (point-min) (point-max))
144 (goto-char (point-min))
146 ;; the decryption failed, alas
147 (password-cache-remove password-key)
148 (gnus-error 5 "%s was NOT decrypted with %s (cipher %s)"
149 file (symbol-name method) cipher))))
151 (defun gnus-encrypt-get-file-contents (file &optional model)
152 "Decrypt FILE and return the contents."
153 (interactive "fFile to decrypt: ")
155 (gnus-encrypt-insert-file-contents file model)
158 (defun gnus-encrypt-put-file-contents (file data &optional model)
159 "Encrypt the DATA to FILE, then continue normally."
162 (gnus-encrypt-write-file-contents file model)))
164 (defun gnus-encrypt-write-file-contents (file &optional model)
165 "Encrypt the current buffer to FILE, then continue normally."
166 (interactive "fFile to write: ")
167 (let* ((model (or model (gnus-encrypt-find-model file)))
168 (method (nth 0 model))
169 (cipher (nth 1 model))
170 (password-key (format "gnus-encrypt-password-%s-%s %s"
171 (symbol-name method) cipher file))
174 (format "%s password for cipher %s? "
175 (symbol-name method) cipher)
181 (setq outdata (gnus-encrypt-gpg-encode-buffer passphrase cipher)))
182 ((eq method 'gnus-encrypt-xor)
183 (setq outdata (gnus-encrypt-xor-encode-buffer passphrase cipher))))
187 (gnus-message 9 "%s was encrypted with %s (cipher %s)"
188 file (symbol-name method) cipher)
189 (delete-region (point-min) (point-max))
190 (goto-char (point-min))
192 ;; do not confirm overwrites
193 (write-file file nil))
194 ;; the decryption failed, alas
195 (password-cache-remove password-key)
196 (gnus-error 5 "%s was NOT encrypted with %s (cipher %s)"
197 file (symbol-name method) cipher))))
199 (defun gnus-encrypt-xor-encode-buffer (passphrase cipher)
200 (gnus-encrypt-xor-process-buffer passphrase cipher t))
202 (defun gnus-encrypt-xor-decode-buffer (passphrase cipher)
203 (gnus-encrypt-xor-process-buffer passphrase cipher nil))
205 (defun gnus-encrypt-xor-process-buffer (passphrase
208 "Given PASSPHRASE, xor-encode or decode the contents of the current buffer."
209 (let* ((bs (buffer-substring-no-properties (point-min) (point-max)))
210 ;; passphrase-sum is a simple additive checksum of the
211 ;; passphrase and the cipher
213 (when (stringp passphrase)
214 (apply '+ (append cipher passphrase nil))))
220 (dolist (x (append bs nil))
221 (setq new-list (cons (logxor x passphrase-sum) new-list)))
224 (insert (format "%d " x))))
226 (setq new-list (reverse (split-string bs)))
228 (setq x (string-to-int x))
229 (insert (format "%c" (logxor x passphrase-sum))))))
230 (buffer-substring-no-properties (point-min) (point-max)))))
232 (defun gnus-encrypt-gpg-encode-buffer (passphrase cipher)
233 (gnus-encrypt-gpg-process-buffer passphrase cipher t))
235 (defun gnus-encrypt-gpg-decode-buffer (passphrase cipher)
236 (gnus-encrypt-gpg-process-buffer passphrase cipher nil))
238 (defun gnus-encrypt-gpg-process-buffer (passphrase
241 "With PASSPHRASE, use GPG to encode or decode the current buffer."
242 (let* ((program gnus-encrypt-gpg-path)
243 (input (buffer-substring-no-properties (point-min) (point-max)))
244 (temp-maker (if (fboundp 'make-temp-file)
247 (temp-file (funcall temp-maker gnus-encrypt-temp-prefix))
248 (default-enable-multibyte-characters nil)
249 (args `("--cipher-algo" ,cipher
252 "--passphrase-fd" "0"
254 exit-status exit-data)
265 (insert passphrase "\n"))
268 (apply #'call-process-region (point-min) (point-max) program
269 t `(t ,temp-file) nil args))
270 (if (equal exit-status 0)
272 (buffer-substring-no-properties (point-min) (point-max)))
274 (when (file-exists-p temp-file)
275 (insert-file-contents temp-file))
276 (gnus-error 5 (format "%s exited abnormally: '%s' [%s]"
277 program exit-status (buffer-string)))))
278 (delete-file temp-file))
279 (gnus-error 5 "GPG is not installed."))
282 (provide 'gnus-encrypt)
283 ;;; gnus-encrypt.el ends here
285 ;; (defcustom netrc-encrypting-method nil
286 ;; "Decoding method used for the netrc file.
287 ;; Use the OpenSSL symmetric ciphers here. Leave nil for no
288 ;; decoding. Encrypt the file with netrc-encrypt, but make sure you
289 ;; have set netrc-encrypting-method to a non-nil value."
291 ;; (const :tag "DES-3" "des3")
292 ;; (const :tag "IDEA" "idea")
293 ;; (const :tag "RC4" "rc4")
294 ;; (string :tag "Explicit cipher name")
295 ;; (const :tag "None" nil))
298 ;; (defcustom netrc-openssl-path (executable-find "openssl")
299 ;; "File path of the OpenSSL shell."
300 ;; :type '(choice (file :tag "Location of openssl")
301 ;; (const :tag "openssl is not installed" nil))
304 ;; (defun netrc-encrypt (plain-file encrypted-file)
305 ;; (interactive "fPlain File: \nFEncrypted File: ")
306 ;; "Encrypt FILE to ENCRYPTED-FILE with netrc-encrypting-method cipher."
307 ;; (when (and (file-exists-p plain-file)
308 ;; (stringp encrypted-file)
309 ;; netrc-encrypting-method
310 ;; netrc-openssl-path)
311 ;; (let ((buffer-file-coding-system 'binary)
312 ;; (coding-system-for-read 'binary)
313 ;; (coding-system-for-write 'binary)
316 ;; (format "OpenSSL Password for cipher %s? "
317 ;; netrc-encrypting-method)
318 ;; (format "netrc-openssl-password-%s"
319 ;; netrc-encrypting-method))))
322 ;; (insert-file-contents plain-file)
323 ;; (setenv "NETRC_OPENSSL_PASSWORD" password)
324 ;; (shell-command-on-region
327 ;; (format "%s %s -pass env:NETRC_OPENSSL_PASSWORD -e"
328 ;; netrc-openssl-path
329 ;; netrc-encrypting-method)
332 ;; (write-file encrypted-file t))))))
334 ;; (if (and netrc-encrypting-method
335 ;; netrc-openssl-path)
336 ;; (let ((buffer-file-coding-system 'binary)
337 ;; (coding-system-for-read 'binary)
338 ;; (coding-system-for-write 'binary)
341 ;; (format "OpenSSL Password for cipher %s? "
342 ;; netrc-encrypting-method)
343 ;; (format "netrc-openssl-password-%s"
344 ;; netrc-encrypting-method))))
346 ;; (insert-file-contents file)
347 ;; (setenv "NETRC_OPENSSL_PASSWORD" password)
348 ;; (shell-command-on-region
351 ;; (format "%s %s -pass env:NETRC_OPENSSL_PASSWORD -d"
352 ;; netrc-openssl-path
353 ;; netrc-encrypting-method)