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 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"))
37 (defgroup encrypt '((password-cache custom-variable)
38 (password-cache-expiry custom-variable))
39 "File encryption configuration.")
41 (defcustom encrypt-file-alist nil
42 "List of file names or regexes matched with encryptions.
47 (encrypt-xor \"Semi-Secret\")))"
50 (list :tag "Encryption entry"
51 (radio :tag "What to encrypt"
52 (file :tag "Filename")
53 (regexp :tag "Regular expression match"))
54 (radio :tag "How to encrypt it"
57 (const :tag "GPG Program" gpg)
58 (radio :tag "Choose a cipher"
59 (const :tag "3DES Encryption" "3DES")
60 (const :tag "CAST5 Encryption" "CAST5")
61 (const :tag "Blowfish Encryption" "BLOWFISH")
62 (const :tag "AES Encryption" "AES")
63 (const :tag "AES192 Encryption" "AES192")
64 (const :tag "AES256 Encryption" "AES256")
65 (const :tag "Twofish Encryption" "TWOFISH")
66 (string :tag "Cipher Name")))
68 :tag "Built-in simple XOR"
69 (const :tag "XOR Encryption" encrypt-xor)
70 (string :tag "XOR Cipher Value (seed value)")))))
73 ;; TODO: now, load gencrypt.el and if successful, modify the
74 ;; custom-type of encrypt-file-alist to add the gencrypt.el options
76 ;; (plist-get (symbol-plist 'encrypt-file-alist) 'custom-type)
79 (defcustom encrypt-gpg-path (executable-find "gpg")
80 "Path to the GPG program."
82 (file :tag "Location of the GPG executable")
83 (const :tag "GPG is not installed" nil))
86 (defvar encrypt-temp-prefix "encrypt"
87 "Prefix for temporary filenames")
90 (defun encrypt-find-model (filename)
91 "Given a filename, find a encrypt-file-alist entry"
92 (dolist (entry encrypt-file-alist)
93 (let ((match (nth 0 entry))
94 (model (nth 1 entry)))
95 (when (or (eq match filename)
96 (string-match match filename))
100 (defun encrypt-insert-file-contents (file &optional model)
101 "Decrypt FILE into the current buffer."
102 (interactive "fFile to insert: ")
103 (let* ((model (or model (encrypt-find-model file)))
104 (method (nth 0 model))
105 (cipher (nth 1 model))
106 (password-key (format "encrypt-password-%s-%s %s"
107 (symbol-name method) cipher file))
109 (password-read-and-add
110 (format "%s password for cipher %s? "
111 (symbol-name method) cipher)
113 (buffer-file-coding-system 'binary)
114 (coding-system-for-read 'binary)
117 ;; note we only insert-file-contents if the method is known to be valid
120 (insert-file-contents file)
121 (setq outdata (encrypt-gpg-decode-buffer passphrase cipher)))
122 ((eq method 'encrypt-xor)
123 (insert-file-contents file)
124 (setq outdata (encrypt-xor-decode-buffer passphrase cipher))))
128 (gnus-message 9 "%s was decrypted with %s (cipher %s)"
129 file (symbol-name method) cipher)
130 (delete-region (point-min) (point-max))
131 (goto-char (point-min))
133 ;; the decryption failed, alas
134 (password-cache-remove password-key)
135 (gnus-error 5 "%s was NOT decrypted with %s (cipher %s)"
136 file (symbol-name method) cipher))))
138 (defun encrypt-get-file-contents (file &optional model)
139 "Decrypt FILE and return the contents."
140 (interactive "fFile to decrypt: ")
142 (encrypt-insert-file-contents file model)
145 (defun encrypt-put-file-contents (file data &optional model)
146 "Encrypt the DATA to FILE, then continue normally."
149 (encrypt-write-file-contents file model)))
151 (defun encrypt-write-file-contents (file &optional model)
152 "Encrypt the current buffer to FILE, then continue normally."
153 (interactive "fFile to write: ")
154 (let* ((model (or model (encrypt-find-model file)))
155 (method (nth 0 model))
156 (cipher (nth 1 model))
157 (password-key (format "encrypt-password-%s-%s %s"
158 (symbol-name method) cipher file))
161 (format "%s password for cipher %s? "
162 (symbol-name method) cipher)
168 (setq outdata (encrypt-gpg-encode-buffer passphrase cipher)))
169 ((eq method 'encrypt-xor)
170 (setq outdata (encrypt-xor-encode-buffer passphrase cipher))))
174 (gnus-message 9 "%s was encrypted with %s (cipher %s)"
175 file (symbol-name method) cipher)
176 (delete-region (point-min) (point-max))
177 (goto-char (point-min))
179 ;; do not confirm overwrites
180 (write-file file nil))
181 ;; the decryption failed, alas
182 (password-cache-remove password-key)
183 (gnus-error 5 "%s was NOT encrypted with %s (cipher %s)"
184 file (symbol-name method) cipher))))
186 (defun encrypt-xor-encode-buffer (passphrase cipher)
187 (encrypt-xor-process-buffer passphrase cipher t))
189 (defun encrypt-xor-decode-buffer (passphrase cipher)
190 (encrypt-xor-process-buffer passphrase cipher nil))
192 (defun encrypt-xor-process-buffer (passphrase
195 "Given PASSPHRASE, xor-encode or decode the contents of the current buffer."
196 (let* ((bs (buffer-substring-no-properties (point-min) (point-max)))
197 ;; passphrase-sum is a simple additive checksum of the
198 ;; passphrase and the cipher
200 (when (stringp passphrase)
201 (apply '+ (append cipher passphrase nil))))
207 (dolist (x (append bs nil))
208 (setq new-list (cons (logxor x passphrase-sum) new-list)))
211 (insert (format "%d " x))))
213 (setq new-list (reverse (split-string bs)))
215 (setq x (string-to-int x))
216 (insert (format "%c" (logxor x passphrase-sum))))))
217 (buffer-substring-no-properties (point-min) (point-max)))))
219 (defun encrypt-gpg-encode-buffer (passphrase cipher)
220 (encrypt-gpg-process-buffer passphrase cipher t))
222 (defun encrypt-gpg-decode-buffer (passphrase cipher)
223 (encrypt-gpg-process-buffer passphrase cipher nil))
225 (defun encrypt-gpg-process-buffer (passphrase
228 "With PASSPHRASE, use GPG to encode or decode the current buffer."
229 (let* ((program encrypt-gpg-path)
230 (input (buffer-substring-no-properties (point-min) (point-max)))
231 (temp-maker (if (fboundp 'make-temp-file)
234 (temp-file (funcall temp-maker encrypt-temp-prefix))
235 (default-enable-multibyte-characters nil)
236 (args `("--cipher-algo" ,cipher
239 "--passphrase-fd" "0"
241 exit-status exit-data)
252 (insert passphrase "\n"))
255 (apply #'call-process-region (point-min) (point-max) program
256 t `(t ,temp-file) nil args))
257 (if (equal exit-status 0)
259 (buffer-substring-no-properties (point-min) (point-max)))
261 (when (file-exists-p temp-file)
262 (insert-file-contents temp-file))
263 (gnus-error 5 (format "%s exited abnormally: '%s' [%s]"
264 program exit-status (buffer-string)))))
265 (delete-file temp-file))
266 (gnus-error 5 "GPG is not installed."))
270 ;;; encrypt.el ends here
272 ;; arch-tag: d907e4f1-71b5-42b1-a180-fc7b84ff0648